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);
    ...
}

[download]

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);
    ...
}

[download]

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{});
    ...
}

[download]

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()
    ...
}

[download]

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

In reply to Re: Perl::Tk and cursor in Menubutton by kcott
in thread Perl::Tk and cursor in Menubutton by Khariton

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.