home *** CD-ROM | disk | FTP | other *** search
- /*********************************************************************
- File : macperl.c - Mac specific extensions
- Author : Matthias Neeracher & Tim Endres
- Started : 28May91 Language : MPW C
- 31Oct93 MN XCMDs
- 05Dec93 MN Faccess
- Last : 05Dec93
-
- Copyright (c) 1991-93 Matthias Neeracher & Tim Endres
- *********************************************************************/
-
- #include <Types.h>
- #include <Resources.h>
- #include <QuickDraw.h>
- #include <Fonts.h>
- #include <Menus.h>
- #include <TextEdit.h>
- #include <Dialogs.h>
- #include <SegLoad.h>
- #include <StandardFile.h>
- #include <Lists.h>
- #include <Files.h>
- #include <Memory.h>
- #include <TFileSpec.h>
- #include <Components.h>
- #include <AppleEvents.h>
- #include <OSA.h>
- #include <AppleScript.h>
- #include <AERegistry.h>
- #include <AESubDescs.h>
- #include <OSUtils.h>
- #include <HyperXCmd.h>
- #include <Gestalt.h>
- #define XLDEBUG
- #include <XL.h>
- #include <TextUtils.h>
- #include <FCntl.h>
-
- /* Ugly hack since QuickDraw defines another invert */
- #define RESOLVE_MAC_CONFLICTS
-
- #include "EXTERN.h"
- #include "perl.h"
-
- void InitToolbox()
- {
- InitGraf((Ptr) &qd.thePort);
- }
-
- static int macperlsub();
- static int macperlset();
- static int macperlval();
- static int doapscript();
- static int xlsub();
- static void loadresfile();
- static void PerlXLGetGlobal(XCmdPtr params);
- static void PerlXLSetGlobal(XCmdPtr params);
-
- enum {
- MP_fsetfileinfo,
- MP_fgetfileinfo,
- MP_ask,
- MP_answer,
- MP_choose,
- MP_pick,
- MP_quit,
- MP_faccess,
- MP_makefsspec,
- MP_makepath,
- MP_volumes,
-
- MP_doapplescript = 0,
- MP_reply,
-
- MP_loadexternals = 0,
- MP_debugexternals = 1,
- MP_extension = 2
- };
-
- enum {
- MV_version
- };
-
- void ShutdownAppleEvents(void)
- {
- }
-
- Boolean hasAppleEvents;
- Boolean hasComponents;
- XLGlue XLPerlGlue;
-
- int
- macperlinit()
- {
- struct ufuncs uf;
- long res;
- int saveallstabs = allstabs;
-
- allstabs = TRUE;
- gPerlQuit = 0;
-
- make_usub("MacPerl'SetFileInfo", MP_fsetfileinfo, macperlsub, "macperl.c");
- make_usub("MacPerl'GetFileInfo", MP_fgetfileinfo, macperlsub, "macperl.c");
- make_usub("MacPerl'Ask", MP_ask, macperlsub, "macperl.c");
- make_usub("MacPerl'Answer", MP_answer, macperlsub, "macperl.c");
- make_usub("MacPerl'Choose", MP_choose, macperlsub, "macperl.c");
- make_usub("MacPerl'Pick", MP_pick, macperlsub, "macperl.c");
- make_usub("MacPerl'Quit", MP_quit, macperlsub, "macperl.c");
- make_usub("MacPerl'FAccess", MP_faccess, macperlsub, "macperl.c");
- make_usub("MacPerl'MakeFSSpec", MP_makefsspec, macperlsub, "macperl.c");
- make_usub("MacPerl'MakePath", MP_makepath, macperlsub, "macperl.c");
- make_usub("MacPerl'Volumes", MP_volumes, macperlsub, "macperl.c");
-
- make_usub("MacPerl'DoAppleScript", MP_doapplescript, doapscript, "macperl.c");
- make_usub("MacPerl'Reply", MP_reply, doapscript, "macperl.c");
-
- make_usub("MacPerl'LoadExternals", MP_loadexternals, xlsub, "macperl.c");
- make_usub("MacPerl'DebugExternals", MP_debugexternals, xlsub, "macperl.c");
-
- uf.uf_set = macperlset;
- uf.uf_val = macperlval;
- uf.uf_index = MV_version;
- magicname("MacPerl'Version", (char *)&uf, sizeof uf);
-
- loadresfile(gAppFile);
-
- if (gPrefsFile)
- loadresfile(gPrefsFile);
-
- if (Gestalt(gestaltAppleEventsAttr, &res))
- hasAppleEvents = false;
- else
- hasAppleEvents = (res & (1<<gestaltAppleEventsPresent)) != 0;
-
- hasComponents = !Gestalt(gestaltComponentMgr, &res);
-
- allstabs = saveallstabs;
-
- XLCopyGlue(XLPerlGlue, XLDefaultGlue);
-
- XLPerlGlue[xl_GetGlobal] = PerlXLGetGlobal;
- XLPerlGlue[xl_SetGlobal] = PerlXLSetGlobal;
-
- return 0;
- }
-
- static void PerlXLGetGlobal(XCmdPtr params)
- {
- StringPtr var = (StringPtr) params->inArgs[0];
- char ch = 0;
- STAB * stab;
- STR * str;
- STRLEN len;
-
- if (stab = stabent(p2cstr(var), allstabs)) {
- str = stab_val(stab);
- len = str_len(str);
- PtrToHand(str_get(str), (Handle *) ¶ms->outArgs[0], len+1);
- (*(Handle) params->outArgs[0])[len] = 0;
- } else
- PtrToHand(&ch, (Handle *) ¶ms->outArgs[0], 1);
-
- c2pstr((char *) var);
-
- params->result = xresSucc;
- }
-
- static void PerlXLSetGlobal(XCmdPtr params)
- {
- StringPtr var = (StringPtr) params->inArgs[0];
- Handle val = (Handle) params->inArgs[1];
- char ch = 0;
- STAB * stab;
- STRLEN len;
-
- HLock(val);
- if (stab = stabent(p2cstr(var), allstabs))
- str_set(stab_val(stab), *val);
- c2pstr((char *) var);
- HUnlock(val);
-
- params->result = xresSucc;
- }
-
- typedef struct {
- short refNum;
- FSSpec file;
- } ResourceFile;
-
- typedef struct {
- short count;
- ResourceFile file[1];
- } ** ResourceFiles;
-
- typedef struct {
- short refNum;
- ResType type;
- short id;
- } Xternal, ** XternalHdl;
-
- static ResourceFiles ResFiles;
- static XternalHdl Xternals;
- static int XternalIndex = 0;
- static Boolean CloseInstalled = false;
-
- void CloseResFiles(void)
- {
- if (ResFiles) {
- while ((*ResFiles)->count--)
- CloseResFile((*ResFiles)->file[(*ResFiles)->count].refNum);
-
- DisposeHandle((Handle) ResFiles);
-
- ResFiles = nil;
- }
-
- if (Xternals) {
- DisposeHandle((Handle) Xternals);
-
- Xternals = nil;
- }
-
- XternalIndex = 0;
- CloseInstalled = false;
- }
-
- static ResType SearchTypes[] = {'XCMD', 'XFCN', 0};
-
- static void loadresfile(short refNum)
- {
- Handle xcmd;
- ResType * type;
- short count;
- short id;
- ResType rtyp;
- short oldRes = CurResFile();
- Xternal x;
- char name[256];
- int saveallstabs = allstabs;
- allstabs = TRUE;
-
- if (!CloseInstalled) {
- atexit(CloseResFiles);
- CloseInstalled = true;
- }
-
- if (!Xternals)
- Xternals = (XternalHdl) NewHandle(0);
-
- UseResFile(refNum);
-
- for (type = SearchTypes; *type; ++type)
- for (count = Count1Resources(*type); count; --count)
- if (xcmd = Get1IndResource(*type, count)) {
- getresinfo(xcmd, &id, &rtyp, name);
-
- x.refNum = refNum;
- x.type = rtyp;
- x.id = id;
-
- PtrAndHand((Ptr) &x, (Handle) Xternals, sizeof(Xternal));
-
- make_usub(name, MP_extension + XternalIndex++, xlsub, "macperl.c");
- }
-
- UseResFile(oldRes);
- allstabs = saveallstabs;
- }
-
- OSErr tryresload(FSSpec * spec)
- {
- short i;
- short refNum;
- ResourceFile file;
-
- if (!ResFiles) {
- i = 0;
-
- PtrToHand((Ptr) &i, (Handle *) &ResFiles, sizeof(short));
- }
-
- for (i = (*ResFiles)->count; i--; ) {
- ResourceFile * file = (*ResFiles)->file + i;
-
- if (file->file.vRefNum != spec->vRefNum)
- continue;
- if (file->file.parID != spec->parID)
- continue;
-
- if (EqualString(file->file.name, spec->name, false, true))
- return 0;
- }
-
- refNum = HOpenResFile(spec->vRefNum, spec->parID, spec->name, fsRdPerm);
-
- if (refNum == -1)
- return ResError();
-
- file.refNum = refNum;
- file.file = *spec;
-
- PtrAndHand((Ptr) &file, (Handle) ResFiles, sizeof(ResourceFile));
- ++(*ResFiles)->count;
-
- loadresfile(refNum);
-
- return 0;
- }
-
- OSErr loadresinclude(char * path)
- {
- int i;
- ARRAY * ar;
- char buf[256];
- FSSpec spec;
-
- if (strchr(path, ':'))
- if (!Path2FSSpec(path, &spec))
- return tryresload(&spec);
- else
- return 1;
-
- ar = stab_array(incstab);
- for (i = 0; i <= ar->ary_fill; i++) {
- char *macptr = str_get(afetch(ar,i,TRUE));
- int colon = macptr[strlen(macptr)-1] == ':';
-
- if (colon)
- (void) sprintf(buf, "%s%s", macptr, path);
- else
- (void) sprintf(buf, "%s:%s", macptr, path);
-
- if (!Path2FSSpec(buf, &spec) && !tryresload(&spec))
- return 0;
- }
-
- return 1;
- }
-
- static void xlsetupparams(STR ** st, int items, XCmdPtr xcmd)
- {
- int i;
- STR *Str; /* used in str_get and str_gnum macros */
-
- xcmd->paramCount = items;
- for (i = 0; i < items; ++i) {
- char * arg = str_get(st[i+1]);
-
- PtrToHand(arg, xcmd->params+i, strlen(arg)+1);
- }
-
- for (i = items; i < 16; ++i)
- xcmd->params[i] = nil;
-
- xcmd->returnValue = nil;
- xcmd->passFlag = 0;
- }
-
- static void xldisposeparams(STR ** st, int items, XCmdPtr xcmd)
- {
- int i;
-
- for (i=0; i<16; ++i)
- if (xcmd->params[i])
- DisposeHandle(xcmd->params[i]);
-
- if (xcmd->returnValue) {
- HLock(xcmd->returnValue);
- st[0] = str_2mortal(str_make(*xcmd->returnValue, 0));
- DisposeHandle(xcmd->returnValue);
- } else
- st[0] = &str_undef;
- }
-
- static int
- xlcall(ix, sp, items)
- int ix;
- int sp;
- int items;
- {
- STR **st = stack->ary_array + sp;
- short resFile;
- struct XCmdBlock xcmd;
- Xternal xt;
- Handle xh;
-
- xlsetupparams(st, items, &xcmd);
-
- xt = (*Xternals)[ix-MP_extension];
-
- resFile = CurResFile();
- UseResFile(xt.refNum);
-
- xh = Get1Resource(xt.type, xt.id);
-
- if (!xh)
- fatal("XCMD disppeared. Film at 11!");
-
- XLCall(xh, XLPerlGlue, &xcmd);
-
- UseResFile(resFile);
-
- xldisposeparams(st, items, &xcmd);
-
- return sp;
- }
-
- static int
- xlsub(ix, sp, items)
- int ix;
- int sp;
- int items;
- {
- STR **st = stack->ary_array + sp;
- STR *Str; /* used in str_get and str_gnum macros */
-
- switch (ix) {
- case MP_loadexternals:
- if (items != 1)
- fatal("Usage: $MacPerl'LoadExternals(LIB)");
-
- switch (loadresinclude(str_get(st[1]))) {
- case 0:
- break;
- case 1:
- fatal("MacPerl'LoadExternals(\"%s\"): File not found.\n", str_get(st[1]));
- default:
- fatal("MacPerl'LoadExternals(\"%s\"): Error opening file.\n", str_get(st[1]));
- }
-
- st[0] = &str_undef;
-
- return sp;
- case MP_debugexternals:
- if (items != 1)
- fatal("Usage: $MacPerl'DebugExternals(LEVEL)");
-
- str_numset(st[0], (double) XLDebug);
-
- XLDebug = (XLDebugLevel) str_gnum(st[1]);
-
- return sp;
- default:
- return xlcall(ix, sp, items);
- }
- }
-
- static void CenterWindow(DialogPtr dlg)
- {
- Rect * screen;
- short hPos;
- short vPos;
-
- screen = &qd.screenBits.bounds;
- hPos = screen->right+screen->left-dlg->portRect.right >> 1;
- vPos = (screen->bottom-screen->top-dlg->portRect.bottom)/3;
- vPos += screen->top;
- MoveWindow(dlg, hPos, vPos, true);
- }
-
- static ControlHandle GetDlgCtrl(DialogPtr dlg, short item)
- {
- short kind;
- Handle hdl;
- Rect box;
-
- GetDItem(dlg, item, &kind, &hdl, &box);
- return (ControlHandle) hdl;
- }
-
- static void GetDlgText(DialogPtr dlg, short item, char * text)
- {
- getitext((Handle) GetDlgCtrl(dlg, item), text);
- }
-
- static void SetDlgText(DialogPtr dlg, short item, char * text)
- {
- setitext((Handle) GetDlgCtrl(dlg, item), text);
- }
-
- static void GetDlgRect(DialogPtr dlg, short item, Rect * r)
- {
- short kind;
- Handle hdl;
-
- GetDItem(dlg, item, &kind, &hdl, r);
- }
-
- static void FrameDlgRect(DialogPtr dlg, short item)
- {
- Rect r;
-
- GetDlgRect(dlg, item, &r);
- InsetRect(&r, -4, -4);
- PenSize(3, 3);
- FrameRoundRect(&r, 16, 16);
- PenSize(1,1);
- }
-
- #define TempPStr(cstr) ((StringPtr) memcpy(tmpPStr+1, cstr, *tmpPStr = strlen(cstr)), tmpPStr)
-
- double
- do_answer(arglast)
- int *arglast;
- {
- register STR **st = stack->ary_array;
- register int sp = arglast[0];
- int maxarg = arglast[2] - sp;
- char * prompt;
- short item;
- DialogPtr dlg;
- Str255 tmpPStr;
-
- if (maxarg > 4)
- fatal("answer() called with more than 4 arguments");
-
- prompt = (char*)str_get(st[++sp]);
-
- dlg = GetNewDialog((maxarg>1) ? 1999+maxarg : 2001, NULL, (WindowPtr)-1);
- InitCursor();
- SetDlgText(dlg, 5, prompt);
-
- if (maxarg>1)
- for (item = 1; item<maxarg; ++item) {
- prompt = (char*)str_get(st[++sp]);
- memcpy(tmpPStr+1, prompt, *tmpPStr = st[sp]->str_cur);
- SetCTitle(GetDlgCtrl(dlg, item), tmpPStr);
- }
- else
- SetCTitle(GetDlgCtrl(dlg, 1), (StringPtr) "\pOK");
-
- CenterWindow(dlg);
- ShowWindow(dlg);
- SetPort(dlg);
- FrameDlgRect(dlg, ok);
- ModalDialog((ModalFilterUPP)0, &item);
- DisposDialog(dlg);
-
- return (maxarg>1) ? maxarg-item-1 : 0;
- }
-
- static char string_reply[256];
-
- STR * do_ask(arglast, maxarg)
- int *arglast;
- int maxarg;
- {
- register STR **st = stack->ary_array;
- register int sp = arglast[0];
- char * prompt;
- short item;
- DialogPtr dlg;
- STR * str;
-
- if (maxarg > 2)
- fatal("ask() called with more than 2 arguments");
-
- prompt = (char*)str_get(st[++sp]);
-
- dlg = GetNewDialog(2010, NULL, (WindowPtr)-1);
- InitCursor();
- SetDlgText(dlg, 3, prompt);
-
- if (maxarg == 2)
- SetDlgText(dlg, 4, (char*)str_get(st[++sp]));
- SelIText(dlg, 4, 0, 1024);
-
- InitCursor();
- CenterWindow(dlg);
- ShowWindow(dlg);
- SetPort(dlg);
- FrameDlgRect(dlg, ok);
- ModalDialog((ModalFilterUPP)0, &item);
- switch (item) {
- case ok:
- str = str_2mortal(Str_new(22,257));
- str->str_cur = 256;
- str->str_pok = 1;
- GetDlgText(dlg, 4, str->str_ptr);
- str->str_cur = strlen(str->str_ptr);
- break;
- case cancel:
- break;
- }
- DisposDialog(dlg);
-
- return (item == ok) ? str : &str_undef;
- }
-
- static ListHandle picklist = NULL;
-
- #define SetCell(cell, row, column) { (cell).h = column; (cell).v = row; }
- #define ROW(cell) (cell).v
-
- pascal void
- MacListUpdate(myDialog, myItem)
- DialogPtr myDialog;
- short myItem;
- {
- Rect myrect;
-
- LUpdate(myDialog->visRgn, picklist);
- myrect = (**(picklist)).rView;
- InsetRect(&myrect, -1, -1);
- FrameRect(&myrect);
- }
-
- #if USESROUTINEDESCRIPTORS
- RoutineDescriptor uMacListUpdate =
- BUILD_ROUTINE_DESCRIPTOR(uppUserItemProcInfo, MacListUpdate);
- #else
- #define uMacListUpdate MacListUpdate
- #endif
-
- pascal Boolean
- MacListFilter(myDialog, myEvent, myItem)
- DialogPtr myDialog;
- EventRecord *myEvent;
- short *myItem;
- {
- Rect listrect;
- short myascii;
- Handle myhandle;
- Point mypoint;
- short mytype;
- int activate;
-
- SetPort(myDialog);
- if (myEvent->what == keyDown) {
- myascii = myEvent->message % 256;
- if (myascii == '\015' || myascii == '\003') { /* This is return or enter... */
- *myItem = 1;
- return true;
- }
- }
- else if (myEvent->what == mouseDown) {
- mypoint = myEvent->where;
- GlobalToLocal(&mypoint);
- GetDItem(myDialog, 4, &mytype, &myhandle, &listrect);
- if (PtInRect(mypoint, &listrect) && picklist != NULL) {
- if (LClick(mypoint, (short)myEvent->modifiers, picklist)) {
- /* User double-clicked in cell... */
- *myItem = 1;
- return true;
- }
- }
- }
- else if (myEvent->what == activateEvt && picklist != NULL) {
- activate = (myEvent->modifiers & 0x01) != 0;
- LActivate((Boolean) activate, picklist);
- }
-
- return false;
- }
-
- #if USESROUTINEDESCRIPTORS
- RoutineDescriptor uMacListFilter =
- BUILD_ROUTINE_DESCRIPTOR(uppModalFilterProcInfo, MacListFilter);
- #else
- #define uMacListFilter MacListFilter
- #endif
-
- STR *
- do_pick(arglast)
- int *arglast;
- {
- register STR **st = stack->ary_array;
- register int sp = arglast[0];
- int maxarg = arglast[2] - sp - 1;
- char * prompt;
- short itemHit;
- Boolean done;
- DialogPtr dlg;
- ListHandle mylist;
- Cell mycell;
- short mytype;
- Handle myhandle;
- Point cellsize;
- Rect listrect, dbounds;
- char * item;
-
- prompt = (char*)str_get(st[++sp]);
- InitCursor();
- dlg = GetNewDialog(2020, NULL, (WindowPtr)-1);
-
- SetDlgText(dlg, 3, prompt);
- GetDItem(dlg, 4, &mytype, &myhandle, &listrect);
- SetDItem(dlg, 4, mytype, (Handle)&uMacListUpdate, &listrect);
-
- SetPort(dlg);
- InsetRect(&listrect, 1, 1);
- SetRect(&dbounds, 0, 0, 1, maxarg);
- cellsize.h = (listrect.right - listrect.left);
- cellsize.v = 17;
-
- listrect.right -= 15;
-
- picklist = LNew(&listrect, &dbounds, cellsize, 0,
- dlg, true, false, false, true);
-
- mylist = picklist;
- LDoDraw(false, mylist);
-
- SetCell(mycell, 0, 0);
- for (; mycell.v<maxarg; ++mycell.v) {
- item = str_get(st[++sp]);
- LSetCell(item, st[sp]->str_cur, mycell, mylist);
- }
-
- LDoDraw(true, mylist);
- CenterWindow(dlg);
- ShowWindow(dlg);
-
- for (done=false; !done; ) {
- SetPort(dlg);
- FrameDlgRect(dlg, ok);
- ModalDialog((ModalFilterUPP) &uMacListFilter, &itemHit);
- switch (itemHit) {
- case ok:
- SetCell(mycell, 0, 0);
- done = true;
- if (!LGetSelect(true, &mycell, picklist))
- itemHit = cancel;
- break;
- case cancel:
- done = true;
- break;
- }
- } /* Modal Loop */
-
- SetPort(dlg);
-
- LDispose(mylist);
- picklist = NULL;
- DisposDialog(dlg);
-
- if (itemHit == ok)
- return str_smake(st[arglast[0]+mycell.v+2]);
- else
- return &str_undef;
- }
-
- static OSErr GetVolInfo(short volume, Boolean indexed, FSSpec * spec)
- {
- OSErr err;
- HParamBlockRec pb;
-
- pb.volumeParam.ioNamePtr = spec->name;
- pb.volumeParam.ioVRefNum = indexed ? 0 : volume;
- pb.volumeParam.ioVolIndex = indexed ? volume : 0;
-
- if (err = PBHGetVInfoSync(&pb))
- return err;
-
- spec->vRefNum = pb.volumeParam.ioVRefNum;
- spec->parID = 1;
-
- return noErr;
- }
-
- static int
- macperlsub(ix, sp, items)
- int ix;
- register int sp;
- register int items;
- {
- STR **st = stack->ary_array + sp;
- register int i;
- register STR *Str; /* used in str_get and str_gnum macros */
-
- switch (ix) {
- case MP_fsetfileinfo:
- {
- unsigned long creator;
- unsigned long type;
-
- if (items < 3)
- fatal("Usage: &MacPerl'SetFileInfo(CREATOR, TYPE, FILE...)");
-
- creator = *(unsigned long*) str_get(st[1]);
- type = *(unsigned long*) str_get(st[2]);
-
- for (i = 3; i<=items; i++)
- fsetfileinfo(str_get(st[i]), creator, type);
-
- st[0] = &str_undef;
-
- return sp;
- }
- case MP_fgetfileinfo:
- {
- unsigned long creator;
- unsigned long type;
-
- if (items != 1)
- fatal("Usage: &MacPerl'GetFileInfo(PATH)");
-
- fgetfileinfo(str_get(st[1]), &creator, &type);
-
- if (errno) {
- st[0] = &str_undef;
-
- return sp;
- }
-
- if (!curcsv || curcsv->wantarray != G_ARRAY) {
- str_nset(st[0], &type, 4);
- return sp;
- }
- st[0] = str_2mortal(str_make(&creator,4));
- st[1] = str_2mortal(str_make(&type,4));
- return sp + 1;
- }
- case MP_ask:
- {
- char * prompt;
- short item;
- DialogPtr dlg;
- STR * str;
-
- if (items < 1 || items > 2)
- fatal("Usage: &MacPerl'Ask(PROMPT [, DEFAULT])");
-
- prompt = (char*)str_get(st[1]);
-
- dlg = GetNewDialog(2010, NULL, (WindowPtr)-1);
- InitCursor();
- SetDlgText(dlg, 3, prompt);
-
- if (items == 2)
- SetDlgText(dlg, 4, (char*)str_get(st[2]));
- SelIText(dlg, 4, 0, 1024);
-
- InitCursor();
- CenterWindow(dlg);
- ShowWindow(dlg);
- SetPort(dlg);
- FrameDlgRect(dlg, ok);
- ModalDialog((ModalFilterUPP)0, &item);
- switch (item) {
- case ok:
- str = str_2mortal(Str_new(22,257));
- str->str_cur = 256;
- str->str_pok = 1;
- GetDlgText(dlg, 4, str->str_ptr);
- str->str_cur = strlen(str->str_ptr);
- break;
- case cancel:
- break;
- }
- DisposDialog(dlg);
-
- st[0] = (item == ok) ? str : &str_undef;
-
- return sp;
- }
- case MP_answer:
- {
- char * prompt;
- short item;
- DialogPtr dlg;
- Str255 tmpPStr;
-
- if (items < 1 || items > 4)
- fatal("Usage: &MacPerl'Answer(PROMPT [, BUTTON1 [, BUTTON2 [, BUTTON3]]])");
-
- prompt = (char*)str_get(st[1]);
-
- dlg = GetNewDialog((items>1) ? 1999+items : 2001, NULL, (WindowPtr)-1);
- InitCursor();
- SetDlgText(dlg, 5, prompt);
-
- if (items>1)
- for (item = 1; item<items; ++item) {
- prompt = (char*)str_get(st[item+1]);
- memcpy(tmpPStr+1, prompt, *tmpPStr = st[item+1]->str_cur);
- SetCTitle(GetDlgCtrl(dlg, item), tmpPStr);
- }
- else
- SetCTitle(GetDlgCtrl(dlg, 1), (StringPtr) "\pOK");
-
- CenterWindow(dlg);
- ShowWindow(dlg);
- SetPort(dlg);
- FrameDlgRect(dlg, ok);
- ModalDialog((ModalFilterUPP)0, &item);
- DisposDialog(dlg);
-
- str_numset(st[0], (items>1) ? (double)(items-item-1) : 0.0);
-
- return sp;
- }
- case MP_choose:
- {
- int domain, type, flags;
- char * prompt;
- char * constraint;
- char * def_addr;
- STR * str;
-
- if (items < 3 || items > 6)
- fatal("Usage: &MacPerl'Choose(DOMAIN, TYPE, PROMPT [, CONSTRAINT [, FLAGS [, DEFAULT]]])");
-
- domain = (int)str_gnum(st[1]);
- type = (int)str_gnum(st[2]);
- prompt = (char*)str_get(st[3]);
- constraint = (items>=4) ? (char*)str_get(st[4]) : nil;
- constraint = constraint && st[4]->str_cur ? constraint : nil;
- flags = (items>=5) ? (int)str_gnum(st[5]) : 0;
- def_addr = (items==6) ? (char*)str_get(st[6]) : nil;
- def_addr = def_addr && st[6]->str_cur ? def_addr : nil;
-
- str = str_2mortal(Str_new(22,257));
- str->str_cur = 256;
- str->str_pok = 1;
-
- if (def_addr) {
- memcpy(str->str_ptr, def_addr, st[6]->str_cur);
- str->str_ptr[st[6]->str_cur] = 0; /* Some types require this */
- }
-
- if (choose(domain, type, prompt, constraint, flags, str->str_ptr, (int*)&str->str_cur) < 0)
- st[0] = &str_undef;
- else
- st[0] = str_2mortal(str);
-
- return sp;
- }
- case MP_pick:
- {
- char * prompt;
- short itemHit;
- Boolean done;
- DialogPtr dlg;
- ListHandle mylist;
- Cell mycell;
- short mytype;
- Handle myhandle;
- Point cellsize;
- Rect listrect, dbounds;
- char * item;
-
- if (items < 2)
- fatal("Usage: &MacPerl'Pick(PROMPT, ITEM...)");
-
- prompt = (char*)str_get(st[1]);
- InitCursor();
- dlg = GetNewDialog(2020, NULL, (WindowPtr)-1);
-
- SetDlgText(dlg, 3, prompt);
- GetDItem(dlg, 4, &mytype, &myhandle, &listrect);
- SetDItem(dlg, 4, mytype, (Handle)&uMacListUpdate, &listrect);
-
- SetPort(dlg);
- InsetRect(&listrect, 1, 1);
- SetRect(&dbounds, 0, 0, 1, items-1);
- cellsize.h = (listrect.right - listrect.left);
- cellsize.v = 17;
-
- listrect.right -= 15;
-
- picklist = LNew(&listrect, &dbounds, cellsize, 0,
- dlg, true, false, false, true);
-
- mylist = picklist;
- LDoDraw(false, mylist);
-
- SetCell(mycell, 0, 0);
- for (; mycell.v<items-1; ++mycell.v) {
- item = str_get(st[mycell.v+2]);
- LSetCell(item, st[mycell.v+2]->str_cur, mycell, mylist);
- }
-
- LDoDraw(true, mylist);
- CenterWindow(dlg);
- ShowWindow(dlg);
-
- for (done=false; !done; ) {
- SetPort(dlg);
- FrameDlgRect(dlg, ok);
- ModalDialog((ModalFilterUPP) &uMacListFilter, &itemHit);
- switch (itemHit) {
- case ok:
- SetCell(mycell, 0, 0);
- done = true;
- if (!LGetSelect(true, &mycell, picklist))
- itemHit = cancel;
- break;
- case cancel:
- done = true;
- break;
- }
- } /* Modal Loop */
-
- SetPort(dlg);
-
- LDispose(mylist);
- picklist = NULL;
- DisposDialog(dlg);
-
- if (itemHit == ok)
- st[0] = str_2mortal(str_smake(st[mycell.v+2]));
- else
- st[0] = &str_undef;
-
- return sp;
- }
- case MP_quit:
- {
- if (items != 1)
- fatal("Usage: &MacPerl'Quit(CONDITION)");
-
- gPerlQuit = (int)str_gnum(st[1]);
-
- str_numset(st[0], (double) 0.0);
-
- return sp;
- }
- case MP_faccess:
- {
- char * file = str_get(st[1]);
- unsigned cmd = (unsigned) str_gnum(st[2]);
- unsigned uarg;
- Rect rarg;
- SelectionRecord sarg;
-
- switch (cmd) {
- case F_GFONTINFO:
- if (items > 2)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_GFONTINFO)");
- if (faccess(file, cmd, (long *)&uarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else if (!curcsv || curcsv->wantarray != G_ARRAY) {
- str_numset(st[0], (double)(uarg >> 16));
-
- return sp;
- } else {
- st[0] = str_2mortal(Str_new(22,257));
- getfontname(uarg >> 16, st[0]->str_ptr);
- st[0]->str_cur = strlen(st[0]->str_ptr);
- st[0]->str_pok = 1;
- str_numset(st[1], (double)(uarg & 0x0FFFF));
-
- return sp + 1;
- }
- case F_GSELINFO:
- if (items > 2)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_GSELINFO)");
- if (faccess(file, cmd, (long *)&sarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else if (!curcsv || curcsv->wantarray != G_ARRAY) {
- str_numset(st[0], (double)sarg.startingPos);
-
- return sp;
- } else {
- str_numset(st[0], (double) sarg.startingPos);
- str_numset(st[1], (double) sarg.endingPos);
- str_numset(st[2], (double) sarg.displayTop);
-
- return sp + 2;
- }
- case F_GTABINFO:
- if (items > 2)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_GTABINFO)");
- if (faccess(file, cmd, (long *)&uarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else {
- str_numset(st[0], (double)uarg);
-
- return sp;
- }
- case F_GWININFO:
- if (items > 2)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_GWININFO)");
- if (faccess(file, cmd, (long *)&rarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else if (!curcsv || curcsv->wantarray != G_ARRAY) {
- str_numset(st[0], (double)rarg.top);
-
- return sp;
- } else {
- astore(stack, sp + 3, Nullstr); /* extend stack */
- st = stack->ary_array + sp; /* possibly realloced */
- str_numset(st[0], (double) rarg.left);
- str_numset(st[1], (double) rarg.top);
- str_numset(st[2], (double) rarg.right);
- st[3] = str_2mortal(str_nmake((double) rarg.bottom));
-
- return sp + 3;
- }
- case F_SFONTINFO:
- if (items < 3 || items > 4)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_SFONTINFO, FONT [, SIZE])");
-
- if (items == 3) {
- if (faccess(file, F_GFONTINFO, (long *)&uarg) < 0)
- uarg = 9;
- } else
- uarg = (unsigned) str_gnum(st[4]);
-
- if (isalpha(*str_get(st[3]))) {
- short family;
-
- getfnum(str_get(st[3]), &family);
-
- uarg = (uarg & 0xFFFF) | ((unsigned) family) << 16;
- } else
- uarg = (uarg & 0xFFFF) | ((unsigned) str_gnum(st[3])) << 16;
-
- if (faccess(file, cmd, (long *)uarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else {
- str_numset(st[0], (double) 1.0);
-
- return sp;
- }
- case F_SSELINFO:
- if (items < 4 || items > 5)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_SSELINFO, START, END [, TOP])");
-
- if (items == 4) {
- if (faccess(file, F_GSELINFO, (long *) &sarg) < 0)
- sarg.displayTop = (long) str_gnum(st[3]);
- } else
- sarg.displayTop = (long) str_gnum(st[5]);
-
- sarg.startingPos = (long) str_gnum(st[3]);
- sarg.endingPos = (long) str_gnum(st[4]);
-
- if (faccess(file, cmd, (long *)&sarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else {
- str_numset(st[0], (double) 1.0);
-
- return sp;
- }
- case F_STABINFO:
- if (items != 3)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_STABINFO, TAB)");
-
- uarg = (unsigned) str_gnum(st[3]);
-
- if (faccess(file, cmd, (long *)uarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else {
- str_numset(st[0], (double) 1.0);
-
- return sp;
- }
- case F_SWININFO:
- if (items != 4 && items != 6)
- fatal("Usage: &MacPerl'FAccess(FILE, &F_SWININFO, LEFT, TOP [, RIGHT, BOTTOM])");
-
- if (items == 4) {
- if (faccess(file, F_GWININFO, (long *)&rarg) < 0)
- rarg.bottom = rarg.right = 400;
- else {
- rarg.right = rarg.right - rarg.left + (short) str_gnum(st[3]);
- rarg.bottom = rarg.bottom - rarg.top + (short) str_gnum(st[4]);
- }
- } else {
- rarg.right = (short) str_gnum(st[5]);
- rarg.bottom = (short) str_gnum(st[6]);
- }
-
- rarg.left = (short) str_gnum(st[3]);
- rarg.top = (short) str_gnum(st[4]);
-
- if (faccess(file, cmd, (long *)&rarg) < 0) {
- st[0] = &str_undef;
-
- return sp;
- } else {
- str_numset(st[0], (double) 1.0);
-
- return sp;
- }
- default:
- fatal("&MacPerl'FAccess() can't handle this command");
- }
- }
- case MP_makefsspec:
- {
- FSSpec spec;
-
- if (items != 1)
- fatal("Usage: &MacPerl'MakeFSSpec(PATH)");
-
- if (Path2FSSpec(str_get(st[1]), &spec)) {
- st[0] = &str_undef;
-
- return sp;
- }
-
- str_set(st[0], FSp2Encoding(&spec));
- return sp;
- }
- case MP_makepath:
- {
- FSSpec spec;
-
- if (items != 1)
- fatal("Usage: &MacPerl'MakePath(FSSPEC)");
-
- if (Path2FSSpec(str_get(st[1]), &spec)) {
- st[0] = &str_undef;
-
- return sp;
- }
-
- str_set(st[0], FSp2FullPath(&spec));
- return sp;
- }
- case MP_volumes:
- {
- FSSpec spec;
-
- if (items != 0)
- fatal("Usage: &MacPerl'Volumes()");
-
- if (!curcsv || curcsv->wantarray != G_ARRAY) {
- Special2FSSpec('macs', kOnSystemDisk, 0, &spec);
- GetVolInfo(spec.vRefNum, false, &spec);
-
- str_set(st[0], FSp2Encoding(&spec));
- return sp;
- } else {
- short index;
-
- for (index = 0; !GetVolInfo(index+1, true, &spec); ++index)
- st[index] = str_2mortal(str_make(FSp2Encoding(&spec), 0));
-
- return sp + index - 1;
- }
- }
- default:
- fatal("macperl: Unknown index (Can't happen)");
- return sp;
- }
- }
-
- ComponentInstance gScriptingComponent;
-
- void ShutDownAppleScript(void)
- {
- CloseComponent(gScriptingComponent);
-
- gScriptingComponent = nil;
- }
-
- OSErr InitAppleScript(void)
- {
- OSErr myErr;
- ComponentDescription descr;
- ComponentDescription capabilities;
- Component myComponent;
- EventRecord myEvent;
- short retryCount;
-
- retryCount = 0;
-
- if (!hasAppleEvents || !hasComponents)
- return -1;
-
- descr.componentType = kOSAComponentType;
- descr.componentSubType = kAppleScriptSubtype;
- descr.componentManufacturer = (OSType) 0;
- descr.componentFlags = kOSASupportsCompiling +
- kOSASupportsGetSource +
- kOSASupportsAESending;
- descr.componentFlagsMask = descr.componentFlags;
-
- myComponent = FindNextComponent(nil, &descr);
-
- if (myComponent==nil)
- return -1;
- else {
- myErr = GetComponentInfo(myComponent, &capabilities, nil, nil, nil);
- gScriptingComponent = OpenComponent(myComponent);
- if (!gScriptingComponent)
- return(-1);
- else
- atexit(ShutDownAppleScript);
- }
-
- return myErr;
- }
-
- static int
- doapscript(ix, sp, items)
- int ix;
- register int sp;
- register int items;
- {
- STR **st = stack->ary_array + sp;
- register int i;
- register STR *Str; /* used in str_get and str_gnum macros */
-
- switch (ix) {
- case MP_reply:
- {
- char * reply;
-
- if (items > 1)
- fatal("MacPerl'Reply called with more than 1 argument");
-
- reply = (char*)str_get(st[1]);
-
- if (gPerlReply)
- DisposeHandle(gPerlReply);
-
- PtrToHand(reply, &gPerlReply, strlen(reply));
-
- st[0] = &str_undef;
-
- return sp;
- }
- case MP_doapplescript:
- {
- AEDesc source;
- AEDesc result;
- char * script;
-
- if (items > 1)
- fatal("MacPerl'DoAppleScript called with more than 1 argument");
-
- if (!gScriptingComponent && InitAppleScript())
- fatal("MacPerl'DoAppleScript couldn't initialize AppleScript");
-
- script = (char*)str_get(st[1]);
- AECreateDesc(typeChar, script, strlen(script), &source);
-
- if (!OSADoScript(
- gScriptingComponent,
- &source,
- kOSANullScript,
- typeChar,
- kOSAModeCanInteract,
- &result))
- {
- AEDisposeDesc(&source);
-
- if (!AECoerceDesc(&result, typeChar, &source)) {
- HLock(source.dataHandle);
-
- st[0] = str_2mortal(str_make(*source.dataHandle,GetHandleSize(source.dataHandle)));
-
- AEDisposeDesc(&source);
- } else
- st[0] = &str_undef;
-
- AEDisposeDesc(&result);
- } else {
- AEDisposeDesc(&source);
-
- st[0] = &str_undef;
- }
-
- return sp;
- }
- default:
- fatal("doapscript: Unknown index (Can't happen)");
- return sp;
- }
- }
-
- extern int StandAlone;
-
- static int
- macperlval(ix, str)
- int ix;
- STR *str;
- {
- VersRecHndl vers;
-
- switch (ix) {
- case MV_version:
- vers = (VersRecHndl) GetResource('vers', 1);
- HLock((Handle) vers);
- str_nset(str, (char *)(*vers)->shortVersion+1, *(*vers)->shortVersion);
- if (StandAlone)
- str_cat(str, " Application");
- else
- str_cat(str, " MPW");
- }
-
- return 0;
- }
-
- static int
- macperlset(ix, str)
- int ix;
- STR *str;
- {
- return 0;
- }
-
- #define STACK_INTERVENTION_LIMIT 8192
-
- void StackAttack()
- {
- if (StackSpace() < STACK_INTERVENTION_LIMIT)
- fatal("Stack space getting low ! Aborting script for your own good...\n");
- }
-