From 5a0014273aa59f4642866dd8ec74da3119973c9a Mon Sep 17 00:00:00 2001
From: mertz
Date: Wed, 29 Jan 2003 08:43:57 +0000
Subject: ZincTrace printout are now more similar to perl code;

---
 Perl/Zinc/Trace.pm | 47 ++++++++++++++++++++++++++++++++++-------------
 1 file changed, 34 insertions(+), 13 deletions(-)

diff --git a/Perl/Zinc/Trace.pm b/Perl/Zinc/Trace.pm
index 77d3460..8a7160a 100644
--- a/Perl/Zinc/Trace.pm
+++ b/Perl/Zinc/Trace.pm
@@ -25,10 +25,13 @@ package ZincTrace;
 
 use Tk;
 use strict;
+use Tk::Font;
+use Tk::Photo;
 
 use Carp;
 
-
+my $asCode = 0;
+#$asCode = 1;
 my ($lastMethod, $package, $filename, $line);
 sub Tk::Methods
 {
@@ -43,10 +46,15 @@ sub Tk::Methods
 				 $filename="" unless defined $filename;
 				 $line="" unless defined $line;
 				 my $obj = shift;
-				 if ($obj =~ /^Tk::Zinc/) {
+				 if ($asCode) {
+				     print "$obj->$name";
+				     &printList (@_);
+				     print ";\n";
+				 } elsif ($obj =~ /^Tk::Zinc/) {
 				     print "$name at $filename line $line ";
+#				     print "\nLIST = @_\n";
 				     &printList (@_);
-				     print "\n";
+				     print ";\n";
 				 }
 				 $obj->WidgetMethod($name,@_) };
   }
@@ -64,14 +72,21 @@ sub printItem {
 	print "{CODE}";
     }
     elsif ($ref eq 'Tk::Photo') {
-	print "Tk::Photo(\"". scalar $value->cget(-file) . "\)";
+#	print " **** $value ***** ";
+	print "Tk::Photo(\"". scalar $value->cget('-file') . "\")";
+    }
+    elsif ($ref eq 'Tk::Font') {
+	print "'$value'";
     }
     elsif ($ref eq '') {  # scalar 
 	if (defined $value) {
 	    if ($value eq '') {
 		print  "''";
-	    }
-	    else {
+	    } elsif ($value =~ /\s/
+		     or $value =~ /^[a-zA-Z]/
+		     or $value =~ /^[\W]$/ ) {
+		print "'$value'";
+	    }  else {
 		print $value;
 	    }
 	}
@@ -92,20 +107,26 @@ sub printArray {
     }
     else {  # the list is not empty
 	my @res;
-	print "[ ";
-	foreach my $value (@values) {
+	print "[";
+	while (@values) {
+	    my $value = shift @values;
 	    &printItem ($value);
-	    print " ";
+	    print ", " if (@values);
 	}
 	print "]" ;
     }
 } # end printarray
 
 sub printList {
-    print "( ";
-    foreach (@_) {
-	printItem $_;
-	print " ";
+    print "(";
+    while (@_) {
+	my $v = shift @_;
+	printItem $v;
+	if ($v =~ /^-\w+/) {
+	    print " => ";
+	} elsif (@_) {
+	    print ", ";
+	}
     }
     print ")";
 } # end printList
-- 
cgit v1.1