view release on metacpan or  search on metacpan

lib/Gtk2/Ex/History.pm  view on Meta::CPAN

                 return_type   => 'Glib::String',
                 flags         => ['run-last'],
                 class_closure => \&_default_place_to_text,
                 accumulator   => \&Glib::Ex::SignalBits::accumulator_first_defined },

               'place-equal' =>
               { param_types   => ['Glib::Scalar', 'Glib::Scalar'],
                 return_type   => 'Glib::Boolean',
                 flags         => ['run-last'],
                 class_closure => \&_default_place_equal,
                 accumulator   => \&Glib::Ex::SignalBits::accumulator_first },
             },

  properties => [ Glib::ParamSpec->scalar
                  ('current',
                   'Current place object',
                   'Current place object in the history.',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->int
                  ('max-history',
                   'Maximum history count',
                   'The maximum number of places to keep in the history (backwards and forwards counted separately currently).',
                   0,                  # min
                   POSIX::INT_MAX(),   # max
                   40,                 # default
                   Glib::G_PARAM_READWRITE),

                  # this one not documented yet ...
                  Glib::ParamSpec->boolean
                  ('use-markup',
                   'Use markup',
                   'Blurb.',
                   0,  # default
                   Glib::G_PARAM_READWRITE),
                ];

BEGIN {
  Glib::Type->register_enum ('Gtk2::Ex::History::Way',
                             back    => 0,
                             forward => 1);
}

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

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

  $self->{'current'} = undef;

  require Gtk2::Ex::History::ListStore;
  my $back_model = $self->{'back_model'}
    = Gtk2::Ex::History::ListStore->new;

  my $forward_model = $self->{'forward_model'}
    = Gtk2::Ex::History::ListStore->new;

  my $current_model = $self->{'current_model'}
    = Gtk2::Ex::History::ListStore->new;
  $current_model->{'current'} = 1; # flag for ListStore drag/drop
  Scalar::Util::weaken ($current_model->{'history'} = $self);

  foreach my $aref ($back_model   ->{'others'} = [ $forward_model ],
                    $forward_model->{'others'} = [ $back_model ],
                    $current_model->{'others'} = [ $back_model, $forward_model ]) {
    foreach (@$aref) {
      Scalar::Util::weaken ($_);
    }
  }
  ### models: { back => $back_model, forward => $forward_model, current => $current_model }
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  if ($pname eq 'current') {
    $self->goto ($newval);
  } else {
    $self->{$pname} = $newval;
  }
}

sub _default_place_to_text {
  my ($self, $place) = @_;
  return "$place";
}
sub _default_place_equal {
  my ($self, $k1, $k2) = @_;
  ### _default_place_equal(): ($k1 eq $k2)
  if (defined $k1) {
    return (defined $k2 && $k1 eq $k2);
  } else {
    return (! defined $k2);
  }
}

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

# this one not documented yet
sub model {
  my ($self, $way) = @_;
  return $self->{"${way}_model"};
}

sub remove {
  my ($self, $place) = @_;
  require Gtk2::Ex::TreeModelBits;
  Gtk2::Ex::TreeModelBits->VERSION(16); # for extra remove args
  foreach my $model ($self->{'back_model'}, $self->{'forward_model'}) {
    Gtk2::Ex::TreeModelBits::remove_matching_rows
        ($model, \&_do_remove_match, [$self, $place]);
  }
}
sub _do_remove_match {
  my ($model, $iter, $userdata) = @_;
  my ($self, $place) = @$userdata;
  return $self->signal_emit ('place-equal',
                             $place,
                             $model->get_value ($iter, $model->COL_PLACE));
}

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

sub _set_current {
  my ($self, $place) = @_;
  my $model = $self->{'current_model'};
  my $iter = $model->get_iter_first || $model->append;