Gtk2-Ex-History
view release on metacpan or search on metacpan
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 <http://www.gnu.org/licenses/>.
Version 8, November 2011
- tests fix MenuToolButton weakening maybe
Version 7, November 2010
- tests fix should be an is() not an ok()
Version 6, November 2010
- use ConnectProperties for button sensitivities
Version 5, September 2010
- tests fix non-string test name
lib/Gtk2/Ex/History/ListStore.pm
lib/Gtk2/Ex/History/Menu.pm
lib/Gtk2/Ex/History/MenuToolButton.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
po/Gtk2-Ex-History.pot
po/header.pot
po/README
SIGNATURE
t/Button-weaken.t
t/Button.t
t/Dialog-weaken.t
t/Dialog.t
t/History-weaken.t
t/History.t
t/Menu-weaken.t
t/Menu.t
t/MenuToolButton-weaken.t
t/MenuToolButton.t
t/MyTestHelpers.pm
xt/0-examples-xrefs.t
xt/0-META-read.t
xt/0-no-debug-left-on.t
xt/0-Test-ConsistentVersion.t
xt/0-Test-DistManifest.t
xt/0-Test-Pod.t
xt/0-Test-Synopsis.t
xt/0-Test-YAML-Meta.t
SHA1 b14a2da8d944253a21d6805b8e90bf7f914f4629 lib/Gtk2/Ex/History.pm
SHA1 003ab3ef234406231966937cb1a2367e02d15782 lib/Gtk2/Ex/History/Action.pm
SHA1 2fb414f598105bc9e0eb853760f0486a73389a37 lib/Gtk2/Ex/History/Button.pm
SHA1 2f1e69e75f8cfa800260b744c3dafb5fbe82b65b lib/Gtk2/Ex/History/Dialog.pm
SHA1 753d0bbdba7bfe88f34505c3fd4453a03fbf16e3 lib/Gtk2/Ex/History/ListStore.pm
SHA1 96ab5e9971fe1be4beca9a502e546c304b9a258f lib/Gtk2/Ex/History/Menu.pm
SHA1 4addbf54faabb6c7167d07a3a95582b4628806c5 lib/Gtk2/Ex/History/MenuToolButton.pm
SHA1 af54473651037466af9b1ddc332c079ff9609437 po/Gtk2-Ex-History.pot
SHA1 ceab03b1599a11baa24c259e5f74931ab99b9ef6 po/README
SHA1 8ab20e40dd4b97ac05dd46d8a9a89cc91ec5ce15 po/header.pot
SHA1 23b52b5c64ce39c8bd8abeb32f1b277c4ba94ebd t/Button-weaken.t
SHA1 891883c2c0b5e6a84c000ec15b473fb3b6e0836f t/Button.t
SHA1 abf5e54a31928af1ce7e94627ae9fce400a7c2e4 t/Dialog-weaken.t
SHA1 823bdac6059d45af988f8f4b2ef9951553c18c42 t/Dialog.t
SHA1 50bfe568023bde97421b3308985b926ca076447d t/History-weaken.t
SHA1 348d02eb7cb4566e87999ba84f4ec85c30c996a7 t/History.t
SHA1 f7d6c7076889c0c4b16df765706e93352753be40 t/Menu-weaken.t
SHA1 e75e0c37c79fcb7c9ec552fd08d04e1b37fcd77f t/Menu.t
SHA1 78f2c657a1f65820f829a62ec87e467bd762039e t/MenuToolButton-weaken.t
SHA1 914cbc40928f178be787d68b74d770f2e288a8ef t/MenuToolButton.t
SHA1 c403f69bce1a210d3e150de65a26d06320ef8a43 t/MyTestHelpers.pm
SHA1 0279c9310ec528d10a2a14e602bf98f1c776cce1 xt/0-META-read.t
SHA1 219395eb91b03829e6f14db4ebd57d88ea972e61 xt/0-Test-ConsistentVersion.t
SHA1 8a5e0f34131de34e584fbb1939c191a152566155 xt/0-Test-DistManifest.t
SHA1 cc04a5fe5d8b8b38bfd56453d5d2686c8ea58783 xt/0-Test-Pod.t
SHA1 8cc52e23427a82cfef5802bf512b13c65de2687a xt/0-Test-Synopsis.t
SHA1 4c14845872d6eb4280e12f862d6ba2c343358c60 xt/0-Test-YAML-Meta.t
SHA1 8609ab0ed7dfa7261d85dd7c9c11736fc4e8df0b xt/0-examples-xrefs.t
SHA1 3510bcc61725fe294e5a508bca4ae78cfe05684e xt/0-no-debug-left-on.t
devel/run.pl view on Meta::CPAN
$history->goto ('FFF');
$history->goto ('GGG');
$history->back(3);
# {
# my $back = $history->model('back');
# ### $back
# use List::Util;
# my $aref = [123];
# my @foo = ($aref);
# Scalar::Util::weaken ($foo[0]);
# List::Util::first {
# ### $_
# (defined $_ && $_==123)
# } @{$back->{'others'}};
# exit 0;
# }
my $d2 = Gtk2::Gdk::Display->open (':3');
my $toplevel = Gtk2::Window->new('toplevel');
devel/toolbar.pl view on Meta::CPAN
$history->goto ('FFF');
$history->goto ('GGG');
$history->back(3);
# {
# my $back = $history->model('back');
# ### $back
# use List::Util;
# my $aref = [123];
# my @foo = ($aref);
# Scalar::Util::weaken ($foo[0]);
# List::Util::first {
# ### $_
# (defined $_ && $_==123)
# } @{$back->{'others'}};
# exit 0;
# }
my $toplevel = Gtk2::Window->new('toplevel');
$toplevel->signal_connect (destroy => sub { Gtk2->main_quit; });
devel/unused/ModelSensitive.pm view on Meta::CPAN
my ($class, $target, $model) = @_;
### ModelSensitive: $target && "$target", $model && "$model"
my $self = bless {}, $class;
$self->set_target ($target);
$self->set_model ($model);
return $self;
}
sub set_target {
my ($self, $target) = @_;
Scalar::Util::weaken ($self->{'target'} = $target);
_update_sensitive ($self);
}
sub set_model {
my ($self, $model) = @_;
Scalar::Util::weaken ($self->{'model'} = $model);
$self->{'ids'} = $model && do {
Scalar::Util::weaken (my $weak_self = $self);
### ModelSensitive connect
Glib::Ex::SignalIds->new
($model,
($model->get_iter_first
? $model->signal_connect (row_deleted => \&_do_model_deleted,
\$weak_self)
: $model->signal_connect (row_inserted => \&_do_model_inserted,
\$weak_self),
));
};
devel/unused/ModelSensitive.t view on Meta::CPAN
{
my $ms = Gtk2::Ex::History::ModelSensitive->new;
isa_ok ($ms, 'Gtk2::Ex::History::ModelSensitive');
is ($ms->VERSION, $want_version, 'VERSION object method');
ok (eval { $ms->VERSION($want_version); 1 },
"VERSION object check $want_version");
ok (! eval { $ms->VERSION($want_version + 1000); 1 },
"VERSION object check " . ($want_version + 1000));
Scalar::Util::weaken ($ms);
is ($ms, undef, 'gc when weakened');
}
#------------------------------------------------------------------------------
{
my $model = Gtk2::ListStore->new ('Glib::String');
my $target = Gtk2::Label->new;
my $ms = Gtk2::Ex::History::ModelSensitive->new ($target, $model);
ok (! $target->get('sensitive'));
devel/unused/ModelSensitive.t view on Meta::CPAN
ok ($target->get('sensitive'));
$model->append;
ok ($target->get('sensitive'));
$model->remove ($model->get_iter_first);
ok ($target->get('sensitive'));
$model->remove ($model->get_iter_first);
ok (! $target->get('sensitive'));
Scalar::Util::weaken ($ms);
is ($ms, undef, 'gc when weakened, with model and target');
}
# initially non-empty
{
my $model = Gtk2::ListStore->new ('Glib::String');
$model->append;
my $target = Gtk2::Label->new;
$target->set_sensitive (0);
my $ms = Gtk2::Ex::History::ModelSensitive->new ($target, $model);
devel/unused/ModelSensitive.t view on Meta::CPAN
$model->append;
ok ($target->get('sensitive'));
$model->remove ($model->get_iter_first);
ok ($target->get('sensitive'));
$model->remove ($model->get_iter_first);
ok (! $target->get('sensitive'));
Scalar::Util::weaken ($ms);
is ($ms, undef, 'gc when weakened, with model and target');
}
exit 0;
lib/Gtk2/Ex/History.pm view on Meta::CPAN
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);
lib/Gtk2/Ex/History/Action.pm view on Meta::CPAN
&& ($button = $toolitem->get_child)
&& $button->isa('Gtk2::Button')) {
# must have 'button-release-mask' or the menu doesn't pop down on button
# release, for some reason
require Gtk2::Ex::WidgetEvents;
$toolitem->{(__PACKAGE__)}->{'wevents'}
= Gtk2::Ex::WidgetEvents->new ($button, ['button-release-mask']);
require Glib::Ex::SignalIds;
Scalar::Util::weaken (my $weak_self = $self);
$toolitem->{(__PACKAGE__)}->{'ids'} = Glib::Ex::SignalIds->new
($button,
$button->signal_connect
(button_press_event => \&_do_button_press_event, \$weak_self));
### ids: $toolitem->{(__PACKAGE__)}->{'ids'}
}
return 1; # keep emission hook
}
# Gtk2::ActionGroup 'disconnect-proxy' emission hook handler
t/Button-weaken.t view on Meta::CPAN
require Test::Weaken::Gtk2;
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
return Gtk2::Ex::History::Button->new;
},
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection, no history');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $history = Gtk2::Ex::History->new;
my $button = Gtk2::Ex::History::Button->new (history => $history);
return [ $button, $history ];
},
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection, with history');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
exit 0;
{
my $button = Gtk2::Ex::History::Button->new;
isa_ok ($button, 'Gtk2::Ex::History::Button');
is ($button->VERSION, $want_version, 'VERSION object method');
ok (eval { $button->VERSION($want_version); 1 },
"VERSION object check $want_version");
ok (! eval { $button->VERSION($want_version + 1000); 1 },
"VERSION object check " . ($want_version + 1000));
Scalar::Util::weaken ($button);
is ($button, undef, 'gc when weakened');
}
exit 0;
t/Dialog-weaken.t view on Meta::CPAN
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $history = Gtk2::Ex::History->new;
my $dialog = Gtk2::Ex::History::Dialog->new (history => $history);
return [ $dialog, $history ];
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
exit 0;
my $dialog = Gtk2::Ex::History::Dialog->new;
isa_ok ($dialog, 'Gtk2::Ex::History::Dialog', 'new()');
is ($dialog->VERSION, $want_version, 'VERSION object method');
ok (eval { $dialog->VERSION($want_version); 1 },
"VERSION object check $want_version");
ok (! eval { $dialog->VERSION($want_version + 1000); 1 },
"VERSION object check " . ($want_version + 1000));
$dialog->destroy;
Scalar::Util::weaken ($dialog);
is ($dialog, undef, 'new() gc when weakened');
}
#------------------------------------------------------------------------------
# present() with no history set
{
my $dialog = Gtk2::Ex::History::Dialog->new;
$dialog->present;
MyTestHelpers::wait_for_event($dialog,'map-event');
$dialog->destroy;
# popup()
{
my $history = Gtk2::Ex::History->new;
my $dialog = Gtk2::Ex::History::Dialog->popup ($history);
isa_ok ($dialog, 'Gtk2::Ex::History::Dialog',
'popup without history');
MyTestHelpers::wait_for_event($dialog,'map-event');
$dialog->destroy;
Scalar::Util::weaken ($dialog);
is ($dialog, undef, 'popup() gc when weakened');
}
{
my $parent = Gtk2::Window->new('toplevel');
my $history = Gtk2::Ex::History->new;
my $dialog = Gtk2::Ex::History::Dialog->popup ($history, $parent);
isa_ok ($dialog, 'Gtk2::Ex::History::Dialog',
'popup with history');
MyTestHelpers::wait_for_event($dialog,'map-event');
$parent->destroy;
$dialog->destroy;
Scalar::Util::weaken ($dialog);
is ($dialog, undef, 'popup() with history, gc when weakened');
}
exit 0;
t/History-weaken.t view on Meta::CPAN
eval "use Test::Weaken 2; 1"
or plan skip_all => "Test::Weaken 2 not available -- $@";
plan tests => 1;
require Gtk2::Ex::History;
{
my $leaks = Test::Weaken::leaks
({ constructor => sub { return Gtk2::Ex::History->new },
});
is ($leaks, undef, 'Test::Weaken deep garbage collection');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
exit 0;
t/History.t view on Meta::CPAN
my $got = $history->signal_emit ('place-to-text', 'abc');
ok ($to_text_called, 'place-to-text handler - called');
is ($to_text_h, $history, 'place-to-text handler - history object arg');
is ($got, "xx abc yy", 'place-to-text handler - result');
is ($history->signal_emit ('place-to-text', $history),
"xx $history yy",
'place-to-text handler - 1,2');
}
#------------------------------------------------------------------------------
# weaken garbage collect
{
my $history = Gtk2::Ex::History->new;
require Scalar::Util;
Scalar::Util::weaken ($history);
is ($history, undef, 'weaken() garbage collect');
}
{
my $history = Gtk2::Ex::History->new;
my $back = $history->model('back');
my $forward = $history->model('forward');
my $current = $history->model('current');
require Scalar::Util;
Scalar::Util::weaken ($history);
Scalar::Util::weaken ($back);
Scalar::Util::weaken ($forward);
Scalar::Util::weaken ($current);
is ($history, undef, 'weaken() history garbage collect');
is ($history, undef, 'weaken() back_model garbage collect');
is ($history, undef, 'weaken() forward_model garbage collect');
is ($history, undef, 'weaken() current_model garbage collect');
}
exit 0;
t/Menu-weaken.t view on Meta::CPAN
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $history = Gtk2::Ex::History->new;
my $menu = Gtk2::Ex::History::Menu->new (history => $history);
return [ $menu, $history ];
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $history = Gtk2::Ex::History->new;
my $menu = Gtk2::Ex::History::Menu->new_popup (history => $history);
return [ $menu, $history ];
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection - with popup');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
exit 0;
my $menu = Gtk2::Ex::History::Menu->new;
isa_ok ($menu, 'Gtk2::Ex::History::Menu', 'new()');
is ($menu->VERSION, $want_version, 'VERSION object method');
ok (eval { $menu->VERSION($want_version); 1 },
"VERSION object check $want_version");
ok (! eval { $menu->VERSION($want_version + 1000); 1 },
"VERSION object check " . ($want_version + 1000));
$menu->destroy;
Scalar::Util::weaken ($menu);
is ($menu, undef, 'new() gc when weakened');
}
#------------------------------------------------------------------------------
# new_popup()
{
my $history = Gtk2::Ex::History->new;
my $menu = Gtk2::Ex::History::Menu->new_popup (history => $history);
isa_ok ($menu, 'Gtk2::Ex::History::Menu', 'new_popup()');
$menu->destroy;
Scalar::Util::weaken ($menu);
is ($menu, undef, 'new_popup() gc when weakened');
}
exit 0;
t/MenuToolButton-weaken.t view on Meta::CPAN
}
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
return Gtk2::Ex::History::MenuToolButton->new;
},
contents => \&my_contents,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection, no history');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $history = Gtk2::Ex::History->new;
my $item = Gtk2::Ex::History::MenuToolButton->new (history=>$history);
return [ $item, $history ];
},
contents => \&my_contents,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection, with history');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $history = Gtk2::Ex::History->new;
my $item = Gtk2::Ex::History::MenuToolButton->new (history => $history);
my $menu1 = $item->get_menu;
# diag $menu1;
$item->signal_emit ('show-menu');
# diag $item->get_menu;
return [ $item, $history, $menu1 ];
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&my_contents,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection, history and show-menu');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
exit 0;
t/MenuToolButton.t view on Meta::CPAN
{
my $item = Gtk2::Ex::History::MenuToolButton->new;
isa_ok ($item, 'Gtk2::Ex::History::MenuToolButton');
is ($item->VERSION, $want_version, 'VERSION object method');
ok (eval { $item->VERSION($want_version); 1 },
"VERSION object check $want_version");
ok (! eval { $item->VERSION($want_version + 1000); 1 },
"VERSION object check " . ($want_version + 1000));
Scalar::Util::weaken ($item);
is ($item, undef, 'gc when weakened');
}
#------------------------------------------------------------------------------
# show-menu
{
my $item = Gtk2::Ex::History::MenuToolButton->new;
$item->signal_emit ('show-menu');
is ($item->get_menu, undef, 'show-menu with no history leaves no menu');
}
t/MenuToolButton.t view on Meta::CPAN
my $history = Gtk2::Ex::History->new;
$item->set (history => $history);
isnt ($item->get_menu, undef,
'with history have menu, so arrow is sensitive');
$item->signal_emit ('show-menu');
my $menu = $item->get_menu;
isa_ok ($menu, 'Gtk2::Ex::History::Menu',
'get_menu() is a history after show-menu');
Scalar::Util::weaken ($item);
Scalar::Util::weaken ($menu);
is ($item, undef, 'item gc when weakened with history');
MyTestHelpers::findrefs($item);
is ($menu, undef, 'menu gc when weakened with history');
MyTestHelpers::findrefs($menu);
}
exit 0;
t/MyTestHelpers.pm view on Meta::CPAN
join(' ',
map {"$_=$obj->{$_}"} keys %$obj));
}
if (eval { require Devel::FindRef }) {
MyTestHelpers::diag (Devel::FindRef::track($obj, 8));
} else {
MyTestHelpers::diag ("Devel::FindRef not available -- ", $@);
}
}
sub test_weaken_show_leaks {
my ($leaks) = @_;
$leaks || return;
my $unfreed = $leaks->unfreed_proberefs;
my $unfreed_count = scalar(@$unfreed);
MyTestHelpers::diag ("Test-Weaken leaks $unfreed_count objects");
MyTestHelpers::dump ($leaks);
my $proberef;
foreach $proberef (@$unfreed) {
( run in 0.499 second using v1.01-cache-2.11-cpan-1f129e94a17 )