summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
commit316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch)
treecb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl
parentcd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff)
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl122
1 files changed, 0 insertions, 122 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl
deleted file mode 100755
index 9fd624bdc22..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl
+++ /dev/null
@@ -1,122 +0,0 @@
-# menbut.pl
-
-use vars qw/$TOP/;
-
-sub menbut {
- my($demo) = @_;
- $TOP = $MW->WidgetDemo(
- -name => $demo,
- -text => '',
- -title => 'Menubutton Demo',
- -iconname => 'Menubutton',
- );
-
- my @menubuttons;
- foreach (qw/below right left above/) {
- my $pos = ucfirst;
- my $menubutton = $TOP->Menubutton(qw/-underline 0 -relief raised/,
- -text => $pos, -direction => $_);
- push @menubuttons, $menubutton;
- my $menu = $menubutton->menu(qw/-tearoff 0/);
- $menubutton->configure(-menu => $menu);
- $menubutton->command(-label => "$pos menu: first item", -command =>
- sub {print "You selected the first item from the $pos menu.\n"});
- $menubutton->command(-label => "$pos menu: second item", -command =>
- sub {print "You selected the second item from the $pos menu.\n"});
- }
- $menubuttons[0]->grid(qw/-row 0 -column 1 -sticky n/);
- $menubuttons[3]->grid(qw/-row 2 -column 1 -sticky n/);
- $menubuttons[1]->grid(qw/-row 1 -column 0 -sticky w/);
- $menubuttons[2]->grid(qw/-row 1 -column 2 -sticky e/);
-
- my $body = $TOP->Frame;
- $body->grid(qw/-row 1 -column 1 -sticky news/);
- $body->Label(qw/-wraplength 300 -justify left/, -font => 'Helvetica 14',
- -text => 'This is a demonstration of menubuttons. The "Below" menubutton pops its menu below the button; the "Right" button pops to the right, etc. There are two option menus directly below this text; one is just a standard menu and the other is a 16-color palette.')->pack(qw/-side top -padx 25
- -pady 25/);
- $bbutt = $body->Frame->pack(qw/-padx 25 -pady 25/);
- $bbutt->Optionmenu(-options => [qw/one two three/])->pack(qw/-side left
- -padx 25 -pady 25/);
-
- my $palette;
- my(@colors) = qw/Black red4 DarkGreen NavyBlue gray75 Red Green Blue
- gray50 Yellow Cyan Magenta White Brown DarkSeaGreen DarkViolet/;
-
- my $colors = native_optionmenu(
- $bbutt,
- \$palette,
- [sub {print "args=@_.\n"}, 'First'],
- @colors,
- );
- $colors->pack(qw/-side left -padx 25 -pady 25/);
-
- my $menu = $colors->cget(-menu);
- my $topborder = 'gray50';
- my $bottomborder = 'gray75';
-
- foreach my $i (0 .. $#colors) {
-
- # Create a 16 pixel x 16 pixel solid color swatch.
- # Add a black ring around the currently selected item.
-
- my $color = $menu->entrycget($i, -label);
- my $p = $TOP->Photo(qw/-width 16 -height 16/);
- $p->put($topborder, qw/-to 0 0 16 1/);
- $p->put($topborder, qw/-to 0 1 1 16/);
- $p->put($bottomborder, qw/-to 1 15 16 16/);
- $p->put($bottomborder, qw/-to 15 1 16 15/);
- $p->put($color, qw/-to 1 1 15 15/);
-
- my $r = $TOP->Photo(qw/-width 16 -height 16/);
- $r->put(qw/black -to 0 0 16 2/);
- $r->put(qw/black -to 0 2 2 16/);
- $r->put(qw/black -to 2 14 16 16/);
- $r->put(qw/black -to 14 2 16 14/);
- $r->put($color , qw/-to 2 2 14 14/);
-
- $menu->entryconfigure($i, -columnbreak => 1) unless $i % 4;
- $menu->entryconfigure($i,
- -image => $p,
- -hidemargin => 1,
- -selectimage => $r,
- );
-
- } # forend all colors
-
- $menu->configure(-tearoff => 1);
-
-} # end menbut
-
-sub native_optionmenu {
-
- my($parent, $varref, $command, @optionvals) = @_;
-
- $$varref = $optionvals[0];
-
- my $mb = $parent->Menubutton(
- -textvariable => $varref,
- -indicatoron => 1,
- -relief => 'raised',
- -borderwidth => 2,
- -highlightthickness => 2,
- -anchor => 'c',
- -direction => 'flush',
- );
- my $menu = $mb->Menu(-tearoff => 0);
- $mb->configure(-menu => $menu);
-
- my $callback = ref($command) =~ /CODE/ ? [$command] : $command;
-
- foreach (@optionvals) {
- $menu->radiobutton(
- -label => $_,
- -variable => $varref,
- -command => [@$callback, $_],
- );
- }
-
- $mb;
-
-} # end native_optionmenu
-
-1;