CLIX - Fazer Clix Custa Nix/CLIX-CD.cdr/mac/lib/Mac/Menus.pm

Perl POD Document | 1998-04-05 | 7.7 KB | 405 lines | [TEXT/McPL]

=head1 NAME

Mac::Menus - Macintosh Toolbox Interface to Menu Manager

=head1 SYNOPSIS


=head1 DESCRIPTION

Access to Inside Macintosh is essential for proper use of these functions.
Explanations of terms, processes and procedures are provided there.
Any attempt to use these functions without guidance can cause severe errors in
your machine, including corruption of data. B<You have been warned.>

=cut

use strict;

package Mac::Menus;

BEGIN {
    use Exporter    ();
    use DynaLoader  ();
    use Mac::Events ();

    use vars qw(@ISA @EXPORT @EXPORT_OK %Menu);

    @ISA = qw(Exporter DynaLoader);
    @EXPORT = qw(
        GetMBarHeight
        NewMenu
        GetMenu
        DisposeMenu
        AppendMenu
        AppendResMenu
        InsertResMenu
        InsertMenu
        DrawMenuBar
        InvalMenuBar
        DeleteMenu
        ClearMenuBar
        GetNewMBar
        GetMenuBar
        SetMenuBar
        InsertMenuItem
        DeleteMenuItem
        HiliteMenu
        SetMenuItemText
        GetMenuItemText
        DisableItem
        EnableItem
        CheckItem
        SetItemMark
        GetItemMark
        SetItemIcon
        GetItemIcon
        SetItemStyle
        GetItemStyle
        CalcMenuSize
        CountMItems
        GetMenuHandle
        FlashMenuBar
        SetMenuFlash
        GetItemCmd
        SetItemCmd
        PopUpMenuSelect
        MenuChoice
        InsertFontResMenu
        InsertIntlResMenu

        noMark
        textMenuProc
        hMenuCmd
        hierMenu
    );

    @EXPORT_OK = qw(
        %Menu
    );
}
#
# _HandleMenu handles a menu selection
#
sub _HandleMenu {
    my($menuid, $item) = @_;
    my($handler);
    if ($handler = $Menu{sprintf("%04X", $menuid)}) {
        $handler->handle($menuid, $item);
    } elsif ($handler = $Menu{sprintf("%04X%04X", $menuid, $item)}) {
        &$handler($menuid, $item);
    }
}

#
# _PrepareMenus prepares all menus before a MenuSelect or MenuKey
#
sub _PrepareMenus {
    for my $menu (keys %Menu) {
        $Menu{$menu}->prepare if length($menu) == 4;
    }
}

my %MDEF;

#
# _MenuDefProc calls a custom MDEF
#
sub _MenuDefProc {
    my($item, $menu) = @_;
    my $mdef = $MDEF{$menu};

    &$mdef(@_) unless !defined $mdef;
}

package MenuHandle;

sub menuProc {
    my($menu, $proc) = @_;

    if (defined($proc)) {
        Mac::Menus::_SetMDEFProc($menu);
        $MDEF{$menu} = $proc;
    } else {
        $MDEF{$menu};
    }
}

package Mac::Menus;

bootstrap Mac::Menus;

=head2 Constants

=over 4

=item noMark

Don't mark this menu item.

=item textMenuProc

The standard menu definition procedure ID.

=item hierMenu

Insert as a hierarchical menu.

=back

=cut
sub noMark ()                      {          0; }
sub textMenuProc ()                {          0; }
sub hMenuCmd ()                    {    chr(27); }
sub hierMenu ()                    {         -1; }

=include Menus.xs

=item PopUpMenuSelect MENU, TOP, LEFT, POPITEM;

=cut
sub PopUpMenuSelect {
    &_HandleMenu(&_PopUpMenuSelect);
}

=item MenuChoice()

=cut
sub MenuChoice {
    &_HandleMenu(&_MenuChoice);
}

sub DisposeMenu {
    my($menu) = @_;
    delete $MDEF{$menu};
    _DisposeMenu($menu);
}

=back

=cut

=head2 MacMenu - The Object Interface

The C<MacMenu> class provides a convenient way of handling menus.

=over 4

=cut

package MacMenu;

BEGIN {
    use Carp;
    use Mac::Hooks ();
    import Mac::Menus;
    import Mac::Menus qw(%Menu);

    use vars qw(@ISA);

    @ISA = qw(Mac::Hooks);
}

=item new MacMenu ID, TITLE [, HANDLER] [, ITEMS]

=item new MacMenu MENU [, HANDLER] [, ITEMS]

Create a new C<MacMenu> and optionally install a default handler and items.

=cut
sub new {
    my($class, $id) = @_;

    if (ref($id) eq "MenuHandle") { # Existing menu
        my($class, $menu, $handler) = @_;
        splice(@_, 0, 3);
        if (ref($handler) eq "ARRAY") {
            unshift @_, $handler;
            $handler = "";
        }
        my($ident) = sprintf("%04X", $id = $menu->menuID);
        my(%my) =
            (   id      => $id,
                ident   => $ident,
                inserted=> 0,
                menu    => $menu,
                items   => [$handler]
            );
        my($me) = bless \%my, $class;
        $Menu{$ident} = $me;
        for (@_) {
            push @{$me->{items}}, ${$_}[0];
        }
        $me;
    } else {
        my($class, $id, $title, $handler) = @_;
        splice(@_, 0, 4);
        if (ref($handler) eq "ARRAY") {
            unshift @_, $handler;
            $handler = "";
        }
        my($ident) = sprintf("%04X", $id);
        my($menu) = NewMenu($id, $title) or croak "NewMenu failed";
        my(%my) =
            (   id      => $id,
                ident   => $ident,
                inserted=> 0,
                menu    => $menu,
                items   => [$handler]
            );
        my($me) = bless \%my, $class;
        $Menu{$ident} = $me;
        for (@_) {
            if (scalar(@{$_})) {
                $me->add_item(@{$_});
            } else {
                $me->add_separator;
            }
        }
        $me;
    }
}

=item dispose

Unregisters and disposes the menu.

=cut
sub dispose {
    my($my) = @_;
    return unless $my->{menu};
    defined($_[0]->callhook("dispose", @_)) and return;
    $my->delete;
    delete $Mac::Menus::Menu{$my->{ident}};
    DisposeMenu($my->{menu});
    $my->{menu} = "";
}

sub DESTROY {
    my($my) = @_;
    $my->dispose;
}

=item handle MENUID, ITEM

Item handle an item selection.

=cut
sub handle {
    my($handled);
    defined($handled = $_[0]->callhook("handle", @_)) and return $handled;
    my($my,$menuid,$item) = @_;
    my($handler) = $my->{items}[$item] || $my->{items}[0];
    $handler or return 0;
    &$handler($menuid, $item);
    1;
}

=item prepare

Prepare menu before MenuSelect or MenuKey.

=cut
sub prepare {
    defined($_[0]->callhook("prepare", @_)) and return;
}

=item insert [BEFORE]

Insert menu in menubar.

=cut
sub insert {
    return if $_[0]->{inserted};
    defined($_[0]->callhook("insert", @_)) and return;
    my($my) = shift;
    InsertMenu($my->{menu}, @_) ;
    $my->{inserted} = 1;
    InvalMenuBar();
}

=item delete

Delete menu from menubar.

=cut
sub delete {
    return unless $_[0]->{inserted};
    defined($_[0]->callhook("delete", @_)) and return;
    my($my) = @_;
    DeleteMenu($my->{id});
    $my->{inserted} = 0;
    InvalMenuBar();
}

=item ITEM = add_item TEXT, HANDLER, [, KEY [, MARK [, ICON]]]

Add an item.

=cut
sub add_item {
    defined($_[0]->callhook("add_item", @_)) and return;
    my($my, $text, $handler, $key, $mark, $icon) = @_;
    my($item) = scalar(@{$my->{items}});
    push @{$my->{items}}, $handler;
    AppendMenu($my->{menu}, "-");
    SetMenuItemText($my->{menu}, $item, $text);
    SetItemCmd($my->{menu}, $item, $key)        if defined($key);
    SetItemMark($my->{menu}, $item, $mark)      if defined($mark);
    SetItemIcon($my->{menu}, $item, $icon)      if defined($icon);
    $item;
}

=item ITEM = add_separator

Add an separator line.

=cut
sub add_separator {
    defined($_[0]->callhook("add_separator", @_)) and return;
    my($my) = @_;
    my($item) = scalar(@{$my->{items}});
    push @{$my->{items}}, "";
    AppendMenu($my->{menu}, "-(");
    $item;
}

=head2 MacHierMenu - The Object Interface to hierarchical menus.

The C<MacHierMenu> class provides a convenient way of handling hierarchical menus.
everything works identically to C<MacMenu>, except that C<insert> always inserts
hierachically.

=over 4

=cut
package MacHierMenu;

BEGIN {
    import Mac::Menus;

    use vars qw(@ISA);

    @ISA = qw(MacMenu);
}

sub insert {
    my($my) = @_;
    MacMenu::insert($my, &hierMenu);
}

=head1 BUGS/LIMITATIONS

=head1 FILES

=head1 AUTHOR(S)

Matthias Ulrich Neeracher <[e-mail]>

=cut

1;

__END__