diff options
| -rw-r--r-- | Perl/Zinc/Trace.pm | 47 |
1 files 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 |