Gtk2-Ex-History
view release on metacpan or search on metacpan
- use ConnectProperties for button sensitivities
Version 5, September 2010
- tests fix non-string test name
Version 4, September 2010
- fix Dialog stray 5.010 should be 5.008
Version 3, September 2010
- new MenuToolButton
- fix Menu new_popup() to return new object per docs
Version 2, August 2010
- use WidgetEvents for action toolbar button release
Version 1, August 2010
- the first version.
devel/run.pl view on Meta::CPAN
);
$hbox->pack_start ($button, 1,1,0);
}
{
my $button = Gtk2::Button->new ('Menu');
$vbox->pack_start ($button, 0,0,0);
$button->signal_connect
(clicked => sub {
require Gtk2::Ex::History::Menu;
my $menu = Gtk2::Ex::History::Menu->new_popup (history => $history);
});
}
{
my $button = Gtk2::Button->new ('Dialog');
$vbox->pack_start ($button, 0,0,0);
$button->signal_connect
(clicked => sub {
require Gtk2::Ex::History::Dialog;
my $menu = Gtk2::Ex::History::Dialog->popup ($history);
});
}
# Gtk2::Ex::History::Dialog->popup ($history);
# my $recent = Gtk2::RecentChooserDialog->new ('Recently', undef);
# $recent->show;
$toplevel->show_all;
Gtk2->main;
exit 0;
lib/Gtk2/Ex/History.pm view on Meta::CPAN
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
lib/Gtk2/Ex/History/Action.pm view on Meta::CPAN
return 1; # keep emission hook
}
# 'button-press-event' handler on a toolitem button child
sub _do_button_press_event {
my ($button, $event, $ref_weak_self) = @_;
### History-Action _do_button_press_event(): $event->button
my $self = $$ref_weak_self || return;
if ($event->button == 3 && (my $history = $self->{'history'})) {
require Gtk2::Ex::History::Menu;
Gtk2::Ex::History::Menu->new_popup (history => $history,
way => $self->get('way'),
event => $event);
}
return Gtk2::EVENT_PROPAGATE;
}
sub _update {
my ($self) = @_;
my $way = $self->get('way');
lib/Gtk2/Ex/History/Action.pm view on Meta::CPAN
sub _do_activate {
my ($self) = @_;
my $history = $self->{'history'} || return;
my $way = $self->get('way');
$history->$way;
}
1;
__END__
=for stopwords tooltip popup UIManager enum Ryde hashref Gtk2-Ex-History
=head1 NAME
Gtk2::Ex::History::Action -- Gtk2::Action to go back or forward in a history
=for test_synopsis my ($my_history, $actiongroup)
=head1 SYNOPSIS
use Gtk2::Ex::History::Action;
lib/Gtk2/Ex/History/Action.pm view on Meta::CPAN
Gtk2::Action
Gtk2::Ex::History::Action
=head1 DESCRIPTION
C<Gtk2::Ex::History::Action> invokes either C<back> or C<forward> on a given
C<Gtk2::Ex::History>. The "stock" icon and tooltip follow the direction.
The action is insensitive when the history is empty.
When the action is used on a toolbar button a mouse button-3 handler is
added to popup C<Gtk2::Ex::History::Menu>.
If you're not using UIManager and its actions system then see
L<Gtk2::Ex::History::Button> for similar button-3 behaviour.
There's no accelerator keys offered as yet. "B" and "F" would be natural,
but would depend what other things are in the UIManager and whether letters
should be reserved for text entry etc, or are available as accelerators.
Control-B and Control-F aren't good choices if using a text entry as they're
cursor movement in the Emacs style
F</usr/share/themes/Emacs/gtk-2.0-key/gtkrc>.
lib/Gtk2/Ex/History/Button.pm view on Meta::CPAN
my ($self) = @_;
### History-Button clicked: $self->get('way')
my $history = $self->{'history'} || return;
my $way = $self->get('way');
$history->$way;
return shift->signal_chain_from_overridden(@_);
}
# 'button-press-event' class closure
#
# Might like this popup to work even when there's no items in the model and
# the button is therefore insensitive, but the button-press-event doesn't
# come through when insensitive.
#
sub _do_button_press_event {
my ($self, $event) = @_;
### History-Button button-press-event: $event->button
if ($event->button == 3 && (my $history = $self->{'history'})) {
require Gtk2::Ex::History::Menu;
Gtk2::Ex::History::Menu->new_popup (history => $history,
way => $self->get('way'),
event => $event);
}
return shift->signal_chain_from_overridden(@_);
}
1;
__END__
=for stopwords enum Ryde Gtk2-Ex-History
lib/Gtk2/Ex/History/Dialog.pm view on Meta::CPAN
#
# 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 <http://www.gnu.org/licenses/>.
# popup menu for items
# Goto
# Copy to Selection
package Gtk2::Ex::History::Dialog;
use 5.008;
use strict;
use warnings;
use Gtk2;
use List::Util;
lib/Gtk2/Ex/History/Dialog.pm view on Meta::CPAN
sub _do_row_activated {
my ($treeview, $path, $treeviewcolumn) = @_;
my $self = $treeview->get_ancestor (__PACKAGE__);
my $history = $self->{'history'} || return; # in case gone somehow
my ($n) = $path->get_indices;
my $way = $treeview->{'way'};
$history->$way ($n+1);
}
# Not sure about this yet, might prefer general Gtk2::Ex::ToplevelBits find
# and popup.
#
# =item C<< Gtk2::Ex::History::Dialog->popup ($history) >>
#
# =item C<< Gtk2::Ex::History::Dialog->popup ($history, $parent) >>
#
# Popup a C<History::Dialog> for the given C<Gtk2::Ex::History> object,
# possibly re-using an existing dialog if there's one showing it already.
#
# Optional C<$parent> is a widget the popup originates from. If a dialog
# already exists on the same screen as C<$parent> (or the default screen) then
# it's re-presented, otherwise a new dialog is created on the screen of
# C<$parent> (or the default screen).
sub popup {
my ($class, $history, $parent) = @_;
### History-Dialog popup(): "$history"
### parent: $parent && "$parent"
my $screen = ($parent ? $parent->get_screen : Gtk2::Gdk::Screen->get_default);
my $dialog = (List::Util::first
{ $_->isa($class)
&& $_->get_screen == $screen
&& $_->get('history') == $history
} Gtk2::Window->list_toplevels)
|| do {
### new dialog
lib/Gtk2/Ex/History/Dialog.pm view on Meta::CPAN
# if ($this_history == $history) {
# return $widget;
# }
# }
# return $class->new (history => $history);
# }
1;
__END__
=for stopwords popup Ryde Gtk2-Ex-History
=head1 NAME
Gtk2::Ex::History::Dialog -- dialog of history "back" and "forward" places
=for test_synopsis my ($history, $parent_widget)
=head1 SYNOPSIS
use Gtk2::Ex::History::Dialog;
Gtk2::Ex::History::Dialog->popup ($history, $parent_widget);
=head1 WIDGET HIERARCHY
C<Gtk2::Ex::History::Dialog> is a subclass of C<Gtk2::Dialog>.
Gtk2::Widget
Gtk2::Container
Gtk2::Bin
Gtk2::Window
Gtk2::Dialog
lib/Gtk2/Ex/History/Menu.pm view on Meta::CPAN
$self->set (model => $history && $history->model($self->get('way')));
#### History-Menu model: $self->get('model')
}
}
# 'activate' signal handler on Dashes::MenuItem tearoff
sub _do_dashesitem_activate {
my ($dashesitem) = @_;
my $self = $dashesitem->get_parent || return; # if orphaned somehow
require Gtk2::Ex::History::Dialog;
Gtk2::Ex::History::Dialog->popup ($self->{'history'}, $self);
}
# 'item-create-or-update' class closure handler
sub _do_item_create_or_update {
my ($self, $item, $model, $path, $iter) = @_;
#### History-Menu _do_item_create_or_update(): $path->to_string
$item ||= Gtk2::MenuItem->new_with_label ('');
my $place = $model->get ($iter, 0);
if (my $history = $self->{'history'}) {
lib/Gtk2/Ex/History/Menu.pm view on Meta::CPAN
# 'activate' class closure handler
sub _do_activate {
my ($self, $item, $model, $path, $iter) = @_;
my $history = $self->{'history'} || return;
my $way = $self->get('way');
my $n = ($path->get_indices)[0];
$history->$way ($n+1);
}
sub new_popup {
my ($class, %options) = @_;
### History-Menu new_popup()
my $event = delete $options{'event'};
my $self = $class->new (%options);
my $button = 0;
my $time = 0;
if ($event) {
if ($event->can('button')) {
$button = $event->button;
}
if ($event->can('time')) {
$time = $event->time;
}
if (my $window = $event->window) {
$self->set_screen ($window->get_screen);
}
}
### screen: $self->get_screen->make_display_name
### $button
### $time
$self->popup (undef, undef, undef, undef, $button, $time);
return $self;
}
1;
__END__
=for stopwords tearoff popup enum Ryde Gtk2-Ex-History
=head1 NAME
Gtk2::Ex::History::Menu -- menu of "back" or "forward" history items
=for test_synopsis my ($my_history)
=head1 SYNOPSIS
use Gtk2::Ex::History::Menu;
lib/Gtk2/Ex/History/Menu.pm view on Meta::CPAN
=item C<< $histmenu = Gtk2::Ex::History::Menu->new (key => value, ...) >>
Create and return a new history menu. Optional key/value pairs set initial
properties as per C<< Glib::Object->new >>. The C<history> property should
be set to say what to display, and C<way> for back or forward.
my $menu = Gtk2::Ex::History::Menu->new
(history => $my_history,
way => 'forward');
=item C<< $histmenu = Gtk2::Ex::History::Menu->new_popup (key => value, ...) >>
Create and popup a new history menu. The key/value parameters set initial
properties, plus an additional
event => Gtk2::Gdk::Event object or undef
If the event has C<button> and C<time> fields then they're used for the menu
popup, and if the C<window> field is set then that gives the screen
(C<Gtk2::Gdk::Screen>) the menu pops up on. For example,
sub my_button_press_handler {
my ($self, $event) = @_;
Gtk2::Ex::History::Menu->new_popup (history => $my_history,
way => 'back',
event => $event);
return Gtk2::EVENT_PROPAGATE; # other handlers
}
=back
=head1 PROPERTIES
=over 4
lib/Gtk2/Ex/History/MenuToolButton.pm view on Meta::CPAN
### History-MenuToolButton clicked: $self->get('way')
my $history = $self->{'history'} || return;
my $way = $self->get('way');
$history->$way;
return shift->signal_chain_from_overridden(@_);
}
1;
__END__
=for stopwords enum MenuToolButton popup Ryde Gtk2-Ex-History
=head1 NAME
Gtk2::Ex::History::MenuToolButton -- toolbar button for history "back" or "forward"
=for test_synopsis my ($my_history, $toolbar)
=head1 SYNOPSIS
use Gtk2::Ex::History::MenuToolButton;
lib/Gtk2/Ex/History/MenuToolButton.pm view on Meta::CPAN
| | |
+-------------+---+
+---------------+
| Some Thing |
| Another Place |
| Future Most |
+---------------+
A plain C<Gtk2::Ex::History::Button> can be put in a C<Gtk2::ToolItem> and
used in a toolbar for a similar result. The difference is whether you
prefer the menu popup with an arrow or with mouse button-3. The arrow has
the advantage of a visual indication that there's something available.
=head1 FUNCTIONS
=over 4
=item C<< $item = Gtk2::Ex::History::MenuToolButton->new (key => value, ...) >>
Create and return a new history button. Optional key/value pairs can be
given to set initial properties, as per C<< Glib::Object->new >>.
# 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/Menu-weaken.t view on Meta::CPAN
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;
"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;
( run in 2.332 seconds using v1.01-cache-2.11-cpan-364913b4093 )