aboutsummaryrefslogtreecommitdiff
path: root/Perl/Zinc/Debug.pm
diff options
context:
space:
mode:
authoretienne2003-03-07 16:14:07 +0000
committeretienne2003-03-07 16:14:07 +0000
commite82e5cf6c4e3b8d56bebab98ead3c441ea84b124 (patch)
treeca55fffff3fcbb36bb2eb408bc64a4e6ae1bbbc2 /Perl/Zinc/Debug.pm
parenta10fdf00213ca14ff4bc02b3425436a192f74773 (diff)
downloadtkzinc-e82e5cf6c4e3b8d56bebab98ead3c441ea84b124.zip
tkzinc-e82e5cf6c4e3b8d56bebab98ead3c441ea84b124.tar.gz
tkzinc-e82e5cf6c4e3b8d56bebab98ead3c441ea84b124.tar.bz2
tkzinc-e82e5cf6c4e3b8d56bebab98ead3c441ea84b124.tar.xz
hack pour pouvoir charger en parallele plusieurs modules qui surchargent Tk::Zinc::InitObject
Diffstat (limited to 'Perl/Zinc/Debug.pm')
-rw-r--r--Perl/Zinc/Debug.pm11
1 files changed, 7 insertions, 4 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index bc3dcfc..e346f48 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -52,12 +52,14 @@ my %instances;
my @instances;
my %cmdoptions;
my $initobjectfunction;
+
sub BEGIN {
# test if ZincDebug is loaded using the -M perl option
$preload = 1 if (caller(2))[2] == 0;
return unless $preload;
# parse ZincDebug options
require Getopt::Long;
+ #Getopt::Long::Configure('pass_through');
Getopt::Long::GetOptions(\%cmdoptions,
'itemModBtn=s', 'tkey=s', 'optionsToDisplay=s', 'optionsFormat=s',
'color=s', 'enclosedModBtn=s', 'overlapModBtn=s', 'searchKey=s',
@@ -65,17 +67,18 @@ sub BEGIN {
);
# save current Tk::Zinc::InitObject function; it will be invoked in
# overloaded one (see below)
- $initobjectfunction = \&Tk::Zinc::InitObject;
+ $initobjectfunction = Tk::Zinc->can('InitObject');
+ *Tk::Zinc::InitObject = *InitObject;
}
# Hack to capture the instance of zinc. ZincDebug functions are invoked here.
# Note that created bindings might be overloaded by the application.
-sub Tk::Zinc::InitObject {
+sub InitObject {
Tk::Widget::InitObject(@_);
+ #print "Tk::Zinc::InitObject\n";
# invoke function possibly overloaded in other modules
- &$initobjectfunction;
- #print "***** ZincDebug Tk::Zinc::InitObject zinc=$_[0]\n";
+ &$initobjectfunction(@_) if $initobjectfunction;
return unless $preload;
my $zinc = $_[0];
my @options = ();