Perl and GUI. Menu operation

Overview of Tk widgets, I will start by reviewing the main menu, taking into account the features of various operating systems.

To begin with, let's create a blank for our application:

 #! / usr / bin / perl -w
 use strict;
 use Tkx;

 our $ PROGNAME = 'app';
 our $ VERSION = '0.1';
 <habracut>

 my $ windowingsystem = Tkx :: tk_windowingsystem ();
 my $ IS_AQUA = ($ windowingsystem eq 'aqua');

 # Given that the names of some buttons may vary, 
 # in OSX this is Control, in Win / X11 this is Ctrl, add some more variables
 # (useful for hotkeys)
 my $ plat_acc_ctrl = ($ ^ O eq 'darwin')?  ('Control-'): ('Ctrl +');
 my $ plat_evt_ctrl = ($ ^ O eq 'darwin')?  ('Control-'): ('Control-');

 # Main window.
 my $ mw = Tkx :: widget-> new ('.');

 Tkx :: tk (appname => $ PROGNAME);
 Tkx :: wm_minsize ($ mw => qw (320 200));

 # new menu is attached using the -menu option
 $ mw-> configure (
   -menu => make_menu ($ mw),
 );


 Tkx :: MainLoop;
 one;

 sub on_quit {
   Tkx :: tk ___ messageBox (-message => 'Goodbye;]');
   exit;
 }

 sub show_about {
   Tkx :: tk ___ messageBox (-message => "$ PROGNAME $ VERSION");
 }

 sub make_menu {
  my $ mw = shift ||  return;

  # By default, all menus look like in GIMP, you can unpin them
  # Therefore, turn off this option.
  Tkx :: option_add ('* Menu.tearOff', 0)

  # ... continued below

   return $ m; 
 }

')
Everything is as usual, File, Edit, Help. (menu cascade). A new object is created using the new_menu () method; (like a container)

 my $ m = $ mw-> new_menu ();  # Upper level
 my $ fm = $ m-> new_menu ();  # File
 my $ em = $ m-> new_menu ();  # Edit

 # Now, add our items to the top level
 $ m-> add_cascade (-label => 'File', -menu => $ fm, -underline => 0);
 $ m-> add_cascade (-label => 'Edit', -menu => $ em, -underline => 0);

Adding is done via add_cascade (), where
-label is the menu title.
-menu widget
-underline - the index of the letter underscore. It is necessary for quick navigation using the Alt + letter button (numbering comes with 0)

look what happened.


There is no sense from the empty menu, so we “fill it” with its commands.

 # File menu
 $ fm-> add_command (
   -label => 'Do something',
   -underline => 0,
   -command => sub {},
 );

 # separator
 $ fm-> add_separator ();

 $ fm-> add_command (
   -label => 'Quit',
   -underline => 0,
   -accelerator => "$ {plat_acc_ctrl} Q",
   -command => [\ & on_quit],
 );

 Tkx :: bind (all => "<$ {plat_evt_ctrl} q>" => [\ & on_quit]);

 # Edit menu
 $ em-> add_command (
   -label => 'Cut',
   -underline => 2,
   -accelerator => "$ {plat_acc_ctrl} X",
   -command => sub {Tkx :: event_generate (Tkx :: focus (), '<< anchor> habracut </ anchor >>')},
 );
    
 $ em-> add_command (
   -label => 'Copy',
   -underline => 0,
   -accelerator => "$ {plat_acc_ctrl} C",
   -command => sub {Tkx :: event_generate (Tkx :: focus (), '<< Copy >>')},
 );
    
 $ em-> add_command (
 -label => 'Paste',
 -underline => 0,
 -accelerator => "$ {plat_acc_ctrl} V",
 -command => sub {Tkx :: event_generate (Tkx :: focus (), '<< Paste >>')},
 );

On the Quit item, we made a hot key (Ctrl + Q) using the bind method.
To specify the "accelerator", -accelerator is used, and the event itself when pressed is -command
command takes a pointer to a subroutine, and if you need to pass parameters to it, then use an anonymous array
[\ & function, parameter1, parameter2]

File, Edit is. Remained item - Help.

X11 has its own system name ( 'help' ) for the Help item. OSX also has an 'apple' menu
Considering this:

 my $ hname = ($ IS_AQUA? 'nothelp': 'help');
 my $ hm = $ m-> new_menu (-name => $ hname);

 $ m-> add_cascade (
   -label => 'Help',
   -menu => $ hm,
   -underline => 0,
 );

 # .. add help, homepage, etc.

 if (! $ IS_AQUA) {
   $ hm-> add_command (
     -label => 'About',
     -underline => 0,
     -command => [\ & show_about],
   );
 } else {
    my $ apple_menu = $ m-> new_menu (-name => 'apple');
    $ m-> add_cascade (
      -label => $ PROGNAME,
      -menu => $ apple_menu,
    );

    $ m-> add_command (
      -label => "About $ PROGNAME",
      -command => [\ & show_about],
    );
 }

Screenshots from Linux / OSX add later.