perl/Tk and expandable widgets

[Elijah]

I have a front end gui I am working on and am trying to figure a way to create a label bar (on top of a ROText widget) that looks something like the following:

Filename           Type  Size  Speed  Location

Beneath this I will have a list of information that is being collected from a database and will be populating in it's respective place in the list, ie. the filename will appear under "Filename", the type of file will appear under "Type and so on. Now my issue is I would like to make this lable menu adjustable and have the corresponding text in the list adjust with it.

This is a common thing in gui's written in C# or C++ but I have not been able to come up with a way to mimic this in perl. If possible I would also like to be able to click each of these labels and have the list sort according to that category.

Here is what I have for code as of now:

#!/usr/bin/perl -w

use Tk;
use Tk::ROText;
use Tk::Photo;
use strict;

my ($font, $bsize, $size) = ('Garamond', '12', '10');
my ($filename, $artist);

my $window = MainWindow->new();
$window->title("viva la fileshare");
$window->minsize(900, 600);

my $menuframe   = $window->Frame()->pack(-side=>'left', -anchor=>'n', 
+-fill=>'y');
my $buttonframe = $menuframe->Frame()->pack(-side=>'top', -anchor=>'n'
+, -fill=>'none');
my $mframe      = $buttonframe->Frame()->pack(-side=>'left', -anchor=>
+'n', -fill=>'none');
my $mframe2     = $buttonframe->Frame()->pack(-side=>'left', -anchor=>
+'n', -fill=>'none');
my $menudisplay = $menuframe->Frame(-relief=>'sunken', -borderwidth=>5
+, -bg=>'#404040')->
                              pack(-pady=>5, -padx=>5, -ipady=>5, -ipa
+dx=>5, -side=>'top', -anchor=>'n', -fill=>'both', -expand=>1);

my $mainframe = $window->Scrolled("ROText", -scrollbars => 'e', -font 
+=> [$font, $size], -background => 'white')->
                         pack(-pady=>10, -padx=>10, -ipady=>10, -ipadx
+=>10, -side=>'top', -fill=>'both', -expand=>1);

my $topframe = $mainframe->Frame(-relief=>'sunken', -borderwidth=>5, -
+bg=>'#404040')->
                           pack(-side=>'top', -anchor=>'n', -fill=>'x'
+);

my $statusframe = $window->Scrolled("ROText", -scrollbars => 'e', -hei
+ght => '8', -font => [$font, $size], -background => 'white')->
                           pack(-pady=>10, -padx=>10, -ipady=>10, -ipa
+dx=>10, -side=>'top', -fill=>'x', -expand=>0);

my $controlframe  = $window->Frame(-bg=>'#404040')->
                   pack(-pady =>5, -padx =>5, -ipady =>5, -ipadx =>5, 
+-side =>'top', -anchor=>'center', -fill =>'both');
my $subCframe     = $controlframe->Frame(-bg=>'#404040')->
                   pack(-pady =>5, -padx =>5, -side =>'top', -anchor=>
+'center', -fill =>'none');

$mframe->Label(-text=>"Select Type:", -font => [$font, $bsize])->pack(
+-side=>'top', -anchor=>'w');
$mframe->Button(-text=>"Any Type", -width=>'10', -font => [$font, $bsi
+ze], -command=>sub {DisplaySearch('any type')})->
         pack(-side=>'top', -anchor=>'w', -fill=>'none');
$mframe->Button(-text=>"Images", -width=>'10', -font => [$font, $bsize
+], -command=>sub {DisplaySearch('image')})->
         pack(-side=>'top', -anchor=>'w', -fill=>'none');
$mframe->Button(-text=>"Documents", -width=>'10', -font => [$font, $bs
+ize], -command=>sub {DisplaySearch('documents')})->
         pack(-side=>'top', -anchor=>'w', -fill=>'none');

$mframe2->Label(-text=>"", -font => [$font, $bsize])->pack(-side=>'top
+', -anchor=>'w');
$mframe2->Button(-text=>"Audio", -width=>'10', -font => [$font, $bsize
+], -command=>sub {DisplaySearch('audio')})->
          pack(-side=>'top', -anchor=>'w', -fill=>'none');
$mframe2->Button(-text=>"Video", -width=>'10', -font => [$font, $bsize
+], -command=>sub {DisplaySearch('video')})->
          pack(-side=>'top', -anchor=>'w', -fill=>'none');
$mframe2->Button(-text=>"Programs", -width=>'10', -font => [$font, $bs
+ize], -command=>sub {DisplaySearch('programs')})->
          pack(-side=>'top', -anchor=>'w', -fill=>'none');

DisplaySearch('any type');

$subCframe->Button(-text=>"Kill Download", -width=>'20', -font => [$fo
+nt, $bsize], -command=>\&kill)->
               pack(-side=>'left', -anchor=>'center', -fill=>'none');
$subCframe->Button(-text=>"Find Other Sources", -width=>'20', -font =>
+ [$font, $bsize], -command=>\&sources)->
               pack(-side=>'left', -anchor=>'center', -fill=>'none');
$subCframe->Button(-text=>"Clear Inactive", -width=>'20', -font => [$f
+ont, $bsize], -command=>\&clear)->
               pack(-side=>'left', -anchor=>'center', -fill=>'none');

$topframe->Label(-text=>"File\t\t\t\t\t\t\t\t\t\t\tType\t\tSize\t\t\tS
+peed\t\t\tLocation", -font => [$font, $size], -bg=>'#404040', -fg=>'#
+FFFFFF')->
           pack(-side=>'left', -anchor=>'w', -fill=>'x');

MainLoop;

sub DisplaySearch {
   chomp(my $type = uc(shift));

   $menudisplay->destroy();
   $menudisplay = $menuframe->Frame(-relief=>'sunken', -borderwidth=>5
+, -bg=>'#404040')->
                              pack(-pady=>5, -padx=>5, -ipady=>5, -ipa
+dx=>5, -side=>'top', -anchor=>'n', -fill=>'both', -expand=>1);
   $menudisplay->Label(-text=>$type, -font => [$font, 15], -bg=>'#4040
+40', -fg=>'#FFFFFF')->pack(-side=>'top', -anchor=>'center');
   $menudisplay->Label(-text=>"Filename:", -font => [$font, $bsize], -
+bg=>'#404040', -fg=>'#FFFFFF')->pack(-side=>'top', -anchor=>'w');
   $menudisplay->Entry(-textvariable=>\$filename, -font => [$font, $bs
+ize], -bg=>'#FFFFFF', -fg=>'#404040')->pack(-side=>'top', -anchor=>'c
+enter');

   if (lc($type) eq 'audio') {
      $menudisplay->Label(-text=>"Artist:", -font => [$font, $bsize], 
+-bg=>'#404040', -fg=>'#FFFFFF')->pack(-side=>'top', -anchor=>'w');
      $menudisplay->Entry(-textvariable=>\$artist, -font => [$font, $b
+size], -bg=>'#FFFFFF', -fg=>'#404040')->pack(-side=>'top', -anchor=>'
+center');
   }

   $menudisplay->Button(-text=>"Search", -width=>'7', -font=>[$font, $
+bsize], -command=> sub {searchTest(lc($type), $filename)})->
                 pack(-pady=>5, -padx=>5, -side=>'top', -anchor=>'w');

   $menudisplay->Label(-text=>"perlSkripts.com", -width=>'17', -font =
+> [$font, 15], -bg=>'#404040', -fg=>'#FFFFFF')->
                 pack(-side=>'bottom', -anchor=>'center');
}

sub kill {

}

sub sources {

}

sub clear {

}

sub searchTest {
   my ($type, $target) = @_;

   if (defined($type) && defined($target)) {
      print "Type is: $type -- Filename is: $target\n";
   } else {
      print "Enter a search subject jackass!\n";
   }
}

As of now I simply have a Label widget inside the ROText widget displaying the label menu I am working on in a simple tabbed seperated format. This represent about the default seperation I am wanting. Is this possible?

[thundergnat]

Would you be able to use a Tk::Table instead of the Tk::ROText?. It will handle the layout issues you are looking for fairly easily, and you can attach sort bindings to the "header" cells.

The drawback is Tk::Table has poor performance if the table is large; more than 1000 or so entries.

[Courage]

tktable for Tcl/Tk http://tktable.sourceforge.net/ is optimized for good performance.

So if you'll move to Tcl::Tk then you will gain performance.

Compared to perl/Tk, Tcl::Tk is better WRT performance in many ways, see for example Comparing Tcl::Tk and perlTk WRT speed

[rcseege]

tkTable = Tk::TableMatrix in Perl/Tk. It was renamed since there was already a Tk::Table present.

TableMatrix does offer a decent boost in performance over other options in Tk. Is Tcl::Tk a bit faster? Sure, however for typical applications I would argue that the performance difference is not noticable -- at least, IMO. Most of the time, GUIs aren't really doing all that much. It's the application logic triggered by the GUI where you tend to get into trouble.

[zentara]

I would say that you are trying to use the wrong widgets to do what you want.

First, you will have problems getting the columns to line up between a label and a ROText widget. Their is no uniform connection between the 2, especially if you allow font changes

Second, sorting on a column will be tricky, but can be done. You will have to read all your ROText, split on tabs, sort, then rewrite.....all hoping that the columns will still line up with the headers.

You might be able to work out some sort of Table with TableMatrix, because it sounds like you are looking for a way for your data to display like an html table would. That is an auto-adjust of column width to the largest entry.

A variant of this question was asked a few weeks ago, about sorting lists by clicking on the headers. Sorry that I can't find the node, but had to do with MListbox leaking some memory.

Anyways, you should look at one of the listbox modules. MListbox is designed for column sorting. I recommended the HList, which is harder to use, but can be made to run without leaking memory on sorting. MListbox probably can too, but I don't have a good MListbox example handy. So here is an HList example:

Read more... (5 kB)

[Elijah]

Good suggestion but this still does not solve the issue of fixed size buttons/windows for each category. I was more interested in a way to make these fields expandable by clicking and dragging. I have read through the docs on HList and it does not seem possible to do. Am I missing something or is this just one of those things that perl is not going to be able to do?

Edited:
It seems that Tk::Columns is what I would need to accomplish this.

[zentara]

I would say you are "pushing the edge" of Tk's abilities. My first inclination would be to reconfigure the header buttons after you know how wide they should be. You could scan the column for the widest entry, then reconfigure the header button text to be padded to that width. Maybe you would have to packForget and repack too. Sounds like you need to experiment a bit. :-) You can reconfigure the headers of an HList to be different text, but like I said earlier, you will run into the problems of the -width specification being different amoung different widgets. Maybe if you confine everything to a certain font?

[rcseege]

It seems that Tk::Columns is what I would need to accomplish this.

Note that Tk::Columns, although a decent widget, suffers from the same memory leak problems as Tk::MListbox, because the problem does't truly originate from either one, but from Tk::Listbox that leaks.

Both of these widgets tend to do sorts faster than what HList will support, because implementing it in HList involves a call for every cell in the Tabular display, where both Columns and MListbox require two for each column: one to delete all entries, and the second to reinsert the sorted elements. For large numbers of rows, this difference can be significant.

Of course... that extra boost of speed is small comfort when you are blissfully sorting large amounts of data and leaking memory like crazy...

Rob

[rcseege]

I agree, Zentara with pretty much everything you said. I didn't realize, until one of your recent posts that the memory leak with Listbox didn't occur when you pass an array reference to the Listbox and manipulating its contents through that. I'm going to take a look at setting up MListbox to use that. Unfortunately, if I do, then it won't be backwards compatible, since it will rely on an API change in 804*.

It's barely worth mentioning, but your solution using HList will still leak if you end up getting smaller result sets, and you are forced to delete entries. The point is, the leak will be significantly less than if you were deleting and recreating everything each update. Reconfiguring is also more efficient for updates than deleting/recreating everything.

Rob

[hexcoder]

Thanks for the demo code!

I like to add a bugfix in the second code snippet in line 8:

my $'HList',->Scrolled(

should be

my $hl = $mw->Scrolled('HList',