| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Gtk2::Ex::Dialogs::Message; |
|
2
|
|
|
|
|
|
|
############################################################################### |
|
3
|
|
|
|
|
|
|
# Gtk2::Ex::Dialogs::Message - Provides a simple message dialog. |
|
4
|
|
|
|
|
|
|
# Copyright (C) 2005 Open Door Software Inc. |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
|
7
|
|
|
|
|
|
|
# modify it under the terms of the GNU Lesser General Public |
|
8
|
|
|
|
|
|
|
# License as published by the Free Software Foundation; either |
|
9
|
|
|
|
|
|
|
# version 2.1 of the License, or (at your option) any later version. |
|
10
|
|
|
|
|
|
|
# |
|
11
|
|
|
|
|
|
|
# This library is distributed in the hope that it will be useful, |
|
12
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
13
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
14
|
|
|
|
|
|
|
# Lesser General Public License for more details. |
|
15
|
|
|
|
|
|
|
# |
|
16
|
|
|
|
|
|
|
# You should have received a copy of the GNU Lesser General Public |
|
17
|
|
|
|
|
|
|
# License along with this library; if not, write to the Free Software |
|
18
|
|
|
|
|
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
19
|
|
|
|
|
|
|
############################################################################### |
|
20
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
42
|
|
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
BEGIN { |
|
23
|
1
|
|
|
|
|
123
|
use vars qw( $VERSION $parent_window $title $icon $text |
|
24
|
1
|
|
|
1
|
|
5
|
$destroy_with_parent $modal $no_separator ); |
|
|
1
|
|
|
|
|
2
|
|
|
25
|
1
|
|
|
1
|
|
29
|
$VERSION = '0.11'; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
56
|
|
|
29
|
1
|
|
|
1
|
|
635
|
use Gtk2; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use Glib; |
|
31
|
|
|
|
|
|
|
use Gtk2::Ex::Utils qw( :main :alter ); |
|
32
|
|
|
|
|
|
|
use Gtk2::Ex::Constants qw( :truth :pad :pack :align :justify ); |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub import { |
|
35
|
|
|
|
|
|
|
my $class = shift(); |
|
36
|
|
|
|
|
|
|
my $cfg = undef; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
if ( @_ % 2 == 0 ) { |
|
39
|
|
|
|
|
|
|
$cfg = { @_ }; |
|
40
|
|
|
|
|
|
|
} elsif ( @_ % 2 >= 1 ) { |
|
41
|
|
|
|
|
|
|
croak( $class . " class received an uneven argument list." ); |
|
42
|
|
|
|
|
|
|
} else { |
|
43
|
|
|
|
|
|
|
$cfg = {}; |
|
44
|
|
|
|
|
|
|
} |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::title = |
|
47
|
|
|
|
|
|
|
$cfg->{title} || ''; |
|
48
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::text = |
|
49
|
|
|
|
|
|
|
$cfg->{text} || ''; |
|
50
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::icon = |
|
51
|
|
|
|
|
|
|
$cfg->{icon} || ''; |
|
52
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::modal = |
|
53
|
|
|
|
|
|
|
$cfg->{modal} || FALSE; |
|
54
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::no_separator = |
|
55
|
|
|
|
|
|
|
$cfg->{no_separator} || FALSE; |
|
56
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::parent_window = |
|
57
|
|
|
|
|
|
|
$cfg->{parent_window} || undef; |
|
58
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::destroy_with_parent = |
|
59
|
|
|
|
|
|
|
$cfg->{destroy_with_parent} || FALSE; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 NAME |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Gtk2::Ex::Dialogs::Message - Provides a simple message dialog. |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
use Gtk2::Ex::Dialogs::Message ( destroy_with_parent => TRUE, |
|
70
|
|
|
|
|
|
|
modal => TRUE, |
|
71
|
|
|
|
|
|
|
no_separator => FALSE ); |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# do some stuff like creating your app's main $window then, |
|
74
|
|
|
|
|
|
|
# to ensure that all messages use the right parent, set it: |
|
75
|
|
|
|
|
|
|
$Gtk2::Ex::Dialogs::Message::parent_window = $window; |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# now popup a new dialog ( blocking the main loop if there is one ) |
|
78
|
|
|
|
|
|
|
new_and_run |
|
79
|
|
|
|
|
|
|
Gtk2::Ex::Dialogs::Message ( title => "Dialog Title", |
|
80
|
|
|
|
|
|
|
text => "This is a simple message" ); |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# now popup a somwhat useful dialog that doesn't block any main loop |
|
83
|
|
|
|
|
|
|
# but on the other side of the coin, if there is no main loop the |
|
84
|
|
|
|
|
|
|
# dialog will be completely unresponsive. |
|
85
|
|
|
|
|
|
|
new_show |
|
86
|
|
|
|
|
|
|
Gtk2::Ex::Dialogs::Message ( title => "Uhm", |
|
87
|
|
|
|
|
|
|
text => "Use when there is a main loop." ); |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
This module provides a simple dialog api that wraps Gtk2::Dialog objectively. |
|
92
|
|
|
|
|
|
|
The objective is a clean and simple message dialog (only an "OK" button). |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 OPTIONS |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
All public methods (and the entire class) support the following options: |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=over |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=item B => STRING |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
The title of the dialog window. Defaults to an empty string. |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=item B => STRING |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
The text to be displayed. This is the core purpose of the module and is the |
|
107
|
|
|
|
|
|
|
only mandatory argument. |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item B => /path/to/image || stock-id || Gtk2::Gdk::Pixbuf || Gtk2::Image |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
The dialog-sized image to place to the left of the text. Note: there are five |
|
112
|
|
|
|
|
|
|
aliased stock-ids which correspond to the five gtk-dialog-* ids, "warning", |
|
113
|
|
|
|
|
|
|
"question", "info", "error" and "authentication". Defaults to no icon being |
|
114
|
|
|
|
|
|
|
created at all. |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item B => Gtk2::Window |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Reference to the main application window. |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=item B => BOOL |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
When the B is destroyed, what do we do? Defaults to FALSE. |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=item B => BOOL |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Does this message make the B freeze while the message exists. |
|
127
|
|
|
|
|
|
|
Defaults to FALSE. |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=item B => BOOL |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Draw the horizontal separator between the content area and the button area |
|
132
|
|
|
|
|
|
|
below. Defaults to FALSE. |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=back |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 PUBLIC METHODS |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=over |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item OBJECT = B ( OPTIONS | STRING ) |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Create a new Gtk2::Dialog with only an "OK" button, some text and an optional |
|
143
|
|
|
|
|
|
|
icon to the left of the text. The icon can be any of the following: a stock-id |
|
144
|
|
|
|
|
|
|
string, a Gtk2::Image, Gtk2::Gdk::Pixbuf or the full path to an image. Return |
|
145
|
|
|
|
|
|
|
a Gtk2::Ex::Dialogs::Message object. In the special case of being passed only |
|
146
|
|
|
|
|
|
|
one argument, all options are set to defaults and the one argument is used as |
|
147
|
|
|
|
|
|
|
the B option. |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=back |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub new { |
|
154
|
|
|
|
|
|
|
my $proto = shift(); |
|
155
|
|
|
|
|
|
|
my $class = ref($proto) || $proto; |
|
156
|
|
|
|
|
|
|
my $cfg = undef; |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
if ( @_ % 2 == 0 ) { |
|
159
|
|
|
|
|
|
|
$cfg = { @_ }; |
|
160
|
|
|
|
|
|
|
} elsif ( @_ == 1 ) { |
|
161
|
|
|
|
|
|
|
$cfg = { text => $_[0] }; |
|
162
|
|
|
|
|
|
|
} else { |
|
163
|
|
|
|
|
|
|
$cfg = {}; |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
croak( $class . " will not create a dialog without a message." ) |
|
167
|
|
|
|
|
|
|
unless $cfg && $cfg->{text}; |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my $self = { CFG => $cfg }; |
|
170
|
|
|
|
|
|
|
bless($self, $class); |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
$cfg->{title} ||= $Gtk2::Ex::Dialogs::Message::title; |
|
173
|
|
|
|
|
|
|
$cfg->{text} ||= $Gtk2::Ex::Dialogs::Message::text; |
|
174
|
|
|
|
|
|
|
$cfg->{icon} ||= $Gtk2::Ex::Dialogs::Message::icon; |
|
175
|
|
|
|
|
|
|
$cfg->{parent_window} ||= $Gtk2::Ex::Dialogs::Message::parent_window; |
|
176
|
|
|
|
|
|
|
$cfg->{destroy_with_parent} ||= $Gtk2::Ex::Dialogs::Message::destroy_with_parent; |
|
177
|
|
|
|
|
|
|
$cfg->{modal} ||= $Gtk2::Ex::Dialogs::Message::modal; |
|
178
|
|
|
|
|
|
|
$cfg->{no_separator} ||= $Gtk2::Ex::Dialogs::Message::no_separator; |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
my $flags = []; |
|
181
|
|
|
|
|
|
|
push( @{ $flags }, 'destroy-with-parent' ) if $cfg->{destroy_with_parent}; |
|
182
|
|
|
|
|
|
|
push( @{ $flags }, 'modal' ) if $cfg->{modal}; |
|
183
|
|
|
|
|
|
|
push( @{ $flags }, 'no-separator' ) if $cfg->{no_separator}; |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
$self->{dialog} = new Gtk2::Dialog ( $cfg->{title}, |
|
186
|
|
|
|
|
|
|
$cfg->{parent_window}, |
|
187
|
|
|
|
|
|
|
$flags, |
|
188
|
|
|
|
|
|
|
'gtk-ok' => 'accept' ); |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
$self->{hbox} = new Gtk2::HBox ( FALSE, 0 ); |
|
191
|
|
|
|
|
|
|
$self->{dialog}->vbox->pack_start( $self->{hbox}, PACK_GROW, PAD_WIDGET ); |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
if ( $cfg->{icon} ) { |
|
194
|
|
|
|
|
|
|
$self->{icon} = undef; |
|
195
|
|
|
|
|
|
|
my $ICON_ALIASES = 'question|warning|error|info|authentication'; |
|
196
|
|
|
|
|
|
|
if ( ref( $cfg->{icon} ) eq "Gtk2::Gdk::Pixbuf" ) { |
|
197
|
|
|
|
|
|
|
$self->{icon} = new_from_pixbuf Gtk2::Image ( $cfg->{icon} ); |
|
198
|
|
|
|
|
|
|
} elsif ( ref( $cfg->{icon} ) eq "Gtk2::Image" ) { |
|
199
|
|
|
|
|
|
|
$self->{icon} = $cfg->{icon}; |
|
200
|
|
|
|
|
|
|
} elsif ( -f $cfg->{icon} ) { |
|
201
|
|
|
|
|
|
|
$self->{icon} = new_from_file Gtk2::Image ( $cfg->{icon} ); |
|
202
|
|
|
|
|
|
|
} elsif ( $cfg->{icon} =~ /^gtk\-|$ICON_ALIASES/ ) { |
|
203
|
|
|
|
|
|
|
$cfg->{icon} = 'gtk-dialog-' . $cfg->{icon} |
|
204
|
|
|
|
|
|
|
unless $cfg->{icon} =~ /^gtk\-/; |
|
205
|
|
|
|
|
|
|
$self->{icon} = new_from_stock Gtk2::Image ( $cfg->{icon}, 'dialog' ); |
|
206
|
|
|
|
|
|
|
} |
|
207
|
|
|
|
|
|
|
unless ( not $self->{icon} ) { |
|
208
|
|
|
|
|
|
|
$self->{hbox}->pack_start( $self->{icon}, PACK_ZERO, PAD_WIDGET ); |
|
209
|
|
|
|
|
|
|
$self->{icon}->set_alignment( A_LEFT, A_MIDDLE ); |
|
210
|
|
|
|
|
|
|
} |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
$self->{label} = new Gtk2::Label; |
|
214
|
|
|
|
|
|
|
make_label_wrap_left_centred( $self->{label} ); |
|
215
|
|
|
|
|
|
|
$self->{label}->set_markup( $cfg->{text} ); |
|
216
|
|
|
|
|
|
|
$self->{hbox}->pack_start( $self->{label}, PACK_GROW, PAD_WIDGET ); |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
return( $self ); |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=over |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=item B ( OPTIONS ) |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
Supports all the same arguments as new(). This will create a new |
|
226
|
|
|
|
|
|
|
Gtk2::Ex::Dialogs::Message, show_all(), run() and then destroy the dialog immediately. |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=back |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=cut |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub new_and_run { |
|
233
|
|
|
|
|
|
|
my $class = shift(); |
|
234
|
|
|
|
|
|
|
my $run = new Gtk2::Ex::Dialogs::Message ( @_ ); |
|
235
|
|
|
|
|
|
|
$run->dialog->show_all(); |
|
236
|
|
|
|
|
|
|
$run->dialog->run(); |
|
237
|
|
|
|
|
|
|
$run->dialog->destroy(); |
|
238
|
|
|
|
|
|
|
} |
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=over |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item B ( OPTIONS ) |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Supports all the same arguments as new(). This will create a new |
|
245
|
|
|
|
|
|
|
Gtk2::Ex::Dialogs::Message, show_all() and process any pending gtk events. This |
|
246
|
|
|
|
|
|
|
functionality is only of any practical use when there is a Gtk2 main loop |
|
247
|
|
|
|
|
|
|
running. If there is no main loop running the dialog will be visible but |
|
248
|
|
|
|
|
|
|
completely unresponsive to the end-user. |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=back |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=cut |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub new_and_show { |
|
255
|
|
|
|
|
|
|
my $class = shift(); |
|
256
|
|
|
|
|
|
|
my $show = new Gtk2::Ex::Dialogs::Message ( @_ ); |
|
257
|
|
|
|
|
|
|
$show->dialog->signal_connect( response => sub { $_[0]->destroy(); } ); |
|
258
|
|
|
|
|
|
|
$show->dialog->signal_connect( 'delete-event' => sub { $_[0]->destroy(); } ); |
|
259
|
|
|
|
|
|
|
$show->dialog->show_all(); |
|
260
|
|
|
|
|
|
|
process_pending_events(); |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# |
|
264
|
|
|
|
|
|
|
# PRIVATE METHODS |
|
265
|
|
|
|
|
|
|
# |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub dialog { return( $_[0]->{dialog} ); } |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
1; |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
__END__ |