home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / macperl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-12-27  |  26.5 KB  |  1,220 lines  |  [TEXT/MPS ]
  1. /*********************************************************************
  2. File        :    macperl.c    - Mac specific extensions
  3. Author    :    Matthias Neeracher & Tim Endres
  4. Started    :    28May91                                Language    :    MPW C
  5.                 31Oct93    MN    XCMDs
  6.                 05Dec93    MN    Faccess
  7. Last        :    05Dec93
  8.  
  9. Copyright (c) 1991-93 Matthias Neeracher & Tim Endres
  10. *********************************************************************/
  11.  
  12. #include <Types.h>
  13. #include <Resources.h>
  14. #include <QuickDraw.h>
  15. #include <Fonts.h>
  16. #include <Menus.h>
  17. #include <TextEdit.h>
  18. #include <Dialogs.h>
  19. #include <SegLoad.h>
  20. #include <StandardFile.h>
  21. #include <Lists.h>
  22. #include <Files.h>
  23. #include <Memory.h>
  24. #include <TFileSpec.h>
  25. #include <Components.h>
  26. #include <AppleEvents.h>
  27. #include <OSA.h>
  28. #include <AppleScript.h>
  29. #include <AERegistry.h>
  30. #include <OSUtils.h>
  31. #include <HyperXCmd.h>
  32. #define XLDEBUG
  33. #include <XL.h>
  34. #include <TextUtils.h>
  35. #include <FCntl.h>
  36.  
  37. /* Ugly hack since QuickDraw defines another invert */
  38. #define RESOLVE_MAC_CONFLICTS
  39.  
  40. #include "EXTERN.h"
  41. #include "perl.h"
  42.  
  43. void InitToolbox()
  44. {
  45.     InitGraf((Ptr) &qd.thePort);
  46. }
  47.  
  48. static int macperlsub();
  49. static int doapscript();
  50. static int xlsub();
  51. static void loadresfile();
  52.  
  53. Handle    PerlReply     =     nil;
  54. int        PerlQuit        =    0;
  55.  
  56. enum {
  57.     MP_fsetfileinfo,
  58.     MP_fgetfileinfo,
  59.     MP_ask,
  60.     MP_answer,
  61.     MP_choose,
  62.     MP_pick,
  63.     MP_quit,
  64.     MP_faccess,
  65.     
  66.     MP_doapplescript = 0,
  67.     MP_reply,
  68.     
  69.     MP_loadexternals  = 0,
  70.     MP_debugexternals = 1,
  71.     MP_extension        = 2
  72. } MacPerlOp;
  73.  
  74. int 
  75. macperlinit()
  76. {
  77.     int saveallstabs = allstabs;
  78.      allstabs = TRUE;
  79.      PerlQuit = 0;
  80.  
  81.      make_usub("MacPerl'SetFileInfo",     MP_fsetfileinfo,    macperlsub, "macperl.c");
  82.      make_usub("MacPerl'GetFileInfo",     MP_fgetfileinfo,    macperlsub, "macperl.c");
  83.      make_usub("MacPerl'Ask",                 MP_ask,                macperlsub, "macperl.c");
  84.      make_usub("MacPerl'Answer",             MP_answer,            macperlsub, "macperl.c");
  85.      make_usub("MacPerl'Choose",             MP_choose,            macperlsub, "macperl.c");
  86.      make_usub("MacPerl'Pick",             MP_pick,                macperlsub, "macperl.c");
  87.      make_usub("MacPerl'Quit",             MP_quit,                macperlsub, "macperl.c");
  88.      make_usub("MacPerl'FAccess",         MP_faccess,            macperlsub, "macperl.c");
  89.      
  90.      make_usub("MacPerl'DoAppleScript",    MP_doapplescript, doapscript, "macperl.c");
  91.      make_usub("MacPerl'Reply",            MP_reply,             doapscript, "macperl.c");
  92.  
  93.      make_usub("MacPerl'LoadExternals",     MP_loadexternals, xlsub,         "macperl.c");
  94.      make_usub("MacPerl'DebugExternals",     MP_debugexternals, xlsub,         "macperl.c");
  95.      
  96.      loadresfile(gAppFile);
  97.      
  98.      if (gPrefsFile)
  99.          loadresfile(gPrefsFile);
  100.      
  101.      allstabs = saveallstabs;
  102.  
  103.     return 0;
  104. }
  105.  
  106. typedef struct {
  107.     short        refNum;
  108.     FSSpec    file;
  109. } ResourceFile;
  110.  
  111. typedef struct {
  112.     short                count;
  113.     ResourceFile    file[1];
  114. } ** ResourceFiles;
  115.  
  116. typedef struct {
  117.     short        refNum;
  118.     ResType    type;
  119.     short        id;
  120. } Xternal, ** XternalHdl;
  121.  
  122. static ResourceFiles ResFiles;
  123. static XternalHdl        Xternals;
  124. static int                XternalIndex;
  125.  
  126. void CloseResFiles(void)
  127. {
  128.     if (ResFiles) {
  129.         while ((*ResFiles)->count--)
  130.             CloseResFile((*ResFiles)->file[(*ResFiles)->count].refNum);
  131.         
  132.         DisposeHandle((Handle) ResFiles);
  133.         
  134.         ResFiles = nil;
  135.     }
  136.     
  137.     if (Xternals) {
  138.         DisposeHandle((Handle) Xternals);
  139.         
  140.         Xternals = nil;
  141.     }
  142. }
  143.  
  144. static ResType SearchTypes[] = {'XCMD', 'XFCN', 0};
  145.  
  146. static void loadresfile(short refNum) 
  147. {
  148.     Handle            xcmd;
  149.     ResType *        type;
  150.     short                count;
  151.     short                id;
  152.     ResType            rtyp;
  153.     short                oldRes = CurResFile();
  154.     Xternal            x;
  155.     char                name[256];
  156.     static Boolean    closing = false;
  157.    int saveallstabs = allstabs;
  158.     allstabs = TRUE;
  159.     
  160.     if (!closing)
  161.         atexit(CloseResFiles);
  162.         
  163.     if (!Xternals)
  164.         Xternals = (XternalHdl) NewHandle(0);
  165.     
  166.     UseResFile(refNum);
  167.     
  168.     for (type = SearchTypes; *type; ++type)
  169.         for (count = Count1Resources(*type); count; --count)
  170.             if (xcmd = Get1IndResource(*type, count)) {
  171.                 getresinfo(xcmd, &id, &rtyp, name);
  172.                 
  173.                 x.refNum = refNum;
  174.                 x.type    = rtyp;
  175.                 x.id        = id;
  176.                 
  177.                 PtrAndHand((Ptr) &x, (Handle) Xternals, sizeof(Xternal));
  178.                 
  179.                 make_usub(name, MP_extension + XternalIndex++, xlsub, "macperl.c");
  180.             }
  181.             
  182.     UseResFile(oldRes);
  183.     allstabs = saveallstabs;
  184. }
  185.  
  186. OSErr tryresload(FSSpec * spec)
  187. {
  188.     short                i;
  189.     short                refNum;
  190.     ResourceFile    file;
  191.     
  192.     if (!ResFiles) {
  193.         i = 0;
  194.         
  195.         PtrToHand((Ptr) &i, (Handle *) &ResFiles, sizeof(short));
  196.     }
  197.     
  198.     for (i = (*ResFiles)->count; i--; ) {
  199.         ResourceFile * file = (*ResFiles)->file + i;
  200.         
  201.         if (file->file.vRefNum != spec->vRefNum)
  202.             continue;
  203.         if (file->file.parID != spec->parID)
  204.             continue;
  205.             
  206.         if (EqualString(file->file.name, spec->name, false, true))
  207.             return 0;
  208.     }
  209.     
  210.     refNum = HOpenResFile(spec->vRefNum, spec->parID, spec->name, fsRdPerm);
  211.     
  212.     if (refNum == -1)
  213.         return ResError();
  214.     
  215.     file.refNum = refNum;
  216.     file.file     = *spec;
  217.     
  218.     PtrAndHand((Ptr) &file, (Handle) ResFiles, sizeof(ResourceFile));
  219.     ++(*ResFiles)->count;
  220.     
  221.     loadresfile(refNum);
  222.     
  223.     return 0;
  224. }
  225.  
  226. OSErr loadresinclude(char * path)
  227. {
  228.     int        i;
  229.    ARRAY *    ar;
  230.     char        buf[256];
  231.     FSSpec    spec;
  232.     
  233.     if (strchr(path, ':'))
  234.         if (!Path2FSSpec(path, &spec))
  235.             return tryresload(&spec);
  236.         else
  237.             return 1;
  238.         
  239.     ar = stab_array(incstab);
  240.     for (i = 0; i <= ar->ary_fill; i++) {
  241.         char *macptr = str_get(afetch(ar,i,TRUE));
  242.         int   colon = macptr[strlen(macptr)-1] == ':';
  243.         
  244.         if (colon)
  245.             (void) sprintf(buf, "%s%s", macptr, path);
  246.         else 
  247.             (void) sprintf(buf, "%s:%s", macptr, path);
  248.     
  249.         if (!Path2FSSpec(buf, &spec) && !tryresload(&spec))
  250.             return 0;
  251.     }
  252.     
  253.     return 1;
  254. }
  255.  
  256. static void xlsetupparams(STR ** st, int items, XCmdPtr xcmd)
  257. {
  258.     int i;
  259.     STR *Str;        /* used in str_get and str_gnum macros */
  260.  
  261.     xcmd->paramCount = items;
  262.     for (i = 0; i < items; ++i) {
  263.         char * arg = str_get(st[i+1]);
  264.         
  265.         PtrToHand(arg, xcmd->params+i, strlen(arg)+1);
  266.     }
  267.     
  268.     for (i = items; i < 16; ++i)
  269.         xcmd->params[i] = nil;
  270.     
  271.     xcmd->returnValue = nil;
  272.     xcmd->passFlag      = 0;
  273. }
  274.  
  275. static void xldisposeparams(STR ** st, int items, XCmdPtr xcmd)
  276. {
  277.     int i;
  278.     
  279.     for (i=0; i<16; ++i)
  280.         if (xcmd->params[i])
  281.             DisposeHandle(xcmd->params[i]);
  282.     
  283.     if (xcmd->returnValue) {
  284.         HLock(xcmd->returnValue);
  285.         st[0] = 
  286.             str_2mortal(
  287.                 str_make(*xcmd->returnValue,GetHandleSize(xcmd->returnValue)-1));        
  288.         DisposeHandle(xcmd->returnValue);
  289.     } else
  290.         st[0] = &str_undef;
  291. }    
  292.  
  293. static int 
  294. xlcall(ix, sp, items)
  295. int ix;
  296. int sp;
  297. int items;
  298. {
  299.     STR **st = stack->ary_array + sp;
  300.     short                    resFile;
  301.     struct XCmdBlock    xcmd;
  302.     Xternal                xt;
  303.     Handle                xh;
  304.     
  305.     xlsetupparams(st, items, &xcmd);
  306.     
  307.     xt = (*Xternals)[ix-MP_extension];
  308.     
  309.     resFile = CurResFile();
  310.     UseResFile(xt.refNum);
  311.     
  312.     xh = Get1Resource(xt.type, xt.id);
  313.     
  314.     if (!xh)
  315.         fatal("XCMD disppeared. Film at 11!");
  316.         
  317.     XLCall(xh, XLDefaultGlue, &xcmd);
  318.  
  319.     UseResFile(resFile);
  320.  
  321.     xldisposeparams(st, items, &xcmd);
  322.     
  323.     return sp;
  324. }
  325.  
  326. static int
  327. xlsub(ix, sp, items)
  328. int ix;
  329. int sp;
  330. int items;
  331. {
  332.     STR **st = stack->ary_array + sp;
  333.     STR *Str;        /* used in str_get and str_gnum macros */
  334.  
  335.     switch (ix) {
  336.     case MP_loadexternals:
  337.         if (items != 1)
  338.             fatal("Usage: $MacPerl'LoadExternals(LIB)");
  339.  
  340.          switch (loadresinclude(str_get(st[1]))) {
  341.         case 0:
  342.             break;
  343.         case 1:
  344.             fatal("MacPerl'LoadExternals(\"%s\"): File not found.\n", str_get(st[1]));
  345.         default:
  346.             fatal("MacPerl'LoadExternals(\"%s\"): Error opening file.\n", str_get(st[1]));
  347.         }
  348.         
  349.         st[0] = &str_undef;
  350.  
  351.         return sp;
  352.     case MP_debugexternals:
  353.         if (items != 1)
  354.             fatal("Usage: $MacPerl'DebugExternals(LEVEL)");
  355.  
  356.         str_numset(st[0], (double) XLDebug);
  357.  
  358.         XLDebug = (XLDebugLevel) str_gnum(st[1]);
  359.         
  360.         return sp;        
  361.     default:
  362.         return xlcall(ix, sp, items);
  363.     }
  364. }
  365.  
  366. static void CenterWindow(DialogPtr dlg)
  367. {
  368.     Rect    *        screen;
  369.     short            hPos;
  370.     short            vPos;
  371.     
  372.     screen    =    &qd.screenBits.bounds;
  373.     hPos    =    screen->right+screen->left-dlg->portRect.right >> 1;
  374.     vPos    =    (screen->bottom-screen->top-dlg->portRect.bottom)/3;
  375.     vPos    +=    screen->top;
  376.     MoveWindow(dlg, hPos, vPos, true);
  377. }    
  378.  
  379. static ControlHandle GetDlgCtrl(DialogPtr dlg, short item)
  380. {
  381.     short     kind;
  382.     Handle    hdl;
  383.     Rect    box;
  384.     
  385.     GetDItem(dlg, item, &kind, &hdl, &box);
  386.     return (ControlHandle) hdl;
  387. }
  388.  
  389. static void GetDlgText(DialogPtr dlg, short item, char * text)
  390. {
  391.     getitext((Handle) GetDlgCtrl(dlg, item), text);
  392. }
  393.  
  394. static void SetDlgText(DialogPtr dlg, short item, char * text)
  395. {
  396.     setitext((Handle) GetDlgCtrl(dlg, item), text);
  397. }
  398.  
  399. static void GetDlgRect(DialogPtr dlg, short item, Rect * r)
  400. {
  401.     short     kind;
  402.     Handle    hdl;
  403.     
  404.     GetDItem(dlg, item, &kind, &hdl, r);
  405. }
  406.  
  407. static void FrameDlgRect(DialogPtr dlg, short item)
  408. {
  409.     Rect    r;
  410.     
  411.     GetDlgRect(dlg, item, &r);
  412.     InsetRect(&r, -4, -4);
  413.     PenSize(3, 3);
  414.     FrameRoundRect(&r, 16, 16);
  415.     PenSize(1,1);
  416. }
  417.  
  418. #define TempPStr(cstr)    ((StringPtr) memcpy(tmpPStr+1, cstr, *tmpPStr = strlen(cstr)), tmpPStr)
  419.  
  420. double
  421. do_answer(arglast)
  422.     int *arglast;
  423. {
  424.     register STR **st = stack->ary_array;
  425.     register int sp = arglast[0];
  426.     int            maxarg = arglast[2] - sp;
  427.     char *        prompt;
  428.     short        item;
  429.     DialogPtr    dlg;
  430.     Str255        tmpPStr;
  431.  
  432.     if (maxarg > 4)
  433.         fatal("answer() called with more than 4 arguments");
  434.         
  435.     prompt = (char*)str_get(st[++sp]);
  436.  
  437.     dlg = GetNewDialog((maxarg>1) ? 1999+maxarg : 2001, NULL, (WindowPtr)-1);
  438.     InitCursor();
  439.     SetDlgText(dlg, 5, prompt);
  440.     
  441.     if (maxarg>1) 
  442.         for (item = 1; item<maxarg; ++item) {
  443.             prompt = (char*)str_get(st[++sp]);
  444.             memcpy(tmpPStr+1, prompt, *tmpPStr = st[sp]->str_cur);
  445.             SetCTitle(GetDlgCtrl(dlg, item), tmpPStr);
  446.         }
  447.     else
  448.         SetCTitle(GetDlgCtrl(dlg, 1), "\pOK");
  449.     
  450.     CenterWindow(dlg);
  451.     ShowWindow(dlg);
  452.     SetPort(dlg);
  453.     FrameDlgRect(dlg, ok);
  454.     ModalDialog((ModalFilterProcPtr)0, &item);
  455.     DisposDialog(dlg);
  456.     
  457.     return (maxarg>1) ? maxarg-item-1 : 0;
  458. }
  459.  
  460. static char     string_reply[256];
  461.  
  462. STR * do_ask(arglast, maxarg)
  463.     int *arglast;
  464.     int maxarg;
  465. {
  466.     register STR **st = stack->ary_array;
  467.     register int sp = arglast[0];
  468.     char *        prompt;
  469.     short        item;
  470.     DialogPtr    dlg;
  471.     STR *         str;
  472.  
  473.     if (maxarg > 2)
  474.         fatal("ask() called with more than 2 arguments");
  475.         
  476.     prompt = (char*)str_get(st[++sp]);
  477.  
  478.     dlg = GetNewDialog(2010, NULL, (WindowPtr)-1);
  479.     InitCursor();
  480.     SetDlgText(dlg, 3, prompt);
  481.     
  482.     if (maxarg == 2)
  483.         SetDlgText(dlg, 4, (char*)str_get(st[++sp]));
  484.     SelIText(dlg, 4, 0, 1024);
  485.  
  486.     InitCursor();
  487.     CenterWindow(dlg);
  488.     ShowWindow(dlg);
  489.     SetPort(dlg);
  490.     FrameDlgRect(dlg, ok);
  491.     ModalDialog((ModalFilterProcPtr)0, &item);
  492.     switch (item) {
  493.     case ok:
  494.         str = str_2mortal(Str_new(22,257));
  495.         str->str_cur = 256;
  496.            str->str_pok = 1;
  497.         GetDlgText(dlg, 4, (StringPtr) str->str_ptr);
  498.         str->str_cur = strlen(str->str_ptr);
  499.         break;
  500.     case cancel:
  501.         break;
  502.     }
  503.     DisposDialog(dlg);
  504.     
  505.     return (item == ok) ? str : &str_undef;
  506. }
  507.  
  508. static ListHandle picklist = NULL;
  509.  
  510. #define SetCell(cell, row, column)    { (cell).h = column; (cell).v = row; }
  511. #define ROW(cell)                     (cell).v
  512.  
  513. pascal void
  514. MacListUpdate(myDialog, myItem)
  515. DialogPtr        myDialog;
  516. short            myItem;
  517. {
  518. Rect            myrect;
  519. #pragma unused (myItem)
  520.  
  521.     LUpdate(myDialog->visRgn, picklist);
  522.     myrect = (**(picklist)).rView;
  523.     InsetRect(&myrect, -1, -1);
  524.     FrameRect(&myrect);
  525.     }
  526.  
  527. pascal Boolean
  528. MacListFilter(myDialog, myEvent, myItem)
  529. DialogPtr        myDialog;
  530. EventRecord        *myEvent;
  531. short            *myItem;
  532. {
  533. Rect    listrect;
  534. short    myascii;
  535. Handle    myhandle;
  536. Point    mypoint;
  537. short    mytype;
  538. int        activate;
  539.  
  540.     SetPort(myDialog);
  541.     if (myEvent->what == keyDown) {
  542.         myascii = myEvent->message % 256;
  543.         if (myascii == '\015' || myascii == '\003') {    /* This is return or enter... */
  544.             *myItem = 1;
  545.             return true;
  546.             }
  547.         }
  548.     else if (myEvent->what == mouseDown) {
  549.         mypoint = myEvent->where;
  550.         GlobalToLocal(&mypoint);
  551.         GetDItem(myDialog, 4, &mytype, &myhandle, &listrect);
  552.         if (PtInRect(mypoint, &listrect) && picklist != NULL) {
  553.             if (LClick(mypoint, (short)myEvent->modifiers, picklist)) {
  554.                 /* User double-clicked in cell... */
  555.                 *myItem = 1;
  556.                 return true;
  557.                 }
  558.             }
  559.         }
  560.     else if (myEvent->what == activateEvt && picklist != NULL) {
  561.         activate = (myEvent->modifiers & 0x01) != 0;
  562.         LActivate((Boolean) activate, picklist);
  563.         }
  564.     
  565.     return false;
  566.     }
  567.  
  568. STR *
  569. do_pick(arglast)
  570.     int *arglast;
  571. {
  572.     register STR **st = stack->ary_array;
  573.     register int sp = arglast[0];
  574.     int            maxarg = arglast[2] - sp - 1;
  575.     char *        prompt;
  576.     short        itemHit;
  577.     Boolean        done;
  578.     DialogPtr    dlg;
  579.     ListHandle    mylist;
  580.     Cell        mycell;
  581.     short        mytype;
  582.     Handle        myhandle;
  583.     Point        cellsize;
  584.     Rect        listrect, dbounds;
  585.     char    *    item;
  586.  
  587.     prompt = (char*)str_get(st[++sp]);
  588.     InitCursor();
  589.     dlg = GetNewDialog(2020, NULL, (WindowPtr)-1);
  590.     
  591.     SetDlgText(dlg, 3, prompt);
  592.     GetDItem(dlg, 4, &mytype, &myhandle, &listrect);
  593.     SetDItem(dlg, 4, mytype, (Handle)MacListUpdate, &listrect);
  594.     
  595.     SetPort(dlg);
  596.     InsetRect(&listrect, 1, 1);
  597.     SetRect(&dbounds, 0, 0, 1, maxarg);
  598.     cellsize.h = (listrect.right - listrect.left);
  599.     cellsize.v = 17;
  600.  
  601.     listrect.right -= 15;
  602.  
  603.     picklist = LNew(&listrect, &dbounds, cellsize, 0,
  604.                             dlg, true, false, false, true);
  605.  
  606.     mylist = picklist;
  607.     LDoDraw(false, mylist);
  608.     
  609.     SetCell(mycell, 0, 0);
  610.     for (; mycell.v<maxarg; ++mycell.v)    {
  611.         item = str_get(st[++sp]);
  612.         LSetCell(item, st[sp]->str_cur, mycell, mylist);
  613.     }
  614.  
  615.     LDoDraw(true, mylist);
  616.     CenterWindow(dlg);
  617.     ShowWindow(dlg);
  618.     
  619.     for (done=false; !done; ) {
  620.         SetPort(dlg);
  621.         FrameDlgRect(dlg, ok);
  622.         ModalDialog(MacListFilter, &itemHit);
  623.         switch (itemHit) {
  624.         case ok:
  625.             SetCell(mycell, 0, 0);
  626.             done = true;
  627.             if (!LGetSelect(true, &mycell, picklist))
  628.                 itemHit = cancel;
  629.             break;
  630.         case cancel:
  631.             done = true;
  632.             break;
  633.         }
  634.     }    /* Modal Loop */
  635.  
  636.     SetPort(dlg);
  637.     
  638.     LDispose(mylist);
  639.     picklist = NULL;
  640.     DisposDialog(dlg);
  641.     
  642.     if (itemHit == ok)
  643.         return str_smake(st[arglast[0]+mycell.v+2]);
  644.     else
  645.         return &str_undef;    
  646. }
  647.  
  648. static int
  649. macperlsub(ix, sp, items)
  650. int ix;
  651. register int sp;
  652. register int items;
  653. {
  654.     STR **st = stack->ary_array + sp;
  655.     register int i;
  656.     register STR *Str;        /* used in str_get and str_gnum macros */
  657.      
  658.      switch (ix) {
  659.      case MP_fsetfileinfo:
  660.          {
  661.             unsigned long    creator;
  662.             unsigned long    type;
  663.             
  664.             if (items < 3)
  665.                 fatal("Usage: &MacPerl'SetFileInfo(CREATOR, TYPE, FILE...)");
  666.                 
  667.              creator    = *(unsigned long*)    str_get(st[1]);
  668.              type        = *(unsigned long*)    str_get(st[2]);
  669.             
  670.              for (i = 3; i<=items; i++)
  671.                  fsetfileinfo(str_get(st[i]), creator, type);
  672.                     
  673.              st[0] = &str_undef;
  674.      
  675.              return sp;
  676.         }
  677.     case MP_fgetfileinfo:
  678.         {
  679.              unsigned long    creator;
  680.              unsigned long    type;
  681.  
  682.             if (items != 1)
  683.                 fatal("Usage: &MacPerl'GetFileInfo(PATH)");
  684.  
  685.             fgetfileinfo(str_get(st[1]), &creator, &type);
  686.             
  687.             if (!curcsv || curcsv->wantarray != G_ARRAY) {
  688.                 str_nset(st[0], &type, 4);
  689.                 return sp;
  690.             }
  691.             st[0] = str_2mortal(str_make(&creator,4));
  692.             st[1] = str_2mortal(str_make(&type,4));
  693.             return sp + 1;
  694.         }
  695.     case MP_ask:
  696.         {
  697.             char *        prompt;
  698.             short            item;
  699.             DialogPtr    dlg;
  700.             STR *         str;
  701.         
  702.             if (items < 1 || items > 2)
  703.                 fatal("Usage: &MacPerl'Ask(PROMPT [, DEFAULT])");
  704.                 
  705.             prompt = (char*)str_get(st[1]);
  706.         
  707.             dlg = GetNewDialog(2010, NULL, (WindowPtr)-1);
  708.             InitCursor();
  709.             SetDlgText(dlg, 3, prompt);
  710.             
  711.             if (items == 2)
  712.                 SetDlgText(dlg, 4, (char*)str_get(st[2]));
  713.             SelIText(dlg, 4, 0, 1024);
  714.         
  715.             InitCursor();
  716.             CenterWindow(dlg);
  717.             ShowWindow(dlg);
  718.             SetPort(dlg);
  719.             FrameDlgRect(dlg, ok);
  720.             ModalDialog((ModalFilterProcPtr)0, &item);
  721.             switch (item) {
  722.             case ok:
  723.                 str = str_2mortal(Str_new(22,257));
  724.                 str->str_cur = 256;
  725.                     str->str_pok = 1;
  726.                 GetDlgText(dlg, 4, (StringPtr) str->str_ptr);
  727.                 str->str_cur = strlen(str->str_ptr);
  728.                 break;
  729.             case cancel:
  730.                 break;
  731.             }
  732.             DisposDialog(dlg);
  733.             
  734.             st[0] = (item == ok)  ? str : &str_undef;
  735.             
  736.             return sp;
  737.         }
  738.     case MP_answer:
  739.         {
  740.             char *        prompt;
  741.             short            item;
  742.             DialogPtr    dlg;
  743.             Str255        tmpPStr;
  744.         
  745.             if (items < 1 || items > 4)
  746.                 fatal("Usage: &MacPerl'Answer(PROMPT [, BUTTON1 [, BUTTON2 [, BUTTON3]]])");
  747.                 
  748.             prompt = (char*)str_get(st[1]);
  749.         
  750.             dlg = GetNewDialog((items>1) ? 1999+items : 2001, NULL, (WindowPtr)-1);
  751.             InitCursor();
  752.             SetDlgText(dlg, 5, prompt);
  753.             
  754.             if (items>1) 
  755.                 for (item = 1; item<items; ++item) {
  756.                     prompt = (char*)str_get(st[item+1]);
  757.                     memcpy(tmpPStr+1, prompt, *tmpPStr = st[item+1]->str_cur);
  758.                     SetCTitle(GetDlgCtrl(dlg, item), tmpPStr);
  759.                 }
  760.             else
  761.                 SetCTitle(GetDlgCtrl(dlg, 1), "\pOK");
  762.             
  763.             CenterWindow(dlg);
  764.             ShowWindow(dlg);
  765.             SetPort(dlg);
  766.             FrameDlgRect(dlg, ok);
  767.             ModalDialog((ModalFilterProcPtr)0, &item);
  768.             DisposDialog(dlg);
  769.             
  770.             str_numset(st[0], (items>1) ? (double)(items-item-1) : 0.0);
  771.             
  772.             return sp;
  773.         }
  774.     case MP_choose:
  775.         {
  776.             int domain, type, flags;
  777.             char * prompt;
  778.             char * constraint;
  779.             char * def_addr;
  780.             STR * str;
  781.             
  782.             if (items < 3 || items > 6)
  783.                 fatal("Usage: &MacPerl'Choose(DOMAIN, TYPE, PROMPT [, CONSTRAINT [, FLAGS [, DEFAULT]]])");
  784.                         
  785.             domain = (int)str_gnum(st[1]);
  786.             type = (int)str_gnum(st[2]);
  787.             prompt = (char*)str_get(st[3]);
  788.             constraint = (items>=4) ? (char*)str_get(st[4]) : nil;
  789.             constraint = constraint && st[4]->str_cur ? constraint : nil;
  790.             flags = (items>=5) ? (int)str_gnum(st[5]) : 0;
  791.             def_addr = (items==6) ? (char*)str_get(st[6]) : nil;
  792.             def_addr = def_addr && st[6]->str_cur ? def_addr : nil;
  793.             
  794.             str = str_2mortal(Str_new(22,257));
  795.             str->str_cur = 256;
  796.             str->str_pok = 1;
  797.             
  798.             if (def_addr) {
  799.                 memcpy(str->str_ptr, def_addr, st[6]->str_cur);
  800.                 str->str_ptr[st[6]->str_cur] = 0;    /* Some types require this */
  801.             }
  802.             
  803.             if (choose(domain, type, prompt, constraint, flags, str->str_ptr, (int*)&str->str_cur) < 0)
  804.                 st[0] = &str_undef;
  805.             else
  806.                 st[0] = str_2mortal(str);
  807.                 
  808.                 return sp;
  809.         }
  810.     case MP_pick:
  811.         {    
  812.             char *        prompt;
  813.             short            itemHit;
  814.             Boolean        done;
  815.             DialogPtr    dlg;
  816.             ListHandle    mylist;
  817.             Cell            mycell;
  818.             short            mytype;
  819.             Handle        myhandle;
  820.             Point            cellsize;
  821.             Rect            listrect, dbounds;
  822.             char    *        item;
  823.         
  824.             if (items < 2)
  825.                 fatal("Usage: &MacPerl'Pick(PROMPT, ITEM...)");
  826.                 
  827.             prompt = (char*)str_get(st[1]);
  828.             InitCursor();
  829.             dlg = GetNewDialog(2020, NULL, (WindowPtr)-1);
  830.             
  831.             SetDlgText(dlg, 3, prompt);
  832.             GetDItem(dlg, 4, &mytype, &myhandle, &listrect);
  833.             SetDItem(dlg, 4, mytype, (Handle)MacListUpdate, &listrect);
  834.             
  835.             SetPort(dlg);
  836.             InsetRect(&listrect, 1, 1);
  837.             SetRect(&dbounds, 0, 0, 1, items-1);
  838.             cellsize.h = (listrect.right - listrect.left);
  839.             cellsize.v = 17;
  840.         
  841.             listrect.right -= 15;
  842.         
  843.             picklist = LNew(&listrect, &dbounds, cellsize, 0,
  844.                                     dlg, true, false, false, true);
  845.         
  846.             mylist = picklist;
  847.             LDoDraw(false, mylist);
  848.             
  849.             SetCell(mycell, 0, 0);
  850.             for (; mycell.v<items-1; ++mycell.v)    {
  851.                 item = str_get(st[mycell.v+2]);
  852.                 LSetCell(item, st[mycell.v+2]->str_cur, mycell, mylist);
  853.             }
  854.         
  855.             LDoDraw(true, mylist);
  856.             CenterWindow(dlg);
  857.             ShowWindow(dlg);
  858.             
  859.             for (done=false; !done; ) {
  860.                 SetPort(dlg);
  861.                 FrameDlgRect(dlg, ok);
  862.                 ModalDialog(MacListFilter, &itemHit);
  863.                 switch (itemHit) {
  864.                 case ok:
  865.                     SetCell(mycell, 0, 0);
  866.                     done = true;
  867.                     if (!LGetSelect(true, &mycell, picklist))
  868.                         itemHit = cancel;
  869.                     break;
  870.                 case cancel:
  871.                     done = true;
  872.                     break;
  873.                 }
  874.             }    /* Modal Loop */
  875.         
  876.             SetPort(dlg);
  877.             
  878.             LDispose(mylist);
  879.             picklist = NULL;
  880.             DisposDialog(dlg);
  881.             
  882.             if (itemHit == ok)
  883.                 st[0] = str_2mortal(str_smake(st[mycell.v+2]));
  884.             else
  885.                 st[0] = &str_undef;    
  886.  
  887.             return sp;
  888.         }
  889.     case MP_quit:
  890.         {
  891.             if (items != 1)
  892.                 fatal("Usage: &MacPerl'Quit(CONDITION)");
  893.  
  894.             PerlQuit = (int)str_gnum(st[1]);
  895.  
  896.              str_numset(st[0], (double) 0.0);
  897.  
  898.             return sp;
  899.         }
  900.      case MP_faccess:
  901.          {
  902.              char *                 file =    str_get(st[1]);
  903.              unsigned             cmd  =  (unsigned) str_gnum(st[2]);
  904.              unsigned                uarg;
  905.             Rect                    rarg;
  906.             SelectionRecord    sarg;
  907.             
  908.              switch (cmd) {
  909.             case F_GFONTINFO:
  910.                 if (items > 2)
  911.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_GFONTINFO)");
  912.                 if (faccess(file, cmd, (long *)&uarg) < 0) {
  913.                      st[0] = &str_undef;
  914.  
  915.                     return sp;
  916.                 } else if (!curcsv || curcsv->wantarray != G_ARRAY) {
  917.                     str_numset(st[0], (double)(uarg >> 16));
  918.                     
  919.                     return sp;
  920.                 } else {
  921.                     st[0] = str_2mortal(Str_new(22,257));
  922.                     getfontname(uarg >> 16, st[0]->str_ptr);
  923.                     st[0]->str_cur = strlen(st[0]->str_ptr);
  924.                     st[0]->str_pok = 1;
  925.                     str_numset(st[1], (double)(uarg & 0x0FFFF));
  926.                     
  927.                     return sp + 1;
  928.                 }
  929.             case F_GSELINFO:
  930.                 if (items > 2)
  931.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_GSELINFO)");
  932.                 if (faccess(file, cmd, (long *)&sarg) < 0) {
  933.                      st[0] = &str_undef;
  934.  
  935.                     return sp;
  936.                 } else if (!curcsv || curcsv->wantarray != G_ARRAY) {
  937.                     str_numset(st[0], (double)sarg.startingPos);
  938.                     
  939.                     return sp;
  940.                 } else {
  941.                     str_numset(st[0], (double) sarg.startingPos);
  942.                     str_numset(st[1], (double) sarg.endingPos);
  943.                     str_numset(st[2], (double) sarg.displayTop);
  944.                     
  945.                     return sp + 2;
  946.                 }
  947.             case F_GTABINFO:
  948.                 if (items > 2)
  949.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_GTABINFO)");
  950.                 if (faccess(file, cmd, (long *)&uarg) < 0) {
  951.                      st[0] = &str_undef;
  952.  
  953.                     return sp;
  954.                 } else {
  955.                     str_numset(st[0], (double)uarg);
  956.                     
  957.                     return sp;
  958.                 }
  959.             case F_GWININFO:
  960.                 if (items > 2)
  961.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_GWININFO)");
  962.                 if (faccess(file, cmd, (long *)&rarg) < 0) {
  963.                      st[0] = &str_undef;
  964.  
  965.                     return sp;
  966.                 } else if (!curcsv || curcsv->wantarray != G_ARRAY) {
  967.                     str_numset(st[0], (double)rarg.top);
  968.                     
  969.                     return sp;
  970.                 } else {
  971.                     astore(stack, sp + 3, Nullstr);        /* extend stack */
  972.                     st = stack->ary_array + sp;            /* possibly realloced */
  973.                     str_numset(st[0], (double) rarg.left);
  974.                     str_numset(st[1], (double) rarg.top);
  975.                     str_numset(st[2], (double) rarg.right);
  976.                     st[3] = str_2mortal(str_nmake((double) rarg.bottom));
  977.                     
  978.                     return sp + 3;
  979.                 }
  980.             case F_SFONTINFO:
  981.                 if (items < 3 || items > 4)
  982.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_SFONTINFO, FONT [, SIZE])");
  983.                 
  984.                 if (items == 3) {
  985.                     if (faccess(file, F_GFONTINFO, (long *)&uarg) < 0)
  986.                         uarg = 9;
  987.                 } else
  988.                     uarg = (unsigned) str_gnum(st[4]);
  989.                 
  990.                 if (isalpha(str_get(st[3]))) {
  991.                     short    family;
  992.                     
  993.                     getfnum(str_get(st[3]), &family);
  994.                     
  995.                     uarg = (uarg & 0xFFFF) | ((unsigned) family) << 16;
  996.                 } else 
  997.                     uarg = (uarg & 0xFFFF) | ((unsigned) str_gnum(st[3])) << 16;
  998.                 
  999.                 if (faccess(file, cmd, (long *)uarg) < 0) {
  1000.                      st[0] = &str_undef;
  1001.  
  1002.                     return sp;
  1003.                 } else {
  1004.                     str_numset(st[0], (double) 1.0);
  1005.                     
  1006.                     return sp;
  1007.                 }
  1008.             case F_SSELINFO:
  1009.                 if (items < 4 || items > 5)
  1010.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_SSELINFO, START, END [, TOP])");
  1011.                 
  1012.                 if (items == 4) {
  1013.                     if (faccess(file, F_GSELINFO, (long *) &sarg) < 0) 
  1014.                         sarg.displayTop = (long) str_gnum(st[3]);
  1015.                 } else 
  1016.                     sarg.displayTop = (long) str_gnum(st[5]);
  1017.                     
  1018.                 sarg.startingPos = (long) str_gnum(st[3]);
  1019.                 sarg.endingPos = (long) str_gnum(st[4]);
  1020.                 
  1021.                 if (faccess(file, cmd, (long *)&sarg) < 0) {
  1022.                      st[0] = &str_undef;
  1023.  
  1024.                     return sp;
  1025.                 } else {
  1026.                     str_numset(st[0], (double) 1.0);
  1027.                     
  1028.                     return sp;
  1029.                 }
  1030.             case F_STABINFO:
  1031.                 if (items != 3)
  1032.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_STABINFO, TAB)");
  1033.                 
  1034.                 uarg = (unsigned) str_gnum(st[3]);
  1035.                 
  1036.                 if (faccess(file, cmd, (long *)uarg) < 0) {
  1037.                      st[0] = &str_undef;
  1038.  
  1039.                     return sp;
  1040.                 } else {
  1041.                     str_numset(st[0], (double) 1.0);
  1042.                     
  1043.                     return sp;
  1044.                 }
  1045.             case F_SWININFO:
  1046.                 if (items != 4 && items != 6)
  1047.                     fatal("Usage: &MacPerl'FAccess(FILE, &F_SWININFO, LEFT, TOP [, RIGHT, BOTTOM])");
  1048.                 
  1049.                 if (items == 4) {
  1050.                     if (faccess(file, F_GWININFO, (long *)&rarg) < 0)
  1051.                         rarg.bottom = rarg.right = 400;
  1052.                     else {
  1053.                         rarg.right = rarg.right - rarg.left + (short) str_gnum(st[3]);
  1054.                         rarg.bottom = rarg.bottom - rarg.top + (short) str_gnum(st[4]);
  1055.                     }
  1056.                 } else {
  1057.                     rarg.right = (short) str_gnum(st[5]);
  1058.                     rarg.bottom = (short) str_gnum(st[6]);
  1059.                 }
  1060.                     
  1061.                 rarg.left = (short) str_gnum(st[3]);
  1062.                 rarg.top = (short) str_gnum(st[4]);
  1063.                 
  1064.                 if (faccess(file, cmd, (long *)&rarg) < 0) {
  1065.                      st[0] = &str_undef;
  1066.  
  1067.                     return sp;
  1068.                 } else {
  1069.                     str_numset(st[0], (double) 1.0);
  1070.                     
  1071.                     return sp;
  1072.                 }
  1073.             default:
  1074.                 fatal("&MacPerl'FAccess() can't handle this command");
  1075.             }
  1076.         }
  1077.     default:
  1078.          fatal("macperl: Unknown index (Can't happen)");
  1079.        return sp;
  1080.     }
  1081. }
  1082.  
  1083. ComponentInstance gScriptingComponent;
  1084.  
  1085. void ShutDownAppleScript(void)
  1086. {
  1087.     CloseComponent(gScriptingComponent);
  1088.     
  1089.     gScriptingComponent = nil;
  1090. }
  1091.  
  1092. OSErr InitAppleScript(void)
  1093. {
  1094.     OSErr                myErr;
  1095.     ComponentDescription descr;
  1096.     ComponentDescription capabilities;
  1097.     Component            myComponent;
  1098.     EventRecord          myEvent;
  1099.     short                retryCount;
  1100.             
  1101.     retryCount = 0;
  1102.     
  1103.     do {
  1104.         /* Don't lose the high level events - expect a null back */
  1105.         
  1106.         myErr = 
  1107.               WaitNextEvent(
  1108.                 mDownMask+mUpMask+keyDownMask+keyUpMask+autoKeyMask, 
  1109.                 &myEvent,
  1110.                 240, /* 4 seconds */
  1111.                 nil);
  1112.     
  1113.         descr.componentType         = kOSAComponentType;
  1114.         descr.componentSubType      = kAppleScriptSubtype;
  1115.         descr.componentManufacturer = (OSType) 0;
  1116.         descr.componentFlags        = kOSASupportsCompiling + 
  1117.                                                 kOSASupportsGetSource + 
  1118.                                                 kOSASupportsAESending;
  1119.         descr.componentFlagsMask    = descr.componentFlags;
  1120.         
  1121.         myComponent = FindNextComponent(nil, &descr);
  1122.         
  1123.         retryCount++;
  1124.     } while (myComponent==nil && retryCount<15); /* Try for one minute */
  1125.     
  1126.     if (myComponent==nil)
  1127.           return -1;
  1128.     else {
  1129.         myErr = GetComponentInfo(myComponent, &capabilities, nil, nil, nil);
  1130.         gScriptingComponent = OpenComponent(myComponent);
  1131.         if (!gScriptingComponent)
  1132.             return(-1);
  1133.         else
  1134.             atexit(ShutDownAppleScript);
  1135.     }
  1136.         
  1137.     return myErr;
  1138. }
  1139.  
  1140. static int
  1141. doapscript(ix, sp, items)
  1142. int ix;
  1143. register int sp;
  1144. register int items;
  1145. {
  1146.     STR **st = stack->ary_array + sp;
  1147.     register int i;
  1148.     register STR *Str;        /* used in str_get and str_gnum macros */
  1149.      
  1150.      switch (ix) {
  1151.      case MP_reply:
  1152.        {
  1153.             char *    reply;
  1154.  
  1155.             if (items > 1)
  1156.                 fatal("MacPerl'Reply called with more than 1 argument");
  1157.             
  1158.             if (!gScriptingComponent && InitAppleScript())
  1159.                 fatal("MacPerl'DoAppleScript couldn't initialize AppleScript");
  1160.                 
  1161.             reply = (char*)str_get(st[1]);
  1162.             
  1163.             if (PerlReply)
  1164.                 DisposeHandle(PerlReply);
  1165.                 
  1166.             PtrToHand(reply, &PerlReply, strlen(reply));
  1167.  
  1168.              st[0] = &str_undef;
  1169.             
  1170.             return sp;
  1171.         }
  1172.      case MP_doapplescript:
  1173.        {
  1174.             AEDesc    source;
  1175.             AEDesc    result;
  1176.             char *    script;
  1177.             
  1178.             if (items > 1)
  1179.                 fatal("MacPerl'DoAppleScript called with more than 1 argument");
  1180.             
  1181.             if (!gScriptingComponent && InitAppleScript())
  1182.                 fatal("MacPerl'DoAppleScript couldn't initialize AppleScript");
  1183.                 
  1184.             script = (char*)str_get(st[1]);
  1185.             AECreateDesc(typeChar, script, strlen(script), &source);
  1186.             
  1187.             if (!OSADoScript(
  1188.                     gScriptingComponent, 
  1189.                     &source, 
  1190.                     kOSANullScript, 
  1191.                     typeChar, 
  1192.                     kOSAModeCanInteract,
  1193.                     &result))
  1194.             {
  1195.                 AEDisposeDesc(&source);
  1196.                 
  1197.                 if (!AECoerceDesc(&result, typeChar, &source)) {
  1198.                     HLock(source.dataHandle);
  1199.                 
  1200.                     st[0] = str_2mortal(str_make(*source.dataHandle,GetHandleSize(source.dataHandle)));
  1201.                     
  1202.                     AEDisposeDesc(&source);
  1203.                 } else
  1204.                     st[0] = &str_undef;
  1205.             
  1206.                 AEDisposeDesc(&result);
  1207.             } else {
  1208.                 AEDisposeDesc(&source);
  1209.                 
  1210.                 st[0] = &str_undef;
  1211.             }
  1212.             
  1213.             return sp;
  1214.         }
  1215.      default:
  1216.          fatal("doapscript: Unknown index (Can't happen)");
  1217.        return sp;
  1218.      }
  1219. }
  1220.