view release on metacpan or  search on metacpan

lib/Gtk2/Ex/TextView/FollowAppend.pm  view on Meta::CPAN

use Glib::Object::Subclass
  'Gtk2::TextView',
  signals => { size_allocate => \&_do_size_allocate,
               # notify        => \&_do_notify,
               destroy       => \&_do_destroy,
             };

sub new_with_buffer {
  my ($class, $textbuf) = @_;
  return $class->Glib::Object::new (buffer => $textbuf);
}

# "notify" is done as a connect to self rather than a class handler.
# A long-standing glib bug causes a $self->signal_chain_from_overridden to
# go to the wrong handler, when a notify is invoked from under another
# handler, or something like that.  Very annoying.
sub INIT_INSTANCE {
  my ($self) = @_;
  $self->signal_connect (notify => \&_do_notify);
}

# 'destroy' class closure
sub _do_destroy {
  my ($self) = @_;
  ### FollowAppend _do_destroy(): "$self"

  # The GtkObjectFlags GTK_IN_DESTRUCTION might do this, if it was exposed
  # at the perl level.  Except gtk_object_dispose() looks like the flag
  # might be set solely while 'destroy' runs, but any notifies during
  # finalize should suppress get_buffer() below too.  Except can finalize
  # emit notify anyway?
  #
  $self->{'destroyed'} = 1;

  $self->signal_chain_from_overridden ();
}

# 'notify' class closure
sub _do_notify {
  my ($self, $pspec) = @_;
  ### FollowAppend _do_notify(): $pspec->get_name

  # my $invocation_hint = $self->signal_get_invocation_hint;
  # require Data::Dumper;
  # print Data::Dumper->Indent(1)->Dump([$invocation_hint],
  #                                     ['invocation_hint']);

#  $self->signal_chain_from_overridden ($pspec);

  # After 'destroy' runs it's important not to call ->get_buffer() since
  # that func creates a new TextBuffer in place of what
  # gtk_text_view_destroy() just destroyed and set to NULL.  If a textbuf is
  # re-created like that it leads to a fatal error in
  # gtk_text_view_finalize().
  #
  if (! $self->{'destroyed'} && $pspec->get_name eq 'buffer') {
    require Glib::Ex::SignalIds;
    require Scalar::Util;

    my $textbuf = $self->get_buffer;
    Scalar::Util::weaken (my $weak_self = $self);
    my $ref_weak_self = \$weak_self;

    $self->{'textbuf_ids'} = $textbuf && Glib::Ex::SignalIds->new
      ($textbuf,
       $textbuf->signal_connect_after ('insert-text',
                                       \&_do_textbuf_insert,
                                       $ref_weak_self),
       $textbuf->signal_connect_after ('insert-pixbuf',
                                       \&_do_textbuf_insert_pixbuf_or_anchor,
                                       $ref_weak_self),
       $textbuf->signal_connect_after ('insert-child-anchor',
                                       \&_do_textbuf_insert_pixbuf_or_anchor,
                                       $ref_weak_self));
  }
}

# 'size-allocate' class closure
sub _do_size_allocate {
  my ($self, $alloc) = @_;
  ### FollowAppend size_allocate: $alloc->x.",".$alloc->y." ".$alloc->width."x".$alloc->height

  my $want_follow = _want_follow ($self);
  ### $want_follow

  $self->signal_chain_from_overridden ($alloc);

  if ($want_follow) {
    ### _do_size_allocate() scroll_to_mark
    $self->scroll_to_mark ($self->get_buffer->get_insert, 0, 0, 0,0);
  }
}

# 'insert-pixbuf' and 'insert-child-anchor' signal handler on textbuf
sub _do_textbuf_insert_pixbuf_or_anchor {
  my ($textbuf, $iter, $pixbuf_or_anchor, $ref_weak_self) = @_;
  _do_textbuf_insert ($textbuf, $iter, undef, 1, $ref_weak_self);
}

# 'insert-text' signal handler on textbuf,
# plus fakery from 'insert-pixbuf' and 'insert-child-anchor' above
sub _do_textbuf_insert {
  my ($textbuf, $iter, $text, $textlen, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  ### FollowAppend _do_textbuf_insert() iter: $iter->get_offset
  ### $textlen
  ### $text

  if ($iter->is_end
      && _want_follow ($self,
                       $textbuf->get_iter_at_offset
                       ($iter->get_offset - $textlen))) {
    ### _do_textbuf_insert() scroll_to_mark
    $self->scroll_to_mark ($textbuf->get_insert, 0, 0, 0,0);
  }
}

sub _want_follow {
  my ($self, $insert_iter) = @_;
  my $textbuf = $self->get_buffer;
  my $cursor_iter = $textbuf->get_iter_at_mark ($textbuf->get_insert);