Khariton has asked for the wisdom of the Perl Monks concerning the following question:

In many widget present option -cursor.
In Menubutton widget it present too...
When I set
$TOP->optionAdd("*Cursor",'');
then cursors of all widgets must be as system cursor.
But in pulldown menus of Menubutton widget I have 'arrow' styled cursor.
Example:
sub help_menuitems { [['command',$messages[44],-command=>[\&help],-accelerator=>'F1']]; } $help=$menubar->Menubutton(-cursor=>'',-text=>$messages[50],-menuitems + => help_menuitems,-tearoff=>0,-state=>'active'); $help->pack(qw/-side left/);
Whith this code I have system cursor for menubutton only. After entering in pulldown menu cursor change to 'arrow' style.
I saw code of Menubutton.pm and find this(from line 191):
... 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 I change cursor or relief options in module - all OK.
But this is not true method.
Can I change these parameters from my perl program? I try it, but don't have positive result...

Replies are listed 'Best First'.
Re: Perl::Tk and cursor in Menubutton
by zentara (Cardinal) on Oct 18, 2010 at 12:11 UTC
    There may be a way to change the existing module from your program, by overriding the existing module's sub, but it would probably generate a "redefined" error. The more proper "Perl way" would be to make your own version of the MenuButton module, and call it say "MyMenuButton.pm".

    You can do it 2 ways. One is to manually edit a copy of the module, and rename it to MyMenuButton.pm and place it somewhere in your PERL5LIB path.

    Two, and the more elegant way, is to make a derived widget from the MenuButton module. Google for "perl tk derived widget" for numerous tutorials and examples for derived widgets. See Making a derived Tk::Text object for a simple example.


    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re: Perl::Tk and cursor in Menubutton
by kcott (Archbishop) on Oct 18, 2010 at 12:34 UTC

    What a coincidence - I was looking at exactly the same thing less than 24 hours ago.

    I managed to change the cursor initially with:

    my $priority = 40; ... $mw->optionAdd(q{*cursor}, q{left_ptr}, $priority);

    However, as soon as I clicked on either the menubar or a menu button, the cursor reverted to what it was prior to using optionAdd.

    Just for completeness, I also tried (and got the same result) with the more specific:

    $mw->optionAdd(q{*Menu.cursor}, q{left_ptr}, $priority);

    Setting $priority as high as 100 had no discernible effect either.

    In the source code (for Menu.pm), I found a binding:

    $mw->bind($class,'<ButtonPress>','ButtonDown');

    I'm fairly sure this is causing the behaviour that we're both seeing.

    I suspect overriding this binding will resolve the issue, though I've not had a chance to try this yet.

    There may be other related issues in Menubar.pm, Menubutton.pm and Menu/Item.pm.

    -- Ken

Re: Perl::Tk and cursor in Menubutton
by kcott (Archbishop) on Oct 19, 2010 at 22:55 UTC

    I now have a working solution for this.

    I have MSWindows and Cygwin environments available to me. I've tested in both. Somewhere behind the scenes, MSWindows uses its own native Menu code and is totally unaffected by configure(), bind(), optionAdd() or anything else I threw at it. So, effectively, everything after here refers to Cygwin. I'm assuming this will also be valid for the majority of UNIX systems (but happy to be corrected if I'm wrong).

    I used a rather lengthy script for testing this. I've pulled out the relevant parts and will annotate as I go.

    Fairly standard start to the script:

    ... use Tk; ... { my $mw = MainWindow->new(); ... configure_option_database($mw); ... build_menu_bar($mw); ... }

    I've used zero-length strings to pick up the system cursor. I wasn't actually aware of that behaviour, so thanks for that one Khariton. While testing, I changed these to various other values and they behaved as expected, i.e. they either affected the entire GUI or just the menu.

    sub configure_option_database { my ($mw) = @_; ... $mw->optionAdd(q{*cursor}, q{}, $priority); ... $mw->optionAdd(q{*Menu.cursor}, q{}, $priority); ... }

    Here I've overridden the Menu.pm code ( $mw->bind($class,'<ButtonPress>','ButtonDown'); ). I've used a different name for the callback which gets around the subroutine redefinition warning noted by zentara; although a no warnings q{redefine} can easily do that anyway. (If you take that route, ensure you add use warnings q{redefine} immediately after the redefined subroutine or put the whole lot inside { ... } so it's lexically hidden.)

    I've also given the menu cursor a starting value. As with optionAdd() (above), I tried this with a number of values and results were as expected. One point to note here is that $parent->configure(...) must come before $mb->configure(...); if you have it the other way around, subsequent calls to $mb->cget() do not return the configured value - it took a bit of head scratching to work that one out. :-)

    sub build_menu_bar { my ($parent) = @_; my $mb = $parent->Menu( -type => q{menubar}, ... ); $mb->bind(ref $mb, q{<ButtonPress>}, \&menu_button_down); $parent->configure(-menu => $mb); $mb->configure(-cursor => q{}); ... }

    Finally, I've copied the ButtonDown() method from Menu.pm and made the modification shown. If your Perl version is less than 5.10, you'll need the defined function instead of // (note that || won't work as an empty string to indicate the system cursor will be seen as a false value).

    # A modified version of Tk::Menu::ButtonDown() sub menu_button_down { ... $Tk::cursor = $menu->cget('-cursor'); # START: Modification of Tk::Menu::ButtonDown() #$menu->configure(-cursor => 'arrow'); my $menu_cursor = $Tk::cursor // $menu->optionGet(q{cursor}, ref $menu) // q{}; $menu->configure(-cursor => $menu_cursor); # END: Modification of Tk::Menu::ButtonDown() ... }

    I have two caveats with this solution:

    1. If Tk::Menu::ButtonDown() ever changes, the menu_button_down() code may require an equivalent modification.
    2. $Tk::cursor is a global variable. I don't believe I've used it in any way different from the original but, obviously, I haven't checked every line of Tk code. I haven't seen any strange behaviour but I also haven't used every Tk widget in the test GUI. Global variables just scare me - which I think is probably a good thing. :-)

    -- Ken

      Sorry for my English(I'm from Ukraine).
      This is interesting way to getting positive result.
      But creating new modules with code changes is not true way. At first this is violation of license. In addition I must have root privilegies to correct module code. In future I neede on all PC's where this program must running, correcting code of Tk module. Now my program needn't root privilegies for running.
      Creating new procedures in my code with copy-paste code from original module is violation of license too. And this way distend my code.

      I think may be present method getting access to menubutton object variables and correct this without correction code im Menubutton.pm?
        At first this is violation of license.

        Ha! You are Microsoft brainwashed.

        The Tk module is open source, and you can make a copy of an existing module, rename it and make it yours, then put it in your own home directory for your personal use.

        must have root privilegies to correct module code.

        You are not correcting it, you are making a copy and modifying it for your own use.

        But, just go to Tk download , unpack it, and get your very own free copy!!!!! Yes FREE as in FREE BEER. :-)


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh

        Thanks for taking the time to reply. Your English is a lot better than my Russian. :-)

        I concur with the comments made by zentara in his response.

        -- Ken