home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CLIX - Fazer Clix Custa Nix
/
CLIX-CD.cdr
/
mac
/
lib
/
Mac
/
Menus.pm
< prev
next >
Wrap
Text File
|
1998-04-05
|
8KB
|
405 lines
=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 <neeri@iis.ee.ethz.ch>
=cut
1;
__END__