Well it was easy enought to try, and your method works. There is a sizing glitch I didn't work out, but the OP should be able to figure it out.
#!/usr/bin/perl -w
use Tk;
use Tk::widgets qw/LabEntry/;
use strict;
package MyCollapsableFrame;
use Carp;
use Tk::widgets qw/Frame/;
use vars qw/$cf_height_bias $im_Close $im_Open/;
use strict;
use base qw/Tk::Frame/;
Construct Tk::Widget 'MyCollapsableFrame';
sub ClassInit {
# Define global variables and images for the class.
my($class, $mw) = @_;
$cf_height_bias = 22;
$im_Close = $mw->Bitmap(-data => <<'END');
#define close_width 16
#define close_height 16
static unsigned char close_bits[] = {
0x00, 0x80, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0x
+c0,
0xf0, 0xc7, 0xe0, 0xc3, 0xc0, 0xc1, 0x80, 0xc0, 0x00, 0xc0, 0x00, 0x
+c0,
0x00, 0xc0, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, };
END
$im_Open = $mw->Bitmap(-data => << 'END');
#define open_width 16
#define open_height 16
static unsigned char open_bits[] = {
0x00, 0x80, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x40, 0xc0, 0xc0, 0x
+c0,
0xc0, 0xc1, 0xc0, 0xc3, 0xc0, 0xc1, 0xc0, 0xc0, 0x40, 0xc0, 0x00, 0x
+c0,
0x00, 0xc0, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, };
END
$class->SUPER::ClassInit($mw);
} # end ClassInit
sub Populate {
# Create an instance of a CollapsableFrame. Instance variables ar
+e:
#
# {frame} = the ridged frame, which contains the open/close
# Label image, the id Label for the collapsable Frame,
# and the container Frame within which the user manages
# collapsable widgets. It's ALMOST possible to forgo
# this extra internal frame, were it not for the -pady
# packer attribute we use to make the widget look pretty
+.
# {opcl} = the open/close image Label.
# {ident} = the identifying Label.
# {colf} = the user's container Frame, advertised as "colf".
my($self, $args) = @_;
my $height = $args->{-height};
croak "Tk::CollapsableFrame: -height must be >= $cf_height_bias" u
+nless
$height >= $cf_height_bias;
$self->SUPER::Populate($args);
$self->{frame} = $self->Frame(
qw/-borderwidth 2 -height 16 -relief ridge/,
);
$self->{frame}->pack(
qw/-anchor center -expand 1 -fill x -pady 7 -side left/,
);
$self->{opcl} = $self->Label(
qw/-borderwidth 0 -relief raised/, -text => $height,
);
$self->{opcl}->bind('<Button-1>' => [sub {$_[1]->toggle}, $self]);
$self->{opcl}->place(
qw/-x 5 -y -1 -width 21 -height 21 -anchor nw -bordermode igno
+re/,
);
$self->{ident} = $self->Label(qw/-anchor w -borderwidth 1/);
$self->{ident}->place(
qw/-x 23 -y 3 -height 12 -anchor nw -bordermode ignore/,
);
$self->{colf} = $self->{frame}->Frame;
$self->{colf}->place(qw/-x 20 -y 15 -relwidth 1.0 -width -20/);
$self->Advertise('colf' => $self->{colf});
if (not defined $args->{-width}) {
$args->{-width} = $self->parent->cget(-width);
}
$self->ConfigSpecs(
-background => [['SELF', 'CHILDREN'], qw/background Background/
+],
-height => [qw/METHOD height Height 47/],
-image => [$self->{opcl}, 'image', 'Image', $im_Open],
-title => '-text',
-text => [$self->{ident}, qw/text Text NoTitle/],
-font => [$self->{ident}, qw/font Font NoTitle/],
-width => [$self->{frame}, qw/width Width 250/],
);
} # end Populate
sub bias {return $cf_height_bias}
# Public instance methods.
sub close {
my($self) = @_;
$self->{opcl}->configure(-image => $im_Open);
$self->{frame}->configure(-height => 16);
}
sub open {
my($self) = @_;
$self->{opcl}->configure(-image => $im_Close);
$self->{frame}->configure(-height => $self->{opcl}->cget(-text));
}
sub state {
my($self) = @_;
my $i = $self->{opcl}->cget(-image);
my $op = ($i == $im_Open) ? 'close' : 'open';
return $op;
}
sub toggle {
my($self) = @_;
my $i = $self->{opcl}->cget(-image);
my $op = ($i == $im_Open) ? 'open' : 'close';
$self->$op();
}
# Private instance methods.
sub height {
my($self, $h) = @_;
$self->{opcl}->configure(-text => $h);
}
1;
package main;
my $mw = MainWindow->new;
$mw->fontCreate('big',
-family=>'arial',
-weight=>'bold',
-size=>int(-18*18/14));
$mw->fontCreate('big1',
-family=>'arial',
-weight=>'bold',
-size=>int(-10*10/14));
my $cf = $mw->MyCollapsableFrame(
-background => 'lightblue',
-height => 110,
-title => 'Copy Details',
-width => 300,
-font => 'big1',
);
$cf->pack(qw/-fill x -expand 1/);
my $cf_frame = $cf->Subwidget('colf');
# Populate the CollapsableFrame with detail information.
my ($file, $from, $to, $bytes) =
('Makefile.PL', '/home/bug', '/tmp', '1,847');
foreach my $item (
['Copying', \$file],
['From', \$from],
['To', \$to],
['Bytes Copied', \$bytes],
) {
my $l = $item->[0] . ':';
my $le = $cf_frame->LabEntry(
-background => 'lightgreen',
-highlightbackground => 'blue',
-label => ' ' x (13 - length $l) . $l,
-labelBackground => 'lightgreen',
-labelPack => [qw/-side left -anchor w/],
-labelFont => '9x15bold',
-relief => 'flat',
-state => 'disabled',
-textvariable => $item->[1],
-width => 35,
);
$le->pack(qw/ -fill x -expand 1/);
}
my $button = $mw->Button(-text =>'Change Font',
-command => sub{
$cf->configure(-font => 'big');
})->pack();
MainLoop;
| 