Re: [Fwd: Re: displaying of Tk::Optionmenu]

I am hoping this is something very simple and easily answered as I dont 
want to bother you to much for my special
requirements.

I cannot figure out why I cannot directly modify the post sub in 
Perl/Site/Lib/Tk/Menu.pm and get this to work.
I added a couple of debug lines and don't see that its getting called, 
yet when I use your code in the main script
it works as expected. One reason I need to doit this way, is for some 
reason it causes perltray (ActiveState) to not
exit when an exit is called. Here is the code for post (modified):

sub Post
{
print "Post called\n";
my $menu = shift;
return unless (defined $menu);
my $x = shift;
my $y = shift;
my $entry = shift;

print "Before X: x% Y: $y\n";
if ($y + $menu->reqheight > $menu->screenheight) {
my $pointery = $menu->pointery;
$y = $pointery - 15 - $menu->reqheight;
if ($y < 0) {
$y = 0;
}
}
print "After X: $x Y: $y\n";

Unpost(undef) if (defined($Tk::popup) || defined($Tk::postedMb));
$menu->PostOverPoint($x,$y,$entry);
$menu->grabGlobal;
$Tk::popup = $menu;
$Tk::focus = $menu->focusCurrent;
$menu->focus();
}







Slaven Rezic wrote:
> listmail <[email protected]> writes:
>
>   
>> I figured out it had to do with my existing use statements.  I tried
>> to migrate this code into Tk::Menu::Post
>> but it doesn't seem to work. During stepping, it looked like Post
>> wasn't being called when I clicked the Menubutton and that Unpost was.
>> Weird.  I'm not familiar with this *post = sub way of defining things.
>> Is it a wildcard and it means it is redifining Tk::Menu::Unpost as
>> well?
>>     
>
> The
>
>     *function = sub {
>         ...
>     };
>
> is just like
>
>     sub function {
>         ...
>     }
>
> but in the latter form the sub is always created, regardless whether
> in a negative condition or not.
>
>   
>> Anyway thats for the immediate fix, it works.
>>
>> -------- Original Message --------
>> Subject: 	Re: displaying of Tk::Optionmenu
>> Date: 	Wed, 06 Dec 2006 15:51:52 -0500
>> From: 	listmail <[email protected]>
>> To: 	[email protected]
>> CC: 	Perl TK Mailing List <[email protected]>
>> References: 	<[email protected]>
>> <[email protected]>
>>
>>
>>
>> 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
>>
>>
>>
>>     
>
>   

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