in reply to Perl::Tk and cursor in Menubutton

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

Replies are listed 'Best First'.
Re^2: Perl::Tk and cursor in Menubutton
by Anonymous Monk on Oct 20, 2010 at 17:54 UTC
    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
        )))
        MS)))
        It's free. Yes. Free for use...
        If I correct some code or use it in my software with corrections, I must tell about this software owner and publicate my source code of new version...
        As I know, this module many years have not support... May be I thinking wrong...
        This is first.

        I want for my program less dependences...
        May be in future all peoples can get new version of Tk module and my module may be have bad compatability with main procedures. I will have not in future headache with this...
        If I choose correct code way I must track on each system version of Tk and its compatability with my module...

      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

        You can speak in Russian?
        <OffTopic>
        Я знаю русский тоже...
        Можешь попробовать поговорить и на русском...)))
        </OffTopic>
        I thinking about one method...
        In code I have for example $mw=TK::MainWindow->new; or $help=$menubar->Menubutton(...
        may be I can find objects method getting address of menubutton pointer variable and change -cursor parameter directly?
        I probe use Data::Dumper to find some information about variables but I can't get positive result.