ZincTrace output is a bit clearer; it also displays the return values

of every Tk::Zinc method call

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