aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm24
1 files changed, 19 insertions, 5 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 81bd6bf..cb84c54 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -507,7 +507,7 @@ sub buildCode {
push(@code, 'use Tk::Zinc;');
push(@code, 'my $mw = MainWindow->new();');
push(@code, 'my $zinc = $mw->Zinc(-render => '.$zinc->cget(-render).
- ')->pack(-expand => 1, -fill => both);');
+ ')->pack(-expand => 1, -fill => "both");');
push(@code, '# hash %items : keys are original items ID, values are built items ID');
push(@code, 'my %items;');
push(@code, '');
@@ -525,7 +525,7 @@ sub buildCode {
} else {
push(@code, &buildItem($zinc, $item, 1));
}
- push(@code, 'MainLoop;');
+ push(@code, &buildend);
my $file = $zinc->getSaveFile(-filetypes => [['Perl Files', '.pl'],
['All Files', '*']],
@@ -543,6 +543,18 @@ sub buildCode {
} # end buildCode
+sub buildend {
+
+ my @code;
+ push(@code, 'for (keys(%items)) {');
+ push(@code, ' $zinc->addtag(\'orig\'.$_, "withtag", $items{$_});');
+ push(@code, '}');
+ push(@code, 'MainLoop;');
+ return @code
+
+} # end buildend
+
+
# build a node of tree (corresponding to a TkZinc group item)
sub buildGroup {
@@ -581,7 +593,7 @@ sub buildItem {
my $numfields = 0;
my $numcontours = 0;
# type group and initargs
- my $initstring = '$items{'.$item.'}=$zinc->add('.$type.', '.$group.', ';
+ my $initstring = '$items{'.$item.'}=$zinc->add("'.$type.'", '.$group.', ';
if ($type eq 'tabular' or $type eq 'track' or $type eq 'waypoint') {
$numfields = $zinc->itemcget($item, -numfields);
$initstring .= $numfields.' ,';
@@ -683,7 +695,7 @@ sub buildOptions {
push(@code, " ".$option.' => "'.$value.'", ');
} elsif (ref($value) eq 'ARRAY') {
- push(@code, " ".$option." => [qw(".join(',', @$value).")], ");
+ push(@code, " ".$option." => [qw/".join(' ', @$value)."/], ");
} else {
push(@code, " ".$option." => '".$value."', ");
@@ -2301,7 +2313,9 @@ sub balloonhelp {
"is selected, draw rectangle using \n".
"left mouse button. ");
$b->attach($button{tree}, -balloonmsg =>
- "Display the items hierarchy.");
+ "Display the items hierarchy. Can\n".
+ "build perl code corresponding to\n".
+ "a specific branch. ");
$b->attach($button{item}, -balloonmsg =>
"Locate an item in the items tree. \n".
"When this mode is on, select in \n".