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