[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / Menubutton.pm

# Converted from menu.tcl --
#
# This file defines the default bindings for Tk menus and menubuttons.
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
# @(#) menu.tcl 1.34 94/12/19 17:09:09
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.


package Tk::Menubutton;
require Tk;

use vars qw($VERSION);
$VERSION = '3.025'; # $Id: //depot/Tk8/Menubutton/Menubutton.pm#25 $

use base  qw(Tk::Widget);

Construct Tk::Widget 'Menubutton';

import Tk qw(&Ev $XS_VERSION);

bootstrap Tk::Menubutton;

sub Tk_cmd { \&Tk::menubutton }

sub InitObject
{
 my ($mb,$args) = @_;
 my $menuitems = delete $args->{-menuitems};
 my $tearoff   = delete $args->{-tearoff};
 $mb->SUPER::InitObject($args);
 if ((defined($menuitems) || defined($tearoff)) && %$args)
  {
   $mb->configure(%$args);
   %$args = ();
  }
 $mb->menu(-tearoff => $tearoff) if (defined $tearoff);
 $mb->AddItems(@$menuitems) if (defined $menuitems)
}


#
#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:
#
# cursor - Saves the -cursor option for the posted menubutton.
# focus - Saves the focus during a menu selection operation.
# Focus gets restored here when the menu is unposted.
# inMenubutton - The name of the menubutton widget containing
# the mouse, or an empty string if the mouse is
# not over any menubutton.
# popup - If a menu has been popped up via tk_popup, this
# gives the name of the menu. Otherwise this
# value is empty.
# postedMb - Name of the menubutton whose menu is currently
# posted, or an empty string if nothing is posted
# A grab is set on this widget.
# relief - Used to save the original relief of the current
# menubutton.
# window - When the mouse is over a menu, this holds the
# name of the menu; it's cleared when the mouse
# leaves the menu.
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# Overall note:
# This file is tricky because there are four different ways that menus
# can be used:
#
# 1. As a pulldown from a menubutton. This is the most common usage.
# In this style, the variable tkPriv(postedMb) identifies the posted
# menubutton.
# 2. As a torn-off menu copied from some other menu. In this style
# tkPriv(postedMb) is empty, and the top-level menu is no
# override-redirect.
# 3. As an option menu, triggered from an option menubutton. In thi
# style tkPriv(postedMb) identifies the posted menubutton.
# 4. As a popup menu. In this style tkPriv(postedMb) is empty and
# the top-level menu is override-redirect.
#
# The various binding procedures use the state described above to
# distinguish the various cases and take different actions in each
# case.
#-------------------------------------------------------------------------
# Menu::Bind --
# This procedure is invoked the first time the mouse enters a menubutton
# widget or a menubutton widget receives the input focus. It creates
# all of the class bindings for both menubuttons and menus.
#
# Arguments:
# w - The widget that was just entered or just received
# the input focus.
# event - Indicates which event caused the procedure to be invoked
# (Enter or FocusIn). It is used so that we can carry out
# the functions of that event in addition to setting up
# bindings.
sub ClassInit
{
 my ($class,$mw) = @_;
 $mw->bind($class,'<FocusIn>','NoOp');
 $mw->bind($class,'<Enter>','Enter');
 $mw->bind($class,'<Leave>','Leave');
 $mw->bind($class,'<1>','ButtonDown');
 $mw->bind($class,'<Motion>',['Motion','up',Ev('X'),Ev('Y')]);
 $mw->bind($class,'<B1-Motion>',['Motion','down',Ev('X'),Ev('Y')]);
 $mw->bind($class,'<ButtonRelease-1>','ButtonUp');
 $mw->bind($class,'<space>','PostFirst');
 $mw->bind($class,'<Return>','PostFirst');
 return $class;
}

sub ButtonDown
{my $w = shift;
 my $Ev = $w->XEvent;
 $Tk::inMenubutton->Post($Ev->X,$Ev->Y) if (defined $Tk::inMenubutton);
}

sub PostFirst
{
 my $w = shift;
 my $menu = $w->cget('-menu');
 $w->Post();
 $menu->FirstEntry() if (defined $menu);
}


# Enter --
# This procedure is invoked when the mouse enters a menubutton
# widget. It activates the widget unless it is disabled. Note:
# this procedure is only invoked when mouse button 1 is *not* down.
# The procedure B1Enter is invoked if the button is down.
#
# Arguments:
# w - The name of the widget.
sub Enter
{
 my $w = shift;
 $Tk::inMenubutton->Leave if (defined $Tk::inMenubutton);
 $Tk::inMenubutton = $w;
 if ($w->cget('-state') ne 'disabled')
  {
   $w->configure('-state','active')
  }
}

sub Leave
{
 my $w = shift;
 $Tk::inMenubutton = undef;
 return unless Tk::Exists($w);
 if ($w->cget('-state') eq 'active')
  {
   $w->configure('-state','normal')
  }
}
# Post --
# Given a menubutton, this procedure does all the work of posting
# its associated menu and unposting any other menu that is currently
# posted.
#
# Arguments:
# w - The name of the menubutton widget whose menu
# is to be posted.
# x, y - Root coordinates of cursor, used for positioning
# option menus. If not specified, then the center
# of the menubutton is used for an option menu.
sub Post
{
 my $w = shift;
 my $x = shift;
 my $y = shift;
 return if ($w->cget('-state') eq 'disabled');
 return if (defined $Tk::postedMb && $w == $Tk::postedMb);
 my $menu = $w->cget('-menu');
 return unless (defined($menu) && $menu->index('last') ne 'none');

 my $tearoff = $Tk::platform eq 'unix' || $menu->cget('-type') eq 'tearoff';

 my $wpath = $w->PathName;
 my $mpath = $menu->PathName;
 unless (index($mpath,"$wpath.") == 0)
  {
   die "Cannot post $mpath : not a descendant of $wpath";
  }

 my $cur = $Tk::postedMb;
 if (defined $cur)
  {
   Tk::Menu->Unpost(undef); # fixme
  }
 $Tk::cursor = $w->cget('-cursor');
 $Tk::relief = $w->cget('-relief');
 $w->configure('-cursor','arrow');
 $w->configure('-relief','raised');
 $Tk::postedMb = $w;
 $Tk::focus = $w->focusCurrent;
 $menu->activate('none');
 $menu->GenerateMenuSelect;
 # If this looks like an option menubutton then post the menu so
 # that the current entry is on top of the mouse. Otherwise post
 # the menu just below the menubutton, as for a pull-down.

 eval
  {local $SIG{'__DIE__'};
   my $dir = $w->cget('-direction');
   if ($dir eq 'above')
    {
     $menu->post($w->rootx, $w->rooty - $menu->ReqHeight);
    }
   elsif ($dir eq 'below')
    {
     $menu->post($w->rootx, $w->rooty + $w->Height);
    }
   elsif ($dir eq 'left')
    {
     my $x = $w->rootx - $menu->ReqWidth;
     my $y = int((2*$w->rooty + $w->Height) / 2);
     if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
      {
       $menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
      }
     else
      {
       $menu->post($x,$y);
      }
    }
   elsif ($dir eq 'right')
    {
     my $x = $w->rootx + $w->Width;
     my $y = int((2*$w->rooty + $w->Height) / 2);
     if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
      {
       $menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
      }
     else
      {
       $menu->post($x,$y);
      }
    }
   else
    {
     if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
      {
       if (!defined($y))
        {
         $x = $w->rootx+$w->width/2;
         $y = $w->rooty+$w->height/2
        }
       $menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
      }
     else
      {
       $menu->post($w->rootx,$w->rooty+$w->height);
      }
    }
  };
 if ($@)
  {
   Tk::Menu->Unpost;
   die $@
  }

 $Tk::tearoff = $tearoff;
 if ($tearoff)
  {
   $menu->focus;
   $w->SaveGrabInfo;
   $w->grabGlobal;
  }
}
# Motion --
# This procedure handles mouse motion events inside menubuttons, and
# also outside menubuttons when a menubutton has a grab (e.g. when a
# menu selection operation is in progress).
#
# Arguments:
# w - The name of the menubutton widget.
# upDown - "down" means button 1 is pressed, "up" means
# it isn't.
# rootx, rooty - Coordinates of mouse, in (virtual?) root window.
sub Motion
{
 my $w = shift;
 my $upDown = shift;
 my $rootx = shift;
 my $rooty = shift;
 return if (defined($Tk::inMenubutton) && $Tk::inMenubutton == $w);
 my $new = $w->Containing($rootx,$rooty);
 if (defined($Tk::inMenubutton))
  {
   if (!defined($new) || ($new != $Tk::inMenubutton && $w->toplevel != $new->toplevel))
    {
     $Tk::inMenubutton->Leave();
    }
  }
 if (defined($new) && $new->IsMenubutton && $new->cget('-indicatoron') == 0 &&
     $w->cget('-indicatoron') == 0)
  {
   if ($upDown eq 'down')
    {
     $new->Post($rootx,$rooty);
    }
   else
    {
     $new->Enter();
    }
  }
}
# ButtonUp --
# This procedure is invoked to handle button 1 releases for menubuttons.
# If the release happens inside the menubutton then leave its menu
# posted with element 0 activated. Otherwise, unpost the menu.
#
# Arguments:
# w - The name of the menubutton widget.

sub ButtonUp {
    my $w = shift;

    my $tearoff = $Tk::platform eq 'unix' || (defined($w->cget('-menu')) &&
					      $w->cget('-menu')->cget('-type') eq 'tearoff');
    if ($tearoff && (defined($Tk::postedMb)     && $Tk::postedMb == $w)
	         && (defined($Tk::inMenubutton) && $Tk::inMenubutton == $w)) {
	$Tk::postedMb->cget(-menu)->FirstEntry();
    } else {
      Tk::Menu->Unpost(undef);
    }
} # end ButtonUp

# Some convenience methods

sub menu
{
 my ($w,%args) = @_;
 my $menu = $w->cget('-menu');
 if (!defined $menu)
  {
   require Tk::Menu;
   $w->ColorOptions(\%args) if ($Tk::platform eq 'unix');
   $menu = $w->Menu(%args);
   $w->configure('-menu'=>$menu);
  }
 else
  {
   $menu->configure(%args);
  }
 return $menu;
}

sub separator   { require Tk::Menu::Item; shift->menu->Separator(@_);   }
sub command     { require Tk::Menu::Item; shift->menu->Command(@_);     }
sub cascade     { require Tk::Menu::Item; shift->menu->Cascade(@_);     }
sub checkbutton { require Tk::Menu::Item; shift->menu->Checkbutton(@_); }
sub radiobutton { require Tk::Menu::Item; shift->menu->Radiobutton(@_); }

sub AddItems
{
 shift->menu->AddItems(@_);
}

sub entryconfigure
{
 shift->menu->entryconfigure(@_);
}

sub entrycget
{
 shift->menu->entrycget(@_);
}

sub FindMenu
{
 my $child = shift;
 my $char = shift;
 my $ul = $child->cget('-underline');
 if (defined $ul && $ul >= 0 && $child->cget('-state') ne 'disabled')
  {
   my $char2 = $child->cget('-text');
   $char2 = substr("\L$char2",$ul,1) if (defined $char2);
   if (!defined($char) || $char eq '' || (defined($char2) && "\l$char" eq $char2))
    {
     $child->PostFirst;
     return $child;
    }
  }
 return undef;
}

1;

__END__
Commit	Line	Data
86530b38 AT	1	# Converted from menu.tcl --
	2	#
	3	# This file defines the default bindings for Tk menus and menubuttons.
	4	# It also implements keyboard traversal of menus and implements a few
	5	# other utility procedures related to menus.
	6	#
	7	# @(#) menu.tcl 1.34 94/12/19 17:09:09
	8	#
	9	# Copyright (c) 1992-1994 The Regents of the University of California.
	10	# Copyright (c) 1994 Sun Microsystems, Inc.
	11	#
	12	# See the file "license.terms" for information on usage and redistribution
	13	# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
	14
	15
	16	package Tk::Menubutton;
	17	require Tk;
	18
	19	use vars qw($VERSION);
	20	$VERSION = '3.025'; # $Id: //depot/Tk8/Menubutton/Menubutton.pm#25 $
	21
	22	use base qw(Tk::Widget);
	23
	24	Construct Tk::Widget 'Menubutton';
	25
	26	import Tk qw(&Ev $XS_VERSION);
	27
	28	bootstrap Tk::Menubutton;
	29
	30	sub Tk_cmd { \&Tk::menubutton }
	31
	32	sub InitObject
	33	{
	34	my ($mb,$args) = @_;
	35	my $menuitems = delete $args->{-menuitems};
	36	my $tearoff = delete $args->{-tearoff};
	37	$mb->SUPER::InitObject($args);
	38	if ((defined($menuitems) \|\| defined($tearoff)) && %$args)
	39	{
	40	$mb->configure(%$args);
	41	%$args = ();
	42	}
	43	$mb->menu(-tearoff => $tearoff) if (defined $tearoff);
	44	$mb->AddItems(@$menuitems) if (defined $menuitems)
	45	}
	46
	47
	48	#
	49	#-------------------------------------------------------------------------
	50	# Elements of tkPriv that are used in this file:
	51	#
	52	# cursor - Saves the -cursor option for the posted menubutton.
	53	# focus - Saves the focus during a menu selection operation.
	54	# Focus gets restored here when the menu is unposted.
	55	# inMenubutton - The name of the menubutton widget containing
	56	# the mouse, or an empty string if the mouse is
	57	# not over any menubutton.
	58	# popup - If a menu has been popped up via tk_popup, this
	59	# gives the name of the menu. Otherwise this
	60	# value is empty.
	61	# postedMb - Name of the menubutton whose menu is currently
	62	# posted, or an empty string if nothing is posted
	63	# A grab is set on this widget.
	64	# relief - Used to save the original relief of the current
65	# menubutton.
66	# window - When the mouse is over a menu, this holds the
67	# name of the menu; it's cleared when the mouse
68	# leaves the menu.
69	#-------------------------------------------------------------------------
70	#-------------------------------------------------------------------------
71	# Overall note:
72	# This file is tricky because there are four different ways that menus
73	# can be used:
74	#
75	# 1. As a pulldown from a menubutton. This is the most common usage.
76	# In this style, the variable tkPriv(postedMb) identifies the posted
77	# menubutton.
78	# 2. As a torn-off menu copied from some other menu. In this style
79	# tkPriv(postedMb) is empty, and the top-level menu is no
80	# override-redirect.
81	# 3. As an option menu, triggered from an option menubutton. In thi
82	# style tkPriv(postedMb) identifies the posted menubutton.
83	# 4. As a popup menu. In this style tkPriv(postedMb) is empty and
84	# the top-level menu is override-redirect.
85	#
86	# The various binding procedures use the state described above to
87	# distinguish the various cases and take different actions in each
88	# case.
89	#-------------------------------------------------------------------------
90	# Menu::Bind --
91	# This procedure is invoked the first time the mouse enters a menubutton
92	# widget or a menubutton widget receives the input focus. It creates
93	# all of the class bindings for both menubuttons and menus.
94	#
95	# Arguments:
96	# w - The widget that was just entered or just received
97	# the input focus.
98	# event - Indicates which event caused the procedure to be invoked
99	# (Enter or FocusIn). It is used so that we can carry out
100	# the functions of that event in addition to setting up
101	# bindings.
102	sub ClassInit
103	{
104	my ($class,$mw) = @_;
105	$mw->bind($class,'<FocusIn>','NoOp');
106	$mw->bind($class,'<Enter>','Enter');
107	$mw->bind($class,'<Leave>','Leave');
108	$mw->bind($class,'<1>','ButtonDown');
109	$mw->bind($class,'<Motion>',['Motion','up',Ev('X'),Ev('Y')]);
110	$mw->bind($class,'<B1-Motion>',['Motion','down',Ev('X'),Ev('Y')]);
111	$mw->bind($class,'<ButtonRelease-1>','ButtonUp');
112	$mw->bind($class,'<space>','PostFirst');
113	$mw->bind($class,'<Return>','PostFirst');
114	return $class;
115	}
116
117	sub ButtonDown
118	{my $w = shift;
119	my $Ev = $w->XEvent;
120	$Tk::inMenubutton->Post($Ev->X,$Ev->Y) if (defined $Tk::inMenubutton);
121	}
122
123	sub PostFirst
124	{
125	my $w = shift;
126	my $menu = $w->cget('-menu');
127	$w->Post();
128	$menu->FirstEntry() if (defined $menu);
129	}
130
131
132	# Enter --
133	# This procedure is invoked when the mouse enters a menubutton
134	# widget. It activates the widget unless it is disabled. Note:
135	# this procedure is only invoked when mouse button 1 is not down.
136	# The procedure B1Enter is invoked if the button is down.
137	#
138	# Arguments:
139	# w - The name of the widget.
140	sub Enter
141	{
142	my $w = shift;
143	$Tk::inMenubutton->Leave if (defined $Tk::inMenubutton);
144	$Tk::inMenubutton = $w;
145	if ($w->cget('-state') ne 'disabled')
146	{
147	$w->configure('-state','active')
148	}
149	}
150
151	sub Leave
152	{
153	my $w = shift;
154	$Tk::inMenubutton = undef;
155	return unless Tk::Exists($w);
156	if ($w->cget('-state') eq 'active')
157	{
158	$w->configure('-state','normal')
159	}
160	}
161	# Post --
162	# Given a menubutton, this procedure does all the work of posting
163	# its associated menu and unposting any other menu that is currently
164	# posted.
165	#
166	# Arguments:
167	# w - The name of the menubutton widget whose menu
168	# is to be posted.
169	# x, y - Root coordinates of cursor, used for positioning
170	# option menus. If not specified, then the center
171	# of the menubutton is used for an option menu.
172	sub Post
173	{
174	my $w = shift;
175	my $x = shift;
176	my $y = shift;
177	return if ($w->cget('-state') eq 'disabled');
178	return if (defined $Tk::postedMb && $w == $Tk::postedMb);
179	my $menu = $w->cget('-menu');
180	return unless (defined($menu) && $menu->index('last') ne 'none');
181
182	my $tearoff = $Tk::platform eq 'unix' \|\| $menu->cget('-type') eq 'tearoff';
183
184	my $wpath = $w->PathName;
185	my $mpath = $menu->PathName;
186	unless (index($mpath,"$wpath.") == 0)
187	{
188	die "Cannot post $mpath : not a descendant of $wpath";
189	}
190
191	my $cur = $Tk::postedMb;
192	if (defined $cur)
193	{
194	Tk::Menu->Unpost(undef); # fixme
195	}
196	$Tk::cursor = $w->cget('-cursor');
197	$Tk::relief = $w->cget('-relief');
198	$w->configure('-cursor','arrow');
199	$w->configure('-relief','raised');
200	$Tk::postedMb = $w;
201	$Tk::focus = $w->focusCurrent;
202	$menu->activate('none');
203	$menu->GenerateMenuSelect;
204	# If this looks like an option menubutton then post the menu so
205	# that the current entry is on top of the mouse. Otherwise post
206	# the menu just below the menubutton, as for a pull-down.
207
208	eval
209	{local $SIG{'__DIE__'};
210	my $dir = $w->cget('-direction');
211	if ($dir eq 'above')
212	{
213	$menu->post($w->rootx, $w->rooty - $menu->ReqHeight);
214	}
215	elsif ($dir eq 'below')
216	{
217	$menu->post($w->rootx, $w->rooty + $w->Height);
218	}
219	elsif ($dir eq 'left')
220	{
221	my $x = $w->rootx - $menu->ReqWidth;
222	my $y = int((2*$w->rooty + $w->Height) / 2);
223	if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
224	{
225	$menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
226	}
227	else
228	{
229	$menu->post($x,$y);
230	}
231	}
232	elsif ($dir eq 'right')
233	{
234	my $x = $w->rootx + $w->Width;
235	my $y = int((2*$w->rooty + $w->Height) / 2);
236	if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
237	{
238	$menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
239	}
240	else
241	{
242	$menu->post($x,$y);
243	}
244	}
245	else
246	{
247	if ($w->cget('-indicatoron') == 1 && defined($w->cget('-textvariable')))
248	{
249	if (!defined($y))
250	{
251	$x = $w->rootx+$w->width/2;
252	$y = $w->rooty+$w->height/2
253	}
254	$menu->PostOverPoint($x,$y,$menu->FindName($w->cget('-text')))
255	}
256	else
257	{
258	$menu->post($w->rootx,$w->rooty+$w->height);
259	}
260	}
261	};
262	if ($@)
263	{
264	Tk::Menu->Unpost;
265	die $@
266	}
267
268	$Tk::tearoff = $tearoff;
269	if ($tearoff)
270	{
271	$menu->focus;
272	$w->SaveGrabInfo;
273	$w->grabGlobal;
274	}
275	}
276	# Motion --
277	# This procedure handles mouse motion events inside menubuttons, and
278	# also outside menubuttons when a menubutton has a grab (e.g. when a
279	# menu selection operation is in progress).
280	#
281	# Arguments:
282	# w - The name of the menubutton widget.
283	# upDown - "down" means button 1 is pressed, "up" means
284	# it isn't.
285	# rootx, rooty - Coordinates of mouse, in (virtual?) root window.
286	sub Motion
287	{
288	my $w = shift;
289	my $upDown = shift;
290	my $rootx = shift;
291	my $rooty = shift;
292	return if (defined($Tk::inMenubutton) && $Tk::inMenubutton == $w);
293	my $new = $w->Containing($rootx,$rooty);
294	if (defined($Tk::inMenubutton))
295	{
296	if (!defined($new) \|\| ($new != $Tk::inMenubutton && $w->toplevel != $new->toplevel))
297	{
298	$Tk::inMenubutton->Leave();
299	}
300	}
301	if (defined($new) && $new->IsMenubutton && $new->cget('-indicatoron') == 0 &&
302	$w->cget('-indicatoron') == 0)
303	{
304	if ($upDown eq 'down')
305	{
306	$new->Post($rootx,$rooty);
307	}
308	else
309	{
310	$new->Enter();
311	}
312	}
313	}
314	# ButtonUp --
315	# This procedure is invoked to handle button 1 releases for menubuttons.
316	# If the release happens inside the menubutton then leave its menu
317	# posted with element 0 activated. Otherwise, unpost the menu.
318	#
319	# Arguments:
320	# w - The name of the menubutton widget.
321
322	sub ButtonUp {
323	my $w = shift;
324
325	my $tearoff = $Tk::platform eq 'unix' \|\| (defined($w->cget('-menu')) &&
326	$w->cget('-menu')->cget('-type') eq 'tearoff');
327	if ($tearoff && (defined($Tk::postedMb) && $Tk::postedMb == $w)
328	&& (defined($Tk::inMenubutton) && $Tk::inMenubutton == $w)) {
329	$Tk::postedMb->cget(-menu)->FirstEntry();
330	} else {
331	Tk::Menu->Unpost(undef);
332	}
333	} # end ButtonUp
334
335	# Some convenience methods
336
337	sub menu
338	{
339	my ($w,%args) = @_;
340	my $menu = $w->cget('-menu');
341	if (!defined $menu)
342	{
343	require Tk::Menu;
344	$w->ColorOptions(\%args) if ($Tk::platform eq 'unix');
345	$menu = $w->Menu(%args);
346	$w->configure('-menu'=>$menu);
347	}
348	else
349	{
350	$menu->configure(%args);
351	}
352	return $menu;
353	}
354
355	sub separator { require Tk::Menu::Item; shift->menu->Separator(@_); }
356	sub command { require Tk::Menu::Item; shift->menu->Command(@_); }
357	sub cascade { require Tk::Menu::Item; shift->menu->Cascade(@_); }
358	sub checkbutton { require Tk::Menu::Item; shift->menu->Checkbutton(@_); }
359	sub radiobutton { require Tk::Menu::Item; shift->menu->Radiobutton(@_); }
360
361	sub AddItems
362	{
363	shift->menu->AddItems(@_);
364	}
365
366	sub entryconfigure
367	{
368	shift->menu->entryconfigure(@_);
369	}
370
371	sub entrycget
372	{
373	shift->menu->entrycget(@_);
374	}
375
376	sub FindMenu
377	{
378	my $child = shift;
379	my $char = shift;
380	my $ul = $child->cget('-underline');
381	if (defined $ul && $ul >= 0 && $child->cget('-state') ne 'disabled')
382	{
383	my $char2 = $child->cget('-text');
384	$char2 = substr("\L$char2",$ul,1) if (defined $char2);
385	if (!defined($char) \|\| $char eq '' \|\| (defined($char2) && "\l$char" eq $char2))
386	{
387	$child->PostFirst;
388	return $child;
389	}
390	}
391	return undef;
392	}
393
394	1;
395
396	__END__
397
398