home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CLIX - Fazer Clix Custa Nix
/
CLIX-CD.cdr
/
mac
/
lib
/
Mac
/
Dialogs.pm
< prev
next >
Wrap
Text File
|
1998-04-13
|
19KB
|
855 lines
=head1 NAME
Mac::Dialogs - Macintosh Toolbox Interface to Dialog 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::Dialogs;
BEGIN {
use Exporter ();
use DynaLoader ();
use Carp;
use Mac::Events;
use Mac::Events qw(DispatchEvent $CurrentEvent @SavedEvents @Event);
use Mac::Windows;
use Mac::Controls qw(HiliteControl GetControlValue SetControlValue);
use vars qw(@ISA @EXPORT @EXPORT_OK %Dialog %DialogUserItem);
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(
NewDialog
GetNewDialog
DisposeDialog
ParamText
ModalDialog
IsDialogEvent
DialogSelect
DrawDialog
UpdateDialog
Alert
StopAlert
NoteAlert
CautionAlert
GetDialogItem
GetDialogItemControl
SetDialogItem
SetDialogItemProc
HideDialogItem
ShowDialogItem
SelectDialogItemText
GetDialogItemText
SetDialogItemText
FindDialogItem
NewColorDialog
GetAlertStage
ResetAlertStage
DialogCut
DialogPaste
DialogCopy
DialogDelete
SetDialogFont
AppendDITL
CountDITL
ShortenDITL
StdFilterProc
SetDialogDefaultItem
SetDialogCancelItem
SetDialogTracksCursor
kControlDialogItem
kButtonDialogItem
kCheckBoxDialogItem
kRadioButtonDialogItem
kResourceControlDialogItem
kStaticTextDialogItem
kEditTextDialogItem
kIconDialogItem
kPictureDialogItem
kUserDialogItem
kItemDisableBit
kStdOkItemIndex
kStdCancelItemIndex
kStopIcon
kNoteIcon
kCautionIcon
kOkItemIndex
kCancelItemIndex
overlayDITL
appendDITLRight
appendDITLBottom
);
@EXPORT_OK = qw(
%Dialog
%DialogUserItem
);
}
=head2 Constants
=item kControlDialogItem
=item kButtonDialogItem
=item kCheckBoxDialogItem
=item kRadioButtonDialogItem
=item kResourceControlDialogItem
=item kStaticTextDialogItem
=item kEditTextDialogItem
=item kIconDialogItem
=item kPictureDialogItem
=item kUserDialogItem
=item kItemDisableBit
Dialog item types.
=cut
sub kControlDialogItem () { 4; }
sub kButtonDialogItem () { 4; }
sub kCheckBoxDialogItem () { 5; }
sub kRadioButtonDialogItem () { 6; }
sub kResourceControlDialogItem () { 7; }
sub kStaticTextDialogItem () { 8; }
sub kEditTextDialogItem () { 16; }
sub kIconDialogItem () { 32; }
sub kPictureDialogItem () { 64; }
sub kUserDialogItem () { 0; }
sub kItemDisableBit () { 128; }
=item kStopIcon
=item kNoteIcon
=item kCautionIcon
Standard icons.
=cut
sub kStopIcon () { 0; }
sub kNoteIcon () { 1; }
sub kCautionIcon () { 2; }
=item kStdOkItemIndex
=item kStdCancelItemIndex
Standard button numbers.
=cut
sub kStdOkItemIndex () { 1; }
sub kStdCancelItemIndex () { 2; }
=item overlayDITL
=item appendDITLRight
=item appendDITLBottom
Options for C<AppendDITL>.
=cut
sub overlayDITL () { 0; }
sub appendDITLRight () { 1; }
sub appendDITLBottom () { 2; }
=back
=cut
#
# _ModalFilter - call a modal filter procedure
#
sub _ModalFilter {
no strict qw(refs);
my($proc, $dialog, $event) = @_;
push @SavedEvents, $CurrentEvent;
$CurrentEvent = $event;
my($res) = &$proc($dialog, $event);
$CurrentEvent = pop @SavedEvents;
$res;
}
#
# _DefaultModalFilter - simply do the right thing; handle nonlocal updates, drags,
# zooms, grows & the like.
#
sub _DefaultModalFilter {
my($dialog, $ev) = @_;
if ($ev->what == updateEvt && ${$ev->window} != $$dialog) {
DispatchEvent $ev;
$ev->what(nullEvent);
return 0;
} elsif ($ev->what == mouseDown) {
my($code,$win) = FindWindow($ev->where);
if ($win && $$win == $$dialog && $code != inContent) {
DispatchEvent $ev;
$ev->what(nullEvent);
return 0;
}
}
StdFilterProc($dialog, $ev);
}
#
# _UserItem - draw an user item
#
sub _UserItem {
my($dialog, $item) = @_;
my($proc) = $DialogUserItem{$$dialog}->[$item-1];
$proc and &$proc($dialog, $item);
}
bootstrap Mac::Dialogs;
=include Dialogs.xs
=cut
#
# The dialog creation procedures can take a WDEF written in Perl, but to
# concentrate that code in one place, we'll redirect that option to
# Mac::Windows.
#
sub NewDialog {
my($bounds, $visible, $title, $proc) = @_;
if (!ref($proc) && (!$proc || $proc != 0)) {
_NewDialog(@_); # Numeric WDEF
} else {
my $dlg = _NewDialog($bounds, 0, $title, zoomDocProc, @_[4..$#_]);
$dlg->windowDefProc($proc);
ShowWindow($dlg) if ($visible);
$dlg;
}
}
sub NewColorDialog {
my($bounds, $visible, $title, $proc) = @_;
if (!ref($proc) && (!$proc || $proc != 0)) {
_NewColorDialog(@_); # Numeric WDEF
} else {
my $dlg = _NewColorDialog($bounds, 0, $title, zoomDocProc, @_[4..$#_]);
$dlg->windowDefProc($proc);
ShowWindow($dlg) if ($visible);
$dlg;
}
}
=item TEXT = GetDialogItemText DIALOG, ITEM
=item TEXT = GetDialogItemText ITEMHANDLE
Returns the text of a dialog item.
=cut
sub GetDialogItemText {
my($variant) = @_;
my($itemhandle,$dialog,$item);
if (ref($variant) eq "GrafPtr") {
($dialog,$item) = @_;
$itemhandle = (GetDialogItem($dialog, $item))[1];
} else {
$itemhandle = @_;
}
_GetDialogItemText($itemhandle);
}
=item SetDialogItemText DIALOG, ITEM, TEXT
=item SetDialogItemText ITEMHANDLE, TEXT
Sets the text of a dialog item.
=cut
sub SetDialogItemText {
my($variant) = @_;
my($itemhandle,$dialog,$item,$text);
if (ref($variant) eq "GrafPtr") {
($dialog,$item,$text) = @_;
$itemhandle = (GetDialogItem($dialog, $item))[1];
} else {
($itemhandle, $text) = @_;
}
_SetDialogItemText($itemhandle, $text);
}
=item SetDialogItemProc DIALOG, ITEM, PROC
Set up a drawing procedure for a dialog item.
=cut
sub SetDialogItemProc {
my($dialog, $item, $proc) = @_;
$DialogUserItem{$$dialog}->[$item-1] = $proc;
_SetDialogItemProc($dialog, $item);
}
=item PROC = GetDialogItemProc DIALOG, ITEM
Returns the drawing procedure for a dialog item.
=cut
sub GetDialogItemProc {
my($dialog, $item) = @_;
$DialogUserItem{$$dialog}->[$item-1];
}
=item DisposeDialog DIALOG
Delete the dialog.
=cut
sub DisposeDialog {
my($dialog) = @_;
delete $DialogUserItem{$$dialog};
_DisposeDialog($dialog);
}
=back
=head2 MacDialog - The Object Interface
Correctly handling a Mac dialog requires quite a bit of event management. The
C<MacDialog> class relieves you of most of these duties.
=over 4
=cut
package MacDialog;
BEGIN {
use Mac::Windows qw(%Window);
import Mac::Dialogs;
import Mac::Dialogs qw(%Dialog %DialogUserItem);
use Mac::Events qw($CurrentEvent);
use Mac::Controls qw(HiliteControl GetControlValue SetControlValue);
use Carp;
use vars qw(@ISA);
@ISA = qw(MacWindow);
}
=item new MacDialog PORT
=item new MacDialog ID [, BEHIND]
=item new MacDialog BOUNDS, TITLE, VISIBLE, PROC, GOAWAY, ITEMS, [, REFCON [, BEHIND]]
=item new MacDialog BOUNDS, TITLE, VISIBLE, PROC, GOAWAY, ITEMLIST, [, REFCON [, BEHIND]]
Register a new dialog. In the first form, registers an existing dialog. In the
second form, calls C<GetNewDialog>. In the third form, calls C<NewDialog>. In
the fourth form, takes items as a dialogitemlist.
=cut
sub new {
my($class) = shift @_;
my($type) = @_;
my($port);
if (ref($type) eq "Rect") {
if (ref($_[5]) eq "ARRAY") { # Item list
my @items = splice(@_, 5);
my @rest;
while (ref($items[$#items]) ne "ARRAY") {
unshift @rest, shift(@items);
}
push @_, (new MacDialogItems @items)->get, @rest;
}
$port = NewDialog(@_) or croak "NewDialog failed";
} elsif (!ref($type)) {
$port = GetNewDialog(@_) or croak "GetNewDialog failed";
} else {
$port = $type;
}
my($my) = MacWindow::new($class, $port);
$Dialog{$$port} = $my;
}
=item dispose
Unregisters and disposes the dialog.
=cut
sub dispose {
my($my) = @_;
return unless $my->{port};
defined($_[0]->callhook("dispose", @_)) and return;
delete $Window{${$my->{port}}};
delete $Dialog{${$my->{port}}};
DisposeDialog($my->{port});
$my->{port} = "";
}
sub _dialogselect {
my($my) = @_;
my($event) = $CurrentEvent;
$event && IsDialogEvent($event) or return 0;
my($itemhit) = StdFilterProc($my->{port}, $event);
unless ($itemhit) {
my($dialog);
($dialog, $itemhit) = DialogSelect($event);
croak("Weirdness in DialogSelect")
if $itemhit && $$dialog != ${$my->{port}};
}
$my->hit($itemhit) if $itemhit;
1;
}
=item activate ACTIVE, SUSPEND
Handle activation of the window, which is already set to the current port.
By default doesn't do anything. Override as necessary.
The parameters distinguish the four cases:
Event ACTIVE SUSPEND
Activate 1 0
Deactivate 0 0
Suspend 0 1
Resume 1 1
=cut
sub activate {
defined($_[0]->callhook("activate", @_)) and return;
_dialogselect(@_);
}
=item update
Handle update events.
=cut
sub update {
defined($_[0]->callhook("update", @_)) and return;
_dialogselect(@_);
}
=item key KEY
Handle a keypress and return 1 if the key was handled.
=cut
sub key {
my($handled);
defined($handled = $_[0]->callhook("key", @_)) and return $handled;
_dialogselect(@_);
}
=item click PT
Handle a mouse click and return 1 if the click was handled.
=cut
sub click {
my($handled);
defined($handled = $_[0]->callhook("click", @_)) and return 1;
_dialogselect(@_);
}
=item modal [FILTER]
Run dialog modally.
=cut
sub modal {
$_[0]->callhook("modal", @_) and return;
my($my) = shift @_;
my($itemhit) = ModalDialog(@_);
$my->hit($itemhit) if $itemhit;
}
=item hit ITEM
Handle a "hit" of an enabled item. Usually dispatches to hook.
=cut
sub hit {
$_[0]->callhook("hit", @_) and return;
my($my, $itemhit) = @_;
my($proc) = $my->{items}->[$itemhit-1];
&$proc($my, $itemhit) if $proc;
}
=item idle
Handle idle (null) events.
=cut
sub idle {
#
# MacPerl 5.1.9r4 and earlier failed to propagate null events, so
# we'll make mouse moved events honorary null events (luckily these
# versions also generated too many mouse moved events :-)
#
my($savedwhat) = $CurrentEvent->what;
$CurrentEvent->what(0);
&_dialogselect;
$CurrentEvent->what($savedwhat);
&MacWindow::idle;
}
=item KIND = item_kind ITEM
=item item_kind ITEM, KIND
Get/Set item kind.
=cut
sub item_kind {
my($my, $item, $kind) = @_;
my($ikind,$ihandle,$ibox) = GetDialogItem($my->{port}, $item);
defined($kind) ?
SetDialogItem($my->{port}, $item, $kind, $ihandle, $ibox)
: $ikind;
}
=item item_handle ITEM
=item item_handle ITEM, HANDLE
Get/Set item handle.
=cut
sub item_handle {
my($my, $item, $handle) = @_;
my($ikind,$ihandle,$ibox) = GetDialogItem($my->{port}, $item);
defined($handle) ?
SetDialogItem($my->{port}, $item, $ikind, $handle, $ibox)
: $ihandle;
}
=item item_control ITEM
Get item control (You should never have a reason to set it).
=cut
sub item_control {
my($my, $item) = @_;
GetDialogItemControl($my->{port}, $item);
}
=item item_box ITEM
=item item_box ITEM, BOX
Get/Set item boundaries.
=cut
sub item_box {
my($my, $item, $box) = @_;
my($ikind,$ihandle,$ibox) = GetDialogItem($my->{port}, $item);
defined($box) ?
SetDialogItem($my->{port}, $item, $ikind, $ihandle, $box)
: $ibox;
}
=item item_draw ITEM
=item item_draw ITEM, PROC
Get/Set procedure to draw item.
=cut
sub item_draw {
my($my, $item, $proc) = @_;
defined($proc) ?
SetDialogItemProc($my->{port}, $item, $proc)
: GetDialogItemProc($my->{port}, $item);
}
=item TEXT = item_text ITEM
=item item_text ITEM, TEXT
Get/Set text of dialog item.
=cut
sub item_text {
my($my, $item, $text) = @_;
defined($text) ?
SetDialogItemText($my->{port}, $item, $text)
: GetDialogItemText($my->{port}, $item);
}
=item item_hit ITEM
=item item_hit ITEM, PROC
Get/Set handler for item hit.
=cut
sub item_hit {
my($my, $item, $proc) = @_;
defined($proc) ?
($my->{items}->[$item-1] = $proc)
: $my->{items}->[$item-1];
}
=item item_hilite ITEM, HILITE
Set item hilite value.
=cut
sub item_hilite {
my($my, $item, $value) = @_;
HiliteControl($my->item_control($item), $value);
}
=item item_value ITEM
=item item_value ITEM, PROC
Get/Set control value for item.
=cut
sub item_value {
my($my, $item, $value) = @_;
defined($value) ?
SetControlValue($my->item_control($item), $value) :
GetControlValue($my->item_control($item));
}
=back
=head2 MacColorDialog - The Object Interface
A C<MacColorDialog> is a colorful version of a C<MacDialog>.
=over 4
=cut
package MacColorDialog;
BEGIN {
import Mac::Dialogs;
use Carp;
}
=item new MacColorDialog PORT
=item new MacColorDialog ID [, BEHIND]
=item new MacColorDialog BOUNDS, TITLE, VISIBLE, PROC, GOAWAY, ITEMS, [, REFCON [, BEHIND]]
=item new MacColorDialog BOUNDS, TITLE, VISIBLE, PROC, GOAWAY, ITEMLIST, [, REFCON [, BEHIND]]
Register a new color dialog. The first two forms are just forwarded to MacDialog,
the third and fourth forms create actual color dialogs.
=cut
sub new {
my($class) = shift @_;
my($type) = @_;
my($port);
if (ref($type) eq "Rect") {
if (ref($_[5]) eq "ARRAY") { # Item list
my @items = splice(@_, 5);
my @rest;
while (ref($items[$#items]) ne "ARRAY") {
unshift @rest, shift(@items);
}
push @_, (new MacDialogItems @items)->get, @rest;
}
$port = NewColorDialog(@_) or croak "NewColorDialog failed";
} elsif (!ref($type)) {
$port = GetNewDialog(@_) or croak "GetNewDialog failed";
} else {
$port = $type;
}
new MacDialog $port;
}
=back
=head2 MacDialogItems - Handle a dialog item list
The C<MacDialogItems> class is a wrapper for dialog item lists.
=over 4
=cut
package MacDialogItems;
BEGIN {
use Mac::Memory ();
import Mac::Dialogs;
}
=item new MacDialogItems
=item new MacDialogItems HANDLE
=item new MacDialogItems ITEMLIST
Construct a dialog item list; either an empty one, one derived from an existing
item list, or one constructed from a list of array references.
=cut
sub new {
my($class) = shift @_;
my($type) = @_;
my($my) = bless [], $class;
if (ref($type) eq "Handle") { # Construct from existing item list
my($data) = $type->get;
my($count,$length) = unpack("s", $data);
$data = substr($data, 2);
while ($count-- >= 0) {
($type,$length) = unpack("CC", substr($data, 12, 2));
$type &= 127;
if ($type == kUserDialogItem) {
$length = 14;
} elsif ($type == 1) { # Help items
$length += 14;
} elsif ($type == kResourceControlDialogItem || $type >= kIconDialogItem) {
$length = 16;
} else {
$length += 14 + ($length & 1);
}
push @$my, substr($data, 0, $length);
$data = substr($data, $length);
}
} else {
for (@_) {
$my->add_item(@$_);
}
}
$my;
}
=item add_item TYPE, ...
Add another dialog item.
=cut
sub add_item {
my($my,$type) = splice(@_, 0, 2);
my($kind) = $type & 127;
if ($type == kUserDialogItem) {
my($r) = @_;
push @$my, pack("x4 a8 C x", $$r, $type);
} elsif ($type == 1) { # Help items
my($htype,$id,$item) = @_;
if ($htype == 8) {
push @$my, pack("x4 x8 C C s s s", $type, 6, $htype, $id, $item);
} else {
push @$my, pack("x4 x8 C C s s", $type, 4, $htype, $id);
}
} elsif ($type == kResourceControlDialogItem || $type >= kIconDialogItem) {
my($r, $id) = @_;
push @$my, pack("x4 a8 C x s", $$r, $id);
} else {
my($r, $text) = @_;
my($len) = length($text);
$len += $len&1;
push @$my, pack("x4 a8 C C a$len", $$r, $type, length($text), $text);
}
}
=item (TYPE, ...) = get_item ITEM
=cut
sub get_item {
my($my, $item) = @_;
return () unless $item = $$my[$item];
my($type) = unpack("C", substr($item, 12, 1));
$type &= 127;
if ($type == kUserDialogItem) {
my($r,$type) = unpack("x4 a8 C x", $item);
return ($type, bless($r, "Rect"));
} elsif ($type == 1) { # Help items
my($type,$htype,$id,$item) = unpack("x4 x8 C x s s s", $item);
if ($htype == 8) {
return ($type, $htype, $id, $item);
} else {
return ($type, $htype, $id);
}
} elsif ($type == kResourceControlDialogItem || $type >= kIconDialogItem) {
my($r, $type, $id) = unpack("x4 a8 C x s", $item);
return ($type, bless($r, "Rect"), $id);
} else {
my($r, $type, $len) = unpack("x4 a8 C C", $item);
my($text) = substr($item, 14, $len);
return ($type, bless($r, "Rect"), $text);
}
}
=item HANDLE = get
Get dialog item list handle.
=cut
sub get {
my($my) = @_;
new Handle(pack("s", scalar(@$my)-1) . join("", @$my));
}
=back
=head1 BUGS/LIMITATIONS
=head1 FILES
=head1 AUTHOR(S)
Matthias Ulrich Neeracher <neeri@iis.ee.ethz.ch>
=cut
1;
__END__