Glib-Object-Introspection

 view release on metacpan or  search on metacpan

bin/perli11ndoc  view on Meta::CPAN

  my $display = $result_view->get_display ();
  $result_view->{__hand_cursor} = Gtk3::Gdk::Cursor->new_from_name ($display, 'pointer');
  $result_view->{__regular_cursor} = Gtk3::Gdk::Cursor->new_from_name ($display, 'text');

  my $hovering_over_link = sub {
    my ($event) = @_;
    my ($x, $y) = $result_view->window_to_buffer_coords ('widget', $event->x, $event->y);
    my $iter = $result_view->get_iter_at_location ($x, $y);
    if (!$iter) {
      return;
    }
    my $tags = $iter->get_tags ();
    foreach my $tag (@$tags) {
      if (defined $tag->{__target}) {
        return $tag;
      }
    }
    return;
  };

  $result_view->{__hovering} = FALSE;
  $result_view->signal_connect (motion_notify_event => sub {
    my ($result_view, $event) = @_;
    my $hovering = defined $hovering_over_link->($event);
    if ($result_view->{__hovering} != $hovering) {
      $result_view->{__hovering} = $hovering;
      $result_view->get_window ('text')->set_cursor (
        $hovering ? $result_view->{__hand_cursor} : $result_view->{__regular_cursor});
    }
    return Gtk3::EVENT_PROPAGATE ();
  });

  my $handle_button = sub {
    my ($event, $cb) = @_;
    if ($event->button == Gtk3::Gdk::BUTTON_PRIMARY ()) {
      my $tag = $hovering_over_link->($event);
      if (defined $tag) {
        if (defined $cb) {
          $cb->($tag);
        }
        return Gtk3::EVENT_STOP ();
      }
    }
    return Gtk3::EVENT_PROPAGATE ();
  };
  $result_view->signal_connect (button_press_event => sub {
    my ($result_view, $event) = @_;
    return $handle_button->($event);
  });
  $result_view->signal_connect (button_release_event => sub {
    my ($result_view, $event) = @_;
    return $handle_button->($event, sub {
      $self->go_to_path ($_[0]->{__target});
    });
  });

  $self->{result_buffer} = $result_buffer;
  $self->{result_view} = $result_view;
}

sub update_gir_view {
  my ($self) = @_;

  $self->{suppress_gir_view_selection_changes} = TRUE;

  $self->{gir_model}->clear;
  $self->{search_entry}->set_text ('');
  $self->{path_bar}->clear;

  my $inserter = sub {
    my ($iter, $text, $path, $is_cat, $is_vis) = @_;
    $self->{gir_model}->set ($iter,
                             GIR_VIEW_COL_TEXT, $text,
                             GIR_VIEW_COL_PATH, $path,
                             GIR_VIEW_COL_IS_CATEGORY, $is_cat,
                             GIR_VIEW_COL_IS_VISIBLE, $is_vis);
  };

  my $results = $self->{parser}->enumerate_namespace (TRUE);
  foreach my $result (@$results) {
    my $heading = $result->[0];
    my $entries = $result->[1];

    my $heading_iter = $self->{gir_model}->append;
    $inserter->($heading_iter, $heading, undef, TRUE, TRUE);

    next unless defined $entries;
    foreach my $entry (@$entries) {
      my $iter = $self->{gir_model}->append ($heading_iter);
      $inserter->($iter, $entry->{name}, $entry->{path}, FALSE, TRUE);

      next unless defined $entry->{sub_results};
      foreach my $sub_result (@{$entry->{sub_results}}) {
        my $sub_heading = $sub_result->[0];
        my $sub_entries = $sub_result->[1];

        my $sub_heading_iter = $self->{gir_model}->append ($iter);
        $inserter->($sub_heading_iter, $sub_heading, undef, TRUE, TRUE);

        next unless defined $sub_entries;
        foreach my $sub_entry (@$sub_entries) {
          my $sub_iter = $self->{gir_model}->append ($sub_heading_iter);
          $inserter->($sub_iter, $sub_entry->{name}, $sub_entry->{path}, FALSE, TRUE);
        }
      }
    }
  }

  $self->{suppress_gir_view_selection_changes} = FALSE;

  $self->display_results ($self->{parser}->format_namespace);
}

sub go_to_selection {
  my ($self) = @_;
  my $selection = $self->{gir_view}->get_selection;
  my ($model, $iter) = $selection->get_selected;
  if (!defined $iter) {
    $self->display_results ($self->{parser}->format_namespace);
  } elsif (!$model->get ($iter, GIR_VIEW_COL_IS_CATEGORY)) {
    my $path = $model->get ($iter, GIR_VIEW_COL_PATH);
    $self->go_to_path ($path);
  }
}

sub go_to_path {
  my ($self, $path) = @_;
  my $name = $self->{parser}->format_node_name_by_path ($path);
  $self->{path_bar}->append ($name, $path); # indirectly calls update_results
}

sub update_results {
  my ($self, $path) = @_;
  $self->display_results ($self->{parser}->format_node_by_path ($path));

  # Show and select the correponding tree entry.
  $self->{gir_model}->foreach (sub {
    my ($model, $tree_path, $iter) = @_;
    my $this_path = $model->get ($iter, GIR_VIEW_COL_PATH);
    if (defined $this_path && $this_path eq $path) {
      $self->{gir_view}->expand_to_path ($tree_path);
      $self->{gir_view}->scroll_to_cell ($tree_path, undef, FALSE, 0.0, 0.0);
      $self->{suppress_gir_view_selection_changes} = TRUE;
      {
        $self->{gir_view}->get_selection ()->select_path ($tree_path);
      }
      $self->{suppress_gir_view_selection_changes} = FALSE;
      return TRUE; # stop
    }
    return FALSE; # continue
  });
}

sub quit {
  my ($self) = @_;
  Gtk3::main_quit ();
}

package PathBar;

# The BEGIN { eval } dance is to support not loading Gtk3 in text mode.
BEGIN { eval 'use Glib::Object::Subclass qw/Gtk3::Box/;' }

sub TRUE () {1}
sub FALSE () {0}

sub INIT_INSTANCE {
  my ($self) = @_;

  my $back_button = Gtk3::Button->new;
  $back_button->set_image (
    Gtk3::Image->new_from_icon_name ('go-previous-symbolic', 'button'));
  $back_button->set_sensitive (FALSE);
  $back_button->signal_connect (clicked => sub { $self->{path_label}->go_back });

  my $forward_button = Gtk3::Button->new;
  $forward_button->set_image (
    Gtk3::Image->new_from_icon_name ('go-next-symbolic', 'button'));
  $forward_button->set_sensitive (FALSE);
  $forward_button->signal_connect (clicked => sub { $self->{path_label}->go_forward });

  my $nav_box = Gtk3::Box->new ('horizontal', 2);
  $nav_box->pack_start ($back_button, FALSE, FALSE, 0);
  $nav_box->pack_start ($forward_button, FALSE, FALSE, 0);
  $nav_box->get_style_context->add_class ('linked');

  my $path_label = PathLabel->new;
  $path_label->set_update_func (sub {
    my ($name, $path) = @_;
    $self->update_buttons;
    if (defined $self->{update_func}) {
      $self->{update_func}->($name, $path);
    }
  });

  $self->pack_start ($nav_box, FALSE, FALSE, 0);
  $self->pack_start (Gtk3::VSeparator->new, FALSE, FALSE, 0);
  $self->pack_start ($path_label, TRUE, TRUE, 0);
  $self->set (margin => 2);

  $self->{back_button} = $back_button;
  $self->{forward_button} = $forward_button;
  $self->{path_label} = $path_label;

  return $self;
}

sub clear {
  my ($self) = @_;
  $self->{path_label}->clear ();
  $self->update_buttons ();
}

sub append {
  my ($self, $name, $path) = @_;
  $self->{path_label}->append ($name, $path);
}

sub set_update_func {
  my ($self, $func) = @_;
  $self->{update_func} = $func;
}

sub update_buttons {
  my ($self) = @_;
  $self->{back_button}->set_sensitive ($self->{path_label}->can_go_back);
  $self->{forward_button}->set_sensitive ($self->{path_label}->can_go_forward);
}

package PathLabel;

# The BEGIN { eval } dance is to support not loading Gtk3 in text mode.
BEGIN { eval 'use Glib::Object::Subclass qw/Gtk3::Label/;' }

sub TRUE () {1}
sub FALSE () {0}

sub INIT_INSTANCE {
  my ($self) = @_;

  $self->signal_connect (activate_link => sub {
    my (undef, $index) = @_;
    $self->{current_child} = $index;
    $self->update;
    return Gtk3::EVENT_STOP ();
  });
  $self->set_track_visited_links (FALSE);

  $self->clear ();
}

sub clear {
  my ($self) = @_;
  $self->{children} = [];
  $self->{current_child} = undef;
  $self->{natural_width} = 0;
  $self->update ();
}

sub append {
  my ($self, $name, $path) = @_;
  my $cur = $self->{current_child};
  # If the new entry is equal to the current entry, do nothing.
  if (defined $cur) {
    my $child = $self->{children}->[$cur];
    if ($child->{name} eq $name && $child->{path} eq $path) {
      return;
    }
  }
  # If the current entry is not the last entry, remove all entries after the
  # current one before appending the new entry.
  if (defined $cur && $cur < $#{$self->{children}}) {
    splice @{$self->{children}}, $cur+1;
  }
  push @{$self->{children}}, {name => $name, path => $path};
  $self->{current_child} = $#{$self->{children}};
  $self->update;
}

sub can_go_back {
  my ($self) = @_;
  return defined $self->{current_child} && $self->{current_child} > 0;
}

sub can_go_forward {
  my ($self) = @_;
  return defined $self->{current_child} && $self->{current_child} < $#{$self->{children}};
}

sub go_back {
  my ($self) = @_;
  return unless $self->{current_child} > 0;
  $self->{current_child}--;
  $self->update;
}

sub go_forward {
  my ($self) = @_;
  return unless $self->{current_child} < $#{$self->{children}};
  $self->{current_child}++;
  $self->update;
}

sub set_update_func {
  my ($self, $func) = @_;
  $self->{update_func} = $func;
}

sub update {
  my ($self) = @_;
  $self->set_markup ($self->_format_children);
  if (defined $self->{current_child} && defined $self->{update_func}) {
    my $child = $self->{children}->[$self->{current_child}];
    $self->{update_func}->($child->{name}, $child->{path});
  }
}

sub GET_PREFERRED_WIDTH {
  #say 'GET_PREFERRED_WIDTH';
  my ($self) = @_;
  (undef, $self->{natural_width}) = $self->SUPER::GET_PREFERRED_WIDTH;
  return (0, 0);
}

sub SIZE_ALLOCATE {
  #say 'SIZE_ALLOCATE';
  my ($self, $allocation) = @_;
  if ($self->{natural_width} > $allocation->{width}) {
    my @selected = ($self->{current_child});
    while (1) {
      my @candidates = @selected;
      if ($selected[0] > 0) {
        unshift @candidates, $selected[0]-1;
      }
      if ($selected[-1] < $#{$self->{children}}) {
        push @candidates, $selected[-1]+1;
      }
      $self->set_markup ($self->_format_children (@candidates));
      my ($ink_rect, $logical_rect) = $self->get_layout->get_extents;
      my $text_width = $logical_rect->{width}/Pango::SCALE ();
      if ($text_width > $allocation->{width}) {
        last;
      } else {
        @selected = @candidates;
      }
    }
    $self->set_markup ($self->_format_children (@selected));
  }
  $self->SUPER::SIZE_ALLOCATE ($allocation);
}

 # Use undef as an indicator for left-out children.
sub _add_omission_markers {
  my ($self, @indices) = @_;
  if (!@indices) {
    return @indices;
  }
  if ($indices[0] > 0) {
    unshift @indices, undef;
  }
  if ($indices[-1] < $#{$self->{children}}) {
    push @indices, undef;
  }
  return @indices;
}

sub _format_child {
  my ($self, $index) = @_;
  return '…' unless defined $index;



( run in 0.558 second using v1.01-cache-2.11-cpan-e1769b4cff6 )