Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re: Tk::Notebook and scope

by blssu (Pilgrim)
on Sep 23, 2003 at 15:18 UTC ( #293525=note: print w/replies, xml ) Need Help??


in reply to Tk::Notebook and scope

graff has the right idea. I've attached some tested code that puts a pretty face on it. There's probably more than you need in the code, but hopefully it's worth reading.

First of all, you need to stop thinking in terms of the variables that you store your Tk widgets in. Tk doesn't know or care you have a variable named $mnuTerms. What Tk cares about is the widget name -- the 'Name' attribute you pass in when creating a widget. If you don't provide a name, then Tk will generate a name. Widgets always have names even if the name is something like 'button37'.

It's useful to think of Tk as a little widget database. Names are the keys used to fetch widgets.

The Notebook add method is a little different. The first argument is the name of the page you are adding. Notebook hides the details, but a page is really just a Frame and the name of the page is just the frame's 'Name'.

Examples:

my $label = $frame->Label('Name' => 'title', -text => 'Tk Names Tutorial'); my $dialog = $top->DialogBox(-title => 'Generated Names', -buttons => [ 'OK' ]); my $page = $notebook->add('Bill', -label => 'Billing');

Using the attached direct_descendant method, you can fetch those widgets like this:

my $title = $frame->direct_descendant('title'); my $button = $dialog->direct_descendant('bottom.button'); my $bill = $notebook->direct_descendant('Bill');

You may need to fetch a widget with a distinctive name, but you don't know which frame it's in. The more general descendant method allows wildcards to skip over any number of frames. This is slower than direct_descendant, but it's generally fast enough if the search is started close to the widget you want to find.

my $title = $top->descendant('*title'); my $mnuTerms = $notebook->descendant('*Bill*terms');

But what if you don't know the widget name? This often happens because Tk doesn't force you to give widgets names. Use list_descendant_names while debugging to print out the names of all children. Use full_name to print out the complete path to a single widget.

print join("\n", $notebook->list_descendant_names()), "\n"; print $mnuTerms->full_name(), "\n";

You must give descriptive names to widgets that will be fetched later. If you don't, any changes to the order of widget creation will cause Tk to assign different names and that's a maintenance disaster waiting to happen.

Hope that helped. I find this database style of Tk programming eliminates most global variables. Add in a few judicious closures for callbacks and you've got a really clean and modular application.

# Save this code to a file called MyTkUtils.pm. # Then from your main script, add "use MyTkUtils". package Tk::Widget; use strict; sub full_name { my($w) = @_; my @name = ( ); while (ref $w) { unshift @name, $w->name; $w = $w->parent; } join('.', @name); } sub direct_descendant { my ($w, $path) = @_; return unless ($w && defined $path); my @path = split(/[,.]/, $path); my @children = $w->children; if (@path) { while (@children) { my $child = pop @children; if ($child->name eq $path[0]) { shift @path; return $child if (!@path); $w = $child; @children = $w->children; } } } } sub _r_list_descendant_names { my ($w, $w_name, $separator, $descendants) = @_; foreach my $child ($w->children) { my $child_name = $w_name . $separator . $child->name; push @{$descendants}, $child_name; _r_list_descendant_names($child, $child_name, $separator, $descend +ants); } } sub list_descendant_names { my ($w, $separator) = @_; $separator ||= '.'; my @descendants = ( ); foreach my $child ($w->children) { my $child_name = $child->name; push @descendants, $child_name; _r_list_descendant_names($child, $child_name, $separator, \@descen +dants); } @descendants; } sub descendant { my ($w, $path) = @_; my @names = ( ); $path =~ s|\.|,|g; if ($path =~ m|\*|) { $path =~ s|\*+|,(\\w+,)*|g; $path =~ s|-|_|g; $path =~ s|,+|,|g; $path =~ s|^,||; $path =~ s|,$||; @names = grep(/^$path$/, list_descendant_names($w, ',')); } else { $path =~ s|-|_|g; $path =~ s|,+|,|g; $path =~ s|^,||; $path =~ s|,$||; @names = ( $path ); } if (!wantarray) { return direct_descendant($w, $names[0]); } else { my @widgets = ( ); foreach (@names) { my $widget = direct_descendant($w, $_); push @widgets, $widget if (ref $widget); } return @widgets; } } sub ancestor { my ($w, $name) = @_; while (ref $w) { return $w if ($w->name eq $name); $w = $w->parent; } } 1;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://293525]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (3)
As of 2021-10-22 04:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (85 votes). Check out past polls.

    Notices?