Re: Auto-adjust row height to line wrap in Tk-Tablematrix

[elef]

Here's the code I came up with for auto-adjusting row height in case anyone needs it. It sets the height of each row to accommodate the tallest cell in the row, based on the width of each column and the content of each cell. Of course it's an approximation so it's occasionally off by one line. You can tune it by changing the -8 value. It's reasonably fast, it reflows 5000 rows in about 2 sec.
On another note, anyone know how I can automatically call the setheight sub when the width of a column is changed (by drag and drop)? If I could detect the change of the width I wouldn't need a separate button for this.

#!/usr/bin/perl
use strict;
use warnings;

use Tk;
use Tk::Dialog;
use Tk::TableMatrix;
use utf8;

sub setheight;


my $mw = MainWindow->new;
$mw->minsize(800, 500);        # minimum size of main window in pixels
+    

my $textfont = '-*-Courier-Medium-R-Normal--*-140-*-*-*-*-*-*';

my $arrayVar = {};

while (<DATA>) {
    my $i = $. - 1;
    /^([^\t]*)\t([^\t]*)/;
    $arrayVar->{"$i,0"} = "$1";
    $arrayVar->{"$i,1"} = "$2";
}

my $rows = $.;
# print "\nrows: $rows\n";


my $cols = 2; # number of columns

my $t = $mw->Scrolled('TableMatrix', 
                    -scrollbars => "osoe",
                    -font   => $textfont,
                    -resizeborders => 'col', # none, col, row
                    -bordercursor => "sb_h_double_arrow",
                    -rows => $rows,
                    -cols => $cols,
                    -wrap => 1,
                    -justify => 'left',        # this only affects mul
+tiline cells
                    -anchor => 'nw',            # this aligns text to 
+the top left
                    # -rowheight => 1,
                    -colwidth =>-400,
                    -variable => $arrayVar,
                    # -colstretchmode => 'all',
                    )->pack(-expand => 1, -fill => 'both');


setheight;    # initial height adjustment; height will be readjusted l
+ater when necessary by calling the same sub


my $buttexit = $mw->Button( -text => "Exit", -command => sub{ $mw->des
+troy});            
my $buttheight = $mw->Button( -text => "Set height", -command => sub {
+setheight;});            


$buttheight->pack();
$buttexit->pack();
$buttexit->focus( -force );


# my $cursorpos = $t->icursor();
# my $activeindex = $t->index('active');
# my $activecont = $t->get('active');


Tk::MainLoop;


sub setheight {
    for my $i (0 .. $rows - 1) {
        # print "\n\nrow $i";
        for my $col (0 .. $cols - 1) {
            $t->activate("$i,$col");
            my $activecont = $t->get('active');
            # print "\n$i,$col";
            my $charcount = length($activecont);
            # print " length: $charcount";
            my $width = $t->colWidth($col,) / -8; # approx width in ch
+aracters
            my $reqheight = int(length($activecont) / $width) + 1;
            # print ", required height: $reqheight";
            my $currheight = $t->rowHeight($i);
            $t->rowHeight($i, $reqheight) if ( ($col == 0) or ($reqhei
+ght > $currheight)); # set row height for the height of the tallest c
+ell in the row
        }
    }
}


__DATA__
this    is a relatively long string that will probably end up displaye
+d on two lines if the window isn't wide enough this is a relatively l
+ong string that will probably end up displayed on two lines if the wi
+ndow isn't wide enough
this is not that short, eitherrr    lalala)(=/%!+"'§΄&#729;`&#731;°^&#
+711;~
well, this cell contains quite a lot of text so I'm expecting it will 
+be wrapped    lalalaια&#369;ϊ&#337;νσόΦ)(=/%!+"'§΄&#729;`&#731;°^&#71
+1;~