hmonroe has asked for the wisdom of the Perl Monks concerning the following question:
package TextUnicode; use base qw(Tk::TextEdit); use File::Temp qw/tempfile/; use File::Basename; Construct Tk::Widget 'TextUnicode'; sub Load {... sub SaveUTF {... ---------------------------- package Guiguts::LineNumberText; use Tk; use Tk::widgets qw(ROText); use base qw(Tk::Frame); Construct Tk::Widget 'LineNumberText'; sub Populate { my ( $self, $args ) = @_; $self->SUPER::Populate($args); $self->{'minwidth'} = 5; $self->{'linenumshowing'} = 0; my $widget; if ( $widget = delete $args->{-widget} ) { $widget = 'TextUnicode'; } else { $widget = 'Text'; } my $ltext = $self->ROText( -takefocus => 0, -cursor => 'X_cursor', -bd => 2, -relief => 'flat', -width => $self->{'minwidth'}, -wrap => 'none', ); $ltext->{_MENU_} = (); $self->{'ltext'} = $ltext; $ltext->tagConfigure( 'CURLINE', -data => 1 ); $ltext->tagConfigure( 'RIGHT', -justify => 'right' ); my $ftext = $self->Scrolled($widget) ->grid( -row => 0, -column => 1, -sticky => 'nsew' ); $self->{'rtext'} = my $rtext = $ftext->Subwidget('scrolled'); $self->gridColumnconfigure( 1, -weight => 1 ); $self->gridRowconfigure( 0, -weight => 1 ); $self->Advertise( 'yscrollbar', $ftext->Subwidget('yscrollbar') ); $self->Advertise( 'xscrollbar', $ftext->Subwidget('xscrollbar') ); $self->Advertise( 'corner', $ftext->Subwidget('corner') ); $self->Advertise( 'frame', $ftext ); $self->Advertise( 'scrolled', $rtext ); $self->Advertise( 'text', $rtext ); $self->Advertise( 'linenum', $ltext ); # Set scrolling command to run the lineupdate.. my $yscroll = $self->Subwidget('yscrollbar'); my $scrollcommand = $yscroll->cget( -command ); $yscroll->configure( -command => sub { $scrollcommand->Call(@_); $self->_lineupdate; } ); $self->ConfigSpecs( -linenumside => [ 'METHOD', undef, undef, 'left' ] +, -linenumbg => [ 'METHOD', 'numlinebg', 'numLinebg', '#eaeaea +' ], -linenumfg => [ 'METHOD', 'numlinefg', 'numLinefg', '#000000 +' ], -curlinehighlight => [ 'PASSIVE', undef, undef, 1 ], -curlinebg => [ 'METHOD', undef, undef, '#00ffff' ], -curlinefg => [ 'METHOD', undef, undef, '#000000' ], -background => [ $ftext, undef, undef, undef ], -foreground => [ $ftext, undef, undef, undef ], -scrollbars => [ $ftext, undef, undef, 'se' ], -font => ['CHILDREN'], -spacing1 => ['CHILDREN'], -spacing2 => ['CHILDREN'], -spacing3 => ['CHILDREN'], 'DEFAULT' => [$rtext], ); $self->Delegates( 'DEFAULT' => 'scrolled' ); #Bindings $ltext->bind( '<FocusIn>', sub { $rtext->focus } ); $ltext->bind( '<Map>', sub { $self->_lineupdate } ); $rtext->bind( '<Configure>', sub { $self->_lineupdate } ); $rtext->bind( '<KeyPress>', sub { $self->_lineupdate } ); $rtext->bind( '<ButtonPress>', sub { $self->{'rtext'}->{'origx'} = undef; $self->_lineupdate; } ); $rtext->bind( '<Return>', sub { $self->_lineupdate } ); $rtext->bind( '<ButtonRelease-2>', sub { $self->_lineupdate } ); $rtext->bind( '<B2-Motion>', sub { $self->_lineupdate } ); $rtext->bind( '<B1-Motion>', sub { $self->_lineupdate } ); $rtext->bind( '<<autoscroll>>', sub { $self->_lineupdate } ); $rtext->bind( '<MouseWheel>', sub { $self->_lineupdate } ); if ( $Tk::platform eq 'unix' ) { $rtext->bind( '<4>', sub { $self->_lineupdate } ); $rtext->bind( '<5>', sub { $self->_lineupdate } ); } my @textMethods = qw/insert delete Delete deleteBefore Contents deleteSelected deleteTextTaggedwith deleteToEndofLine FindAndReplaceAll GotoL +ineNumber Insert InsertKeypress InsertSelection insertTab openLine yview + ReplaceSelectionsWith Transpose see/; if ( ref($rtext) eq 'TextUnicode' ) { push( @textMethods, 'Load', 'SaveUTF', 'IncludeFile', 'ntinsert', 'ntdelete', 'replacewith' ); } for my $method (@textMethods) { no strict 'refs'; *{$method} = sub { my $cw = shift; my @arr = $cw->{'rtext'}->$method(@_); $cw->_lineupdate; @arr; }; } } # end Populate
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Perl Debugger with Two Customs Tk Widgets
by Anonymous Monk on Jan 29, 2012 at 18:39 UTC | |
by Anonymous Monk on Jan 29, 2012 at 19:15 UTC | |
|
Re: Perl Debugger with Two Customs Tk Widgets
by thundergnat (Deacon) on Jan 30, 2012 at 16:30 UTC | |
by hmonroe (Novice) on Jan 31, 2012 at 22:29 UTC |