diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
commit | 316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch) | |
tree | cb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl | |
parent | cd0f87b5d39480d85ad9bd4ee37f520f75bed560 (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-x | Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/menbut.pl | 122 |
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; |