File Coverage

blib/lib/Gtk2/Ex/History.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# Copyright 2007, 2008, 2009, 2010, 2011 Kevin Ryde

# This file is part of Gtk2-Ex-History.
#
# Gtk2-Ex-History is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Gtk2-Ex-History is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Gtk2-Ex-History.  If not, see .

package Gtk2::Ex::History;
use 5.008;
use strict;
use warnings;
use Gtk2 1.220;
use POSIX ();
use Scalar::Util;

use Gtk2;
use Glib::Ex::SignalBits;
use Glib::Ex::FreezeNotify;

# uncomment this to run the ### lines
#use Smart::Comments;

our $VERSION = 8;


# place-to-icon-pixbuf
# $h->dialog_class, default sub of self
# $h->dialog_popup (parent => ...)
# $h->menu_popup (parent => ..., way => ..., event => ...)
# MenuBits popup_for_event (parent, event)

# place-to-renderers
# place-to-cellinfo
# place-serialize     \ or Storable freeze
# place-unserialize   /

# place-to-selectiondata
#    default place-to-text
#    flag for set, or emptiness of SelectionData
# selectiondata-to-place
# Gtk2::SelectionData


use Glib::Object::Subclass
  'Glib::Object',
  signals => { 'place-to-text' =>
               { param_types   => ['Glib::Scalar'],
                 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;
  $model->set ($iter, $model->COL_PLACE, $place);
  $self->{'current'} = $place;
  $self->notify('current');
}

sub goto {
  my ($self, $place) = @_;
  ### history goto: $place

  my $current = $self->{'current'};
  if (defined $current) {
    if ($self->signal_emit ('place-equal', $current, $place)) {
      ### same as current
      return;
    }
    ### push back_model: $current
    my $back_model = $self->{'back_model'};
    $back_model->insert_with_values (0, $back_model->COL_PLACE, $current);
    _limit ($self, $back_model);
  }
  _set_current ($self, $place);
}

sub back {
  my ($self, $n) = @_;
  if (! defined $n) { $n = 1; }
  ### History back: $n

  my $current = $self->{'current'};
  if ($n > 0) {
    my $back_model = $self->{'back_model'};
    my $forward_model = $self->{'forward_model'};
    while ($n-- > 0) {
      my $iter = $back_model->get_iter_first || do {
        ### no more back
        last;
      };
      my $place = $back_model->get_value ($iter, $back_model->COL_PLACE);
      ### back to: $place
      $back_model->remove ($iter);

      ### push forward: $current
      $forward_model->insert_with_values (0, $back_model->COL_PLACE, $current);
      _limit ($self, $forward_model);

      $current = $place;
    }
    ### back set current to: $place
    _set_current ($self, $current);
  }
  ### back at: $current
  return $current;
}

sub forward {
  my ($self, $n) = @_;
  if (! defined $n) { $n = 1; }
  ### History forward: $n

  my $freezer = Glib::Ex::FreezeNotify->new ($self); # hold off 'current' prop
  if ($n > 0) {
    my $forward_model = $self->{'forward_model'};
    while ($n--) {
      my $iter = $forward_model->get_iter_first || last;
      my $place = $forward_model->get_value ($iter, $forward_model->COL_PLACE);
      $forward_model->remove ($iter);

      $self->goto ($place);
    }
  }
  ### History forward to: $self->{'current'}
  return $self->{'current'};
}

# enforce 'max-history' on the given liststore model
# if it's too big then remove elements from the end
sub _limit {
  my ($self, $model) = @_;
  ### _limit to: $self->get('max-history'), "$model"
  my $len = $model->iter_n_children (undef);
  my $max = $self->get('max-history');
  for (my $pos = $len - 1; $pos >= $max; $pos--) {
    $model->remove ($model->iter_nth_child (undef, $pos));
  }
}


1;
__END__