Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
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 drinking their drinks and smoking their pipes about the Monastery: (13)
As of 2015-07-02 08:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (31 votes), past polls