diff options
Diffstat (limited to 'Perl/Zinc')
| -rw-r--r-- | Perl/Zinc/Trace.pm | 58 |
1 files changed, 33 insertions, 25 deletions
diff --git a/Perl/Zinc/Trace.pm b/Perl/Zinc/Trace.pm index 8a7160a..9748c0b 100644 --- a/Perl/Zinc/Trace.pm +++ b/Perl/Zinc/Trace.pm @@ -21,6 +21,7 @@ # for using this file do some thing like : # perl -MZincTrace myappli.pl +BEGIN { print "ZincTrace is ON\n"; select STDOUT; $|=1 } ## for flushing the trace output package ZincTrace; use Tk; @@ -33,31 +34,38 @@ use Carp; my $asCode = 0; #$asCode = 1; my ($lastMethod, $package, $filename, $line); -sub Tk::Methods -{ - my ($package) = caller; - no strict 'refs'; - foreach my $meth (@_) - { - my $name = $meth; - *{$package."::$meth"} = sub { $lastMethod=$package."::$meth"; - ($package, $filename, $line) = caller; - $package="" unless defined $package; - $filename="" unless defined $filename; - $line="" unless defined $line; - my $obj = shift; - if ($asCode) { - print "$obj->$name"; - &printList (@_); - print ";\n"; - } elsif ($obj =~ /^Tk::Zinc/) { - print "$name at $filename line $line "; -# print "\nLIST = @_\n"; - &printList (@_); - print ";\n"; - } - $obj->WidgetMethod($name,@_) }; - } +sub Tk::Methods { + my ($package) = caller; + no strict 'refs'; + foreach my $meth (@_) { + my $name = $meth; + *{$package."::$meth"} = sub { $lastMethod=$package."::$meth"; + ($package, $filename, $line) = caller; + $package="" unless defined $package; + $filename="" unless defined $filename; + $line="" unless defined $line; + my $obj = shift; + if ($asCode) { + print "$obj->$name"; + &printList (@_); + print ";"; + } elsif ($obj =~ /^Tk::Zinc/) { + print "TRACE: $filename line $line $name"; + &printList (@_); + } + if (wantarray()) { + my @res = $obj->WidgetMethod($name,@_); + print " RETURNS "; + &printList (@res); print "\n"; + return @res; + } else { + my $res = $obj->WidgetMethod($name,@_); + print " RETURNS "; + &printItem ($res); print "\n"; + return $res; + } + } + } } ### to print something |