aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
authoretienne2003-02-21 15:53:31 +0000
committeretienne2003-02-21 15:53:31 +0000
commit13fb04564db37860f5ee842a109056a7cb1bcb89 (patch)
tree6c4b55aa502642d08e8e5167ecaa6bfd8cf1c486 /Perl
parent5dbfd0e8a55369eaeaf0e72ba54aea05391c955d (diff)
downloadtkzinc-13fb04564db37860f5ee842a109056a7cb1bcb89.zip
tkzinc-13fb04564db37860f5ee842a109056a7cb1bcb89.tar.gz
tkzinc-13fb04564db37860f5ee842a109056a7cb1bcb89.tar.bz2
tkzinc-13fb04564db37860f5ee842a109056a7cb1bcb89.tar.xz
Possibilit� de param�trer les fonctions ZincDebug sur la ligne de commande.
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm75
1 files changed, 59 insertions, 16 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 6b92f45..ce853a9 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -50,15 +50,20 @@ my %defaultoptions;
my %focus;
my %instances;
my @instances;
+my %cmdoptions;
sub BEGIN {
# test if ZincDebug is loaded using the -M perl option
$preload = 1 if (caller(2))[2] == 0;
return unless $preload;
# parse ZincDebug options
- my @options = @ARGV;
- use Getopt::Long;
-
+ require Getopt::Long;
+ Getopt::Long::GetOptions(\%cmdoptions,
+ 'itemModBtn=s', 'tkey=s', 'optionsToDisplay=s', 'optionsFormat=s',
+ 'color=s', 'enclosedModBtn=s', 'overlapModBtn=s', 'searchKey=s',
+ 'skey=s', 'verbosity=s', 'basename=s',
+ );
+
}
# Hack to capture the instance of zinc. ZincDebug functions are invoked here.
@@ -67,9 +72,29 @@ sub Tk::Zinc::InitObject {
Tk::Widget::InitObject(@_);
return unless $preload;
my $zinc = $_[0];
- &tree($zinc);
- &finditems($zinc);
- &snapshot($zinc);
+ my @options = ();
+ push (@options, -itemModBtn => [split(/,/, $cmdoptions{itemModBtn})])
+ if $cmdoptions{itemModBtn};
+ push (@options, -tkey => $cmdoptions{tkey}) if $cmdoptions{tkey};
+ push (@options, -optionsToDisplay => $cmdoptions{optionsToDisplay})
+ if $cmdoptions{optionsToDisplay};
+ push (@options, -optionsFormat => $cmdoptions{optionsFormat})
+ if $cmdoptions{optionsFormat};
+ print "options=@options\n";
+ &tree($zinc, @options);
+ @options = ();
+ push (@options, -color => $cmdoptions{color}) if $cmdoptions{color};
+ push (@options, -enclosedModBtn => [split(/,/, $cmdoptions{enclosedModBtn})])
+ if $cmdoptions{enclosedModBtn};
+ push (@options, -overlapModBtn => [split(/,/, $cmdoptions{overlapModBtn})])
+ if $cmdoptions{overlapModBtn};
+ &finditems($zinc, @options);
+ @options = ();
+ push (@options, -searchKey => $cmdoptions{searchKey}) if $cmdoptions{searchKey};
+ push (@options, -skey => $cmdoptions{skey}) if $cmdoptions{skey};
+ push (@options, -verbosity => $cmdoptions{verbosity}) if $cmdoptions{verbosity};
+ push (@options, -basename => $cmdoptions{basename}) if $cmdoptions{basename};
+ &snapshot($zinc, @options);
}
@@ -96,7 +121,7 @@ sub tree {
my %options = @_;
for my $opt (keys(%options)) {
carp "in ZincDebug module, tree() function, unknown option $opt\n"
- unless ($opt eq '-itemModBtn' or $opt eq '-key' or
+ unless ($opt eq '-itemModBtn' or $opt eq '-key' or $opt eq '-tkey' or
$opt eq '-optionsToDisplay' or $opt eq '-optionsFormat');
}
@@ -112,8 +137,13 @@ sub tree {
}
$zinc->Tk::bind('<'.$seq.'>', '');
}
-
- $treeKey{$zinc} = ($options{-key}) ? $options{-key} : 'Control-t';
+ if ($options{-tkey}) {
+ $treeKey{$zinc} = $options{-tkey};
+ } elsif ($options{-key}) {
+ $treeKey{$zinc} = $options{-key};
+ } else {
+ $treeKey{$zinc} = 'Control-t';
+ }
$treeModBtn{$zinc} = ($options{-itemModBtn}) ? $options{-itemModBtn} :
['Control', 2];
$options{-optionsFormat} = 'column' unless $options{-optionsFormat};
@@ -251,13 +281,19 @@ sub snapshot {
my %options = @_;
for my $opt (keys(%options)) {
carp "in ZincDebug module, snapshot() function, unknown option $opt\n"
- unless ($opt eq '-key' or
+ unless ($opt eq '-key' or $opt eq '-skey' or
$opt eq '-verbosity' or $opt eq '-basename');
}
# unset previous bindings;
$zinc->Tk::bind("<".$snapKey{$zinc}.">", '') if $snapKey{$zinc};
- $snapKey{$zinc} = ($options{-key}) ? $options{-key} : 'Control-s';
+ if ($options{-skey}) {
+ $snapKey{$zinc} = $options{-skey};
+ } elsif ($options{-key}) {
+ $snapKey{$zinc} = $options{-key};
+ } else {
+ $snapKey{$zinc} = 'Control-s';
+ }
my $snapshotVerbosity = (defined $options{-verbosity}) ? $options{-verbosity} : 1;
my $snapshotBasename = ($options{-basename}) ? $options{-basename} : "zincsnapshot";
# binding for printing a full zinc window
@@ -384,6 +420,8 @@ sub showtree {
} # end showtree
+
+
sub searchInTree {
my $zinc = shift;
$searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl);
@@ -444,6 +482,7 @@ sub searchInTree {
} # end searchInTree
+
sub extractinfo {
my $zinc = shift;
my $item = shift;
@@ -486,7 +525,9 @@ sub extractinfo {
}
$WARNING = 1;
return $info;
-}
+
+} # end extractinfo
+
sub scangroup {
my ($zinc, $tree, $group, $path, $format, @optionstodisplay) = @_;
@@ -1798,7 +1839,7 @@ ZincDebug - a perl module for analysing a Zinc application.
=head1 SYNOPSIS
- perl -MZincDebug zincapplication.pl
+ perl -MZincDebug zincscript [zincscript-opts] [zincdebug-opts]
or
@@ -1821,7 +1862,9 @@ With B<snapshot()> function, you are able to snapshot the application window, in
Press B<Escape> key in the toplevel of the application to have some help about available input sequences.
-B<If you load ZincDebug using the -M perl option, nothing needs to be added to your code>. In this mode, all the previous specific functions are invoked with default options for each instance of Zinc widget.
+B<If you load ZincDebug using the -M perl option, nothing needs to be added to your code>. By default, all the previous specific functions are invoked with their default attributes for each instance of Zinc widget. You can overload these by passing the same options to the command. Note that perl arrays must be transformed to comma separated string. For example:
+ perl -M ZincDebug zincscript -optionsToDisplay '-tags'
+ -optionsFormat row -itemModBtn Control,1
=head1 FUNCTIONS
@@ -1859,7 +1902,7 @@ This function creates required Tk bindings to build items tree. You can specify
=over
-=item E<32>E<32>E<32>B<-key> => key
+=item E<32>E<32>E<32>B<-tkey|-key> => key
Defines input sequence used to build and display items tree. Default to 'Control-t'.
@@ -1885,7 +1928,7 @@ This function creates required Tk binding to snapshot the application window. Yo
=over
-=item E<32>E<32>E<32>B<-key> => key
+=item E<32>E<32>E<32>B<-skey|-key> => key
Defines input key used to process a snapshot of the zinc window. Default to ['Control-s'].