wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs
resizable layout, but mostly complete, wonky in places, mostly not oop, code in spoiler readmore tags
#!/usr/bin/perl --
use Path::Class;
use constant THISFILE => file( __FILE__ )->absolute->stringify;
use constant THISDIR => file( THISFILE )->dir->stringify;
use strict; use warnings;
use Data::Dump qw/ dd pp /;
use Regexp::Common;
use Storable ();
use constant WXCLASSES_STORABLE => 'wxperl_usage_storage';
sub TRACE; sub DEBUG;
#~ *TRACE = *DEBUG = sub { print STDERR @_,"\n" };
*TRACE = *DEBUG = sub { };
chdir THISDIR or die "$!\n$^E\n ";
Main( @ARGV );
exit( 0 );
use vars qw/ $counter $constants_re /;
sub wxMethodsClasses {
if(not(@_) and my $aref = eval { Storable::retrieve( WXCLASSES_STO
+RABLE()) } ){
return $aref->[0], $aref->[1];
} else {
{## SNAP_load_Wx
package SNAP;
require Wx;
Wx->import( qw' :allclasses :everything ');
}
local $counter = 0;
unless( $constants_re ){
$constants_re = join '|', map {"\Q$_\E"} @{$Wx::EXPORT_TAG
+S{everything}};
$constants_re = 'Wx::(?:'.$constants_re .')';
}
my ( $methods, $classes ) = fudgeMethodsClasses('Wx::', \%Wx::
+);
Storable::store( [ $methods, $classes ], WXCLASSES_STORABLE())
+;
return ( $methods, $classes ) ;
}
}
sub fudgeMethodsClasses {
my( $prefix, $stash, $seen, $stuff, $classes ) = @_;
$seen ||= {};
$stuff ||= [];
$classes ||= [];
for my $item ( sort keys %$stash ){
next if $item =~ /^_/; ## ignore private
next if $item =~ /bootstrap|load_dll/; ## ignore trouble
my $name = $prefix.$item;
my $ref = $stash->{$item};
if( $name =~ /Wx::Event::EVT_/ ){
my $proto = eval { prototype *$ref };
if( not defined $proto ){
DEBUG "no proto for $name \n";
next;
}
my $usage = "Usage: $name( window ";
2 < length $proto and $usage .= ', window_or_id ';
$name =~ /RANGE$/ and $usage .= ', window_or_id2 ';
$name =~ /_COMMAND\b/ and $usage .= ', WXTYPE commandEvent
+Type = 0 ';
$usage .= ', func )';
push @$stuff, [{ string => $usage, explain => explainUsage
+($usage) }];
$counter++;
next;
}
$counter++;
next if $name =~ /Wx::Loader/;;
DEBUG "##!!## $name $ref\n";
if( $item =~ /::$/ ){
next if $name =~ /Wx_Exp/;
push @$classes, [{ string => $name }];
fudgeMethodsClasses( $name, $ref, $seen, $stuff );
}elsif( eval{ defined *{$ref}{CODE} } ){
next if skipSkippers( $name );
if( fakeSkippers( $name ) ){
my $usage = "SkipUsage: $name()";
push @$stuff, [{ string => $usage, explain => explainU
+sage($usage) }];
} else {
my $usage = provokeUsage( *{$ref}{CODE}, $name );
push @$stuff, [{ string => $usage, explain => explainU
+sage($usage) }];
}
} else {
#~ DEBUG "no can do $name $ref\n";
}
}
return $stuff, $classes;
}
sub skipSkippers {
my( $name ) = @_;
return 1 if $name =~ m{
^Wx::wx
|^Wx::AUTOLOAD
|^Wx::Perl
|::import\b
|::SetEvents
|
(?:
^
Wx::
(?:
import
|AUTOLOAD
|Perl
|Load
|UnLoad
|SetConstants
|SetConstantsOnce
|SetAlwaysUTF8
|CLONE
|constant
|gettext_noop
|looks_like_number
|set_end_function
|set_load_function
|[a-z_]+
)
$
)
}mx;
return 1 if $name =~ /^$constants_re$/;
return 1 if $name =~ /^Wx::[a-z_]+$/;
return 1 if $name =~ /^(?:Wx::ListCtrl::SelectItem|Wx::ListCtrl::
+GetLastSelectedItem|Wx::ListCtrl::GetSelectedItems|Wx::ListCtrl::Ensu
+reVisibleTop)$/;
return 0;
}
sub fakeSkippers {
my( $name ) = @_;
#~ http://docs.wxwidgets.org/2.8/wx_processfunctions.html
return 1 if $name =~ m{
Wx::LogFatalError
|Wx::Shell
|Wx::Shutdown
|Wx::Exit
|Wx::LogTrace
|Wx::Trap
|Wx::Socket::Event
|Wx::DisableAssertHandler
|Wx::EnableDefaultAssertHandler
}xm;
return 0;
}
sub escapeHTML {
local $_ = join '',@_;
s{<}{<}g;
s{>}{>}g;
return $_;
}
sub wxDocsUrlTrunk {
my( $name ) = @_;
my @class = split /::/, $name;
my $classmethod = lc join '_', @class;
my $method = pop @class;
my $classname = lc join '', @class;
my $href = "http://docs.wxwidgets.org/trunk/class$classname.html#$
+classmethod";
$classname = lcfirst join '', @class;
qq{<a href="$href">${classname}::$method</a>};
}
#~ wxWindow::IsExposed
#~ http://docs.wxwidgets.org/2.8/wx_wxwindow.html#wxwindowisexposed
#~ http://docs.wxwidgets.org/stable/wx_wxwindow.html#wxwindowisexposed
sub wxDocsUrlStable {
my( $name ) = @_;
my @class = split /::/, $name;
my $classmethod = lc join '', @class;
my $method = pop @class;
my $classname = lc join '', @class;
my $href = "http://docs.wxwidgets.org/stable/wx_$classname.html#$c
+lassmethod";
$classname = lcfirst join '', @class;
qq{<a href="$href">${classname}::$method</a>};
}
sub wxDocsUrlTrunkSearch {
my( $name ) = @_;
my @class = split /::/, $name;
my $method = pop @class;
my $href = "http://docs.wxwidgets.org/trunk/search.php?query=";
my $text = '';
my $classname = lcfirst join '', @class;
if( $method =~ /^EVT_/){
$classname = '';
} else {
$method = '' if $method =~ /^new/;
$method = '::'.$method if length $method;
}
$href .= $classname.$method;
$text = escapeHTML( $classname.$method );
qq{<a href="$href">$text</a>};
}
sub how_you_call_that_thing {
my( $fullmethod , $thisOrClass, @parts ) = @_;
my( $class, $sub ) = $fullmethod =~ m{^(Wx.*?)::( [^:\)\(]+ )[\)\
+(]*$}mxi;
if( not defined $class or not defined $sub ){
#~ warn $fullmethod ; ## Wx::Font:: Wx::TreeItemId::
return;
}
my $prefix = '';
if( defined $thisOrClass and $thisOrClass =~ m{^\$?THIS$} ){
$prefix .= "\$THIS->$sub";
}elsif( defined $thisOrClass and $thisOrClass =~ m{^\$?CLASS$}
+){
$prefix .= "$class->$sub";
}else{
defined $thisOrClass and unshift @parts, $thisOrClass;
if( $class eq 'Wx' or $class eq 'Wx::Event' ){
$prefix .= $fullmethod;
} else {
my $classonly = lcfirst $class;
$classonly =~ s/:://g;
$prefix .= "#~ \$THIS->$sub( ##?? \n";
$prefix .= "#~ \$${classonly}_obj->$sub( ##?? \n";
$prefix .= "$class->$sub";
}
}
if( @parts ){
@parts = map {
my $val;
my $ret;
my $name = $_;
my $type;
if( ref $name ){
( $name, $type , $val ) = @$_;
defined $val or $val = $type;
}
$ret = " $name";
if( defined $val ){
$ret .= " = $val";
}
$ret.',';
} @parts;
return $prefix . join "\n",'(', @parts, ')';
} else {
return $prefix . "()\n";
}
}
sub printUsage { print &get_printUsage, "\n" }
sub explainUsage { return &get_printUsage }
sub get_printUsage {
local $_ = $_[0];
my $rawusage = $_;
pos = 0;
my @parts;
ULOOP:
while( length > pos ){
m{\G\s+}gcsx and do { next ULOOP; };
m{
\G(?:Un|Skip)Usage:\s+([^\(\)]+)
}gcmx and do {
TRACE "skip { $1 }";
push @parts, $1;
last ULOOP;
};;;
m{\GUsage:\s+}gcsx and do { next ULOOP; };
m{
\G( Wx::[^\(\s]+ )
}gcsx and do {
TRACE "method { $1 }";
push @parts, $1;
next ULOOP;
};;;
m{
\G$RE{balanced}{-parens=>'()'}
}gcsx and do {
TRACE "function(balanced) { $1 }";
push @parts, makeArgs($1);
next ULOOP;
};;;
/\G(\S)/gcmx and do {
print "## ERRORing forward (@{[pp($1)]})\n";
next ULOOP;
};;;
}
my $count = (tr/=//);
my $refcount = grep {ref($_)} @parts;
$count != $refcount and print "#### mismatch $count != $refcount #
+### $_\n";
#~ if(0)
{
$count = (tr/,//);
$refcount = -1 + @parts;
$count and $count+1 != $refcount and print "#### comma mismatc
+h $count != $refcount #### $_\n";
}
return
join(
"\n",
escapeHTML( $rawusage ) . '<pre>',
escapeHTML( override_in_subclass( @parts ) ),
escapeHTML( how_you_call_that_thing( @parts ) ),
wxDocsUrlTrunkSearch( $parts[0] ),
wxDocsUrlStable( $parts[0] ),
wxDocsUrlTrunk( $parts[0] ),
'',
).'</pre>',
;;;
}
sub makeArgs {
my( @args ) ;
local $_ = $_[0];
s/^\(//;s/\)$//;
pos = 0;
ARGSLOOP:
while( length > pos ){
m{\G\s+}gcsx and do { next ARGSLOOP; };
m{
\G (wx[A-Z]\w+)\s*\,
}gcsx and do {
TRACE "constant { $1 }";
push @args, 'Wx::'.$1.'()';
next ARGSLOOP;
};
m{
\G(\w+)\s*=\s*( wx[A-Z]\w+::\w+ )\b\s*,?
}gcsx and do {
TRACE "varname0=wx::func { $1 = $2 }";
push @args, [ makeVarname( $1 ), makeValue( $2 ) ];
next ARGSLOOP;
};
m{
\G(\w+)\s*=\s*( wx[A-Z]\w+(?: \s* \| \s* wx[A-Z]\w+ )* )\b\s*,?
}gcsx and do {
TRACE "varname0=wxConstant(s) { $1 = $2 }";
push @args, [ makeVarname( $1 ), makeEnum($2) ];
next ARGSLOOP;
};
m{
\G
(?:\s* WXTYPE \s*)? ### grrrrrr
(\w+)\s*=\s*
(
0x[0-9A-F]{2,6}
|
(?:
\x2D?
(?: \x30 | (?: [\x{31}-\x{39}] (?: [\x{30}-\x{39}] )* ) )
(?: \x2E[\x{30}-\x{39}]+ )?
(?: [\x65\x45] [+-]? [\x{30}-\x{39}]+ )?
)
)
}gcsx and do {
TRACE "varname0=real { $1 = $2 }";
push @args, [ makeVarname( $1 ), $2 ];
next ARGSLOOP;
};
m{
\G (\w+)\s*=\s* ( true | false | NULL )
}gcsx and do {
TRACE "varname0=tfn { $1 = $2 }";
push @args, [ makeVarname( $1 ), $2 eq 'true' ? 1 : 0 ];
next ARGSLOOP;
};
m{
\G (\w+)\s*=\s* ($RE{quoted})
}gcsx and do {
TRACE "varname0=quoted { $1 = $2 }";
push @args, [ makeVarname( $1 ), $2 ];
next ARGSLOOP;
};
m{
\G
(\w+)
\s*
=
\s*
\(
\s*
(\w+)
\s*
\*
\s*
\)
\s*
\&?
\s*
(\w+)
}gcsx and do {
TRACE "varname0=type constant { $1 = ( $2 ) $3 }";
push @args, [ makeVarname( $1 ), $2, makeValue( $3 ) ];
next ARGSLOOP;
};
m{
\G( $RE{quoted} )
}gcsx and do {
TRACE "quoted { $1 }";
push @args, $1;
next ARGSLOOP;
};
m{
\G( \w+\( $RE{quoted} \) | $RE{quoted} )
}gcsx and do {
TRACE "function(quoted) { $1 ( $2 ) }";
push @args, $1;
next ARGSLOOP;
};
m{
\G( \w+ )( $RE{balanced}{-parens=>'()'} )
}gcsx and do {
TRACE "constructor(balanced) { $1 ( $2 ) }";
my( $class, $args ) = ($1,$2);
$class =~ s/^wx/Wx::/;
$class .= '->new( ';
$args = $class . join( ', ', makeArgs( $args ) ).' )';
push @args, $args;
next ARGSLOOP;
};
m{
\G( wx[A-Z]\w+ (?: \s* \| \s* wx[A-Z]\w+ )* )
}gcsx and do {
TRACE "enum-ored { $1 }";
push @args, makeEnum($1);
next ARGSLOOP;
};
m{
\G (\w+)\s*\,
}gcsx and do {
TRACE "varname0, { $1 }";
push @args, makeVarname( $1 );
next ARGSLOOP;
};
m{
\G (\w+)\s*=\s*( \w+\( $RE{quoted} \) )
}gcsx and do {
TRACE "varname0=function(quoted) { $1 = $2 }";
push @args, [ makeVarname( $1 ), $2 ];
next ARGSLOOP;
};
m{
\G (\w+)\s*=\s*( [\&\w][\w:]* )\s*,?
}gcsx and do {
TRACE "varname0=somethinggeneric { $1 = $2 }";
push @args, [ makeVarname( $1 ), makeValue( $2 ) ];
next ARGSLOOP;
};
m{
\G \.\.\.
}gcsx and do {
TRACE "manyars(...)";
push @args, '...';
next ARGSLOOP;
};
m{
\G( \w+ )
}gcsx and do {
TRACE "varname { $1 }";
push @args, makeVarname( $1 );
next ARGSLOOP;
};
m{
\G ( . )
}gcsx and do {
TRACE "next-char { $1 }";
next ARGSLOOP;
};
}
#~ warn pp(\@args);
@args;
}
sub makeValue {
my( $val ) = @_;
return 'undef' if $val =~ /PL_sv_undef/;
return 'Wx::' . $val . '()' if $val =~ m{^wx[A-Z]} ;
return join '', @_;
}
sub makeVarname {
TRACE "makeVarname( @_ )";
return join '', '$', @_;
return join '', @_;
my( $varname ) = @_;
return '$this' if $varname eq 'this';
return '$this->{'.$varname.'}';
}
sub makeEnum {
local $_;
return join ' | ', map {
s/^\s+//;
s/\s+$//;
'Wx::'.$_.'()';
} grep defined, split /\|/, $_[0];
}
sub override_in_subclass {
my( $class, $sub ) = $_[0] =~ m{^(Wx.*?)::( [^:\)\(]+ )[\)\(]*$}mx
+i;
return if not defined $class or not defined $sub;
return if $class eq 'Wx';
return if not ( $sub =~ m{^On} or $class=~m{::Pl[A-Z]} ); ## virtu
+al
( my $wxless = $class )=~ s/^Wx:://;
my @init;
my $args = '';
my @duh_args = @_[1..$#_];
if( @duh_args )
{
my @args ;
for my $item ( @duh_args ){
#~ dd ITEM => $item;
my $val;
my $name = $item;
my $type;
if( ref $name ){
( $name, $type , $val ) = @$item;
defined $val or $val = $type;
}
#~ $name = '$'.$name;
push @args, $name;
if( defined $val ){
#~ dd "GOT VAL!!! $val";
#~ $init .= " defined $name or $name = $val;";
push @init , " defined $name or $name = $val;";
}
#~ else {
#~ dd "NO VAL!!\n";
#~ }
}
if( @args ){
$args .= ' my( ';
$args .= join ', ', @args;
$args .= ') = @_; ';
}
#~ dd INIT=>\@init;
}
$args .= "\n".join "\n", @init;
$args .= "\n" . ' return $THIS->SUPER::' . $sub ."( ... ); ## ??
+";
return "###\npackage My$wxless;\nuse base qw' $class ';\nsub $sub
+{\n$args\n}\n###\n";
}
sub provokeUsage {
my( $ref , $name ) = @_;
( my $package = $name ) =~ s/::[^:]+$//;
DEBUG "$counter @_\n";
local $@;
undef $@;
no warnings;
if( not $name =~ /Wx::GetFontFromUser|FromUser/ ){
eval { $ref->(); };
}
my $err1 = "$@";
if( $err1 =~ m{ (Usage: \s* [^\s\(]+ \s* $RE{balanced}{-parens=>'
+()'} ) }sx ){
$err1 = $1;
return $err1;
} else {
$err1 = "" ;
}
undef $@;
eval { $ref->($package, (undef)x(42)); };
my $err2 = "$@";
if( $err2 =~ m{ (Usage: \s* [^\s\(]+ \s* $RE{balanced}{-parens=>'(
+)'} ) }sx ){
$err2 = $1;
return $err2;
} else {
$err2 = "";
}
return "UnUsage: $name()";
}
sub wx_usage_gui {
my( $methods, $classes ) = wxMethodsClasses( @_ );
#~ print int @$methods, ' ', int @$classes, " ", int @$methods + i
+nt @$classes, "\n";
require Wx;
require Wx::AUI;
require Wx::Perl::ListView;
require Wx::Perl::ListView::SimpleModel;
require Wx::Html;
require LWP; require Wx::Perl::FSHandler::LWP; Wx::FileSystem::Add
+Handler( Wx::Perl::FSHandler::LWP->new( LWP::UserAgent->new ));
my $frame = Wx::Frame->new(undef,-1, "wxperl_usage / wxperl-usage
+/ wxPerl::Usage / Class Method Browser ", [-1,-1], [-1,-1], Wx::wxDEF
+AULT_FRAME_STYLE()|Wx::wxTAB_TRAVERSAL()); ### HOORAY, DO NOT NEED Wx
+::Panel you FOOLS!
$frame->{low_right_pane} = Wx::Panel->new($frame );
$frame->{top_right_pane} = Wx::Panel->new($frame );
$frame->{low_left_pane} = Wx::Panel->new($frame );
$frame->{top_left_pane} = Wx::Panel->new($frame );
$frame->{sizer_low_right_pane} = Wx::BoxSizer->new(Wx::wxVERTICAL(
+));
$frame->{sizer_top_right_pane} = Wx::BoxSizer->new(Wx::wxVERTICAL(
+));
$frame->{sizer_low_left_pane} = Wx::BoxSizer->new(Wx::wxVERTICAL()
+);
$frame->{sizer_top_left_pane} = Wx::BoxSizer->new(Wx::wxVERTICAL()
+);
$frame->{top_left_pane}->SetSizer($frame->{sizer_top_left_pane});
$frame->{low_left_pane}->SetSizer($frame->{sizer_low_left_pane});
$frame->{top_right_pane}->SetSizer($frame->{sizer_top_right_pane})
+;
$frame->{low_right_pane}->SetSizer($frame->{sizer_low_right_pane})
+;
my $usage = Wx::HtmlWindow->new( $frame->{top_right_pane} , -1 );
$usage->SetBackgroundColour( Wx::Colour->new( (250) x 3 ) );
$frame->{usage_statusbar} = Wx::TextCtrl->new( $frame->{top_right_
+pane}, -1 , " ");
$frame->{usage_statusbar}->SetBackgroundColour( Wx::Colour->new( (
+240) x 3 ) );
#~ wxLogLevel http://docs.wxwidgets.org/trunk/interface_2wx_2log_8h.ht
+ml#aacf1e0ade132ca66e9414ee658c94887
Wx::Log::SetLogLevel( 0 );
my $search = Wx::TextCtrl->new( $frame->{low_right_pane} ,-1,"Wx:
+:About", );
my $usage_model = Wx::Perl::ListView::SimpleModel->new( $methods )
+;
my $usage_listview = Wx::Perl::ListView->new( $usage_model, $frame
+->{low_right_pane} );
$usage_listview->InsertColumn( 0, '' );
$usage_listview->SetSingleStyle( Wx::wxLC_NO_HEADER(), 1 );
$usage_listview->SetSingleStyle( Wx::wxLC_SINGLE_SEL(), 1 );
$usage_listview->SetColumnWidth(0, 3000 ) ;
$usage_listview->refresh;
my $classes_model = Wx::Perl::ListView::SimpleModel->new( $classes
+ );
my $classes_listview = Wx::Perl::ListView->new( $classes_model , $
+frame->{top_left_pane} );
$classes_listview->InsertColumn( 0, '' );
$classes_listview->SetSingleStyle( Wx::wxLC_NO_HEADER(), 1 );
$classes_listview->SetSingleStyle( Wx::wxLC_SINGLE_SEL(), 1 );
$classes_listview->SetColumnWidth(0, Wx::wxLIST_AUTOSIZE() ) ;
$classes_listview->SetColumnWidth(0, Wx::wxLIST_AUTOSIZE_USEHEADER
+() ) ; ## works better, oddball
$classes_listview->refresh;
my $tagsconstants = Wx::ComboBox->new(
$frame->{low_left_pane} ,
-1,
"",
[-1,-1], [-1,-1],
[ do { delete local $Wx::EXPORT_TAGS{everything}; sort keys %W
+x::EXPORT_TAGS }],
Wx::wxCB_DROPDOWN()
| Wx::wxCB_READONLY()
);
my $constants = Wx::TextCtrl->new(
$frame->{low_left_pane},
-1,"", [-1,-1], [-1,-1], Wx::wxTE_MULTILINE() | Wx::wxHSCROLL(
+)
);
$frame->{tagsconstants} = $tagsconstants;
$frame->{constants} = $constants;
{
my $but_s = Wx::BoxSizer->new( Wx::wxHORIZONTAL() );
my $forward = Wx::Button->new( $frame->{top_right_pane}, -1, 'Forw
+ard' );
my $back = Wx::Button->new( $frame->{top_right_pane}, -1, 'Back' )
+;
$but_s->Add( $back );
$but_s->Add( $forward );
$frame->{sizer_top_right_pane}->Add( $but_s , 0, Wx::wxEXPAND() );
Wx::Event::EVT_BUTTON( $frame, $forward, sub { $_[0]->{usage}->His
+toryForward } );
Wx::Event::EVT_BUTTON( $frame, $back, sub { $_[0]->{usage}->Histo
+ryBack } );
}
$frame->{sizer_top_right_pane}->Add( $usage , 1, Wx::wxEXPAND() );
$frame->{sizer_top_right_pane}->Add( $frame->{usage_statusbar} , 0
+, Wx::wxEXPAND() );
Wx::Event::EVT_HTML_CELL_HOVER(
$frame,
$usage ,
sub {
my( $frame, $event ) = @_;
my $val = eval { $event->GetCell->GetLink->GetHref };
$val and $frame->{usage_statusbar} ->SetValue( $val );
}
);
$frame->{sizer_low_right_pane}->Add( $search , 0, Wx::wxEXPAND() )
+;
$frame->{sizer_low_right_pane}->Add( $usage_listview, 1, Wx::wxEXP
+AND() );
$frame->{sizer_top_left_pane}->Add( $classes_listview , 1, Wx::wxE
+XPAND() );
$frame->{sizer_low_left_pane}->Add( $tagsconstants, 0, Wx::wxEXPAN
+D() );
$frame->{sizer_low_left_pane}->Add( $constants, 1, Wx::wxEXPAND()
+);
$frame->{sizer_low_left_pane}->Fit( $frame->{low_left_pane} );
$frame->{sizer_low_left_pane}->SetSizeHints( $frame->{low_left_pan
+e} );
$frame->{sizer_top_left_pane}->Fit( $frame->{top_left_pane} );
$frame->{sizer_top_left_pane}->SetSizeHints( $frame->{top_left_pan
+e} );
$frame->{sizer_low_right_pane}->Fit( $frame->{low_right_pane} );
$frame->{sizer_low_right_pane}->SetSizeHints( $frame->{low_right_p
+ane} );
$frame->{sizer_top_right_pane}->Fit( $frame->{top_right_pane} );
$frame->{sizer_top_right_pane}->SetSizeHints( $frame->{top_right_p
+ane} );
$frame->{auim} = Wx::AuiManager->new();
$frame->{auim}->SetManagedWindow( $frame );
## Name critical for SavePerspective/LoadPerspective
$frame->{auim}->AddPane( $frame->{top_right_pane}, Wx::AuiPaneInfo
+->new->Name("aui_usage")->Caption("Usage")->Center->MinSize( 100,50 )
+->Resizable->CloseButton(0) );
$frame->{auim}->AddPane( $frame->{low_right_pane}, Wx::AuiPaneInfo
+->new->Name("aui_methods")->Caption("Method list")->Center->MinSize(
+100,50 )->Resizable->CloseButton(0) );
$frame->{auim}->AddPane( $frame->{top_left_pane}, Wx::AuiPaneInfo-
+>new->Name("aui_classes")->Caption("Classes")->Top->Left->MinSize( 20
+0, 150 )->Resizable->CloseButton(0) );
$frame->{auim}->AddPane( $frame->{low_left_pane}, Wx::AuiPaneInfo-
+>new->Name("aui_constants")->Caption("Constants")->Bottom->Left->MinS
+ize( 200,150 )->Resizable->CloseButton(0) );
$frame->{auim}->Update();
$frame->{auim}->LoadPerspective( ## whitespace is not a dealbreake
+r
"
layout2
|
name=aui_usage;
caption=Usage;
state=2044;
dir=5;
layer=0;
row=0;
pos=0;
prop=88981;
bestw=100;
besth=50;
minw=100;
minh=50;
maxw=-1;
maxh=-1;
floatx=-1;
floaty=-1;
floatw=-1;
floath=-1
|
name=aui_methods;
caption=Method list;
state=2044;
dir=5;
layer=0;
row=0;
pos=1;
prop=111019;
bestw=256;
besth=157;
minw=100;
minh=50;
maxw=-1;
maxh=-1;
floatx=-1;
floaty=-1;
floatw=-1;
floath=-1
|
name=aui_classes;
caption=Classes;
state=2044;
dir=4;
layer=0;
row=0;
pos=0;
prop=47419;
bestw=256;
besth=150;
minw=200;
minh=150;
maxw=-1;
maxh=-1;
floatx=-1;
floaty=-1;
floatw=-1;
floath=-1
|
name=aui_constants;
caption=Constants;
state=2044;
dir=4;
layer=0;
row=0;
pos=1;
prop=152581;
bestw=200;
besth=150;
minw=200;
minh=150;
maxw=-1;
maxh=-1;
floatx=-1;
floaty=-1;
floatw=-1;
floath=-1
|
dock_size(5,0,0)=117
dock_size(4,0,0)=202
" , 1);
$frame->Layout();
$frame->SetAutoLayout(1);
$frame->Show;
my $app = Wx::SimpleApp->new;
$app->SetTopWindow($frame);
$frame ->{usage} = $usage;
$frame ->{search} = $search;
$frame ->{usage_listview} = $usage_listview;
$frame ->{classes_listview} = $classes_listview;
$search->SetFocus();
#~ http://wxperl.sourceforge.net/tutorial/tutorial4.html
Wx::Event::EVT_TEXT( $frame, $search, \&findSelect );
Wx::Event::EVT_LIST_ITEM_SELECTED( $frame, $usage_listview, \&show
+Usage );
Wx::Event::EVT_LIST_ITEM_SELECTED( $frame, $classes_listview, \&fi
+ndSelectThis);
Wx::Event::EVT_COMBOBOX( $frame, $tagsconstants, \&listConstants);
my %ID;
my $ACCL = new Wx::AcceleratorTable(
[
Wx::wxACCEL_CTRL(),
#~ Wx::WXK_CONTROL_F(), ## not wrapped -- this whole things is
+ fundocumented http://docs.wxwidgets.org/trunk/defs_8h.html#a41c46092
+11685cff198618963ec8f77d
'F',
$ID{CONTROL_F} = Wx::NewId(),
]
);
$frame->SetAcceleratorTable( $ACCL );
Wx::Event::EVT_MENU( $frame, $ID{CONTROL_F}, sub { $_[0]->{search}
+->SetFocus } );
$app->MainLoop;
#~ dd $frame->{auim}->SavePerspective;
$frame->{auim}->UnInit();
}
sub listConstants {
my( $frame, $ev ) = @_;
my $tag = $ev->GetEventObject->GetValue;
$frame->{constants}->SetValue( join "\n", values @{$Wx::EXPORT_TAG
+S{$tag}} );
}
sub findSelectTag {
#~ warn "@_ ";
my( $frame , $match ) = @_;
my $tagsconstants = $frame->{tagsconstants};
#~ dd [ $tagsconstants-> GetStrings ];
my $ix = 0;
for my $tag ( $tagsconstants-> GetStrings ){
if( -1 < index lc $match, $tag ){
#~ warn "matched $tag ";
#~ $frame->{tagsconstants}->SetSelection( $ix ); ## doesn'
+t spawn an event?
$frame->{tagsconstants}->Select( $ix ); ## changes selecti
+on but doesn't spawn event
$frame->{constants}->SetValue( join "\n", values @{$Wx::EX
+PORT_TAGS{$tag}} );
}
$ix++;
}
}
sub findSelectThis {
my( $frame, $ev ) = @_;
#~ warn
my $search = $ev->GetText;
$frame->{search}->SetValue( $search );
findSelectTag( $frame , $search );
return;
my $usage_listview = $frame->{usage_listview};
my $model = $usage_listview->model;
my $data = $model->data;
for my $ix ( 0 .. -1 + $model->get_item_count ){
my $text = $data->[$ix][0]{string};
if( $text ){
if( -1 < index $text , $search ){
$usage_listview->EnsureVisible( $ix );
last;
}
} else {
warn "no string for $ix ";
}
}
}
sub findSelect {
my( $frame, $ev ) = @_;
my $search_o = my $search = lc $frame->{search}->GetValue;
return if not length $search;
$search = quotemeta $search;
$search =~ s/^wx(\w)/Wx::$1/i;
$search =~ s/^::/Wx::/i;
#~ warn $search;
return if length $search < 4;
my $usage_listview = $frame->{usage_listview};
my $model = $usage_listview->model;
my $data = $model->data;
for my $ix ( 0 .. -1 + $model->get_item_count ){
my $text = $data->[$ix][0]{string};
if( $text ){
if( $text =~ m/\b$search/i ){
$usage_listview->SelectItem( $ix );
$usage_listview->EnsureVisibleTop( $ix );
findSelectTag( $frame , $search_o );
last;
}
} else {
warn "no string for $ix "; ### 2013-03-29-03:08:48 duh, of
+f by one
}
}
}
sub showUsage {
my( $frame, $ev ) = @_;
my $usage_listview = $frame->{usage_listview};
my $itemix = lc $usage_listview->GetLastSelectedItem;
my $model = $usage_listview->model;
my $item = $model->get_item( $itemix );
$frame->{usage}->HistoryClear(); ##???
$frame->{usage}->SetPage( $item->{explain} );
findSelectTag( $frame , $item->{string} );
$ev->Skip(1);
}
sub Wx::ListCtrl::SelectItem { shift->SetItemState( shift , Wx::wxLIST
+_STATE_SELECTED () , Wx::wxLIST_STATE_SELECTED () ) }
sub Wx::ListCtrl::GetLastSelectedItem { ( shift(@_)->GetSelectedItems
+)[-1] }
sub Wx::ListCtrl::GetSelectedItems {
my $self = shift;
my $count = $self->GetSelectedItemCount ;
return if not $count;
my @items;
my $item = -1;
while(1){
$item = $self->GetNextItem( $item, Wx::wxLIST_NEXT_ALL(), Wx::
+wxLIST_STATE_SELECTED() );
last if -1 == $item;
push @items, $item;
}
die "The impossible happened , SelectedItemCount doesn't match ! "
+ if @items != $count;
@items;
}
sub Wx::ListCtrl::EnsureVisibleTop {
my( $usage_listview , $ix ) = @_;
$usage_listview->EnsureVisible( $ix ); ## otherwise ScrollLines ge
+ts each item one by one
my $scrollby = abs( $usage_listview->GetTopItem - $ix );
#~ $usage_listview->ScrollLines( $scrollby ); ## perfect
$usage_listview->ScrollLines( $scrollby - 1 ) if $scrollby > 2;
}
sub checkMismatch {
my $mismatch = <<'__MISMATCH__';
#### Usage: Wx::ListCtrl::newFull(CLASS, parent, id = wxID_ANY, pos =
+wxDefaultPosition, size = wxDefaultSize, style = wxLC_ICON, validator
+ = (wxValidator*)&wxDefaultValidator, name = wxListCtrlNameStr)
#### Usage: Wx::GetFontFromUser(parent = 0, fontInit = (wxFont*)&wxNul
+lFont)
#### Usage: Wx::BitmapDataObject::new(CLASS, bitmap = (wxBitmap*)&wxNu
+llBitmap)
#### Usage: Wx::CheckBox::newFull(CLASS, parent, id, label, pos = wxDe
+faultPosition, size = wxDefaultSize, style = 0, validator = (wxValida
+tor*)&wxDefaultValidator, name = wxCheckBoxNameStr)
#### Usage: Wx::DateTime::GetSecond(THIS, tz= wxDateTime::Local)
#### Usage: Wx::DC::DrawLabelBitmap(THIS, text, image, rect, alignment
+ = wxALIGN_LEFT | wxALIGN_TOP, indexAccel = -1)
#### Usage: Wx::BitmapComboBox::Insert(THIS, ...)
#### Usage: Wx::BitmapDataObject::new(CLASS, bitmap = (wxBitmap*)&wxNu
+llBitmap)
#### Usage: Wx::Event::EVT_COMMAND( window , window_or_id , WXTYPE com
+mandEventType = 0 , func )
#### Usage: Wx::GraphicsContext::CreateFont(THIS, font, col = (wxColou
+r*)wxBLACK)
#### Usage: Wx::SingleChoiceDialog::new(CLASS, parent, message, captio
+n, chs, dt = &PL_sv_undef, style = wxCHOICEDLG_STYLE, pos = wxDefault
+Position)
#### Usage: Wx::PlDataObjectSimple::new(CLASS, format = (wxDataFormat*
+)&wxFormatInvalid)
#### Usage: Wx::BestHelpController::new(CLASS, parent = NULL, style =
+wxHF_DEFAULT_STYLE)
#### SkipUsage: Wx::LogFatalError()
#### UnUsage: Wx::App::OnInit()
#### Usage: Wx::App::OnAssertFailure(THIS, file, line, func, cond, msg
+)
#### Usage: Wx::View::OnActivateView(THIS, activate = 0, activeView, d
+eactiveView)
#### Usage: Wx::PlCommand::new(CLASS, canUndoIt= false, name= wxEmptyS
+tring)
#### Usage: Wx::PlOwnerDrawnComboBox::Create(THIS, parent, id, value=
+wxEmptyString, pos= wxDefaultPosition, size= wxDefaultSize, choices,
+style= 0, validator= wxDefaultValidatorPtr, name= wxEmptyString)
Usage: Wx::Window::newDefault(CLASS)
Usage: Wx::Window::GetWindowStyleFlag(THIS)
Usage: Wx::Event::EVT_WIZARD_PAGE_CHANGED( window , window_or_id , fun
+c )
####
#### Usage:
#### Usage:
__MISMATCH__
my @mismatch = $mismatch =~ m{^.*?((?:UnUsage|SkipUsage|Usage):.{4,})$
+}gm;
#~ dd\@mismatch;
#~ return dd\@mismatch;
## print "$_\n" for @mismatch ;
#~ use re 'debug';
#~ printUsage($mismatch[0]);
#~ printUsage($mismatch[1]);
#~ printUsage($mismatch[2]);
#~ printUsage($mismatch[-2]);
#~ printUsage($mismatch[-1]);
#~ printUsage($_) for @mismatch ;
printUsage($_) for @mismatch[-1,-2] ;
}
sub Main {
#~ return checkMismatch( );
#~ wx_usage_gui( 'force_refresh_database');
wx_usage_gui( );
}
__END__
=head1 NAME
wxperl_usage - wxperl-usage / wxPerl::Usage / Class Method Browser ,
+available methods, method invocation syntax, link to docs
=head1 PREREQUISITED
=head1 DEPENDENCIES
=head1 KNOWN TO WORK WITH
Carp 1.26
Carp::Heavy 1.26
Class::Struct 0.63
Cwd 3.40
Data::Dump 1.21
DynaLoader 1.14
Errno 1.15
Exporter 5.66
Exporter::Heavy 5.66
Fcntl 1.11
File::Basename 2.84
File::Path 2.08_01
File::Spec 3.40
File::Spec::Unix 3.40
File::Spec::Win32 3.40
File::Temp 0.23
File::stat 1.05
HTTP::Config 6.00
HTTP::Date 6.02
HTTP::Headers 6.05
HTTP::Message 6.06
HTTP::Request 6.00
HTTP::Response 6.04
HTTP::Status 6.03
IO 1.25_06
IO::Dir 1.1
IO::File 1.16
IO::Handle 1.33
IO::Scalar 2.110
IO::Seekable 1.1
IO::WrapTie 2.110
LWP 6.05
LWP::Protocol 6.00
LWP::UserAgent 6.05
List::Util 1.27
Path::Class 0.32
Path::Class::Dir 0.32
Path::Class::Entity 0.32
Path::Class::File 0.32
Regexp::Common 2013030901
Regexp::Common::number 2010010201
Scalar::Util 1.27
SelectSaver 1.02
Storable 2.39
Symbol 1.07
Tie::Handle 4.2
Tie::Hash 1.04
Tie::StdHandle 4.2
Time::Local 1.2300
URI 1.60
URI::Escape 3.31
Wx 0.9917
Wx::AUI 0.01
Wx::FS 0.01
Wx::Html 0.01
Wx::Perl::FSHandler::LWP 0.03
Wx::Perl::ListView 0.01
XSLoader 0.16
attributes 0.19
base 2.18
bytes 1.04
constant 1.27
overload 1.18
overloading 0.02
re 0.19_01
subs 1.01
vars 1.02
warnings 1.13
warnings::register 1.02
=head1 AUTHOR
Anonymous Monk
=head1 LICENSE
This program is free software; you can redistribute it and/or modify i
+t under the same terms as Perl itself.
=head1 SEE ALSO
L<Wx>
L<Wx::Perl::ListView>
L<Wx::Perl::FSHandler::LWP>
L<http://www.wxperl.it/>
L<http://wiki.wxperl.it/>
L<http://wiki.wxwidgets.org/>
L<http://forums.wxwidgets.org/>
L<http://docs.wxwidgets.org/>
=cut