? perllib/FVWM/.Module.pm.swp
? perllib/FVWM/Module/.Gtk.pm.swp
? perllib/FVWM/Module/.Tk.pm.swp
Index: perllib/FVWM/Module/Tk.pm
===================================================================
RCS file: /home/cvs/fvwm/fvwm/perllib/FVWM/Module/Tk.pm,v
retrieving revision 1.9
diff -u -r1.9 Tk.pm
--- perllib/FVWM/Module/Tk.pm 10 Jun 2003 00:00:17 -0000 1.9
+++ perllib/FVWM/Module/Tk.pm 14 Jun 2003 03:45:17 -0000
@@ -17,7 +17,7 @@
use 5.004;
use strict;
-use FVWM::Module::Toolkit qw(base Tk Tk::Dialog);
+use FVWM::Module::Toolkit qw(base Tk Tk::Dialog Tk::ROText);
sub new ($$@) {
my $class = shift;
@@ -75,6 +75,72 @@
$self->send("All ('$title') Close") if $btn eq 'Close All Errors';
}
+sub showMessage ($$;$)
+{
+ my $self = shift;
+ my $msg = shift;
+ my $title = shift || ($self->name . " Message");
+
+ $self->topLevel()->messageBox(-icon => 'info',
+ -type => 'ok',
+ -title => $title,
+ -message => $msg);
+}
+
+sub showDebug ($$;$)
+{
+ my $self = shift;
+ my $msg = shift;
+ my $title = shift || ($self->name . " Debug");
+
+ if (!$self->{tkDebugDialog})
+ {
+ if (!defined $self->topLevel())
+ {
+ # App hasn't been fully created - too early to popup a
dialog.
+ $self->FVWM::Module::showDebug($msg);
+ return;
+ }
+
+ # # Tk's Dialog widgets are too damn inflexible. It's less
+ # hassle to build one from scratch.
+ my $tl = $self->topLevel()->Toplevel(-title => $title);
+ my $top = $tl->Frame()->pack(-expand => 1, -fill => 'both');
+ my $bottom = $tl->Frame()->pack(-expand => 1, -fill => 'x');
+ my $t = $top->Scrolled('ROText',
+ -bg => 'white',
+ -wrap => 'word',
+ -scrollbars => 'oe')->pack();
+
+ $tl->protocol('WM_DELETE_WINDOW', sub { $tl->withdraw(); });
+ my (@pl) = (-side => 'left', -expand => 1, -fill => 'both');
+ $bottom->Button(-text => 'Close', -command => sub {
+ $tl->withdraw(); })->pack(@pl);
+ $bottom->Button(-text => 'Clear', -command => sub {
+ $t->delete('0.0', 'end'); })->pack(@pl);
+ $bottom->Button(-text => 'Save', -command => sub {
+ my $f = $tl->getSaveFile(-title => 'Save' . $title);
+ return if (!defined $f);
+ if (!open(OUT, ">$f"))
+ {
+ $self->showError("Couldn't save $f: $!", 'Save
Error');
+ return;
+ }
+
+ print OUT $t->get('0.0', 'end');
+ close(OUT); })->pack(@pl);
+
+ $self->{tkDebugDialog} = $tl;
+ $self->{tkDebugTextW} = $t;
+ }
+ else
+ {
+ $self->{tkDebugDialog}->deiconify();
+ }
+ $self->{tkDebugTextW}->insert('end', $msg . "\n");
+ $self->{tkDebugTextW}->see('end');
+}
+
sub topLevel ($) {
return shift->{topLevel};
}
@@ -108,8 +174,9 @@
=head1 DESCRIPTION
The B<FVWM::Module::Tk> package is a sub-class of B<FVWM::Module> that
-overloads the methods B<new>, B<eventLoop> and B<showError> to manage
-Tk objects as well. It also adds new methods B<topLevel> and B<winId>.
+overloads the methods B<new>, B<eventLoop>, B<showMessage>, B<showDebug> and
+B<showError> to manage Tk objects as well. It also adds new methods
+B<topLevel> and B<winId>.
This manual page details only those differences. For details on the
API itself, see L<FVWM::Module>.
@@ -146,6 +213,21 @@
"Exit Module" terminates your entire module.
Good for diagnostics of a Tk based module.
+
+=item B<showMessage> I<msg> [I<title>]
+
+Creates a message window with one "Ok" button.
+
+=item B<showDebug> I<msg> [I<title>]
+
+Creates a debug window with 3 buttons - Close, Clear & Save.
+All debug messages are added to the debug window.
+
+"Close" will withdraw the window until the next debug message arrives.
+"Clear" erases the current contents of the debug window.
+"Save" will dump the current contents of the debug window to the selected file.
+
+Useful for debugging Tk based modules.
=item B<topLevel>
