Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs

by Anonymous Monk
on Apr 07, 2013 at 16:58 UTC ( #1027386=CUFP: print w/ replies, xml ) Need Help??

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{<}{&lt;}g; s{>}{&gt;}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

Comment on wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs
Download Code
Re: wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs
by Anonymous Monk on Apr 11, 2013 at 09:36 UTC
    fixup wxDocsUrlTrunk
    sub wxDocsUrlTrunk { my( $name ) = @_; my @class = split /::/, $name; my $classmethod = lc join '_', @class; my $method = pop @class; my $classname = lcfirst join '', @class; $classname =~ s/([A-Z])/_\l$1/g; my $href = "http://docs.wxwidgets.org/trunk/class$classname.html"; $classname = lcfirst join '', @class; qq{<a href="$href">${classname}::$method</a>}; }
Re: wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs
by Anonymous Monk on Apr 19, 2013 at 08:25 UTC

    workaround for this bug #13096 (URLs passed to wxFileSystemHandler::OpenFile() sometimes contain double slashes) wxWidgets

    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; } $text = escapeHTML( $classname.$method ); $method =~ s/:/%3A/g; $href .= $classname.$method; qq{<a href="$href">$text</a>}; }
Re: wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs
by Anonymous Monk on Apr 20, 2013 at 04:05 UTC

    More comprehensive loading workaround

    {## SNAP_load_Wx package SNAP; require Wx; Wx->import( qw' :allclasses :everything '); eval { require Wx::DataView; }; eval { require Wx::AUI; }; eval { require Wx::STC; }; }
Re: wxperl_usage / wxperl-usage / wxPerl::Usage / Class Method Browser , available methods, method invocation syntax, link to docs
by Anonymous Monk on Apr 29, 2013 at 08:21 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1027386]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (13)
As of 2014-08-01 12:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (12 votes), past polls