Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

perl Tk::Scrolled : how do I hijack existing subwidget bindings?

by Rudif (Hermit)
on Mar 31, 2005 at 19:40 UTC ( [id://443946]=perlquestion: print w/replies, xml ) Need Help??

Rudif has asked for the wisdom of the Perl Monks concerning the following question:

Estimated Tk monks

In the example below, I would like to keep the bindings provides by the Scrolled widget - when user clicks or or drags the scrollbar elements - but I'd like to be called so that I can add some behavior. Specifically, when user scrolls down to the last planet, I'd like to add to the list some exoplanets, for example. When called, I would also need to know/find out what is the current scroll position. Is there a general pattern for doing this in Tk? Pointers to doc, tutorials or working examples would be welcome.

#perl -w use strict; use Tk; my @planets = qw / Mercury Venus Earth Mars Jupiter Saturn Uranus Nept +un Pluto /; my $mw = MainWindow->new(); my $plist = $mw->Scrolled( "Listbox", -scrollbars => 'oe', -selectmode => 'single', -height => 4, -setgrid => 1 ); foreach my $planet (@planets) { $plist->insert( 'end', $planet ); } $plist->pack(); MainLoop();


Replies are listed 'Best First'.
Re: perl Tk::Scrolled : how do I hijack existing subwidget bindings?
by zentara (Archbishop) on Mar 31, 2005 at 20:25 UTC
    Well you can get to the actual scrollbar with the Subwidget method.
    my $scrollery = $plist ->Subwidget("yscrollbar"); $scrollery ->configure(-background => "green", -troughcolor => "black", -command => \&somecallback );
    Now whenever the y scrollbar is moved, the callback will be executed. Read "perldoc Tk::Scrollbar"

    I'm not really a human, but I play one on earth. flash japh
Re: perl Tk::Scrolled : how do I hijack existing subwidget bindings?
by zentara (Archbishop) on Mar 31, 2005 at 21:05 UTC
    Just to give you a little more help with the scrollbar, here is a little example to show what happens when you override the scrollbar callback. Notice in this example, if I override the scrollbar's internal callback, it will stop working unless you manually do it.
    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(); my $text_box = $mw->Scrolled("Text", -scrollbars => 'e', -relief => 'sunken', -takefocus => 1) ->pack(-expand => 1, -fill => 'both'); for(1..1000){ $text_box->insert('end', "$_ test\n"); $text_box->see('end'); } $text_box -> Subwidget("yscrollbar")->configure( -background => "lightgreen", -troughcolor => "black", #comment out the following line to restore normal #scroll function -command => \&scrollcallback, ); MainLoop; #if you specify a scrollcallback, you will override the #normal scroll behavior. sub scrollcallback{ #uncomment the following line to restore the normal function # $text_box->yview(@_); #do your additional stuff here print "1\n"; }

    I'm not really a human, but I play one on earth. flash japh
      Thank you, zentara, your example is a good starting point for a lazy monk.

      I will follow your advice and read up the doc.


      Hi zentara, it's me again.

      I experimented with  sub scrollcallback{...} as you suggested, and indeed it provides a solution for my problem : to keep the existing behavior of the Text widget when the user drags or clicks on the scrollbar's elements, and to extend this behavior with actions that I specify (adding text to the Text widget, perhaps fetching it from a file).

      Now this part works, and I realize that there are two pairs of bindings on the Text widget itself that I want to extend in similar way. (1) when the user presses repeatedly the up (down) arrow and the cursor hits the top (bottom) of the Text window, this causes Text to scroll up (down). When there is no more text to scroll to, I want to add some more from an external source (a file), just as if the user was clicking on the Scrollbar's arrows. (2) I want to add similar behavior for the mouse wheel rotation which normally also scrolls the text (on Win32).

      I looked into Tk docs, tutorials and examples, but so far I failed to puzzle it out: should I use bind? bindtags? configure? - I'm lost again.

      Another succint example from you (or anyone else) would take me closer to the goal.

      I was about to post above plea, out of laziness (the wrong kind), but I thought again. Another plea? This time my hubris would not let me, and I went on to search and experiment some more. Couple of hours later, here is the demo that shows all three behaviors that I was after.

      To test it, just try to scroll the text in every possible way and watch the effect.

      #!/usr/bin/perl use warnings; use strict; use Tk; # create a Main window and a scrolled text widget my $mw = MainWindow->new(); my $text = $mw->Scrolled( "Text", -scrollbars => 'e', -relief => 'sunken', -takefocus => 1 )->pack( -expand => 1, -fill => 'both' ); # redefine the scrollbar's callback that tells the Text to scroll $text->Subwidget("yscrollbar")->configure( -command => \&Yscrollcallba +ck, ); # add bindings for MouseWheel and for the Y arrow keys $text->bind( "<MouseWheel>", \&OnYscrolllimit ); $text->bind( "<Key-Up>", \&OnYarrowlimit ); $text->bind( "<Key-Down>", \&OnYarrowlimit ); # for demo, fill Text with some lines ... for ( 1 .. 200 ) { $text->insert( 'end', "$_ test\n" ); $text->see('end'); } my $lineAdded = 0; # and count the inserted ones MainLoop; ### subs sub Yscrollcallback { $text->yview(@_); # scrollbar tells Text to scroll or moveto OnYscrolllimit(); # additional behavior } sub OnYarrowlimit { my $i = int( $text->index('insert') ); my $e = int( $text->index('end') ); if ( $i == 1 ) { insertLines('1.0'); # up arrow hits the first line } elsif ( $i == $e - 1 ) { insertLines('end'); # down arrow hits the last line } } sub OnYscrolllimit { my ( $top, $bot ) = $text->yview; if ( $top == 0 ) { insertLines('1.0'); # wheel or scrollbar try to go above th +e first line } elsif ( $bot == 1 ) { insertLines('end'); # wheel or scrollbar try to go below th +e last line } } sub insertLines { my $where = shift; my $number = shift || 1; return unless $where =~ /^1.0|end$/; ++$lineAdded; #print "insert [$lineAdded]: $where $number\n"; $text->insert( $where, "insertLines at $where $lineAdded\n" ); $text->see($where); } __END__
      Thank you again for the help.


        Hi again, I looked at your code, and your problem with the up and down arrow buttons being bound, can be solved by putting $text->focus. That will make the up down arrows work right away.
        $text->focus MainLoop;

        The mouse scroll wheel can be made to work with:

        $text->bind('<MouseWheel>' => [ sub { $_[0]->yview('scroll', -($_[1] / 120) * 3, 'units') }, Ev('D') ]);
        I got that from googling the archives of for "mouse scroll". But I don't have a scroll mouse, nor Windows to say if it works there.

        I'm not really a human, but I play one on earth. flash japh
        and I went on to search and experiment some more. Couple of hours later...

        Thats the way to do it, you have to put in those "hours of experimenting" to get results. It's like exercising, the muscles only grow if you do the workouts. :-)

        I'll look at this later, and see if I see something. I would suggest that you post this to the newsgroup , because Jack D. (who maintains the text widget) is a regular there, amoung others who have deep insight into overriding things. Generally, in your type of problem, you would create your own "special text widget", say called "", or a package in your script. It is a common procedure called Derived, read "perldoc Tk::Derived". An easy example is Making a derived Tk::Text object. So look at the source code for and see which sub you want to change.

        I'm not really a human, but I play one on earth. flash japh

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://443946]
Approved by moot
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (6)
As of 2024-04-17 09:20 GMT
Find Nodes?
    Voting Booth?

    No recent polls found