Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

RFC - early draft of Menu::Simple

by RonW (Vicar)
on Jun 06, 2014 at 17:13 UTC ( #1089076=perlmeditation: print w/replies, xml ) Need Help??

A while back, to further simplify making menus for occasional Tk driven Perl tool, I started Menu::Simple as an alternative to the -menuitems option in Tk::Menu::Items. It has significantly helped others to add their own Tk GUIs to Perl tools. (None of us here do much GUI coding, so anything that makes it easier helps us.)

Recently, while adding a Tk GUI to yet another tool I created using Perl, it occurred to me that Menu::Simple might be worth sharing.

It still needs more documentation, but I do have a simple example that shows the basic usage. (It also needs some clean up. Over time, I have changed and enhanced it. Just haven't thought about sharing outside my team at work.)

So, here is the module and usage example. (Warning: It currently uses the 'current_sub' feature, so at least Perl 5.16 is needed.)

Update: Determined that Perl 5.16 is currently needed. Will try to make it work with earlier versions.

Update 2: After clean-ups, of course, would this be worth submitting to CPAN? Maybe change the name to Tk::Menu::Simple?

Update 3: Removed requirement for Perl 5.16, but not sure how old a Perl it will work with.

Update 4: Added a draft of documentation. Also, changed name to Menu::Builder. (I am planning to contact the maintainer of the Tk namespace on CPAN about having this included as Tk::Menu::Builder.)

#!perl -w =head1 NAME =for :Dox @package - Simple menu builder for Perl Tk =cut package Menu::Builder; $VERSION = '0.007'; =head1 SYNOPSIS use Tk; use Tk::Menu; use Menu::Builder; my $checkbox; my $menuCfg = [ File => [ New => \&FileNew, Save => \&FileSave, Exit => \&FileExit, ], Options => [ Fancy => { -type => 'checkbutton', -variable => \$checkbox + }, ], Help => [ Help => \&HelpHelp, About => \&HelpAbout, ], ]; my $mw = MainWindow->new(-title => 'Menu Builder Test'); my $menuBar = $mw->Menu(-tearoff => 0); $mw->configure(-menu => $menuBar); Menu::Builder::BuildMenu($menuBar, $menuCfg); =head1 DESCRIPTION This is a tool for quickly and easily building multi-level Menu System +s, such as, but not limited to, a menubar. The main focus is commands and cascades. Other menu entry types are also supported. (Although -menuitems, in Tk::Menu:Item, provides similar functionality +, building cascade menus can get very complicated. This tool simplifies that, as well as simple commands, while providing means to describe ot +her menu item types and full options for commands.) =head2 Defining Menu Systems A Menu System is defined, to this tool, by an array ref. The reference +d array is a an ordered set of name/value pairs. (Since hashes are unord +ered, they do not work for this.) Each pair is taken as an entry name and co +ntent. If the content specifier is a code ref, a commend entry is created wit +h the specified name and code ref. If the content specifier is an array ref, a cascade is created with th +e specified name and the array is processed into the associated submenu. Cascades may be nested to an arbitrary width and depth, limited only b +y the resources available. If the content specifier is a hash ref whose hash contains at least a -type key/value pair, a menu item of the specified name and type is created, via the add method of Tk::Menu, using the remaining pairs in +the hash as options. =cut use warnings; use strict; use Tk; use Tk::Menu; use Carp; our @stack = (); our $parent; =head2 Functions =for :Dox Create the widget tree for the menu. =cut sub BuildMenu { ## @params my ($menu, #< Reference of Tk::Menu widget in which to build the m +enu. $desc #< Reference of array containing menu description. ) = @_; ## @endparams $parent = $_[0]; _build($_[1]); } sub _build { my $r = $_[0]; return unless (ref($r) eq 'ARRAY'); my $name = undef; for (@$r) { if (defined $name) { if (ref eq 'ARRAY') { my $c = $parent->cascade(-label => $name); my $m = $parent->Menu(-tearoff=>0); $c->configure(-menu=>$m); push @stack, $parent; $parent = $m; _build($_); $parent = pop @stack; } elsif (ref eq 'CODE') { $parent->command(-label => $name, -command => $_); } elsif (ref eq 'HASH') { my $t = delete($_->{-type}); unless (defined $t) { carp "Menu parse error: Missing -type for $name\n" +; return; } $parent->add($t, -label => $name, %$_); } else { carp "Menu parse error: Missing ARRAY, CODE or HASH re +f. for $name\n"; return; } $name = undef; } else { if (ref ne '') { carp "Menu parse error: Ref where name expected.\n"; return; } unless (/\w+/) { carp "Menu parse error: empty item name.\n"; return; } $name = $_; } } } 1; =head1 CAVEATS This module is a tool, not a new widget. You supply it with a referenc +e to the menu widget to be populated. Additional menu widgets are created a +s needed. =head1 SEE ALSO C<Tk::Menu>, C<Tk::Menu:Item> =head1 AUTHOR RonW of =head1 COPYRIGHT Copyright 2013, RonW of All rights reserved. =head1 LICENSE This tool is open source software. You may redistribute it and/or modi +fy it under the same terms as Perl itself. =cut
#!perl -w use warnings; use strict; use Tk; use Tk::Menu; use Menu::Simple; my $checkbox; my $menuCfg = [ File => [ New => \&FileNew, Save => \&FileSave, Exit => \&FileExit, ], Options => [ Fancy => { -type => 'checkbutton', -variable => \$checkbox }, ], Help => [ Help => \&HelpHelp, About => \&HelpAbout, ], ]; my $mw = MainWindow->new(-title=>'Menu Builder Test'); my $menuBar = $mw->Menu(-tearoff=>0); $mw->configure(-menu=>$menuBar); Menu::Simple::BuildMenu($menuBar, $menuCfg); MainLoop; sub FileNew {} sub FileSave {} sub FileExit { Tk::exit; } sub HelpHelp {} sub HelpAbout {}

Replies are listed 'Best First'.
Re: RFC - early draft of Menu::Simple
by taint (Chaplain) on Jun 06, 2014 at 21:30 UTC
    ++ RonW. Thanks for sharing.

    A couple of things jump out at me, related to

    Warning: It currently uses the 'current_sub' feature, so a recent Perl is needed.
    Some might not already know how recent, is "recent".
    Others might assume, it must be in one of the require's. It's not. :)

    While I already know. Others might not. So I just thought [given this is an RFC] I'd bring it up. :)

    Thanks again, RonW.


    λɐp ʇɑəɹ⅁ ɐ əʌɐɥ puɐ ʻꜱdləɥ ꜱᴉɥʇ ədoH

      Thanks for your feedback. I will try to test with earlier versions (in part, by s/__SUB__->/_build/)
        Hint; available since 5.16
        use 5.16.0;

        See also: perlsub. But I know you already knew that. Just mentioning it here for completeness. :)

        Best wishes, and thanks again, RonW.


        UPDATE: I see you've updated to add a require. :)

        λɐp ʇɑəɹ⅁ ɐ əʌɐɥ puɐ ʻꜱdləɥ ꜱᴉɥʇ ədoH

Re: RFC - early draft of Menu::Simple
by RonW (Vicar) on Jul 02, 2014 at 16:16 UTC
    I've made some significant updates to the original post

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://1089076]
Approved by boftx
Front-paged by Arunbear
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2017-11-21 05:33 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (295 votes). Check out past polls.