perllib/FVWM/Module/Gtk2.pm

   1 # Copyright (c) 2003-2009, Mikhael Goikhman
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package FVWM::Module::Gtk2;
  18
  19 use 5.004;
  20 use strict;
  21
  22 use FVWM::Module::Toolkit qw(base Gtk2 Gtk2::Helper);
  23
  24 sub event_loop ($@) {
  25         my $self = shift;
  26         my @params = @_;
  27
  28         $self->event_loop_prepared(@params);
  29         Gtk2::Helper->add_watch(
  30                 $self->{istream}->fileno, 'in',
  31                 sub ($$$) {
  32                         #my ($socket, $fd, $flags) = @_;
  33                         #return 0 unless $flags->{'read'};
  34                         unless ($self->process_packet($self->read_packet)) {
  35                                 Gtk2->main_quit;
  36                         }
  37                         $self->event_loop_prepared(@params);
  38                         return 1;
  39                 }
  40         );
  41         Gtk2->main;
  42         $self->event_loop_finished(@params);
  43 }
  44
  45 sub show_error ($$;$) {
  46         my $self = shift;
  47         my $msg = shift;
  48         my $title = shift || ($self->name . " Error");
  49
  50         my $dialog = new Gtk2::Dialog;
  51         $dialog->set_title($title);
  52         $dialog->set_border_width(4);
  53
  54         my $label = new Gtk2::Label $msg;
  55         $dialog->vbox->pack_start($label, 0, 1, 10);
  56
  57         my $button = new Gtk2::Button "Close";
  58         $dialog->action_area->pack_start($button, 1, 1, 0);
  59         $button->signal_connect("clicked", sub { $dialog->destroy; });
  60
  61         $button = new Gtk2::Button "Close All Errors";
  62         $dialog->action_area->pack_start($button, 1, 1, 0);
  63         $button->signal_connect("clicked",
  64                 sub { $self->send("All ('$title') Close"); });
  65
  66         $button = new Gtk2::Button "Exit Module";
  67         $dialog->action_area->pack_start($button, 1, 1, 0);
  68         $button->signal_connect("clicked", sub { Gtk2->main_quit; });
  69
  70         $dialog->show_all;
  71 }
  72
  73 sub show_message ($$;$) {
  74         my $self = shift;
  75         my $msg = shift;
  76         my $title = shift || ($self->name . " Message");
  77
  78         my $dialog = new Gtk2::Dialog;
  79         $dialog->set_title($title);
  80         $dialog->set_border_width(4);
  81
  82         my $label = new Gtk2::Label $msg;
  83         $dialog->vbox->pack_start($label, 0, 1, 10);
  84
  85         my $button = new Gtk2::Button "Close";
  86         $dialog->action_area->pack_start($button, 1, 1, 0);
  87         $button->signal_connect("clicked", sub { $dialog->destroy; });
  88
  89         $dialog->show_all;
  90 }
  91
  92 sub show_debug ($$;$) {
  93         my $self = shift;
  94         my $msg = shift;
  95         my $title = shift || ($self->name . " Debug");
  96
  97         my $dialog = $self->{gtk_debug_dialog};
  98
  99         if (!$dialog) {
 100                 $self->{gtk_debug_string} ||= "";
 101
 102                 $dialog = new Gtk2::Dialog;
 103                 $dialog->set_title($title);
 104                 $dialog->set_border_width(4);
 105                 $dialog->set_default_size(540, 400);
 106
 107                 my $scroll = Gtk2::ScrolledWindow->new;
 108                 $scroll->set_policy('automatic', 'automatic');
 109                 $scroll->set_shadow_type('in');
 110                 my $text = Gtk2::TextBuffer->new(undef);
 111                 $text->insert($text->get_iter_at_offset(0), $self->{gtk_debug_string});
 112                 my $view = Gtk2::TextView->new;
 113                 $view->set_buffer($text);
 114                 $view->set_editable(0);
 115                 $view->set_cursor_visible(0);
 116                 $view->set_wrap_mode('word');
 117                 $view->set_pixels_above_lines(2);
 118                 $view->set_pixels_below_lines(2);
 119                 $scroll->add($view);
 120                 $dialog->vbox->pack_start($scroll, 1, 1, 4);
 121
 122                 my $button = new Gtk2::Button "Close";
 123                 $dialog->action_area->pack_start($button, 1, 1, 0);
 124                 $button->signal_connect("clicked", sub { $dialog->destroy; });
 125
 126                 $button = new Gtk2::Button "Clear";
 127                 $dialog->action_area->pack_start($button, 1, 1, 0);
 128                 $button->signal_connect("clicked", sub {
 129                         $text->delete($text->get_bounds);
 130                         $self->{gtk_debug_string} = "";
 131                 });
 132
 133                 $button = new Gtk2::Button "Save";
 134                 $dialog->action_area->pack_start($button, 1, 1, 0);
 135                 $button->signal_connect("clicked", sub {
 136                         my $file_dialog = new Gtk2::FileSelection("Save $title");
 137                         my $filename = "$ENV{FVWM_USERDIR}/";
 138                         $filename .= $self->name . "-debug.txt";
 139                         $file_dialog->set_filename($filename);
 140                         $file_dialog->ok_button->signal_connect("clicked", sub {
 141                                 $filename = $file_dialog->get_filename;
 142                                 require General::FileSystem;
 143                                 my $text = \$self->{gtk_debug_string};
 144                                 General::FileSystem::save_file($filename, $text)
 145                                         if $filename;
 146                                 $file_dialog->destroy;
 147                         });
 148                         $file_dialog->cancel_button->signal_connect("clicked", sub {
 149                                 $file_dialog->destroy;
 150                         });
 151                         $file_dialog->show;
 152                 });
 153
 154                 $dialog->signal_connect('destroy', sub {
 155                         $self->{gtk_debug_dialog} = undef;
 156                         $self->{gtk_debug_text_wg} = undef;
 157                 });
 158                 $dialog->show_all;
 159
 160                 $self->{gtk_debug_dialog} = $dialog;
 161                 $self->{gtk_debug_text_wg} = $text;
 162         }
 163
 164         my $text = $self->{gtk_debug_text_wg};
 165         $text->insert(($text->get_bounds)[1], "$msg\n");
 166         $self->{gtk_debug_string} .= "$msg\n";
 167 }
 168
 169 1;
 170
 171 __END__
 172
 173 =head1 NAME
 174
 175 FVWM::Module::Gtk2 - FVWM::Module with the GTK+ v2 widget library attached
 176
 177 =head1 SYNOPSIS
 178
 179 Name this module TestModuleGtk2, make it executable and place in ModulePath:
 180
 181     #!/usr/bin/perl -w
 182
 183     use lib `fvwm-perllib dir`;
 184     use FVWM::Module::Gtk2;
 185     Gtk2->init;
 186
 187     my $module = new FVWM::Module::Gtk2(
 188         Debug => 2,
 189     );
 190
 191     my $dialog = new Gtk2::Dialog;
 192     $dialog->signal_connect("destroy", sub { Gtk2->main_quit; });
 193     $dialog->set_title("Simple Test");
 194     my $button = new Gtk2::Button "Close";
 195     $button->signal_connect("clicked", sub { $dialog->destroy; });
 196     $dialog->action_area->pack_start($button, 1, 1, 0);
 197     $dialog->show_all;
 198     my $id = $dialog->window->XWINDOW();
 199
 200     $module->add_default_error_handler;
 201     $module->add_handler(M_ICONIFY, sub {
 202         my $id0 = $_[1]->_win_id;
 203         $module->send("Iconify off", $id) if $id0 == $id;
 204     });
 205     $module->track('Scheduler')->schedule(60, sub {
 206         $module->show_message("You run this module for 1 minute")
 207     });
 208
 209     $module->send('Style "Simple Test" Sticky');
 210     $module->event_loop;
 211
 212 =head1 DESCRIPTION
 213
 214 The B<FVWM::Module::Gtk2> class is a sub-class of B<FVWM::Module::Toolkit>
 215 that overloads the methods B<event_loop>, B<show_error>, B<show_message> and
 216 B<show_debug> to manage GTK+ version 2 objects as well.
 217
 218 This manual page details only those differences. For details on the
 219 API itself, see L<FVWM::Module>.
 220
 221 =head1 METHODS
 222
 223 Only overloaded or new methods are covered here:
 224
 225 =over 8
 226
 227 =item B<event_loop>
 228
 229 From outward appearances, this methods operates just as the parent
 230 B<event_loop> does. It is worth mentioning, however, that this version
 231 enters into the B<Gtk2>->B<main> subroutine, ostensibly not to return.
 232
 233 =item B<show_error> I<msg> [I<title>]
 234
 235 This method creates a dialog box using the GTK+ widgets. The dialog has
 236 three buttons labeled "Close", "Close All Errors" and "Exit Module".
 237 Selecting the "Close" button closes the dialog. "Close All Errors" closes
 238 all error dialogs that may be open on the screen at that time.
 239 "Exit Module" terminates your entire module.
 240
 241 Useful for diagnostics of a GTK+ based module.
 242
 243 =item B<show_message> I<msg> [I<title>]
 244
 245 Creates a message window with one "Close" button.
 246
 247 Useful for notices by a GTK+ based module.
 248
 249 =item B<show_debug> I<msg> [I<title>]
 250
 251 Creates a persistent debug window with 3 buttons "Close", "Clear" and "Save".
 252 All new debug messages are added to this window (i.e. the existing debug
 253 window is reused if found).
 254
 255 "Close" withdraws the window until the next debug message arrives.
 256
 257 "Clear" erases the current contents of the debug window.
 258
 259 "Save" dumps the current contents of the debug window to the selected file.
 260
 261 Useful for debugging a GTK+ based module.
 262
 263 =back
 264
 265 =head1 BUGS
 266
 267 Awaiting for your reporting.
 268
 269 =head1 AUTHOR
 270
 271 Mikhael Goikhman <migo@homemail.com>.
 272
 273 =head1 THANKS TO
 274
 275 gtk2-perl.sf.net team for Gtk2-Perl extension.
 276
 277 =head1 SEE ALSO
 278
 279 For more information, see L<fvwm>, L<FVWM::Module> and L<Gtk2>.
 280
 281 See also L<FVWM::Module::Gtk> for use with GTK+ version 1.
 282
 283 =cut