Can the source code for a module found on CPAN be changed?? I am trying to use Tk::DialogBox for a program but it doesn't let me place it on the screen where I want. I found Tk::XDialogBox which has the -from_x, -from_y options but it doesn't place the dialog box in front of my TOPLEVEL windows.
So I looked at the source for both and the Show method for XDIALOGBOX has #cw::Popup commented out! Well this is what I think makes it popup and go to the front. Here are the Show methods for both. I want to uncomment out that line and see if it works. Can this be done?
DIALOGBOX
[cpan://Tk::DialogBox]
sub Show {
croak 'DialogBox: "Show" method requires at least 1 argument'
if scalar @_ < 1;
my $cw = shift;
my ($grab) = @_;
my $old_focus = $cw->focusSave;
my $old_grab = $cw->grabSave;
shift if defined $grab && length $grab && ($grab =~ /global/);
$cw->Popup(@_);
Tk::catch {
if (defined $grab && length $grab && ($grab =~ /global/)) {
$cw->grabGlobal;
} else {
$cw->grab;
}
};
if (my $focusw = $cw->cget(-focus)) {
$focusw->focus;
} elsif (defined $cw->{'default_button'}) {
$cw->{'default_button'}->focus;
} else {
$cw->focus;
}
$cw->Wait;
&$old_focus;
&$old_grab;
return $cw->{'selected_button'};
XDIALOGBOX
[cpan://Tk::XDialogBox]
sub Show {
my ($cw, $grab) = @_;
croak 'DialogBox: "Show" method requires at least 1 argument'
if scalar @_ < 1;
my $old_focus = $cw->focusSave;
my $old_grab = $cw->grabSave;
# $cw->Popup();
$cw->update;
Tk::catch {
if (defined $grab && length $grab && ($grab =~ /global/)) {
$cw->grabGlobal;
} elsif(defined $grab && length $grab && ($grab =~ /nograb/)) {
# No Grab
} else {
$cw->grab;
}
};
if (defined $cw->{'focus'}) {
$cw->{'focus'}->focus;
} elsif (defined $cw->{'default_button'}) {
$cw->{'default_button'}->focus;
} else {
$cw->focus;
}
$cw->Wait;
&$old_focus;
&$old_grab;
return $cw->{'selected_button'};
}
package My::Tk::DialogBox;
use base qw/Tk::DialogBox/;
sub Show {
# your version of Show() here.
}
package main;
my $dialogbox = My::Tk::DialogBox->new( ... );
Can also just override it like this (it will throw a warning)
package Tk::DialogBox;
sub Show {
# your version of Show() here.
}
package main;
my $dialogbox = Tk::DialogBox->new( ... );
These last two aren't preferrable solutions though, because it can (will?) break w/an upgrade of the original module.
I have patched versions of several Tk modules in my local lib directory (local to the application) and the techniques seems to work fine. The only problem you have is if an update of another module changes a dependency.
BUT, you may be better off addressing the underlying problem, and just use a toplevel window, and do a grabGlobal on it. That is all the dialogbox does( besides adding a few buttons. That way you can make custom colors, positions, etc. Once you make it once, you can reuse it over and over. When you are done getting the information from the toplevel, do a grabRelease to return control to the main program.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $tl;
my $mw = MainWindow->new;
$mw->title( "MainWindow" );
$mw->Button( -text => "Toplevel", -command => \&do_Toplevel )->pack();
MainLoop;
sub do_Toplevel {
if ( !Exists( $tl ) ) {
$tl = $mw->Toplevel();
$tl->geometry('300x100+100+100');
$tl->title( "Toplevel" );
#put all your widgets here
$tl->Button(
-text => "Close",
-command => sub { $tl->grabRelease;
$tl->withdraw }
)->pack;
}
else {
$tl->deiconify();
$tl->raise();
$tl->grabGlobal;
}
}
##############################################################
perlmonks.org content © perlmonks.org and davidrw, jdtoronto, mikasue, xorl, zentara
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03