RFC - early draft of Menu::Simple

[RonW]

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 perlmonks.org

=head1 COPYRIGHT

Copyright 2013, RonW of perlmonks.org. 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 {}

[taint]

++ 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.

--Chris

[RonW]

Thanks for your feedback. I will try to test with earlier versions (in part, by s/__SUB__->/_build/)

[taint]

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.

--Chris

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

[Anonymous Monk]

Testing really isn't required :) __SUB__ is all about anonymous subroutines and closures -- you've got a named sub, use its name , its what its for :) Use __SUB__ to get a reference to the current subroutine | The Effective Perler

[RonW]

I've made some significant updates to the original post