home | O'Reilly's CD bookshelfs | FreeBSD | Linux | Cisco | Cisco Exam  

Book HomeMastering Perl/TkSearch this book

14.3. Mega-Widget Implementation Details

Once again, briefly, here's the basic structure of a Perl/Tk mega-widget, but this time using a derived NavListbox widget (described in Section 14.5, "Derived Mega-Widgets") as the model:

 1   package Tk::NavListbox;
 3   use vars qw($VERSION);
 4   $VERSION = '1.0';
 6   use Tk::widgets qw(Listbox Dialog);
 7   use base qw(Tk::Derived Tk::Listbox);
 8   use strict;
10   Construct Tk::Widget 'NavListbox';
12   sub ClassInit {}
13   sub Populate {}
15   1;

Line 1 declares the widget's class name.

Lines 3 and 4 show another way of specifying the module's version number.

Line 6 concisely declares the widgets used by the module.

Line 7 is the signature line of a derived mega-widget, because the base class list starts with Tk::Derived and includes another Tk widget class. Tk::Derived provides all the option specification and configuration, and method delegation support methods. A composite mega-widget would list a single base class, either Tk::Toplevel or Tk::Frame. As Figure 14-4 shows, composite mega-widgets need not include Tk::Derived in their @ISA array, because Tk::Derived is a base class of Tk::Frame.

Line 10, also written as Tk::Widget->Construct('NavListbox'), creates a constructor named NavListbox in the class Tk::Widget. When the user types:

$nlb = $mw->NavListbox;

Perl eventually finds Tk::Widget::NavListbox via MainWindow's @ISA array. This constructor, like all Perl/Tk widget constructors, then calls Tk::Widget::new (described next) to actually create the widget.

Lines 12 and 13 are well-known methods invoked by Tk::Widget::new. As we are about to see, there are several other methods you may occasionally find useful.

14.3.5. Subroutine Populate

Finally, it's Populate time! This method is invoked only because Tk::Derived is somewhere in the @ISA method lookup hierarchy. Since composite widgets are based on Tk::Frame or Tk::Toplevel, they need not include Tk::Derived in their @ISA lists, because Tk::Derived is a base class of the Frame or Toplevel. Derived mega-widgets, on the other hand, must specifically declare Tk::Derived.

Populate is passed two arguments: a reference to the mega-widget and a reference to the argument hash. If the argument hash contains options that aren't destined for configure, they must be removed before calling SUPER::Populate. The idiom uses delete, like this:

my $frog = delete $args->{-frog};

$frog then contains the value of the -frog option.

As we learned earlier, SUPER::Populate often makes ConfigSpecs calls on behalf of the mega-widget, so remember to call SUPER::Populate.

Populate is also the appropriate place to create subwidget bindings. Note that if you want the subwidgets of a mega-widget to react to the class bindings created byClassInit, you'll have to add the new class to the subwidget's bindtags list (see Chapter 15, "Anatomy of the MainLoop" for more details).

Populate is not expected to return a result.

sub Populate {
    my($self, $args) = @_;
    # Create and advertise subwidgets here.
    $self->ConfigSpecs( );
    $self->Delegates( );

In general, Populate should never perform any explicit mega-widget configuration, for these reasons:

  • Doing so prevents the user from customizing the widget to her liking.

  • Often it won't work anyway and only leads to frustration and confusion.

To see why, let's start with this tiny program, el, that uses a mythical EntList (Entry and Listbox) composite. Using the Subwidget method, the code fetches the widget references to the advertised Entry and Listbox widgets and inserts some text into each.

my $el = $mw->EntList->pack;
$el->Subwidget('entry')->insert('end', 'Entry!');
$el->Subwidget('listbox')->insert('end', 'Listbox!');

Suppose the user of this code has established some color and font preferences in his .Xdefaults file:

el*Foreground: purple
el*Font: -adobe-courier-bold-r-normal--34-240-100-100-m-200-iso8859-1

When the code is executed, the user expects large, purple text, shown in Figure 14-6.

Figure 14-6

Figure 14-6. Large, purple text

Now, it's okay to provide a default font and color scheme, but we can't mandate one. Let's examine EntList.pm to see the right and wrong way to do this. First, the incorrect way:

$Tk::EntList::VERSION = '1.0';

package Tk::EntList;

use Tk::widgets qw/Entry Listbox/;
use base qw/Tk::Frame/;
use strict;

Construct Tk::Widget 'EntList';

sub Populate {

    my($self, $args) = @_;


    my $e = $self->Entry->pack;
    my $l = $self->Listbox(-height => 2)->pack;
    $self->Advertise('entry'   => $e);
    $self->Advertise('listbox' => $l);

    # Wrong - hardcoding configurable options leads to 
    # frustration and confusion.

    $e->configure(-font => '9x15', -foreground => 'red');
    $l->configure(-font => '9x15', -foreground => 'red');

} # end Populate


When the poor user runs his code, instead of large, purple text, he sees small, purple text, as seen in Figure 14-7.

Figure 14-7

Figure 14-7. Small, purple text

Now two people are confused: the user, because the font size is too small, and the programmer, because the foreground color is wrong! So replace the two configure lines with this call:

        -font       => [[$e, $l], qw/font Font 9x15/],
        -foreground => [[$e, $l], qw/foreground Foreground red/],

Each ConfigSpecs entry (explained in the next section) is a reference to a list of values, the first of which specifies where to apply the option. In this case, it's another list of widgets. Now the user can customize the widget either via the option database or explicit configure calls, and if he doesn't, our default of 9x15, red lettering takes effect (see Figure 14-8).

Figure 14-8

Figure 14-8. 9x15 red lettering

The following sections describe other methods often called from Populate.

14.3.6. Subroutine ConfigSpecs

The ConfigSpecs method tells Perl/Tk what to do when a configure (or cget) request for an option is received. Any number of option/value pairs can be specified in the call, and ConfigSpecs can be called any number of times. (Indeed, we know that one or more of the mega-widget's superclasses may call ConfigSpecs.)

These are the three major ways of using ConfigSpecs:

    'DEFAULT' => [where],
    -alias    => '-otherattribute',
    -option   => [where, DBname, DBclass, default_value]

If Perl/Tk can't find a ConfigSpecs entry for an option, the default where action is used (described later).

You can use the second flavor of ConfigSpecs to make aliases for options. Perl/Tk automatically aliases -bg and -fg for -background and -foreground, respectively.

The third form is the most common. DBname and DBclass are the name and class of the option in the X11 resource database, fully described in Chapter 16, "User Customization". If the option isn't specified when Tk::Widget::new autoconfigures the mega-widget, the option is assigned the default_value.

where specifies how Perl/Tk configures the mega-widget and/or its subwidgets. It's a scalar: either a single value from the following list or a reference to a list of the following values. All these values are strings except the last, which is a real widget reference:

The configure request is sent to all advertised subwidgets. A subwidget is advertised explicitly via an Advertise call or implicitly via a Component call.

Treats the value of the option as a standard Perl/Tk callback: a code reference or a reference to an array with a code reference and subroutine arguments. The proper way to invoke the callback is to use the Callback method, e.g., $widget->Callback(-option [=> @args]). Perl/Tk will look up the value of -option (the callback) and then call it, passing any optional arguments.

The configure request is sent to the mega-widget's immediate children.

The configure request is sent to the mega-widget's descendants (children, children of children, and so on).

Perl/Tk invokes a subroutine having the same name as the option (excluding the leading dash). The method is called for configure and cget calls. For a configure request, it's called with two arguments: the mega-widget reference and the option value. For a cget request, it's called with only the mega-widget reference, and the subroutine should return the option's value.

The option/value pair is simply stored in a hash instance variable. cget can retrieve the value at any time. See Section 14.3.9, "Mega-Widget Instance Variables" for details you really shouldn't know!

The configure request is applied only to the mega-widget (the Frame, Toplevel, or derived widget).

The configure request is applied only to the specified widget. ConfigSpecs Examples

This example defines a -validate option that expects a Perl/Tk callback as its value and supplies a default subroutine that always validates true:

    -validate => ["CALLBACK", "validate", "Validate", sub { return 1 }],

This is an example from Section 14.4.1, "Tk::Thermometer", described later in this chapter.

    -background                   =>
     [['DESCENDANTS', 'SELF'], 'background', 'Background', 'white'],
    -from                         => [$scale, qw/from From 500/],
    -highlightthickness => 
      [[@highlightthickness], qw/highlightThickness HighlightThickness 0/],
    -length                       => [$scale, qw/length Length 200/],
    -tscale                       => [qw/METHOD tscale Tscale/, $TSCALES[0]],
    -sliderlength                 => [$scale, qw/sliderLength SliderLength 10/],
    -to                           => [$scale, qw/to To 0/],
    -width                        => [$scale, qw/width Width 10/],
    'DEFAULT'                     => [$scale],

The -background option is applied to the mega-widget ($self) and all it descendants, with a default value of white. The -from option is applied to the widget, $scale with a default of 500. The -highlightthickness option is applied to a list of widgets @highlightthickness, with a default of 0. The -length option is applied to $scale with a default of 200. The -tscale option is a method (when the option is configured, Tk invokes the subroutine tscale) with a default of $TSCALE[0]. The -sliderlength, -to, and -width options all apply to $scale, with the indicated default values. All other options default to $scale.

Finally, multiple options can be configured across multiple widgets simultaneously if where is a hash reference. Suppose we have this ConfigSpecs entry:

-option => [{-optionX => $w1, -optionY => [$w2, $w3]}, DBname, ... ]


$cw->configure(-option => value);

actually does:

$w1->configure(-optionX => value);
$w2->configure(-optionY => value);
$w3->configure(-optionY => value);

14.3.8. Other Useful Methods

The following sections describe various methods that are useful when writing mega-widgets.

14.3.9. Mega-Widget Instance Variables

The mega-widget hash is Perl/Tk territory, but that hasn't stopped folks from using it as their private data structure. Typically, they just swipe a few hash keys to store their instance data, but there's always the risk of clobbering a key used by Perl/Tk. For the most part, Perl/Tk reserves keys beginning with an underscore. Unfortunately, over time, important keys not beginning with an underscore have crept into the mega-widget support code.

Now we're not supposed to peek at object internals, but for the record, these important mega-widget related keys are also reserved by Perl/Tk:





Since we're being bad, let's run this tiny program, named xray, and look inside an opaque LabOptionmenu widget. Each of the four hash keys is a reference to an anonymous hash, and xray just pretty-prints the keys and values from these hashes. Notice the tkinit convenience command that creates a MainWindow and returns its reference, which we use to create a widget of the class specified on the command line.

#!/usr/local/bin/perl -w

use Tk;

die "Usage:  xray widget" unless @ARGV >= 1;
my $class = shift;        # get class name from command line

require "Tk/$class.pm";
my $w = tkinit->$class(@ARGV)->pack;
print "X-ray data for widget $w\n";

foreach my $secret (
                    ["Advertised Subwidgets"      => 'SubWidget'],
                    ["Delegated Methods"          => 'Delegates'],
                    ["configure( ) Options"      => 'Configure'],
                    ["Configure Specifications"   => 'ConfigSpecs'],
                   ) {
    printf "\n%-11s - %s\n", $secret->[1], $secret->[0];
    foreach (keys %{$w->{$secret->[1]}}) {
        printf "%20s: %31s\n", $_, $w->{$secret->[1]}->{$_};


We run the program by typing xray LabOptionmenu -label X-ray (which effectively does $mw->LabOptionmenu(-label => 'X-ray'), and we see this output:

X-ray data for widget Tk::LabOptionmenu=HASH(0x814d394)

SubWidget   - Advertised Subwidgets
               label:       Tk::Label=HASH(0x8251070)
          optionmenu:  Tk::Optionmenu=HASH(0x828884c)

Delegates   - Delegated Methods
             DEFAULT:  Tk::Optionmenu=HASH(0x828884c)

Configure   - configure( ) Options
         -background:                         #d9d9d9
         -foreground:                           Black
              -label:                           X-ray
      -labelVariable:               SCALAR(0x814d5c4)

ConfigSpecs - Configure Specifications
         -background:                ARRAY(0x814d3b4)
                 -bg:                     -background
                 -fg:                     -foreground
         -foreground:                ARRAY(0x814d420)
              -label:                ARRAY(0x82863b8)
        -labelAnchor:                ARRAY(0x81e0320)
    -labelBackground:                ARRAY(0x82a5158)
        -labelBitmap:                ARRAY(0x82a51dc)
   -labelBorderwidth:                ARRAY(0x82a5f34)
        -labelCursor:                ARRAY(0x82a5fb8)
          -labelFont:                ARRAY(0x82a603c)
    -labelForeground:                ARRAY(0x82a60c0)
        -labelHeight:                ARRAY(0x82a6144)
-labelHighlightbackground:           ARRAY(0x82a61c8)
-labelHighlightcolor:                ARRAY(0x82a624c)
-labelHighlightthickness:            ARRAY(0x82a6c04)
         -labelImage:                ARRAY(0x82a6c88)
       -labelJustify:                ARRAY(0x82a6d0c)
          -labelPack:                ARRAY(0x8286304)
          -labelPadx:                ARRAY(0x82a6d90)
          -labelPady:                ARRAY(0x82a6e14)
        -labelRelief:                ARRAY(0x82a6e98)
     -labelTakefocus:                ARRAY(0x82a6f1c)
          -labelText:                ARRAY(0x82a6fa0)
  -labelTextvariable:                ARRAY(0x82a7cd0)
     -labelUnderline:                ARRAY(0x82a7d54)
      -labelVariable:                ARRAY(0x8286340)
         -labelWidth:                ARRAY(0x82a7dd8)
    -labelWraplength:                ARRAY(0x82a7e5c)
             DEFAULT:                ARRAY(0x814cd3c)

The first thing to note is that the SubWidget key points to a hash of advertised widgets, with their names as keys and widget references as values. The Delegates key references a hash of Delegates options, and there we see our DEFAULT entry, the Optionmenu subwidget. Perl/Tk uses the anonymous hash referenced by Configure to store all PASSIVE option values and as instance variables for other options; notice -label and its value from the command line. Finally, the ConfigSpecs key points to all the ConfigSpecs entries, all but one (DEFAULT) of which Perl/Tk supplied automatically.

Library Navigation Links

Copyright © 2002 O'Reilly & Associates. All rights reserved.