Re: Embedded widgets in HList and Text leaking memory?

Michael Erskine <[email protected]> Thu, 22 Feb 2007 10:27:34 +0000
Newsgroups gmane.comp.lang.perl.tk
Organization KeTech Systems Ltd
Message-ID <[email protected]>
On Thursday 22 February 2007 09:36, [email protected] wrote:
> How do you remove the embedded widgets? I guess that you need both,
> removing the widget
> from the container widget *and* explicitely destroying the embedded widget
> using destroy().

Hi Slaven,
At the moment I'm using the delete method of the Text widget (with 
delete('1.0', 'end')) which claims in the manpage to destroy embedded 
windows. I did consider explicitly destroying the embedded widgets but I 
haven't yet tackled programmatically finding them in the Text widget!

Anyhow, here follows a version of the sort of thing I'm trying to achieve that 
I've made standalone. I really love the flexibility of using a Text widget 
but I still need to learn a lot more about it! On Windows the leakage seems 
much worse than on Linux but that could be a Tk version thing.

Regards,
Michael Erskine

----------------- >8 ----- CUT HERE ----- >8 ------------------
#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::Button;
use Tk::Spinbox;
use Tk::ROText;

=for docs

A notes list: an editable list of option=value pairs that are dynamically 
reflected in a list of lists.

On each row
* the option can be chosen from a fixed list of available options
* the value can be chosen but is restrained to limits dependent on the option

=cut

sub t(@);
sub d($ );
sub dclean( $ );
sub vmem();

my $opts = [qw(NOTE NOTE2 GAP)];
my $notedata = [
['NOTE', 100],
['NOTE2', 100],
['GAP', 100],
['NOTE', 200],
['NOTE2', 200],
['GAP', 200],
['NOTE', 300],
['NOTE2', 300],
['GAP', 300],
];

my $mw = new MainWindow();


my $t = $mw->Scrolled('ROText', -scrollbars => 'osoe',
-wrap => 'none',
-setgrid => 1,
-cursor => 'left_ptr',
-insertofftime => 0,
)->pack(-fill => 'both', -expand => 1);
$mw->Button(-text => "load", -command => \&load)->pack;
$mw->Button(-text => "save", -command => \&save)->pack;
MainLoop;
##################################

sub load {
    t "load";
    # wipe clean...
    $t->delete('1.0', 'end');
    foreach(@$notedata){
        add_row($_);
    }
    t "virtual bytes = ".vmem;
}
sub save {
    t "save";
    t dclean $notedata;
    t "virtual bytes = ".vmem;
}

# adds a row to the end...
# should really insert a row at a given position
sub add_row {
    my $r = shift;
    my $p = $r->[0];
    my $v = $r->[1];
    #~ $t->insert('end', $p);
    my $op = $t->Spinbox(
        -state => 'readonly',
        -values => $opts,
        -width  => 6,
        -textvariable => \$r->[0],
        -command => \&opt_spun,
    );
    $t->windowCreate('end', -window => $op);
    $op->set($p); # not sure why I need to do this again!
    #~ $t->insert('end', "\t");
    my $vw = $t->Spinbox(
        -width  => 6,
        -from => 0, -to => 100,
        -textvariable => \$r->[1],
        -validate => 'all',
        -validatecommand => sub {t "validate ".dclean(\@_); 1;},
    );
    $t->windowCreate('end', -window => $vw);
    my $b = $t->Button(-text => '-', -command => sub{t "del row NYI";});
    $t->windowCreate('end', -window => $b);
    $b = $t->Button(-text => '+', -command => sub{t "add row NYI";});
    $t->windowCreate('end', -window => $b);
    #~ $t->insert('end', $v);
    $t->insert('end', "\n");
}

# when the option is changed, the values will have a different valid range
sub opt_spun {
    t dclean \@_;
}
sub t(@) {
    foreach (@_) {
	    print STDOUT "$_\n";
    }
}
sub d($) {
    require Data::Dumper;
    my $s = $_[0];
    my $d = Data::Dumper::Dumper($s);
    $d =~ s/^\$VAR1 =\s*//;
    $d =~ s/;$//;
    chomp $d;
    return $d;
}

# dump with formatting into a single line...
sub dclean($) {
    my $ref = shift;
    local $_ = d $ref;
    s/^\s+//gm;
    s/\n//g;
    return $_;
}


# how much virtual memory are we using?
sub vmem() {
    # Under Linux use ps(1) to get virtual bytes...
    my $wha = `ps --no-headers -p $$  -o vsz`;
    chomp($wha);
    return $wha;
}
--++**==--++**==--++**==--++**==--++**==--++**==--++**==
ptk mailing list
[email protected]
https://mailman.stanford.edu/mailman/listinfo/ptk