Re: displaying of Tk::Optionmenu

It tried just plopping this is in my script and get a Can't locate 
auto/Tk/Widget/Construct.al
error. I'd like to blend your code into the existing Menu.pm post sub if 
I can.





Slaven Rezic wrote:
> listmail <[email protected]> writes:
>
>   
>> A Tk::Optionmenu typically displays it’s drop down list for its options 
>> just below the drop down selector. When the Tk::Optionmenu is located 
>> close to the bottom of the screen (such as near the windows taskbar) and 
>> the option list is too long to have room to display its list below the 
>> drop down select, it will display the list upwards which ends up 
>> overlapping the menu selector. I suppose the display portion could be 
>> something that is handled by the window manger and not necessarily 
>> Tk::Optionmen/Tk::Menubutton etc.
>>
>> I would like to have it start displaying the contents from the top of 
>> the drop down selector and move upward when the list is too long to 
>> display downward. One of the main reasons for this is that is easy for 
>> the end user to accidentaly select the wrong option when it overlaps and 
>> draws itself under the current mouse position as well. Can anyone give 
>> me a clue as to how I could get things work as I describe? Does this 
>> problem exist in the more recent versions of Tk?
>>
>>     
>
> Yes, the problem still exists, and it seems to be existent in current
> Tcl/Tk versions, too. Under Unix/X11, there is a similar problem with
> application menus in Tk (I am not sure if the problem is also under
> Windows, maybe there native menus will be used).
>
> To workaround this problem, you can drop the following lines into your
> script. I originally wrote it for the Unix menu problem, but it seems
> to also solve the Optionmenu problem.
>
>
> {
> package Tk::Menu;
> use Tk::Menu;
> my $orig_menu_post;
> BEGIN {
>     $orig_menu_post = \&Tk::Menu::post;
> }
> if ($Tk::VERSION < 805) {
>     *post = sub {
> 	my($self, $x, $y) = @_;
> 	if ($y + $self->reqheight > $self->screenheight) {
> 	    my $pointery = $self->pointery;
> 	    $y = $pointery - 10 - $self->reqheight;
> 	    if ($y < 0) {
> 		$y = 0;
> 	    }
> 	}
> 	$orig_menu_post->($self, $x, $y);
>     };
> }
> }
>
>
>
> Regards,
>         Slaven
>
>   

--++**==--++**==--++**==--++**==--++**==--++**==--++**==
ptk mailing list
[email protected]
https://mailman.stanford.edu/mailman/listinfo/ptk