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