Chapter 14. Creating Custom Widgets in Pure Perl/Tk

14.1. A Mega-Widget Quick-Start

When first trying to decide if you need to write your own mega-widget, you need to know what you want it to do. What features should it have? Which features are absolutely necessary, and which are extras? After creating this list, prioritize the items according to necessity. At this point, you should have a general idea of what types of widgets your mega-widget requires. The next step is to take a look around at the various resources available (CPAN,[32] newsgroups, and this book) to see if there is already a widget out there. There is no sense in reinventing the wheel if a widget already exists. You might find one that is close enough to do what you want. If you find what you want, congratulations, you no longer need to keep reading this chapter. Still curious, or didn't find what you needed? Keep reading!

[32] Visit http://www.Lehigh.EDU/sol0/ptk/modlist for a full list of Perl/Tk modules.

You won't learn object-oriented programming here; at least, we don't intend to try to teach it, as there are entire books devoted to the subject.[33] The actual techniques we use are pretty straightforward and are fully described in the standard Perl documentation. For instance, this code should make sense to you:

[33] Object Oriented Perl by Damian Conway (Manning) is an excellent read.

package Frog;

sub new {
    my($class, %args) = @_;
    bless \%args, $class;
}

sub get {
    my($self, $attr) = @_;
    $self->{$attr};
}

package main;

my $frog = Frog->new(qw/-color blue -poisonous 1/);
print "$frog: color = ", $frog->get(-color), "\n";

Frog=HASH(0x80ccf7c): color = blue

If this code is unclear, or if terms like base class, subclass, superclass, and @ISA are unfamiliar to you, then please read the Perl documents perlsub, perlmod, perlmodlib, perlref, perltoot, perlobj, and perlbot before continuing.

The class package Frog has a constructor (sometimes called a class method) named new that returns a reference to an anonymous hash, blessed into $class, which in this case is Frog. It also has an object method, get, which returns the value of any attribute of a Frog object. These object attributes are also known as instance variables and are stored in the object hash. All in all, this is pretty much standard OO Perl. Perl/Tk widgets are also modeled using an anonymous hash, exactly like the Frog object we just encountered.

You can create an entire mega-widget in fewer lines of code than class Frog's constructor. Of course, this is only because Perl/Tk does a lot of behind-the-scenes work.

package Tk::Nil;             # 1
use base qw/Tk::Toplevel/;   # 2
Construct Tk::Widget 'Nil';  # 3
package main;
use Tk;
use strict;

my $mw = MainWindow->new(-title => 'Nil MW');
my $nil = $mw->Nil(-title => 'Nil object');
$nil->configure(-background  => '#d9d9d9');
print '-background = ', $nil->cget(-background), "\n";
MainLoop;

Running this program creates a Nil widget and produces this output:

-background = #d9d9d9

As Figure 14-1 shows, three lines of code define a Toplevel-based Nil widget class,[34] including a constructor that can handle widget options and methods such as configure and cget. In short, Perl/Tk does everything for you except give the widget an appearance and behavior. But it tries to, even in this minimalist case. You see, as a Nil widget is created, Perl/Tk calls out to well-known methods (i.e., tries to invoke methods in class Nil) that we widget writers can provide. These "gateways" allow us to create bindings and arrange subwidgets within the Toplevel, thus breathing life into our mega-widget. Any method we fail to provide, or override, in our new widget class, Perl finds in one of our base classes by searching the @ISA array in the standard manner.

[34] This new widget, unfortunately, doesn't do anything useful, hence its name.

Figure 14-1. Nil, a (dis)functional, Toplevel-based mega-widget

There are two primary gateway methods of concern to us, ClassInit and Populate. ClassInit is called once to initialize the class, where it typically creates class bindings. Populate is called for every new widget instance, where, usually, it "populates" the mega-widget with component subwidgets and defines configuration specifications. The essence of making mega-widgets is learning how to effectively write these two subroutines. With that in mind, let's make a real mega-widget.

Risking oversimplification and technical inaccuracy, the remainder of this section gives a brief, to-the-point global view of mega-widget use and construction. (Don't worry. Further sections remedy any deficiencies.) The candidate mega-widget is a simple composite consisting of two subwidgets enclosed in a container Frame, so it's a Frame-based mega-widget. The Frame serves two functions. First, it bundles all the individual subwidgets that comprise the composite into a tidy package, which is then easily manipulated by a geometry manager. Second, through the object-oriented mechanism of inheritance, the Frame provides the widget's constructor and routines that handle option specification and configuration, method delegation, and other miscellaneous tasks.

From a user's perspective, using a mega-widget should be identical to using a coreTk widget. Given that, these statements create and configure the labeled Optionmenu widget shown in Figure 14-2. The Label is aligned across the top and the Optionmenu is activated, displaying its list of choices.

my $mw = MainWindow->new;

use Tk::LabOptionmenu;
my $lo = $mw->LabOptionmenu(-label => 'Ranking', -options => [1..2]);
$lo->pack;
$lo->configure(-background => '#d9d9d9');
$lo->addOptions(3 .. 5);

This mega-widget has -label and -options arguments that apply to the Label and Optionmenu subwidgets, respectively. That's nice. We don't have to worry about Tk trying to apply -label to the Optionmenu or -options to the Label. On the other hand, applying a background color to both subwidgets is equally logical, and that's just what Tk does. These actions are described by a list of configuration specifications. Similarly, method calls such as addOptions are directed, or delegated, to one or more widgets. All of this heavy magic is initiated when Perl processes the use Tk::LabOptionmenu statement, which reads the file LabOptionmenu.pm from somewhere in the @INC directory list.

Figure 14-2. LabOptionmenu, a Frame-based mega-widget

This listing of LabOptionmenu.pm (including its POD documentation, which we'll examine shortly) serves as a good mega-widget template.

 1  $Tk::LabOptionmenu::VERSION = '1.0';
 2
 3  package Tk::LabOptionmenu;
 4
 5  use Tk::widgets qw/Optionmenu/;
 6  use base qw/Tk::Frame/;
 7  use strict;
 8
 9  Construct Tk::Widget 'LabOptionmenu';
10
11  sub ClassInit {
12
13      my($class, $mw) = @_;
14      $class->SUPER::ClassInit($mw);
15
16  } # end ClassInit
17
18  sub Populate {
19
20      my($self, $args) = @_;
21
22      $self->SUPER::Populate($args);
23      my $o = $self->Optionmenu->pack;
24      $self->Advertise  ( 'optionmenu' =>  $o  );
25      $self->ConfigSpecs( 'DEFAULT'    => [$o] );
26      $self->Delegates  ( 'DEFAULT'    =>  $o  );
27
28  } # end Populate
29
30  1;

It's always good to maintain version information with a module, and it's required if it's distributed via the Comprehensive Perl Archive Network (CPAN) or ActiveState's Perl Package Manager (PPM) archive. In either case, this version information is used by MakeMaker, the utility that reads Makefile.PL files and installs Perl modules. There are several ways to define this version information; line 1 shows a possibility. Typically, some other program parses the module file and extracts this version information. Section 14.6, "Packaging a Mega-Widget for Public Distribution", explores this and other distribution details.

Lines 3 through 7 are pretty much boilerplate code and are found in all well-behaved mega-widget modules.

Line 3 defines the widget's class name, which must be unique among all the Tk classes (unless you really know what you are doing). Note that hierarchical class names (Tk::A::B) are also possible but that the internal Tk class is always the leaf part (B). The internal Tk class is used as the identifier for option database lookups, as described in Chapter 16, "User Customization".

Line 5 imports widget definitions required by the new class, saving us from having to use or require them individually. (There is a reason we don't bother including Label, as we'll see soon.)

Line 6 initializes the class @ISA array by declaring the object-oriented base class or classes that the mega-widget is based upon. For composites, the choices are Tk::Frame or Tk::Toplevel. For derived widgets, the list includes Tk::Derived and the widget class being derived from. (Again, we'll clarify all this shortly.) You might see some modules declare their base classes by assigning directly to the @ISA array, but this form is deprecated: @ISA = qw/Tk::Frame/;.

Line 7: just do it.

Line 9 is the magic line. Briefly, it adds a &LabOptionmenu symbol table entry that calls a generic new constructor located in one of the base classes. When a LabOptionmenu widget is created, the generic new constructor creates the initial Frame widget, blesses it into the proper class, and then invokes the class' well-known subroutine, Populate, to create and arrange the Frame's subwidgets and to define configuration specifications and method delegation information. If this is the first LabOptionmenu instance for a MainWindow, ClassInit is called before Populate.

Lines 11 through 16 define subroutine Tk::LabOptionmenu::ClassInit. This subroutine is called once for each MainWindow and is commonly used to create class bindings. ClassInit must return a true result. This example depends on SUPER::ClassInit to do that for us.

Line 14 is obligatory. The statement invokes a ClassInit method in one of the mega-widget's base classes that may (or may not) perform a function on the behalf of our class. For a composite widget based on a Frame or Toplevel, this call currently does nothing, but that may change. However, a derived widget's superclass almost always has required initialization, so don't forget this statement.

Lines 18 through 28 define subroutine Tk::LabOptionmenu::Populate. This subroutine creates and arranges the composite's remaining widgets, advertises important subwidgets, defines configuration options, and specifies how these options (as well as widget methods) are applied to the various subwidgets. Generally, Populate should not configure any of these internal widgets, because Perl/Tk does that later. This is also the place to add subwidget bindings and/or modify the bindtags list. Populate is not expected to return a result.

Line 20 defines Populate's arguments. $self is not a simple Tk::Frame object, but a full-fledged Tk::LabOptionmenu object. $args is a reference to the keyword/value argument hash (in our sample code -label => 'Ranking', -options => [1..5]). If you need to make changes to the argument list, here's your chance.

Line 22 is obligatory. The statement invokes a Populate method in one of the mega-widget's base classes that may (or may not) perform a function on the behalf of our class. For a Frame-based composite such as LabOptionmenu this call invokes Tk::Frame::Populate, which generates additional configuration specifications that transparently handle processing of the Label widget. Omitting this statement would break the mega-widget, because the built-in Label support provided by the Frame would be disabled. The LabEntry widget takes advantage of this feature too. For an exhaustive list of these Label options, see Section 14.3.9, "Mega-Widget Instance Variables".

Line 23 creates the Optionmenu subwidget and uses the packer to manage its geometry. The Label widget is created and packed automatically by the base class Tk::Frame. (The implication here is that Tk uses pack to manage the Label's geometry, hence you must be wary if using grid in the same program, it's possible that the different geometry managers may enter a race condition as they compete with each other, causing the application to hang.)

Line 24 advertises the Optionmenu widget $o with the name optionmenu. In object-oriented programming, there's a de facto contract that forbids us from meddling with the internals of an object. By advertising a subwidget, it becomes part of the widget's public interface, and we can do with it as we please. Given an advertised name, the Subwidget method returns the corresponding widget reference.

Line 25 defines the mega-widget's configuration specifications. For this simple widget with a single primary subwidget, all configure and cget requests are directed to it. ConfigSpecs is fully described in Section 14.3.6, "Subroutine ConfigSpecs".

Line 26 defines how methods targeted for the mega-widget are redirected to subwidgets. Again, the Optionmenu is the primary subwidget, so all mega-widget methods default to it. Delegates is fully described in Section 14.3.7, "Subroutine Delegates".

Line 30 returns a true value and is the standard Perl way of indicating that a module "loaded" successfully.

Finally, this POD defines the mega-widget's public interface. It has many of the same headings as the POD for the phone program from Chapter 11, " Frame, MainWindow,and Toplevel Widgets". Additionally, it itemizes the mega-widget's new arguments and methods, lists advertised subwidgets, and provides an example.

__END__

=head1 NAME

Tk::LabOptionmenu - An Optionmenu with a descriptive label

=head1 SYNOPSIS

S<    >I<$lo> = I<$parent>-E<gt>B<LabOptionmenu>(I<-option> =E<gt> I<value>, ... );

=head1 DESCRIPTION

This widget is a standard Optionmenu with a descriptive label that can
appear on the top, left, right or bottom of the Optionmenu.   

The following additional option/value pairs are supported:

=over 4

=item B<-label>

Label text to appear next to the Optionmenu.  If I<-labelVariable> is
also specified, I<-label> takes precedence.

=item B<-labelPack>

Where to pack the label relative to the Optionmenu.  This parameter
is a reference to a list of B<pack> options. WARNING: The implication 
here is that Tk uses pack( ) to manage the Label's geometry, hence you
must be wary if using grid( ) in the same program - it's possible that
the different geometry managers may enter a race condition as they
compete with each other, causing the application to hang.

=item B<-labelVariable>

A reference to a Perl variable containing the label string.

=item B<-labelXYZZY>

The label attribute B<XYZZY>, where B<XYZZY> can be any valid Label 
option except -text and -textvariable, which, obviously, are
superseded by -label and -labelVariable.

=back

=head1 METHODS

None.

=head1 ADVERTISED WIDGETS

Component subwidgets can be accessed via the B<Subwidget> method.
Valid subwidget names are listed below.

=over 4

=item Name:  label, Class: Label

Widget reference of Label widget.

=item Name:  optionmenu, Class: Optionmenu

  Widget reference of Optionmenu widget.

=back

=head1 EXAMPLE

I<$lo> = I<$mw>-E<gt>B<LabOptionmenu>(-label =E<gt> 'Ranking:',
-options =E<gt> [1 .. 5], -labelPack =E<gt> [-side => 'left']);

I<$lo>-E<gt>configure(-labelFont =E<gt> [qw/Times 18 italic/]);

=head1 AUTHOR

JPolooka@xy.zz.y

Copyright (C) 2001, Joe Polooka. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 KEYWORDS

Optionmenu

=cut