summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/LabFrame.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/LabFrame.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/LabFrame.pm138
1 files changed, 0 insertions, 138 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/LabFrame.pm b/Master/tlpkg/tlperl/lib/Tk/LabFrame.pm
deleted file mode 100644
index 6fcab1acc56..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/LabFrame.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-#
-# Labeled frame. Derives from Tk::Frame, but intercepts the labeling
-# part.
-
-package Tk::LabFrame;
-
-use vars qw($VERSION);
-$VERSION = '4.010'; # $Id: //depot/Tkutf8/Tixish/LabFrame.pm#11 $
-
-use Tk;
-use base qw(Tk::Frame);
-Tk::Widget->Construct('LabFrame');
-
-sub autoLabel { 0 }
-
-sub Populate {
- my ($cw, $args) = @_;
-
- $cw->{m_geoMgr} = "";
-
- my $border = $cw->Component(
- Frame => 'border',
- -relief => 'groove',
- -bd => 2,
- );
-
- my $pad = $border->Frame;
- $cw->Advertise(pad => $pad);
-
- my $frame = $border->Frame;
- $cw->Advertise(frame => $frame);
-
- my $label = $cw->Component(Label => 'label');
-
- $cw->SUPER::Populate($args);
-
- $cw->Delegates(DEFAULT => $frame);
- $cw->ConfigSpecs(
- -background => [[qw/SELF ADVERTISED/],
- qw/background Background/],
- -borderwidth => [$border, qw/borderWidth Border 2/],
- -font => [$label, qw/font Font/],
- -foreground => [$label, qw/foreground Foreground black/],
- -label => [{-text => $label}, qw/label Label/],
- -labelside => [qw/METHOD labelSide LabelSide acrosstop/],
- -labelvariable => [{-textvariable => $label}],
- -relief => [$border, qw/relief Relief groove/],
- DEFAULT => [$frame]
- );
- return $cw;
-}
-
-use Tk::Submethods(
- form => [qw/check forget grid info slaves/],
- grid => [qw/bbox columnconfigure configure forget info location
- propagate rowconfigure remove size slaves/],
- pack => [qw/forget info propagate slaves/],
- place => [qw/forget info slaves/]
-);
-
-sub labelside {
- my ($cw, $side) = @_;
- return $cw->{Configure}{-labelside} unless $side;
-
- my $border = $cw->Subwidget('border');
- my $pad = $cw->Subwidget('pad');
- my $frame = $cw->Subwidget('frame');
- my $label = $cw->Subwidget('label');
-
- ## packForget/formForget as appropriate
- foreach ($border, $label, $pad, $frame) {
- $_->formForget if $cw->{m_geoMgr} eq "form";
- $_->packForget if ($cw->{m_geoMgr} eq "pack" && $_->ismapped);
- }
-
- if ($side eq "acrosstop") {
-
- my $y = $label->reqheight / 2;
- my $ph = $y - ($border->cget(-bd));
- $ph = 0 if $ph < 0;
-
- $label->form(qw/-top 0 -left 4 -padx 6 -pady 2/);
- $border->form(-top => $y,
- qw/-bottom -1 -left 0 -right -1 -padx 2 -pady 2/);
- $pad->form(-bottom => $ph,
- qw/-top 0 -left 0 -right -1/);
- $frame->form(-top => $pad,
- qw/-bottom -1 -left 0 -right -1 -fill both/);
- $cw->{m_geoMgr} = "form";
-
- } else {
-
- $label->pack(-side => $side);
- $frame->pack(-expand => 1, -fill => 'both');
- $border->pack(-side => $side, -expand => 1, -fill => 'both');
- $cw->{m_geoMgr} = "pack";
- }
-}
-
-sub form {
- my $cw = shift;
- $cw = $cw->Subwidget('frame')
- if (@_ && $_[0] =~ /^(?:slaves)$/);
- $cw->SUPER::form(@_);
-}
-
-sub grid {
- my $cw = shift;
- $cw = $cw->Subwidget('frame') if (@_ && $_[0] =~
- /^(?:bbox
- |columnconfigure
- |location
- |propagate
- |rowconfigure
- |size
- |slaves)
- $/x);
- $cw->SUPER::grid(@_);
-}
-
-
-sub pack {
- my $cw = shift;
- $cw = $cw->Subwidget('frame')
- if (@_ && $_[0] =~ /^(?:propagate|slaves)$/);
- $cw->SUPER::pack(@_);
-}
-
-sub place {
- my $cw = shift;
- $cw = $cw->Subwidget('frame')
- if (@_ && $_[0] =~ /^(?:slaves)$/);
- $cw->SUPER::place(@_);
-}
-
-1;
-
-