| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # parent => $widget ? | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | # Copyright 2007, 2008, 2009, 2010 Kevin Ryde | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | # This file is part of Chart. | 
| 6 |  |  |  |  |  |  | # | 
| 7 |  |  |  |  |  |  | # Chart is free software; you can redistribute it and/or modify | 
| 8 |  |  |  |  |  |  | # it under the terms of the GNU General Public License as published by the | 
| 9 |  |  |  |  |  |  | # Free Software Foundation; either version 3, or (at your option) any later | 
| 10 |  |  |  |  |  |  | # version. | 
| 11 |  |  |  |  |  |  | # | 
| 12 |  |  |  |  |  |  | # Chart is distributed in the hope that it will be useful, but | 
| 13 |  |  |  |  |  |  | # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | 
| 14 |  |  |  |  |  |  | # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License | 
| 15 |  |  |  |  |  |  | # for more details. | 
| 16 |  |  |  |  |  |  | # | 
| 17 |  |  |  |  |  |  | # You should have received a copy of the GNU General Public License along | 
| 18 |  |  |  |  |  |  | # with Chart.  If not, see <http://www.gnu.org/licenses/>. | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | package App::Chart::Gtk2::Ex::ToplevelBits; | 
| 21 | 1 |  |  | 1 |  | 14 | use 5.008; | 
|  | 1 |  |  |  |  | 3 |  | 
| 22 | 1 |  |  | 1 |  | 3 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 16 |  | 
| 23 | 1 |  |  | 1 |  | 3 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 18 |  | 
| 24 | 1 |  |  | 1 |  | 4 | use Carp; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 45 |  | 
| 25 | 1 |  |  | 1 |  | 5 | use List::Util; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 64 |  | 
| 26 | 1 |  |  | 1 |  | 6 | use App::Chart::Gtk2::Ex::ToplevelSingleton; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 409 |  | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | # uncomment this to run the ### lines | 
| 29 |  |  |  |  |  |  | #use Smart::Comments; | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | # screen | 
| 32 |  |  |  |  |  |  | # parent | 
| 33 |  |  |  |  |  |  | # with_properties | 
| 34 |  |  |  |  |  |  | # init_properties | 
| 35 |  |  |  |  |  |  | # modal | 
| 36 |  |  |  |  |  |  | # hide_on_delete | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | sub popup { | 
| 39 | 0 |  |  | 0 | 1 |  | my ($class, %options) = @_; | 
| 40 |  |  |  |  |  |  | ### ToplevelBits popup(): $class | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 0 |  | 0 |  |  |  | my $properties = $options{'properties'} || {}; | 
| 43 |  |  |  |  |  |  | my $screen = _screen | 
| 44 | 0 |  | 0 |  |  |  | ($options{'transient_for'} || $options{'parent'} || $options{'screen'}); | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | my $dialog = List::Util::first | 
| 47 | 0 | 0 | 0 | 0 |  |  | {$_->isa($class) | 
|  |  |  | 0 |  |  |  |  | 
| 48 |  |  |  |  |  |  | && (! defined $screen || $_->get_screen == $screen) | 
| 49 |  |  |  |  |  |  | && _object_properties_equal($_,$properties)} | 
| 50 | 0 |  |  |  |  |  | Gtk2::Window->list_toplevels; | 
| 51 |  |  |  |  |  |  | ### ToplevelBits found: $dialog | 
| 52 |  |  |  |  |  |  |  | 
| 53 | 0 | 0 |  |  |  |  | if ($dialog) { | 
| 54 | 0 | 0 |  |  |  |  | if (exists $options{'modal'}) { | 
| 55 | 0 |  |  |  |  |  | $dialog->set_modal ($options{'modal'}); | 
| 56 |  |  |  |  |  |  | } | 
| 57 | 0 | 0 |  |  |  |  | if (exists $options{'transient_for'}) { | 
| 58 | 0 |  |  |  |  |  | $dialog->set_transient_for ($options{'transient_for'}); | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | } else { | 
| 62 |  |  |  |  |  |  | ### new dialog $class | 
| 63 | 0 | 0 |  |  |  |  | if (eval { require Gtk2::Ex::WidgetCursor }) { | 
|  | 0 |  |  |  |  |  |  | 
| 64 | 0 |  |  |  |  |  | Gtk2::Ex::WidgetCursor->busy; | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 | 0 |  |  |  |  |  | require Module::Load; | 
| 68 | 0 |  |  |  |  |  | Module::Load::load ($class); | 
| 69 |  |  |  |  |  |  | $dialog = $class->Glib::Object::new | 
| 70 |  |  |  |  |  |  | ((defined $screen ? (screen => $screen) : ()), | 
| 71 |  |  |  |  |  |  | (exists $options{'modal'} ? (modal => $options{'modal'}) : ()), | 
| 72 | 0 | 0 |  |  |  |  | (exists $options{'transient_for'} ? (transient_for => $options{'transient_for'}) : ()), | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | %$properties); | 
| 74 | 0 | 0 |  |  |  |  | if ($options{'hide_on_delete'}) { | 
| 75 | 0 |  |  |  |  |  | $dialog->signal_connect (delete_event => \&Gtk2::Widget::hide_on_delete); | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | #   if (! $dialog->visible) { | 
| 80 |  |  |  |  |  |  | #     if (my $func = $options{'newly_visible_func'}) { | 
| 81 |  |  |  |  |  |  | #       $func->($dialog); | 
| 82 |  |  |  |  |  |  | #     } | 
| 83 |  |  |  |  |  |  | #   } | 
| 84 | 0 |  |  |  |  |  | $dialog->present; | 
| 85 | 0 |  |  |  |  |  | return $dialog; | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | sub _screen { | 
| 89 | 0 |  |  | 0 |  |  | my ($obj) = @_; | 
| 90 | 0 | 0 |  |  |  |  | if (! defined $obj) { | 
| 91 | 0 |  |  |  |  |  | return Gtk2::Gdk::Screen->get_default; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  | # don't want $display->get_screen($screennum) | 
| 94 | 0 | 0 |  |  |  |  | if ($obj->isa('Gtk2::Gdk::Display')) { | 
| 95 | 0 |  |  |  |  |  | return $obj->get_default_screen; | 
| 96 |  |  |  |  |  |  | } | 
| 97 | 0 | 0 |  |  |  |  | if (my $func = $obj->can('get_screen')) { | 
| 98 | 0 |  | 0 |  |  |  | return $obj->$func || croak "No screen for target $obj"; | 
| 99 |  |  |  |  |  |  | } | 
| 100 | 0 | 0 |  |  |  |  | if (my $func = $obj->can('get_default_screen')) { | 
| 101 | 0 |  | 0 |  |  |  | return $obj->$func || croak "No default screen for target $obj"; | 
| 102 |  |  |  |  |  |  | } | 
| 103 | 0 |  |  |  |  |  | return $obj; | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | sub _object_properties_equal { | 
| 107 | 0 |  |  | 0 |  |  | my ($obj, $properties) = @_; | 
| 108 | 0 |  |  |  |  |  | while (my ($pname, $value) = each %$properties) { | 
| 109 | 0 |  | 0 |  |  |  | my $pspec = $obj->find_property ($pname) | 
| 110 |  |  |  |  |  |  | || croak "No such property '",$pname,"'"; | 
| 111 | 0 | 0 |  |  |  |  | if ($pspec->values_cmp ($value, $obj->get($pname)) != 0) { | 
| 112 | 0 |  |  |  |  |  | return 0; | 
| 113 |  |  |  |  |  |  | } | 
| 114 |  |  |  |  |  |  | } | 
| 115 | 0 |  |  |  |  |  | return 1; | 
| 116 |  |  |  |  |  |  | } | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | 1; | 
| 119 |  |  |  |  |  |  | __END__ | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | =for stopwords Ryde Chart | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | =head1 NAME | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | App::Chart::Gtk2::Ex::ToplevelBits -- helpers for Gtk2::Window toplevel widgets | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | use App::Chart::Gtk2::Ex::ToplevelBits; | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | =head1 FUNCTIONS | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | =over 4 | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | =item C<< $toplevel = App::Chart::Gtk2::Ex::ToplevelBits::popup ($class, key => value, ...) >> | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | Create or raise a dialog. | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =over | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | =item C<< screen => $screen >> | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | =item C<< screen => $widget >> | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | =item C<< screen => $display >> | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | The screen on which the dialog should appear, either an existing dialog on | 
| 148 |  |  |  |  |  |  | that screen or by creating a new one on it. | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | =item C<< properties => $hashref >> | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | Property settings an existing dialog must have, or to be applied on a newly | 
| 153 |  |  |  |  |  |  | created dialog. | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | =item C<< transient_for => $toplevel >> | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | Set the dialog's C<transient-for> property to the given toplevel | 
| 158 |  |  |  |  |  |  | C<Gtk2::Window>.  This normally makes the window manager keep the dialog on | 
| 159 |  |  |  |  |  |  | top of the C<$toplevel>. | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | =item C<< modal => $bool >> | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | Set the dialog to modal, or not.  Modal forces the user to interact only | 
| 164 |  |  |  |  |  |  | with this window or dialog, not any of the other application windows. | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =item C<< hide_on_delete => $bool >> | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | When creating a new dialog, make it do a C<< $dialog->hide >> on a "delete" | 
| 169 |  |  |  |  |  |  | request from the window manager.  This is done in the usual way by | 
| 170 |  |  |  |  |  |  | connecting C<Gtk2::Widget::hide_on_delete> as a handler for the | 
| 171 |  |  |  |  |  |  | C<delete-event> signal.  The default is to destroy the dialog on delete. | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | =back | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | =back | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | L<Gtk2::Window>, L<Gtk2::Dialog>, L<Gtk2::Ex::WidgetBits> | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | =head1 HOME PAGE | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | L<http://user42.tuxfamily.org/chart/index.html> | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | =head1 LICENSE | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | Copyright 2008, 2009, 2010 Kevin Ryde | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | Chart is free software; you can redistribute it and/or modify | 
| 190 |  |  |  |  |  |  | it under the terms of the GNU General Public License as published by the | 
| 191 |  |  |  |  |  |  | Free Software Foundation; either version 3, or (at your option) any later | 
| 192 |  |  |  |  |  |  | version. | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | Chart is distributed in the hope that it will be useful, but | 
| 195 |  |  |  |  |  |  | WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | 
| 196 |  |  |  |  |  |  | or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for | 
| 197 |  |  |  |  |  |  | more details. | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | You should have received a copy of the GNU General Public License along with | 
| 200 |  |  |  |  |  |  | Chart.  If not, see L<http://www.gnu.org/licenses/>. | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | =cut |