Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

Perl Debugger with Two Customs Tk Widgets

by hmonroe (Novice)
on Jan 29, 2012 at 16:28 UTC ( #950595=perlquestion: print w/replies, xml ) Need Help??
hmonroe has asked for the wisdom of the Perl Monks concerning the following question:

The Perl debugger will not run on a 19,000 line program for a specialized text editor that I am trying to refactor. I believe the program occurs when one custom widget delegates to another custom subwidget. The first widget is called TextUnicode based on TextEdit with special methods to handle Unicode files. The second is called LineNumberText based on ROText to provide line numbers down the right hand side of the screen. Does this diagnosis sound correct and is there a simple fix I could use? Or do I need to combine these two widgets into one to avoid teh double delegation issue? The code can be found here: Here is the beginning of the two widgets:
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

    Wait, what is the problem? Won't run how, it exists without error? It hangs without showing anything? It dies?

    I doubt that combining the widgets is any kind of solution :/

    What kind of problem are you trying to debug with the debugger (if you couldn't tell, i'm from the "debugging with Print" school) ?

    Hmm, why are you including python in the tree? Python/Tk and Perl/Tk, one Tk too many :)

    Ouch, and an included perl-5.8? I thought you wanted to support unicode :)

    You should check out and , and consider packaging things as if for CPAN (Makefile.PL etc... )

Re: Perl Debugger with Two Customs Tk Widgets
by thundergnat (Deacon) on Jan 30, 2012 at 16:30 UTC

    I don't know that it will be of any use to you, but as I recall, guiguts used to crash the perl debugger before I added the line number mega widget (2002-2003??), so I doubt that that is the (or at least the only) issue. I never figured out why it would crash back then (and truthfully, didn't really care as I didn't heavily use the perl debugger.)

      Thundergnat: the problem with with the Text widget--regex searches crash the debugger.
      #!/usr/bin/env perl use Tk; $topWin = MainWindow->new(); my $text = $topWin->Text(); $text->insert("end", "Type text into this window"); print $text->search("-exact", 'e', '1.0', 'end')."\n"; print $text->search("-regexp", 'e', '1.0', 'end')."\n"; $text->pack(); MainLoop();

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://950595]
Approved by BrowserUk
[Corion]: So after talking it through with you even while I'm still not entirely clear on where AE ends and my implementation begins, I think I understand that I only need to implement some smaller parts for each functionality I want to support.
[Corion]: Yeah... and you might even be able to mix and match additional functionality if you have additional async suppliers, like from a separate thread
[ambrus]: You hvae to be careful with the timer, because apparently Prima::Timer insists on being periodic, wheras AnyEvent::Impl:: Whatever::timer should give a one-shot timer watcher
[ambrus]: I think the minimal implementation here is just a timer and io function, plus pushing to the @REGISTRY.

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (3)
As of 2016-12-08 12:26 GMT
Find Nodes?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:

    Results (141 votes). Check out past polls.