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__ |