view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/GUI.pm  view on Meta::CPAN

  my ($class) = @_;
  _chart_style_parse();
  $class =~ s/:/_/g;
  Gtk2::Rc->parse_string
      ("class \"$class\" style:gtk \"Chart_style\"");
}
sub chart_style_widget {
  my ($name) = @_;
  _chart_style_parse();
  Gtk2::Rc->parse_string
      ("widget \"*.$name\" style:application \"Chart_style\"");
}
use constant::defer _chart_style_parse => sub {
  Gtk2::Rc->parse_string (<<'HERE');
style "Chart_style" {
  # white on black
  fg[ACTIVE]        = { 1.0, 1.0, 1.0 }
  fg[NORMAL]        = { 1.0, 1.0, 1.0 }
  fg[PRELIGHT]      = { 1.0, 1.0, 1.0 }
  fg[SELECTED]      = { 1.0, 1.0, 1.0 }
  fg[INSENSITIVE]   = { 1.0, 1.0, 1.0 }
  text[ACTIVE]      = { 1.0, 1.0, 1.0 }
  text[NORMAL]      = { 1.0, 1.0, 1.0 }
  text[PRELIGHT]    = { 1.0, 1.0, 1.0 }
  text[SELECTED]    = { 1.0, 1.0, 1.0 }
  text[INSENSITIVE] = { 1.0, 1.0, 1.0 }

  bg[ACTIVE]        = { 0, 0, 0 }
  bg[NORMAL]        = { 0, 0, 0 }
  bg[PRELIGHT]      = { 0, 0, 0 }
  bg[SELECTED]      = { 0, 0, 0 }
  bg[INSENSITIVE]   = { 0, 0, 0 }
  base[ACTIVE]      = { 0, 0, 0 }
  base[NORMAL]      = { 0, 0, 0 }
  base[PRELIGHT]    = { 0, 0, 0 }
  base[SELECTED]    = { 0, 0, 0 }
  base[INSENSITIVE] = { 0, 0, 0 }
}
HERE
  return; # nothing
};


#------------------------------------------------------------------------------

# $uri is either a string or a URI object
sub browser_open {
  my ($uri, $parent_widget) = @_;
  $uri = "$uri";  # stringize URI object
  ### browser_open(): $uri

  if (Gtk2->can('show_uri')) { # new in Gtk 2.14
    my $screen = $parent_widget && $parent_widget->get_screen;
    if (eval { Gtk2::show_uri ($screen, $uri); 1 }) {
      return;
    }
    # possible Glib::Error "operation not supported" on http urls
    ### show_uri() error: $@
  }
  {
    # Debian "sensible-browser" program which looks at $BROWSER and various
    # other things.
    my @command = ('sensible-browser', $uri);
    if (_spawn (@command)) { return }
  }
  {
    # The quoting, or lack thereof, expected of the url in openURL is in
    # mozilla XRemoteService.cpp.  It looks for ( ) delims, then the last
    # "," is the last arg to take off new-window, new-tab, noraise, etc.
    my @command = ('mozilla', '-remote', "openURL($uri,new-window)");
    ### run: @command
    if (system (@command) == 0) {
      return;
    }
    ### run status: $?
    ### error: "$!"
  }
  {
    my @command = ('mozilla', $uri);
    if (_spawn (@command)) { return }
  }
  warn "Cannot run browser: none of show_uri, sensible-browser or mozilla work";
}
sub _spawn {
  my @command = @_;
  ### spawn(): @command
  require Proc::SyncExec;
  my $pid = Proc::SyncExec::sync_exec (\&_spawn_detach, @command);
  if (! defined $pid) {
    ### cannot run: $!
    return 0;
  }
  if (waitpid ($pid, 0) != $pid) {
    warn "Error waiting spawned $pid: $!\n";
  }
  return 1;
}
sub _spawn_detach {
  if (my $pid = Proc::SyncExec::fork_retry()) {
    POSIX::_exit (0); # parent
  } else {
    ## no critic (RequireCheckingReturnValueOfEval)
    eval { POSIX::setsid() };
    return 1; # ok, child continues
  }
}

#-----------------------------------------------------------------------------

sub color_object {
  my ($widget, $colour_str) = @_;
  if (defined $colour_str) {
    require App::Chart::Gtk2::Ex::GdkColorAlloc;
    return ($colour_str,
            $widget->{'color'}->{$colour_str}
            ||= App::Chart::Gtk2::Ex::GdkColorAlloc->new (widget => $widget,
                                              color  => $colour_str));
  } else {
    return ('fg', $widget->style->fg($widget->state));
  }
}

sub gc_for_colour {
  my ($widget, $colour_str) = @_;
  ($colour_str, my $color_obj) = color_object ($widget, $colour_str);
  return ($widget->{'gc_solid'}->{$colour_str} ||= do {
    require App::Chart::Gtk2::Ex::GtkGCBits;
    App::Chart::Gtk2::Ex::GtkGCBits->get_for_widget