You cannot select more than 25 topics
			Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
		
		
		
		
		
			
		
			
				
	
	
		
			83 lines
		
	
	
		
			2.3 KiB
		
	
	
	
		
			Perl
		
	
			
		
		
	
	
			83 lines
		
	
	
		
			2.3 KiB
		
	
	
	
		
			Perl
		
	
| #!/usr/bin/perl
 | |
| 
 | |
| # Note: this program is part of PerlTQt and makes use of its internal functions.
 | |
| #       You should not rely on those in your own programs.
 | |
| 
 | |
| use Getopt::Std;
 | |
| use strict 'vars';
 | |
| 
 | |
| our (%o, @x, $h);
 | |
| getopts('r:hvimp', \%o);
 | |
| 
 | |
| package TQt::_internal;
 | |
| use TQt;
 | |
| 
 | |
| exists $o{'v'} and do{ print "PerlTQt-$TQt::VERSION using TQt-".&TQt::version."\n" and exit 0 };
 | |
| exists $o{'h'} and do{ print $h and exit 0 };
 | |
| exists $o{'m'} and do{      # interactive mode for driving the TQt Designer Plugin
 | |
|     select(STDOUT); $| = 1; # unbuffered
 | |
|     while(<STDIN>)
 | |
|     {
 | |
|         chomp;
 | |
|         s/^Q(?=[A-Z])/TQt::/;
 | |
|         my $i = find_pclassid( $_ );
 | |
|         print "__START__\n";
 | |
|         if ($i)
 | |
|         {
 | |
|             my $a = findAllMethods( $i );
 | |
|             my $t = dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] );
 | |
|             getAllParents($i, \my @sup);
 | |
|             for my $s(@sup)
 | |
|             {
 | |
|                 $a = findAllMethods( $s );
 | |
|                 $t.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] );
 | |
|             }
 | |
|             $t =~ s/\t//gs;
 | |
|             print $t;
 | |
|         }
 | |
|         print "__END__\n";
 | |
|     }
 | |
| };
 | |
| (my $c = $ARGV[0]) =~ s/^Q(?=[A-Z])/TQt::/;
 | |
| my $i = $c ? find_pclassid( $c ) : 1;
 | |
| my $r = exists $o{'r'} ? (exists $o{'i'} ? qr|$o{'r'}|i : qr|$o{'r'}|) : 0;
 | |
| my $d = "";
 | |
| 
 | |
| while ($i)
 | |
| {
 | |
|    my $a=findAllMethods($i);
 | |
|    last unless keys %$a;
 | |
|    @x=map {@{ $$a{$_} }} sort keys %$a;
 | |
|    $d = dumpCandidates(\@x);
 | |
|    if($c and $i and exists $o{'p'})
 | |
|    {
 | |
|         getAllParents($i, \my @sup);
 | |
|         for my $s(@sup)
 | |
|         {
 | |
|             $a = findAllMethods( $s );
 | |
|             $d.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] );
 | |
|         }
 | |
|    }
 | |
|    if($r)
 | |
|    {
 | |
|        map { print "$_\n" if $_=~$r } split("\n", $d);
 | |
|    }
 | |
|    else
 | |
|    {
 | |
|        print $d
 | |
|    }
 | |
|    $c and last;
 | |
|    $i++
 | |
| }
 | |
| 
 | |
| BEGIN {
 | |
|     $h = "pqtapi - a PerlTQt introspection tool\t(c) Germain Garand 2003 <germain\@ebooksfrance.org>\n\n".
 | |
|          "usage: pqtapi [-r <re>] [<class>]\n\n".
 | |
|          "options:\n". 
 | |
|          "\t-r <re> : find all functions matching regular expression/keyword <re>\n".
 | |
|          "\t-i : together with -r, performs a case insensitive search\n".
 | |
|          "\t-p : display also inherited methods for <class>.\n".
 | |
|          "\t-v : print PerlTQt and TQt versions\n".
 | |
|          "\t-h : print this help message\n";
 | |
| }
 |