aboutsummaryrefslogtreecommitdiff
path: root/Perl/Zinc
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/Zinc')
-rw-r--r--Perl/Zinc/Trace.pm58
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