From 13fb04564db37860f5ee842a109056a7cb1bcb89 Mon Sep 17 00:00:00 2001 From: etienne Date: Fri, 21 Feb 2003 15:53:31 +0000 Subject: Possibilit� de param�trer les fonctions ZincDebug sur la ligne de commande. --- Perl/Zinc/Debug.pm | 75 ++++++++++++++++++++++++++++++++++++++++++------------ 1 file 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 function, you are able to snapshot the application window, in Press B key in the toplevel of the application to have some help about available input sequences. -B. In this mode, all the previous specific functions are invoked with default options for each instance of Zinc widget. +B. 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']. -- cgit v1.1