| RTapo.com | Site Last updated 12/30/2011 |
| Home > Tk::Tree Example |
my $jobs = {
project_1 => {
job_1 => {
'perl_source_1.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_2.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_3.pl' => {
size => '2,00',
type => 'Both',
date => '03/09/05',
time => '10:03 AM',
history => []}
},
job_2 => {
'perl_source_4.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['12:19 PM', '03/09/05', '12:29 PM', '03/14/06']}
'perl_source_5.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_6.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_7.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['01:15 PM', '06/29/06', '01:15 PM', '06/30/06']}
'perl_source_8.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_9.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_10.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
}
},
project_2 => {
job_1 => {
'perl_source_11.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['01:15 PM', '01/13/06', '01:15 PM', '01/14/06']}
'perl_source_12.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_13.pl' => {
size => '2,00',
type => 'Both',
date => '03/09/05',
time => '10:03 AM',
history => []}
},
job_2 => {
'perl_source_14.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['01:15 PM', '01/12/06', '01:15 PM', '01/07/06']}
'perl_source_15.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_16.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_17.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['6:19 PM', '01/13/06', '6:19 PM', '03/13/06']}
'perl_source_18.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_19.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_20.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
}
},
project_3 => {
job_1 => {
'perl_source_21.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['6:19 PM', '03/05/05', '6:19 PM', '01/05/05']}
'perl_source_22.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_23.pl' => {
size => '2,00',
type => 'Both',
date => '03/09/05',
time => '10:03 AM',
history => []}
},
job_2 => {
'perl_source_24.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_25.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_26.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_27.pl' => {
size => '14,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['10:19 AM', '01/05/05', '10:19 AM', '02/05/05']}
'perl_source_28.pl' => {
size => '5,00',
type => 'Backup',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_29.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
'perl_source_30.pl' => {
size => '2,00',
type => 'Format',
date => '03/09/05',
time => '10:03 AM',
history => ['11:15 PM', '03/05/05', '12:04 PM', '04/06/06']}
}
}
};
tk_tree_ex_1.pl parses the keys in the $jobs data hash, and builds a tree of top level project nodes. Under each project, child nodes representing a job can be expanded or contracted. When a job name is selected, the name of each file associated with that job is listed, along with it's attributes, as a row in a tabular display widget. Fig. 1 shows the program's interface.
Given a mainwindow $mw, packed with a frame called $workareaFrame, Code Listing 2 creates an instance of Tk::Tree as a scrolled widget.
$jobstree = $workareaFrame->Scrolled( 'Tree', -background => 'white', -selectmode => 'extended', -selectbackground => 'LightGoldenrodYellow', -selectforeground => 'RoyalBlue3', -highlightthickness => 0, -font => 'verdana 8', -relief => 'flat', -scrollbars => 'osoe', -borderwidth => 0, -browsecmd => \&showjob_files )->pack(-side => 'left', -fill => 'both', -expand => 1, -anchor => 'w');
Code Listing 3 configures some Tk::Tree options.
$jobstree->configure( -separator => '/', -drawbranch => 'true', -indicator => 'true', -selectborderwidth => '0', -selectmode => 'extended', -highlightcolor => 'red' ); $jobstree->focus();
The Standard, and Widget-Specific Options described by the document linked to in Ref. 2, represent only the tip of the iceberg for features with Tk::Tree. Every Tk::Tree object inherits the methods and options of it's Super-Class, Tk::HList. Along with Tk::HList, come the methods and options of Tk::DItem, Tk::Derived, and the Tk::Widget classes. Table 1 has a list of links to documentation, that is most useful while designing, and building Tk::Tree based applications.
|
Tk::Tree
Tk::HList
Tk::Derived
|
Tk::DItem
Tk::Widget
|
After creation, and configuration, the Tk::Tree instance, $jobstree, is ready to initialize. Initialization of a Tk::Tree widget is generically, a two step process. The first step is to parse a datasource, and build a hierarchically ordered path list.
my @job_list;
for my $p (sort keys %{$jobs}) {
push(@job_list, "$p");
my @listofjobs = sort keys %{$jobs->{$p}};
for my $j (@listofjobs) {
push(@job_list, "$p/$j");
}
}
The ordered path list can represent any hierarchical data, like a relational table, an xml document, or a directory tree, for example. The code in Listing 4 simply iterates over the keys in the multi-level hash $jobs, and creates a path list in @job_list that looks like this:
['project_1', 'project_1/job_1', 'project_1/job_2', 'project_2', 'project_2/job_1', 'project_2/job_2', 'project_3', 'project_3/job_1', 'project_3/job_2']
When making a path list, ensure that the delimiter separating the path nodes, matches the one specified by the Tk::Tree widget's -seperator option. The -seperator option default is a dot, '.', or period. Also, be certain that the list is ordered in such a way. that no child node in the list precedes it's parent node. For example, the list structure below is not a valid list to initialize a Tk::Tree instance with, because the list element 'project_2/job_1' is not preceded by an element for it's parent, 'project_2'.
['project_1', 'project_1/job_1', 'project_1/job_2', 'project_2/job_1', 'project_2/job_2', 'project_3', 'project_3/job_1', 'project_3/job_2']
The second generic step to initializing a Tk::Tree widget is, loop over the ordered path list, and make tree nodes.
my $col = 0;
foreach $node (@job_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node);
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text');
}
$jobstree->autosetmode();
Fig. 2 shows what the tree looks like after the code in Listing 5 is executed. There are three method calls made on $jobstree in Listing 5. Two of the calls are made inside the foreach loop, and one call is made outside the loop. The two calls made inside the loop, $jobstree->add and $jobstree->itemCreate, create, a list entry, and a display item respectively, for each path element in @job_list. A list entry is a path to an element in the tree structure, which is a hierarchical list (HList). A display item is visual information associated with a particular list entry. The list entry, and it's associated display item implement what is conceptually a tree 'node' for each path in @job_list.
The third method call, $jobstree->autosetmode, is made once. It parses the tree, and sets the mode of each list entry in the tree. The mode is a set of actions to be performed (like mode expansion, or contraction) when the indicator of a list entry is single clicked. The indicator is an automatically provided image (a '+' or '-' symbol by default) in the display item that visually represents the current mode for the entry it is next to. The mode of an entry can be one of three values: 'open' '+', 'close' '-', or 'none' ''.
Beside the autosetmode method, there are additional methods, and several options for those methods, that affect the behavior and appearance of a tree. Some of them will be discussed next. But first, a quick re-iteration on the add, and the itemCreate methods.
$jobstree->add($node);
From Code Listing 5, the add method call creates a new list entry for the path in, "$node". Any parent entry names in the path must already exist when the add method call is made.
$jobstree->itemCreate( $node, $col, -text => $node_name, -itemtype => 'text');
The itemCreate method call associates a new display item with the list entry specified by the path in $node. A display item is always associated with a list entry, and does not exist by itself.
A display item is composed of two elements:
Of these two elements, the indicator image is automatically provided by the display item and need not be specified. The item to be displayed, however, must be defined, and configured, by the programer. The item to be displayed can be one of three possible types:
The type of item to be displayed is specified with the -itemtype option.
-itemtype => 'text'
The other itemCreate arguments that configure the display item, beside the -itemtype argument pair, must be consistent with the value of -itemtype. Table 2, below, describes what arguments itemCreate will expect for each type of display item.
| -itemtype value | itemCreate expected arguments |
| -itemtype => 'text' | -text => string where string is a quoted string or a scalar variable containing a string value |
| -itemtype => 'imagetext' | -text => string -image => $image_reference where $image_reference contains a reference to an image created by one of the Tk::Bitmap, Tk::Image, or TK::Photo modules |
| -itemtype => 'window' | -window => $widget_reference where $widget_reference contains a reference to a Tk::Widget object |
In Code Listing 5, -itemtype has a value of 'text', so, -text => $node_name is a valid option/value pair for the itemCreate method. The indicator, and the string in $node_name, define the display item, that will appear in the column designated by $col.
Display Item's can be created by other methods beside the itemCreate method. Confusion can arise regarding when (or weather) to use itemCreate. It should be used when there is an entry needing multiple display items, in multiple columns, or when creating a display item in any column other than the zeroth column. The Tk::HList author(s) have this display item advice in the BUGS section of their documentation.
"...Whenever multiple columns exist, the programmer should use ONLY the item method to create and configure the display items in each column; the add, addchild, entryCget and entryConfigure should be used ONLY to create and configure entries."
The list entry, and the display item can be created with the add method. The add method accepts all configuration options for a display item that itemCreate does except for the column number argument after the entryPath. The column will be zero for any display items made with the add method.
Ref. 7itemCreate, add, addchild, entryCget, entryConfigure
Code Listing 6 does the same thing that the code in Listing 5 does, which is, initialize $jobstree tree, only it does so without calling itemCreate.
foreach $node (@dir_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node, -text, $node_name, -itemtype, 'text');
}
$jobstree->autosetmode();
$jobstree->autosetmode();
The last statement in Code Listing 5, and Listing 6, is a call to autosetmode. This method passes over every entry in the tree, and makes a setmode call on each entry, configuring it to one of three mode states: 'open', 'close', or 'none'. Below are the three criteria that guide the mode setting behavior of autosetmode.
In Fig. 3, after initializing $jobstree, then calling $jobstree->autosetmode(); each of the top level entries, in the tree, have a mode value 'close'. Their children are visible, and each of the child entries has a mode of 'none'.
Fig. 4 shows the tree's appearance after an identical initialization, only with no call to autosetmode().
After initializing the tree with the code in Listing 7, each of the entries have a mode value 'none', which is the default mode value for a list entry.
my $col = 0;
foreach $node (@job_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node);
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text');
}
# $jobstree->autosetmode();
To initialize the example tree to the same mode state shown in Fig. 3, without calling autosetmode, the right setmode call must be made on each list entry.
my $col = 0;
foreach $node (@job_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node);
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text');
($node_name eq $node) ?
$jobstree->setmode($node, 'close') :
$jobstree->setmode($node, 'none');
}
# $jobstree->autosetmode();
The tree in Fig. 5 is identical to the tree in Fig. 3, which was initialized with a call to autosetmode. That's because the code in Listing 8 does explicitly, what autosetmode does automatically. It makes the correct setmode call on each tree entry.
Code Listings 9, and 10, demonstrate two ways to initialize a Tk::Tree instance, so that all top level entry's have a mode of 'open'.
Listing 9From tk_tree_ex_1_nodes_closed_setmode.pl
my $col = 0;
foreach $node (@job_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node);
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text');
unless ($node_name eq $node) {
$jobstree->setmode($node, 'none');
$jobstree->hide('entry', $node);
} else {
$jobstree->setmode($node, 'open');
}
}
# $jobstree->autosetmode();
my $col = 0;
foreach $node (@job_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node);
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text');
}
$jobstree->autosetmode();
foreach ($jobstree->info('children', '')) {
$jobstree->close($_);
}
Fig. 6 shows the tree's appearance after the code in either Listing 9, or Listing 10, is executed. All top level entries are mode 'open', and each child entry is hidden. Code Listing 9 accomplishes this by iterating through the path list, creating a list entry for each path, and explicitly calling setmode to configure the appropriate mode for each entry. If the entry is not a top level entry, the hide method is also called on it, to render it not visible. Code Listing 10's approach is to first, create the entire tree, and call autosetmode to configure the mode of each entry, then get a list of all the top level entries, through an info method call, and use each top level entryPath, as the path argument in a close command.
$jobstree->hide('entry', $node);
The hide method, and it's antagonist, the show method, both do to list entries what their names suggest. A call to the hide method makes the entry at the specified path not visible, while a call to the show method makes the entry at the specified path visible. Both methods expect as first argument, an option specifying what part of an entry to hide. As of Tk::HList version 4.014, the only supported option is 'entry'. The second argument expected is the path to the targeted entry.
foreach ($jobstree->info('children', '')) { $jobstree->close($_); }
The info method provides a Tk::Tree instance with the ability to be introspective. The info method argument list should be in this format: $jobstree->info('option', 'entry/path'), an option followed by an entryPath. The return value of the info method varies, depending on option. Table 3 is a list of options supported by info, and a description of it's return value, when called with that option.
| option | return type description |
| anchor | entryPath |
| children | list of the entryPaths |
| data | scalar, string of data |
| dragsite | entryPath |
| dropsite | entryPath |
| exists | boolean |
| hidden | boolean |
| next | entryPath |
| parent | name of the parent of the list entry identified by the entryPath argument |
| prev | entryPath |
| selection | list of entryPaths |
The option 'children' will return a list of entryPaths to the children of the entry described by the path argument. If the path argument is blank, for example: $jobstree->info('children', '') a list of top level entries will be returned.
A user click on an entry indicator triggers an open or close event depending on the mode of the list entry. The actions performed in response to open or close events are the same actions performed by open, or close method calls on a list entry.
The open method will open the entry, specified by the entryPath argument $_, if it's mode is 'open'. The default open behavior of a Tk::Tree entry with mode 'open' is this:
The close method will close the entry, specified by the entryPath argument $_, if its mode is 'close'. The default close behavior of a Tk::Tree entry with mode 'close' is this:
The default open and close behavior of a Tk::Tree widget can be overridden by configuring the -opencmd, and/or -closecmd options with callback routines that implement custom open or close behavior. For example, Listing 11, from the example application, assigns two subroutines to handle the open and close events, overriding the default routines built into Tk::Tree.
$jobstree->configure( -closecmd => \&close_silhouette, -opencmd => \&open_silhouette );
Fig. 8 shows the tree's appearance with the custom open and close event handlers configured. The first top level entry, 'project1' has a mode of 'close'. The other two top level entries, 'project2' and 'project3', each have a mode of 'open'. When a top level entry has a mode of 'open', the job entries are hidden, and a single child entry is shown, indicating the total number of files in all the jobs for that entry. When a top level entry has a mode of 'close', job entries are shown, and the file count entry is hidden. Code Listing 12 has the two subroutines that implement this custom open and close behavior.
sub open_silhouette {
foreach ($jobstree->info(children, $_[0])) {
($jobstree->info(hidden, $_)) ?
$jobstree->show('entry', $_) :
$jobstree->hide('entry', $_);
}
}
sub close_silhouette {
my $found_hidden_node = 0;
# get the children for the node being closed
my @children = $jobstree->info(children, $_[0]);
#
# for each child node under a project,
# hide it if it is visible,
# show it if it is hidden
#
foreach (@children) {
unless ($jobstree->info(hidden, $_)) {
$jobstree->hide('entry', $_);
} else {
$found_hidden_node = 1;
$jobstree->show(
'entry', $_
);
}
}
#
# if $found_hidden_node == 1, the file count node
# was found and successfully shown so return.
#
return if $found_hidden_node;
#
# if $found_hidden_node == 0, the file count node
# has not been created yet so create it and show it
#
my $fcount = 0;
foreach (@children) {
my @bucket = split(/\//, $_);
$fcount += keys %{$jobs->{$bucket[0]}->{$bucket[1]}};
}
$jobstree->add("$_[0]/file_count");
$jobstree->itemCreate(
"$_[0]/file_count", 0,
-text => "$_[0] File Count \= $fcount",
-itemtype => 'text');
$jobstree->setmode("$_[0]/file_count", 'none');
}
The tree examples in this tutorial, have all, so far, had list entries with display items of type 'text'. The 'widget', and 'imagetext' display items, will be covered next.
The 'imagetext' display item consists of an image, and a string of text. The -image, and -text options need to be specified when the display item is created. The value for the -image option should be a reference to an image created by one of the Tk::Bitmap, Tk::Image, or TK::Photo modules. The value for the -text option should be a quoted, or scalar string. The -itemtype => 'imagetext' argument pair is also required, unless the Tk::Tree widget object's -itemtype is 'imagetext'. Listing 13 is example code that made the tree in Fig. 8. Fig. 8 is from the previous 'custom close' example, tk_tree_ex_2.pl, modified, to make the file count entry have an 'imagetext' display item. The '#' (pound sign) is the image, positioned to the left of the text, the default position of an image in 'imagetext' display items.
my $filect = $workareaFrame->Photo(-file => '/demo_gifs/file_ct_13.gif'); . . . $jobstree->add("$_[0]/file_count", -state => 'disabled'); $jobstree->itemCreate( "$_[0]/file_count", 0, -text => "$_[0] File Count \= $fcount", -image => $filect, -itemtype => 'imagetext'); $jobstree->setmode("$_[0]/file_count", 'none');
Fig. 9 shows a second 'imagetext' example. It uses the image in the display item to further signify entry selection. Selected entries have an open folder image, while non-selected entries have a closed folder. In the example programs used in this tutorial, when a list entry is selected, the subroutine, &show_jobfiles is executed. The purpose of &show_jobfiles is to identify which entries are currently selected, and display their associated file data in the tabular display widget. &show_jobfiles is also a good place to set the selected display item's folder image. Code Listing 14 has sample code that implements open folder for selected entries, and closed folder for non-selected entries, at the beginning of &show_jobfiles.
my $folderclose = $workareaFrame->Photo( -file => '/demo_gifs/folderclose.gif' ); my $folderopen = $workareaFrame->Photo( -file => '/demo_gifs/folderopen.gif' ); . . . sub showjob_files { # stuff goes here . . . my @paths = $jobstree->info('selection'); my $selected_hash; $selected_hash->{$_}++ for(@paths); foreach my $topentry($jobstree->info('children')) { $selected_hash->{$topentry} ? $jobstree->itemConfigure($topentry,0,-image, $folderopen) : $jobstree->itemConfigure($topentry,0,-image, $folderclose); foreach my $childentry($jobstree->info('children',$topentry)) { $selected_hash->{$childentry} ? $jobstree->itemConfigure($childentry,0,-image, $folderopen) : $jobstree->itemConfigure($childentry,0,-image, $folderclose); } } # more stuff goes here . . . return 1; }
A 'window' display item contains a single Tk::Widget instance. See Fig. 10, which shows a tree with list entries that each have a Tk::Checkbutton display item. To configure a list entry for a 'window' display item, first, make a Tk::Widget instance and get a reference to it.
my $ref = $jobstree->Checkbutton();Next, make a call to any method that can create display items. In the argument list, include the -window option, or it's alias, -widget; with the Tk::Widget reference as it's value.
-window => $ref - or - -widget => $ref
Include the -itemtype => 'window' arguments, if the Tk::Tree widget's -itemtype is not 'window'.
Ref. 13window, -window, -widget
Fig. 11 illustrates that when a 'window' display item is clicked, an event registers with that widget, but nothing happens to the list entry. Fig. 12 shows that when the list entry is clicked, a selection event registers with the tree widget, but nothing happens to the display item widget. The list entry, and the widget in the display item, are separate objects with their own bindings, so it is up to the programer, to synchronize the state of the 'window' display item, and the list entry when events happen in either direction.
A good first step is to decide why a widget is being used as the display item, and what tree behavior will the widget affect. In the case of the tk_tree_ex_1_widget.pl example, a Checkbutton display item on each list entry is useful because, it provides a responsive way to invoke, and signify, entry selection. This suggests making the Checkbutton's check and un-check events do the same thing that the list entry's select and de-select events do. When a Checkbutton is checked or un-checked, the list entry must programatically be selected or de-selected. Here is a description of the desired behavior, in response to Checkbutton events:
The behavior described above can be implemented using the Checkbutton widget's -command option callback. Code Listing 14 is an initialization of a Tk::Tree widget with list entries that have a Checkbutton widget for the display item.
my @dir_list;
for my $p (sort keys %{$jobs}) {
push(@dir_list, "$p");
my @listofjobs = sort keys %{$jobs->{$p}};
for my $j (@listofjobs) {
push(@dir_list, "$p/$j");
}
}
my $ck_bt = {};
foreach my $node (@dir_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$ck_bt->{$node}->{checked} = 0;
my $ref = $jobstree->Checkbutton(
-background => 'white',
-activebackground => 'LightGoldenrodYellow',
-highlightbackground => 'LightGoldenrodYellow',
-activeforeground => 'RoyalBlue3',
-text => "$node_name",
-variable => \$ck_bt->{$node}->{checked},
-command => [\&map_check_to_select, $node]);
$ck_bt->{$node}->{reference} = $ref;
$jobstree->add($node, -window, $ref);
}
$jobstree->autosetmode();
Code Listing 14 shows that each list entry has a unique instance of Tk::Checkbutton as it's display item. Each Checkbutton's -command option assigns &map_check_to_select as the callback, with the list entryPath as it's only argument. Listing 15 is the implementation for &map_check_to_select, which echo's Checkbutton events to any affected list entries in tk_tree_ex_1_widget.pl.
sub map_check_to_select {
if (my $parent = $jobstree->info('parent', $_[0])) {
# $_[0] is a child node
unless ($ck_bt->{$_[0]}->{checked}) {
# if the child is not checked, the parent should not be checked, or selected
$jobstree->selectionClear($parent);
$jobstree->selectionClear($_[0]);
$ck_bt->{$parent}->{checked} = 0;
$ck_bt->{$parent}->{reference}->configure(-background => 'white');
foreach ($jobstree->info('children', $parent)) {
# check each sibling, if any are checked, grey the parent node background
# it is grey because we know at least one sibling, ($_[0]), is not checked
# set checked siblings background to color of the list item selection
if ($ck_bt->{$_}->{checked}) {
$ck_bt->{$parent}->{reference}->configure(
-background => 'grey86'
);
$ck_bt->{$_}->{reference}->configure(
-background => 'LightGoldenrodYellow');
} else {
$ck_bt->{$_}->{reference}->configure(
-background => 'white'
);
}
}
} else {
# if the child is checked, initialize the parent and the current
# node $_[0] to checked and selected
$jobstree->selectionSet($parent);
$jobstree->selectionSet($_[0]);
$ck_bt->{$parent}->{checked} = 1;
$ck_bt->{$parent}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
foreach ($jobstree->info('children', $parent)) {
# iterate all siblings and determine if all are checked/selected or no
# and configure accordingly
unless ($ck_bt->{$_}->{checked}) {
$ck_bt->{$parent}->{reference}->configure(
-background => 'grey86'
);
$jobstree->selectionClear($parent);
$ck_bt->{$parent}->{checked} = 0;
$ck_bt->{$_}->{reference}->configure(
-background => 'white'
);
} else {
$ck_bt->{$_}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
}
}
}
} else {
# $_[0] is a top level node
unless ($ck_bt->{$_[0]}->{checked}) {
# if top level node is not checked, de-select it
# and un-check and de-selected all child nodes
$ck_bt->{$_[0]}->{reference}->configure(-background => 'white');
$jobstree->selectionClear($_[0]);
foreach ($jobstree->info('children', $_[0])) {
$ck_bt->{$_}->{checked} = 0;
$jobstree->selectionClear($_);
$ck_bt->{$_}->{reference}->configure(-background => 'white');
}
} else {
# if top level node is checked, select it
# and check and selected all child nodes
$ck_bt->{$_[0]}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
$jobstree->selectionSet($_[0]);
foreach ($jobstree->info('children', $_[0])) {
$ck_bt->{$_}->{checked} = 1;
$jobstree->selectionSet($_);
$ck_bt->{$_}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
}
}
}
&showjob_files; # get the data and display it
}
When a list entry is selected or de-selected, the Checkbutton must programatically be checked or un-checked. Here is a description of the desired behavior, in response to list entry events:
The behaviors listed above can be implemented using the Tk::Tree widget's -browsecmd callback &show_jobfiles, which is called each time a list entry is selected. It was used earlier to swap the folder images in the -imagetext display items example. Code Listing 17 demonstrates how &show_jobfiles can be used in this example to propagate list entry selection events to any other affected list entries, and their Tk::Widget display items.
sub showjob_files {
# stuff goes here
.
.
.
# (caller(1))[4] == 0 - showjob_files called from callback bound to HList
# (caller(1))[4] == 1 - showjob_files called by &main::map_check_to_select
&map_select_to_check($_[0]) unless (caller(1))[4];
# more stuff goes here
.
.
.
return 1;
}
Code Listing 18 is the implementation for &map_select_to_check.
sub map_select_to_check {
#print qq^map_select_to_check\n^;
my $path = shift;
$ck_bt->{$path}->{checked} = 1;
$ck_bt->{$path}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
if (my $parent = $jobstree->info('parent', $path)) {
# is child
# set parent node to not selected, un-checked, highlighted grey
$jobstree->selectionClear($parent);
$ck_bt->{$parent}->{checked} = 0;
$ck_bt->{$parent}->{reference}->configure(-background => 'grey86');
# if anything is checked, top level stays grey
foreach my $q1 ($jobstree->info('children', $parent)) {
return if (($q1 ne $path) && (!($ck_bt->{$q1}->{checked})));
}
# all children are selected,
# set parent node to selected, checked, highlighted yellow
$jobstree->selectionSet($parent);
$ck_bt->{$parent}->{checked} = 1;
$ck_bt->{$parent}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
} else {
# is parent
# make node selected and yellow highlight
$ck_bt->{$path}->{checked} = 1;
$ck_bt->{$path}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
foreach my $q1 ($jobstree->info('children', $path)) {
$jobstree->selectionSet($q1);
$ck_bt->{$q1}->{checked} = 1;
$ck_bt->{$q1}->{reference}->configure(
-background => 'LightGoldenrodYellow'
);
}
}
# iterate whole tree anything checked is marked selected
foreach my $q ($jobstree->info('children')) {
$jobstree->selectionSet($q) if ($ck_bt->{$q}->{checked});
foreach my $q1 ($jobstree->info('children', $q)) {
$jobstree->selectionSet($q1) if ($ck_bt->{$q1}->{checked});
}
}
}
The default plus, and minus sign, entry indicators, that come with Tk::Tree, can be changed by rewriting the private method, &_indicator_image. The first step, is to create the new indicator images using one of the Tk::Bitmap Tk::Image or TK::Photo modules, as shown in Listing 19.
my $folderclose = $workareaFrame->Photo( -file => '/demo_gifs/folderclose.gif' ); my $folderopen = $workareaFrame->Photo( -file => '/demo_gifs/folderopen.gif' ); my $folderclosearm = $workareaFrame->Photo( -file => '/demo_gifs/folderclosearm.gif' ); my $folderopenarm = $workareaFrame->Photo( -file => '/demo_gifs/folderopenarm.gif' );
Next, make a hash with the internal, indicator names for keys, matched to their appropriate image reference.
my $img = { minus => $folderclose, # mode close minusarm => $folderclosearm, # button pressed while mode close plus => $folderopen, # mode open plusarm => $folderopenarm # button pressed while mode open };
Finally, rewrite &_indicator_image as demonstrated, in Code Listing 21.
sub Tk::Tree::_indicator_image
{
my( $w, $ent, $image ) = @_;
my $data = $w->privateData();
if (@_ > 2)
{
if (defined $image)
{
$w->indicatorCreate( $ent, -itemtype => 'image' )
unless $w->indicatorExists($ent);
$data->{$ent} = $image;
$w->indicatorConfigure( $ent, -image => $img->{$image} );
}
else
{
$w->indicatorDelete( $ent ) if $w->indicatorExists( $ent );
delete $data->{$ent};
}
}
return $data->{$ent};
}
In the new &_indicator_image, the call to indicatorConfigure has a different argument list. It changed from this...
$w->indicatorConfigure( $ent, -image => $w->Getimage( $image ) );
to this...
$w->indicatorConfigure( $ent, -image => $img->{$image} );
everything else is unchanged. The &_indicator_image method now finds it's images in the $img hash. Fig. 14 shows the trees appearance..
Click on a list entry's indicator image, and an 'open', or 'close' event occurs, depending on mode. A click on the list entry itself, registers a browse event. Browse events are bound to nothing, by default. When the Tk::Tree option -browsecmd is configured with a subroutine reference, then that subroutine is executed on browse events, with the clicked list entry path as it's only argument.
In tk_tree_ex_1.pl, -browsecmd is assigned the callback &showjob_files:
-browsecmd => \&showjob_files
Fig. 15 shows the tk_tree_ex_1.pl program interface with two selected list entries. When a list entry is selected, &showjob_files collects the file names under all selected entries, and displays the name of each file, along with it's attributes, in a Tk::MListbox widget. Code Listing 22 is the implementation for &showjob_files.
sub showjob_files {
$jobfiles->delete(0, 'end');
my @paths = $jobstree->info('selection');
my @bucket;
my $seen = {};
while (my $q = shift(@paths)) {
my ($project_name, $job_name) = split(/\//, $q);
next if ($seen->{$project_name} && $job_name);
$seen->{$project_name}++ unless ($job_name);
my @jobnames;
($job_name) ?
push(@jobnames,$job_name) :
{@jobnames = keys %{$jobs->{$project_name}}};
foreach $job_name (@jobnames) {
my $obj = $jobs->{$project_name}->{$job_name};
foreach my $file_name (keys %{$obj}) {
push(@bucket,[
"$file_name",
"$job_name",
"$project_name",
"$obj->{$file_name}->{type}",
"$obj->{$file_name}->{size}",
"$obj->{$file_name}->{date}",
"$obj->{$file_name}->{time}"
])
}
}
}
foreach my $q(sort {$a->[0] cmp $b->[0]} @bucket) {
my $row = [];
for my $l(0..6) {push(@{$row},"$q->[$l]")}
$jobfiles->insert('end', $row);
}
return 1;
}
The Tk::Tree add method has a -data option that can associate a string with a list entry, when the entry is created. The string can later, be retrieved from the entry, by calling the info method, with the option 'data', and an entryPath, as arguments.
The &showjob_files implementation in tk_tree_ex_1.pl, retrieves file name and attribute data for display, by iterating over selected entryPaths, splitting them, and using the node names as keys to the $jobs data hash. The implementation for &showjob_files can be modified to iterate over selected entries, and retrieve the file name, and attribute data directly from data islands, that were created during initialization, for each job level entry, using the 'data' option.
First, the Tk::Tree initialization will have to be changed. File data for each job will need to be retrieved and ordered into delimited records, then concatenated into a single string, which will then be stored with each job entry, as it is added to the tree. Code Listing 23 shows, for reference, the current initialization code. Code Listing 24 shows the new initialization code that pre-stages the file data with each job level list entry.
my $col = 0;
foreach $node (@dir_list) {
$node_name = (split('/', $node))[-1];
$node_name = $node if ($node_name eq '');
$jobstree->add($node);
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text',);
}
$jobstree->autosetmode();
my $col = 0;
foreach $node (@dir_list) {
$node_name = (split('/', $node))[-1];
if ($node_name eq '') {
$node_name = $node;
$jobstree->add($node);
} else {
my $string = &make_file_data($node);
$jobstree->add($node, -data => $string);
}
$jobstree->itemCreate(
$node, $col,
-text => $node_name,
-itemtype => 'text'
);
}
$jobstree->autosetmode();
The statement $jobstree->add($node, -data => $string) is used when the entry is a job entry. All of the file data under a job is delimited and concatenated in $string. Code Listing 25 shows method &make_file_data, a utility method, that bundles the file data and returns it to $string. Code Listing 26 is the code for the new &showjob_files implementation. In Listing 26, the statement
$jobstree->info('data',$_)
is the data retrieval statement. It retrieves the string that was stored with the entryPath specified by $_, during initialization, in Code Listing 26.
sub make_file_data {
my $path = shift;
my ($proj,$job) = split(/\//,$path);
my $obj = $jobs->{$proj}->{$job};
my @file_names = keys %{$obj};
my @bucket;
while (my $file = shift @file_names) {
push(@bucket,"$file\|" .
"$job\|" .
"$proj\|" .
"$obj->{$file}->{type}\|" .
"$obj->{$file}->{size}\|" .
"$obj->{$file}->{date}\|" .
"$obj->{$file}->{time}\|" .
"$obj->{$file}->{history}")
}
return join('~!~',@bucket);
}
sub showjob_files {
$jobfiles->delete(0, 'end');
my @paths = $jobstree->info('selection');
my @bucket;
while (my $q = shift(@paths)) {
unless ($jobstree->info('parent',$q)) {
foreach ($jobstree->info('children', $q)) {
push(@bucket,split(/\~\!\~/,$jobstree->info('data',$_)));
}
} else {
push(@bucket,split(/\~\!\~/,$jobstree->info('data',$q)));
}
}
for (0..$#bucket) {
my $row = [];
@{$row} = split(/\|/,shift(@bucket));
push(@bucket,$row);
}
foreach my $q (sort {$a->[0] cmp $b->[0]} @bucket) {
my $row = [];
for my $l (0 .. 6) {push(@{$row}, "$q->[$l]")}
$jobfiles->insert('end', $row);
}
return 1;
}
To some, the Tk::Tree module has an initial learning curve that is steeper than usual. This intent behind this document is to save valuable time, for programers, by explaining, and demonstrating code that performs some basic tree operations. Frequent references are provided, so that familiarity with the content of relevant technical documents can be established. Hopefully, this tutorial can help programers quickly leverage the useful methods, and options, of Tk::Tree, Tk::HList, and Tk::DItem. Many thanks to the authors of those classes.
(MD5: 62A9F3E1B4D497B6F2BF0D98B4E33D3E tree_examples.zip)
| RTapo.com | Site Last updated 12/30/2011 |