perllib/FVWM/Module/Toolkit.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::Toolkit;
  18
  19 use 5.004;
  20 use strict;
  21 use vars qw($VERSION @ISA $_dialog_tool);
  22
  23 use FVWM::Module;
  24
  25 BEGIN {
  26         $VERSION = $FVWM::Module::VERSION;
  27         @ISA = qw(FVWM::Module);
  28 }
  29
  30 sub import ($@) {
  31         my $class = shift;
  32         my $caller = caller;
  33         my $error = 0;
  34         my $name = "*undefined*";
  35
  36         while (@_) {
  37                 $name = shift;
  38                 if ($name eq 'base') {
  39                         next if UNIVERSAL::isa($caller, __PACKAGE__);
  40                         my $caller2 = (caller(1))[0];
  41                         eval "
  42                                 package $caller2;
  43                                 use FVWM::Constants;
  44
  45                                 package $caller;
  46                                 use vars qw(\$VERSION \@ISA);
  47                                 use FVWM::Constants;
  48                                 \$VERSION = \$FVWM::Module::Toolkit::VERSION;
  49                                 \@ISA = qw(FVWM::Module::Toolkit);
  50                         ";
  51                         if ($@) {
  52                                 die "Internal error:\n$@";
  53                         }
  54                 } else {
  55                         my ($name0, $args) = split(/>?=/, $name, 2);
  56                         my $mod = $args? "$name0 split(/,/, q{$args})": $name;
  57                         eval "
  58                                 package $caller;
  59                                 use $mod;
  60                         ";
  61                         if ($@) {
  62                                 $error = 1;
  63                                 last;
  64                         }
  65                 }
  66         }
  67         if ($error) {
  68                 my $script_name = $0; $script_name =~ s|.*/||;
  69                 my $error_title = 'FVWM Perl library error';
  70                 my $error_msg = "$script_name requires Perl package $name to be installed.\n\n";
  71                 $error_msg .= "You may either find it as a binary package for your distribution\n";
  72                 $error_msg .= "or download it from CPAN, http://cpan.org/modules/by-module/ .\n";
  73                 $class->show_message($error_msg, $error_title, 1);
  74                 print STDERR "[$error_title]: $error_msg\n$@";
  75                 exit(1);
  76         }
  77 }
  78
  79 sub show_error ($$;$) {
  80         my $self = shift;
  81         my $msg = shift;
  82         my $title = shift || ($self->name . " Error");
  83
  84         $self->show_message($msg, $title, 1);
  85         print STDERR "[$title]: $msg\n";
  86 }
  87
  88 sub show_message ($$;$) {
  89         my $self = shift;
  90         my $msg = shift;
  91         my $title = shift || ($self->name . " Message");
  92         my $no_stderr = shift || 0;  # for private usage only
  93
  94         unless ($_dialog_tool) {
  95                 my @dirs = split(':', $ENV{PATH});
  96                 # kdialog is last because at least v0.9 ignores --title
  97                 TOOL_CANDIDATE:
  98                 foreach (qw(gdialog Xdialog zenity gtk-shell xmessage kdialog)) {
  99                         foreach my $dir (@dirs) {
 100                                 my $file = "$dir/$_";
 101                                 if (-x $file) {
 102                                         $_dialog_tool = $_;
 103                                         last TOOL_CANDIDATE;
 104                                 }
 105                         }
 106                 }
 107         }
 108         my $tool = $_dialog_tool || "xterm";
 109
 110         $msg =~ s/'/'"'"'/sg;
 111         $title =~ s/'/'"'"'/sg;
 112         if ($tool eq "gdialog" || $tool eq "Xdialog" || $tool eq "kdialog") {
 113                 system("$tool --title '$title' --msgbox '$msg' 500 100 &");
 114         } elsif ($tool eq "gtk-shell") {
 115                 system("gtk-shell --size 500 100 --title '$title' --label '$msg' --button Close &");
 116         } elsif ($tool eq "zenity") {
 117                 system("zenity --title '$title' --info --text '$msg' --no-wrap &");
 118         } elsif ($tool eq "xmessage") {
 119                 system("xmessage -name '$title' '$msg' &");
 120         } else {
 121                 $msg =~ s/"/\\"/sg;
 122                 $msg =~ s/\n/\\n/sg;
 123                 system("xterm -g 70x10 -T '$title' -e \"echo '$msg'; sleep 600000\" &");
 124         }
 125         print STDERR "[$title]: $msg\n" if $! && !$no_stderr;
 126 }
 127
 128 sub show_debug ($$;$) {
 129         my $self = shift;
 130         my $msg = shift;
 131         my $title = shift || ($self->name . " Debug");
 132
 133         print STDERR "[$title]: $msg\n";
 134 }
 135
 136 sub add_default_error_handler ($) {
 137         my $self = shift;
 138
 139         $self->add_handler(M_ERROR, sub {
 140                 my ($self, $event) = @_;
 141                 $self->show_error($event->_text, "fvwm error");
 142         });
 143 }
 144
 145 1;
 146
 147 __END__
 148
 149 =head1 NAME
 150
 151 FVWM::Module::Toolkit - FVWM::Module with abstract widget toolkit attached
 152
 153 =head1 SYNOPSIS
 154
 155 1) May be used anywhere to require external Perl classes and report error in
 156 the nice dialog if absent:
 157
 158     use FVWM::Module::Toolkit qw(Tk X11::Protocol Tk::Balloon);
 159
 160     use FVWM::Module::Toolkit qw(Tk=804.024,catch X11::Protocol>=0.52);
 161
 162 There is the same syntactic sugar as in "perl -M", with an addition
 163 of ">=" being fully equivalent to "=". The ">=" form may look better for
 164 the user in the error message. If the required Perl class is absent,
 165 FVWM::Module::Toolkit->show_message() is used to show the dialog and the
 166 application dies.
 167
 168 2) This class should be uses to implement concrete toolkit subclasses.
 169 A new toolkit subclass implementation may look like this:
 170
 171     package FVWM::Module::SomeToolkit;
 172     # this automatically sets the base class and tries "use SomeToolkit;"
 173     use FVWM::Module::Toolkit qw(base SomeToolkit);
 174
 175     sub show_error ($$;$) {
 176         my ($self, $error, $title) = @_;
 177         $title ||= $self->name . " Error";
 178
 179         # create a dialog box using SomeToolkit widgets
 180         SomeToolkit->Dialog(
 181             -title => $title,
 182             -text => $error,
 183             -buttons => ['Close'],
 184         );
 185     }
 186
 187     sub event_loop ($$) {
 188         my $self = shift;
 189         my @params = @_;
 190
 191         # enter the SomeToolkit event loop with hooking $self->{istream}
 192         $self->event_loop_prepared(@params);
 193         fileevent($self->{istream},
 194             read => sub {
 195                 unless ($self->process_packet($self->read_packet)) {
 196                     $self->disconnect;
 197                     $top->destroy;
 198                 }
 199                 $self->event_loop_prepared(@params);
 200             }
 201         );
 202         SomeToolkit->MainLoop;
 203         $self->event_loop_finished(@params);
 204     }
 205
 206 =head1 DESCRIPTION
 207
 208 The B<FVWM::Module::Toolkit> package is a sub-class of B<FVWM::Module> that
 209 is intended to be uses as the base of sub-classes that attach widget
 210 toolkit library, like Perl/Tk or Gtk-Perl. It does some common work to load
 211 widget toolkit libraries and to show an error in the external window like
 212 xmessage if the required libraries are not available.
 213
 214 This class overloads one method B<add_default_error_handler> and expects
 215 sub-classes to overload the methods B<show_error>, B<show_message> and
 216 B<show_debug> to use native widgets. These 3 methods are implemented in this
 217 class, they extend the superclass versions by adding a title parameter and
 218 using an external dialog tool to show error/message.
 219
 220 This manual page details only those differences. For details on the
 221 API itself, see L<FVWM::Module>.
 222
 223 =head1 METHODS
 224
 225 Only overloaded or new methods are covered here:
 226
 227 =over 8
 228
 229 =item B<show_error> I<msg> [I<title>]
 230
 231 This method is intended to be overridden in subclasses to create a dialog box
 232 using the corresponding widgets. The default fall back implementation is
 233 similar to B<show_message>, but the error message (with title) is also always
 234 printed to STDERR.
 235
 236 May be good for module diagnostics or any other purpose.
 237
 238 =item B<show_message> I<msg> [I<title>]
 239
 240 This method is intended to be overridden in subclasses to create a dialog
 241 box using the corresponding widgets. The default fall back implementation is
 242 to find a system message application to show the message. The potentially
 243 used applications are I<gdialog>, I<Xdialog>, I<zenity>, I<gtk-shell>,
 244 I<xmessage>, I<kdialog>, or I<xterm> as the last resort. If not given,
 245 I<title> is based on the module name.
 246
 247 May be good for module debugging or any other purpose.
 248
 249 =item B<show_debug> I<msg> [I<title>]
 250
 251 This method is intended to be overridden in subclasses to create a dialog box
 252 using the corresponding widgets. The default fall back implementation is
 253 to print a message (with a title that is the module name by default)
 254 to STDERR.
 255
 256 May be good for module debugging or any other purpose.
 257
 258 =item B<add_default_error_handler>
 259
 260 This methods adds a M_ERROR handler to automatically notify you that an error
 261 has been reported by fvwm. The M_ERROR handler then calls C<show_error()>
 262 with the received error text as a parameter to show it in a window.
 263
 264 =back
 265
 266 =head1 AUTHOR
 267
 268 Mikhael Goikhman <migo@homemail.com>.
 269
 270 =head1 SEE ALSO
 271
 272 For more information, see L<fvwm>, L<FVWM::Module>, L<FVWM::Module::Gtk>,
 273 L<FVWM::Module::Gtk2>, L<FVWM::Module::Tk>.
 274
 275 =cut