#!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
[download]

#!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 {}
[download]