Perl/Tk programs are event driven, meaning they are designed to respond, via callbacks, to various stimuli, called events. A callback is simply a hunk of code, often a Perl subroutine, that is automatically called when an event, like a button click, occurs. Perl/Tk defines default behaviors for most of its widgets, which you can modify by deleting, adding, or supplementing bindings. Simply put, a binding tells your Perl/Tk application what to do when something of interest happens.
For instance, I can create and display a Quit button like so:
my $b = $mw->Button(qw/-text Quit -command/ => \&exit)->grid;
Clicking mouse button 1 (typically the left button) while the cursor is over the button would then invoke the Perl exit() function. The Perl code is invoked because it's associated with the X event <ButtonRelease-1> (you don't know this yet), and this association of a callback with an X event is known as a binding. Bindings are managed with the bind() and bindtags() commands, the topic of this column.
The literal string "<ButtonRelease-1>" is known as an event descriptor, and it has two fields enclosed in angle brackets: an event type and an event detail. For <ButtonRelease-1> to invoke our button's callback, mouse button 1 must be released when the cursor is over the widget. Here are some of the more common event types:
Button or ButtonPress A mouse button was pressed ButtonRelease A mouse button was released Key or KeyPress A key was pressed KeyRelease A key was released Enter The cursor moved into a widget Leave The cursor moved out of a widget
We'll see more of these events shortly, but for now note that button and keyboard event types usually require a detail field that specifies the particular button or keyboard character of interest.
Like most widgets, a button's default behavior is defined by bindings supplied by Perl/Tk; in fact, that's why we didn't have to create the Quit button's <ButtonRelease-1> binding explicitly. These default bindings, called class bindings, are shared by all buttons. Using bind() it's possible to see the default class bindings (or more precisely, the default event descriptors), for our button. There are at least six different formats of bind(), but this one performs the simple query we want:
$b->bind(tag);
tag can take one of several forms as we'll see later - for now it's a Perl/Tk class name. In the butclass program (which, like all the programs mentioned in this article, can be found on the TPJ web site), the Perl ref() function returns the button's class name, so the bind() message replies with the bindings for the class: Tk::Button.
my $class = ref $b;
print "Button \$b is an instance of class $class.\n".
"This class has bindings for these events:\n\n";
print $b->bind($class), "\n";
Here's the output:
Button $b is an instance of class Tk::Button. This class has bindings for these events: <Key-space><ButtonRelease-1><Button-1><Leave><Enter>
which includes the <ButtonRelease-1> event descriptor that we bound to exit() previously.
But what do these other bindings do? What default behaviors do they give their buttons? As usual, the answer can be found in the online Perl/Tk documentation. The documentation for every Perl/Tk widget contains a section titled "Default Bindings." Here's what it tells us about buttons:
All these behaviors are elicited by event bindings that someone other than you created: #1 by <Enter> and <Leave>, #2 by <Button-1>, #3 by <ButtonRelease-1> and #4 by <Key-space>. (<Key> events require a detail field called a keysym to specify the keyboard character of interest - in this case a space. More about keysyms in a bit.)
Suppose you require a specialized button that responds to <ButtonRelease-2> and <ButtonRelease-3> events. Since those event descriptors are not part of the default class bindings, you need to create them yourself with another form of the bind() command:
$noisy_button->bind('<event_descriptor>' => \&callback);
This statement creates a new binding for $noisy_button only. The butinst program, like butclass, displays the new instance bindings using the query form of bind(), but substitutes the button reference for the class name string:
my $noisy_button = $mw->Button(qw/-text NoisyButton -command/ =>
sub {print "<ButtonRelease-1> callback invoked!\n"})->grid;
$noisy_button->bind('<ButtonRelease-2>' => [\&beep, 2]);
$noisy_button->bind('<ButtonRelease-3>' => [\&beep, 3]);
my $class = ref $noisy_button;
print "Button \$noisy_button is an instance of class $class.\n".
"This button has class bindings identical to our button\n".
"\$b, plus additional instance bindings for these events:\n\n";
print $noisy_button->bind($noisy_button), "\n";
MainLoop;
sub beep {
my($button, $count) = @ARG;
while ($count-- > 0) {
$button->bell; # ring the bell
$button->after(250);
}
}
Here is the code's output:
Button $noisy_button is an instance of class Tk::Button. This button has class bindings identical to our button $b, plus additional instance bindings for these events: <ButtonRelease-3><ButtonRelease-2>
If you press button 2 you'll hear two bells, and if you press button 3 three bells sound, while pressing button 1 prints a line of text. Notice how the first bind() call glues the event descriptor to its associated callback. This callback, a reference to an anonymous array, expects a code reference to the actual callback as the first element, and any parameters as additional elements. bind()'s object, $noisy_button, is implicitly passed to the subroutine as the first parameter, as cursory inspection of beep() will confirm.
$noisy_button's bind() query is pretty noisy itself. Since bind() knows its object we could have omitted the argument and just written: print $noisy_button->bind, "\n";
There are six ways to call bind():
- $w->bind; # query descriptors for $w
- $w->bind(tag); # query descriptors for tag
- $w->bind(event_descriptor); # query callbacks for $w
- $w->bind(tag, event_descriptor); # query callbacks for tag
- $w->bind(event_descriptor => callback); # set callback for $w
- $w->bind(tag, event_descriptor => callback); # set callback for tag
We've already discussed flavors 1, 2 and 5. Flavors 3 and 4 aren't particularly interesting or even useful - they return the actual callback bound to an event descriptor, which in Perl/Tk is an opaque CODE reference (in Tcl/Tk, callbacks are readable strings). On the other hand, bind() flavor 6 is often used to add bindings to an entire widget class. If we wanted to make lots of noisy buttons we could use this technique to create one class binding instead of many instance bindings:
my $class = ref $b; $b->bind($class, '<ButtonRelease-2>' => [\&beep, 2]); $b->bind($class, '<ButtonRelease-3>' => [\&beep, 2]);
Now all buttons, old and new, demonstrate the noisy behavior.
$noisy_button reacts to three button release events: Release of button 1 (handled by the class binding) and releases of buttons 2 or 3 (handled by instance bindings). What do you suppose happens if an instance binding for <ButtonRelease-1> is created? Is it executed in deference to the class binding, or is the class binding executed in place of the instance binding? Or are both bindings executed, and, if so, which binding is executed first?
Unless you specify otherwise, the class binding is executed first, followed by the instance binding, with the order of execution dependent on the order of the binding tags associated with $noisy_button. Whenever a binding is created using bind() it's always associated with a particular identifying tag.
We've already seen two kinds of binding tags: class names like Tk::Button, and widget references like $b and $noisy_button. When an event occurs it's compared against all the bindings for every tag that a widget owns, and if the event matches one of the tag's list of bindings the associated callback is executed.
By default $noisy_button, like most Perl/Tk widgets, has four binding tags: the widget's class name, the widget instance itself, the widget's closest Toplevel, and the string "all", in that order. (A Toplevel widget only has three binding tags.) To prove this, program buttags1 prints out the binding tags for $noisy_button, using the bindtags() method:
my $noisy_button = $mw->Button(qw/-text NoisyButton/);
print "Default list of binding tags:\n\n";
my(@bindtags) = $noisy_button->bindtags;
foreach my $tag (@bindtags) {
print "binding tag = '$tag'\n";
}
And here's the output:
Default list of binding tags: binding tag = 'Tk::Button' binding tag = '.button1' binding tag = '.' binding tag = 'all'
Ignoring the fact that $noisy_button is represented by a string (a vestige of Perl/Tk's origins in Tcl), the tag list order is: class, instance, toplevel, and "all".(You should never refer to a widget using the internal string name. Always use the Perl/Tk widget reference.)
Let's add two features to program butinst - an instance binding for <ButtonRelease-1>, and some additional print statements to list the bindings associated with each binding tag. Program buttags2 follows:
my $noisy_button =
$mw->Button(qw/-text NoisyButton -command/ =>
sub {
print "You invoked two <ButtonRelease-1> callbacks!\n"
})
->grid;
$noisy_button->bind('<ButtonRelease-1>' => [\&beep, 1]);
$noisy_button->bind('<ButtonRelease-2>' => [\&beep, 2]);
$noisy_button->bind('<ButtonRelease-3>' => [\&beep, 3]);
my $class = ref $noisy_button;
print "\$noisy_button is an instance of class $class.\n" .
"This button has class bindings identical to our button\n" .
"\$b, plus instance bindings for these events:\n\n";
print $noisy_button->bind, "\n";
print "\n\$noisy_button's tags, and their bindings:\n\n";
foreach my $tag ($noisy_button->bindtags) {
print " bindtag tag '$tag' has these bindings:\n";
print " ", $noisy_button->bind($tag), "\n";
}
Here's the output:
$noisy_button is an instance of class Tk::Button.
This button has class bindings identical to our button $b,
plus instance bindings for these events:
<ButtonRelease-3><ButtonRelease-2><ButtonRelease-1>
$noisy_button's tags, and their bindings:
bindtag tag 'Tk::Button' has these bindings:
<Key-space><ButtonRelease-1><Button-1><Leave><Enter>
bindtag tag '.button1' has these bindings:
<ButtonRelease-3><ButtonRelease-2><ButtonRelease-1>
bindtag tag '.' has these bindings:
bindtag tag 'all' has these bindings:
<Key-F10><Alt-Key><Shift-Key-Tab><Key-Tab>
Now we can see exactly what happens when button 1 is released: first the class binding is executed and a line of text is printed. Perl/Tk then looks at the next tag in the binding tag list, finds a matching binding, and executes its callback, which in this case beeps. The search continues through the toplevel and "all" bindings, but no other matching event descriptor is found.
Another use of bindtags() might be to remove every binding tag belonging to a widget. So you want a "view only" text widget that displays some fancy instructions? And the widget can't interact with the user at all? Check out votext:
my $mw = MainWindow->new;
my $b = $mw->Button(qw/-text => Quit
-command/ => \&exit)->grid;
my $t =$mw->Text->grid;
$t->insert(qw/end HelloWorld/);
$t->bindtags(undef);
Now $t has an empty binding tag list, and thus cannot react to any external event whatsoever.
In addition to listing, adding, and subtracting binding tags, bindtags() can reorder them too, as we'll see.
The break() command short-circuits Perl/Tk's search through the binding tag list. Suppose we want $noisy_button to invoke only its instance binding for a button 1 release. We can use bindtags() to reorder the binding tag list so the instance tag is first and the class tag is second, and then use break() in our callback code to exit the binding tag search early. Here's an excerpt from the butbreak program:
my $noisy_button =
$mw->Button(qw/-text NoisyButton -command/ =>
sub {
print "You invoked the <ButtonRelease-1> callback!\n"})
->grid;
$noisy_button->bind('<ButtonRelease-1>' => [\&beep, 1]);
$noisy_button->bind('<ButtonRelease-2>' => [\&beep, 2]);
$noisy_button->bind('<ButtonRelease-3>' => [\&beep, 3]);
my(@tags) = $noisy_button->bindtags;
$noisy_button->bindtags([@tags[1, 0, 2, 3]]); # reorder tags
MainLoop;
sub beep {
my($button, $count) = @ARG;
while ($count-- > 0) {
$button->bell; # ring the bell
$button->after(250);
}
$button->break; # short circuit tag search
}
bindtags() expects a reference to a list of binding tags, and the slightly tricky array slice simply reverses tags 0 and 1. (Once done, the -command callback will never be executed.)
This code merely demonstrates break(); it's not the proper way to sound the bell on a button 1 release. As this picture shows, the button is left in the sunken state:
Since we've overridden the class bindings there's no longer any code to restore the button's relief after the callback executes. Anyway, it's easier to have the -command option invoke beep().
A binding definition is slightly more complicated than we've seen - it may contain one or more modifiers to further qualify the binding. The full specification is <modifier[s]-type-detail>.
"Double" and "Triple" modifiers repeat events, so we often see event descriptors like <Double-Button-1>. Common keyboard modifiers include Alt, Control, Meta, Mod, and Shift; thus, <Control-Key-c> traps a Control-c. Since we've seen only a handful of the possible event modifiers and event types, you'll want to read the Perl/Tk bind and bindtags documentation. Several times.
When an event is dispatched, its X11 event structure is available to the callback. The event structure contains various useful fields, like the screen coordinates of the cursor or perhaps a keyboard character. To access components of the structure we first need to get a reference to structure itself, via XEvent(), then using the reference we can read whatever event component is relevant to our callback. The keysym program samples several event fields:
#!/usr/local/bin/perl -w
use English;
use Tk;
use strict;
my $mw = MainWindow->new;
$mw->Label(-text =>
'Type a character to see its keysym.')->grid;
$mw->Button(qw/-text Quit -command/ => \&exit)->grid;
$mw->bind('<Key>' => \&print_keysym);
MainLoop;
sub print_keysym {
my($widget) = @ARG;
# get reference to X11 event structure
my $e = $widget->XEvent;
my($keysym_text, $keysym_decimal) = ($e->K, $e->N);
my($X, $Y, $x, $y) = ($e->X, $e->Y, $e->x, $e->y);
print "Character = $keysym_decimal, keysym = $keysym_text".
" at abs=($X,$Y), rel=($x,$y).\n";
} # end print_keysym
The bind() call binds all keypresses to print_keysym(). Again, this callback is supplied one implicit parameter, the widget instance $mw, which we use to fetch the X11 event structure and read the character's keysym and numeric value, as well as the cursor's screen-absolute and widget-relative Cartesian coordinates.
Some final notes - every canvas widget has its own bind() method that binds callbacks to individual canvas items rather than the canvas as a whole. Unsurprisingly, the syntax parallels the normal bind():
$canvas->bind(tagorid, '<event_descriptor>' => \&callback);
where tagorid identifies the particular canvas item. But to create a binding for the canvas instance we need to use this special method:
$canvas->CanvasBind('<B2-Motion>' => \&callback);
If CanvasBind() isn't available with your version of Perl/Tk you can always fall back to the old syntax:
$canvas->Tk::bind('<B2-Motion>' => \&callback);
_ _END_ _