home *** CD-ROM | disk | FTP | other *** search
/ Netscape Plug-Ins Developer's Kit / Netscape_Plug-Ins_Developers_Kit.iso / CGIPERL / MACPERL / MSRCE418.HQX / Perl Source ƒ / MacPerl / MPScript.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-02-19  |  21.5 KB  |  1,106 lines
  1. /*********************************************************************
  2. Project    :    MacPerl            -    Real Perl Application
  3. File        :    MPScript.c        -    Handle scripts
  4. Author    :    Matthias Neeracher
  5. Language    :    MPW C
  6.  
  7. $Log: MPScript.c,v $
  8. Revision 1.2  1994/05/04  02:54:19  neeri
  9. Always keep the right resource file in front.
  10.  
  11. Revision 1.1  1994/02/27  23:01:56  neeri
  12. Initial revision
  13.  
  14. Revision 0.2  1993/10/14  00:00:00  neeri
  15. Run front window
  16.  
  17. Revision 0.1  1993/08/17  00:00:00  neeri
  18. Set up correct default directory
  19.  
  20. *********************************************************************/
  21.  
  22. #define ORIGINAL_WRAPPER
  23.  
  24. #ifdef RUNTIME
  25. /* This is not merely my personal opinion. SegLoad.h now requires this */
  26. #define OBSOLETE
  27.  
  28. #include <SegLoad.h>
  29. #endif
  30.  
  31. #include <AERegistry.h>
  32. #include <String.h>
  33. #include <TFileSpec.h>
  34. #include <sys/types.h>
  35. #include <ctype.h>
  36. #include <stdio.h>
  37. #include <fcntl.h>
  38. #include <unistd.h>
  39. #include <Signal.h>
  40. #include <StandardFile.h>
  41. #include <Resources.h>
  42. #include <PLStringFuncs.h>
  43. #include <LowMem.h>
  44. #include <FragLoad.h>
  45. #include <AEBuild.h>
  46. #include <AEStream.h>
  47. #include <AESubDescs.h>
  48. #include <OSA.h>
  49.  
  50. #include "MPScript.h"
  51. #include "MPWindow.h"
  52. #include "MPAppleEvents.h"
  53. #include "MPAEVTStream.h"
  54. #include "MPFile.h"
  55. #include "MPSave.h"
  56. #include "MPMain.h"
  57.  
  58. #ifndef RUNTIME
  59. pascal Boolean GetScriptFilter(CInfoPBPtr pb, void * data)
  60. {
  61. #if !defined(powerc) && !defined(__powerc)
  62. #pragma unused(data)
  63. #endif
  64.     switch (GetDocTypeFromInfo(pb)) {
  65.     case kPreferenceDoc:
  66.         /* We don't want preference files here. */
  67.     case kUnknownDoc:
  68.         return true;
  69.     default:
  70.         return false;
  71.     }
  72. }
  73.  
  74. #if USESROUTINEDESCRIPTORS
  75. RoutineDescriptor    uGetScriptFilter = 
  76.         BUILD_ROUTINE_DESCRIPTOR(uppFileFilterYDProcInfo, GetScriptFilter);
  77. #else
  78. #define uGetScriptFilter *(FileFilterYDUPP)&GetScriptFilter
  79. #endif
  80. #else
  81. pascal Boolean GetScriptFilter(ParmBlkPtr    info)
  82. {
  83.     switch (info->fileParam.ioFlFndrInfo.fdType) {
  84.     case 'APPL':
  85.         switch (info->fileParam.ioFlFndrInfo.fdCreator) {
  86.         case MPRtSig:
  87.             return false;
  88.         case MPAppSig:
  89.             return !info->fileParam.ioFlLgLen;
  90.         default:
  91.             return true;
  92.         }
  93.     case 'TEXT':
  94.         return false;
  95.     default:
  96.         return true;
  97.     }
  98. }
  99. #endif
  100.  
  101. #ifndef RUNTIME
  102.  
  103. #define gsDebugItem        10
  104.  
  105. pascal short GetScriptHook(short item, DialogPtr dlg, void * params)
  106. {
  107.     short                kind;
  108.     ControlHandle    dbg;
  109.     Rect                r;
  110.     Boolean *        par = (Boolean *) params;
  111.     
  112.     if (GetWRefCon(dlg) != 'stdf')
  113.         return item;
  114.  
  115.     switch (item) {
  116.     case sfHookFirstCall:
  117.         *par    =    false;
  118.     
  119.         return sfHookFirstCall;
  120.     case gsDebugItem:
  121.         *par = !*par;
  122.         
  123.         GetDItem(dlg, item, &kind, (Handle *) &dbg, &r);
  124.         
  125.         SetCtlValue(dbg, *par);
  126.         
  127.         return sfHookNullEvent;
  128.     default:
  129.         return item;
  130.     }
  131. }
  132.  
  133. #if USESROUTINEDESCRIPTORS
  134. RoutineDescriptor    uGetScriptHook = 
  135.         BUILD_ROUTINE_DESCRIPTOR(uppDlgHookYDProcInfo, GetScriptHook);
  136. #else
  137. #define uGetScriptHook *(DlgHookYDUPP)&GetScriptHook
  138. #endif
  139.  
  140. void PopupOffending(AEDesc * repl)
  141. {
  142.     OSErr                        err;
  143.     AEDesc                    target;
  144.     short                        line;
  145.     DescType                    type;
  146.     Size                        size;
  147.     FSSpec                    file;
  148.     
  149.     if (AEGetParamPtr(repl, kOSAErrorOffendingObject, typeFSS, &type, &file, sizeof(FSSpec), &size))
  150.         return;
  151.     if (AEGetKeyDesc(repl, kOSAErrorRange, typeWildCard, &target))
  152.         return;
  153.     err = AEGetKeyPtr(&target, keyOSASourceStart, typeShortInteger, &type, &line, sizeof(short), &size);
  154.     AEDisposeDesc(&target);
  155.     if (err)
  156.         return;
  157.     IssueJumpCommand(&file, nil, line);
  158. }
  159.  
  160. static void SendScriptEvent(
  161.     DescType argType, 
  162.     Ptr         argPtr, 
  163.     Handle    argHdl,
  164.     Size         argSize, 
  165.     Boolean     debug)
  166. {
  167.     OSErr                    err;
  168.     AppleEvent            cmd, repl;
  169.     AEAddressDesc        addr;
  170.     
  171.     if (err = MakeSelfAddress(&addr))
  172.         goto failedAddress;
  173.         
  174.     if (err = 
  175.         AECreateAppleEvent(
  176.             kAEMiscStandards, kAEDoScript, &addr, 
  177.             kAutoGenerateReturnID, kAnyTransactionID, 
  178.             &cmd)
  179.     )
  180.         goto failedAppleEvent;
  181.     
  182.     if (argHdl) {
  183.         HLock(argHdl);
  184.         argPtr = *argHdl;
  185.     }
  186.     
  187.     if (err = AEPutParamPtr(&cmd, keyDirectObject, argType, argPtr, argSize))
  188.         goto failedParam;
  189.     
  190.     if (debug)
  191.         if (err =
  192.             AEPutParamPtr(
  193.                 &cmd, 'DEBG', 
  194.                 typeBoolean, (Ptr) &debug, sizeof(Boolean))
  195.         )
  196.             goto failedParam;
  197.         
  198.     if (AESend(&cmd, &repl,
  199.             kAEWaitReply+kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeout,
  200.             nil, nil)
  201.     && !gQuitting
  202.     ) 
  203.         PopupOffending(&repl);
  204.  
  205.     AEDisposeDesc(&repl);
  206. failedParam:    
  207.     if (argHdl)
  208.         HUnlock(argHdl);
  209.         
  210.     AEDisposeDesc(&cmd);
  211. failedAppleEvent:
  212.     AEDisposeDesc(&addr);
  213. failedAddress:
  214.     ;
  215. }
  216.  
  217. pascal void DoScriptMenu(short theItem)
  218. {
  219.     StandardFileReply    reply;
  220.     Point                    where;
  221.     Boolean                debug;
  222.     
  223.     where.h = where.v = -1;
  224.  
  225.     BuildSEList();
  226.     
  227.     switch (theItem) {
  228.     case pmRun:
  229.         CustomGetFile(
  230.             &uGetScriptFilter,
  231.             MacPerlFileTypeCount, 
  232.             MacPerlFileTypes,
  233.             &reply,
  234.             GetScriptDialog,
  235.             where,
  236.             &uGetScriptHook,
  237.             (ModalFilterYDUPP) nil,
  238.             nil,
  239.             (ActivateYDUPP) nil,
  240.             &debug);
  241.         if (reply.sfGood)
  242.             SendScriptEvent(typeFSS, (Ptr) &reply.sfFile, nil, sizeof(FSSpec), debug);
  243.         break;
  244.     case pmRunFront:
  245.         {
  246.             DPtr    doc = DPtrFromWindowPtr(FrontWindow());
  247.             
  248.             if (!doc || doc->kind != kDocumentWindow)
  249.                 break;
  250.             
  251.             if (doc->dirty || !doc->u.reg.everSaved) {
  252.                 if (doc->u.reg.everSaved)
  253.                     strcpy(gPseudoFileName, FSp2FullPath(&doc->theFSSpec));
  254.                 else
  255.                     getwtitle(FrontWindow(), gPseudoFileName);
  256.  
  257.                 SendScriptEvent(
  258.                     typeChar, nil, (*doc->theText)->hText, 
  259.                     GetHandleSize((*doc->theText)->hText),
  260.                     false);
  261.             } else {
  262.                 gPseudoFileName[0] = 0;
  263.                 SendScriptEvent(typeFSS, (Ptr) &doc->theFSSpec, nil, sizeof(FSSpec), false);
  264.             }
  265.         }
  266.         break;
  267.     }
  268. }
  269.  
  270. #endif
  271.  
  272. typedef void (*atexitfn)();
  273.  
  274. void MP_Exit(int status)
  275. {
  276.     if (gRunningPerl)
  277.         longjmp(gExitPerl, -status-1);
  278.     else {
  279.         exit(status);
  280.     }
  281. }
  282.  
  283. static atexitfn     PerlExitFn[20];
  284. static int            PerlExitCnt;
  285.  
  286. int MP_AtExit(atexitfn func)
  287. {
  288.     if (gRunningPerl)
  289.         PerlExitFn[PerlExitCnt++] = func;
  290.     else {
  291.         return atexit(func);
  292.     }
  293.         
  294.     return 0;
  295. }
  296.  
  297. static char **        PerlArgs;
  298. static int            PerlArgMax;
  299. static char **        PerlEnviron;
  300. static Handle        PerlEnvText;
  301. static char *        DefaultPerlEnviron = "=PERLDB=require \"macperldb.pl\"";
  302. static int            DefaultPerlEnvLen;
  303.  
  304. char * MP_GetEnv(const char * var)
  305. {
  306.     char **     env;
  307.     
  308.     for (env = PerlEnviron; *env; ++env)
  309.         if (!strcmp(*env, var))
  310.             return *env + strlen(*env) + 1;
  311.         
  312.     return nil;
  313. }
  314.  
  315. #if defined(powerc) || defined(__powerc)
  316. extern void *(*DB_calloc)(size_t nmemb, size_t size);
  317. extern void (*DB_free)(void *ptr);
  318. extern void *(*DB_malloc)(size_t size);
  319. extern void *(*DB_realloc)(void *ptr, size_t size);
  320. extern void *ice_calloc(size_t nmemb, size_t size);
  321. extern void ice_free(void *ptr);
  322. extern void *ice_malloc(size_t size);
  323. extern void *ice_realloc(void *ptr, size_t size);
  324. #endif
  325.  
  326. pascal void InitPerlEnviron()
  327. {
  328.     DefaultPerlEnvLen                            = strlen(DefaultPerlEnviron) + 1;
  329.     *strrchr(DefaultPerlEnviron, '=')     = 0;
  330.     *strchr(DefaultPerlEnviron, '=')     = 0;
  331.  
  332.     gDebugLogName     = "Dev:Console:Debug Log";
  333.     gExit                = MP_Exit;
  334.     gAtExit            = MP_AtExit;
  335.     gGetEnv            = MP_GetEnv;
  336.     gAlwaysExtract    = true;
  337.     gHandleEvent    = HandleEvent;
  338. #if defined(powerc) || defined(__powerc)
  339.     gCAlloc            = ice_calloc;
  340.     gFree                = ice_free;
  341.     gMalloc            = ice_malloc;
  342.     gRealloc            = ice_realloc;
  343.     DB_calloc        = ice_calloc;
  344.     DB_free            = ice_free;
  345.     DB_malloc        = ice_malloc;
  346.     DB_realloc        = ice_realloc;
  347. #endif
  348. }
  349.  
  350. Handle MakeLibraries()
  351. {
  352.     int        libCount;
  353.     short        resFile;
  354.     Handle    libs;
  355.     Str255    lib;
  356.  
  357.     PtrToHand("PERLLIB", &libs, 8);
  358.     
  359.     resFile = CurResFile();
  360.     UseResFile(gPrefsFile);
  361.     
  362.     for (libCount = 1; ; ++libCount) {
  363.         GetIndString(lib, LibraryPaths, libCount);
  364.         
  365.         if (!lib[0])
  366.             break;
  367.             
  368.         if (libCount > 1)
  369.             PtrAndHand(",", libs, 1);
  370.         
  371.         PtrAndHand(lib+1, libs, lib[0]);
  372.     }
  373.     
  374.     UseResFile(resFile);
  375.     
  376.     return libs;
  377. }
  378.  
  379. /* Build environment from AEDescriptor passed in 'ENVT' parameter */
  380.  
  381. void MakePerlEnviron(AEDesc * desc)
  382. {
  383.     Handle        envText  = MakeLibraries();
  384.     int            index;
  385.     int            libOffset= 8;
  386.     int            dbOffset = GetHandleSize(envText)+8;
  387.     int            totalLength;
  388.     int            envCount = 2;
  389.     void *         curName;
  390.     void *         curValue;
  391.     long            curNameLen;
  392.     long            curValueLen;
  393.     char *        text;
  394.     AEKeyword    key;
  395.     AESubDesc    strings;
  396.     AESubDesc    cur;    
  397.     
  398.     PtrAndHand(DefaultPerlEnviron, envText, DefaultPerlEnvLen);
  399.     
  400.     if (desc) {
  401.         HLock(desc->dataHandle);
  402.         AEDescToSubDesc(desc, &strings); 
  403.         
  404.         for (index = 0; !AEGetNthSubDesc(&strings, ++index, &key, &cur); ) {
  405.             curName = AEGetSubDescData(&cur, &curNameLen);
  406.             
  407.             if (AEGetNthSubDesc(&strings, ++index, &key, &cur))
  408.                 curValue = nil;
  409.             else
  410.                 curValue = AEGetSubDescData(&cur, &curValueLen);
  411.             
  412.             if (curNameLen == 7 && !memcmp(curName, "PERLLIB", 7)) {
  413.                 if (curValue) {
  414.                     Munger(envText, libOffset, nil, 0, curValue, curValueLen+1);
  415.                     (*envText)[libOffset+curValueLen] = ',';
  416.                     dbOffset += curValueLen+1;
  417.                 }
  418.             } else if (curNameLen == 6 && !memcmp(curName, "PERLDB", 6)) {
  419.                 if (curValue)
  420.                     Munger(
  421.                         envText, dbOffset, 
  422.                         nil, strlen(*envText)+dbOffset, curValue, curValueLen+1);
  423.             } else {
  424.                 ++envCount;
  425.                 
  426.                 totalLength = GetHandleSize(envText);
  427.                 
  428.                 PtrAndHand(curName, envText, curNameLen+1);
  429.                 
  430.                 (*envText)[totalLength+curNameLen] = 0;
  431.                 
  432.                 if (curValue) {
  433.                     PtrAndHand(curValue, envText, curValueLen+1);
  434.                 
  435.                     (*envText)[totalLength+curNameLen+curValueLen+1] = 0;
  436.                 } else {
  437.                     PtrAndHand(curName, envText, 1);
  438.                 
  439.                     (*envText)[totalLength+curNameLen+1] = 0;
  440.                 }
  441.             }
  442.         }
  443.     }
  444.     
  445.     if (PerlEnvText) {
  446.         DisposePtr((Ptr) PerlEnviron);
  447.         DisposeHandle(PerlEnvText);
  448.     }
  449.  
  450.     MoveHHi(PerlEnvText = envText);
  451.     HLock(envText);
  452.         
  453.     PerlEnviron                 = (char **) NewPtr((envCount+1) * sizeof(char *));
  454.     PerlEnviron[envCount]     = nil;
  455.     text                            = *envText;
  456.     
  457.     while (envCount--) {
  458.         PerlEnviron[envCount]    = text;
  459.         text                           += strlen(text) + 1;
  460.         text                           += strlen(text) + 1;
  461.     }
  462. }
  463.  
  464. void CleanupPerl()
  465. {
  466.     int i;
  467.     extern FILE * _lastbuf;
  468.  
  469.     UseResFile(gAppFile);
  470.  
  471.     // Borrowed from GUSI
  472.     
  473.     // Close stdio files (necessary to flush buffers)
  474.     // This implementation is not nice, but who cares ?
  475.     // In case you wonder, _iob is defined in <stdio.h>
  476.  
  477.     fwalk(fflush);
  478.     fwalk(fclose);
  479.  
  480.     // Close all files
  481.  
  482.     for (i = 0; i<FD_SETSIZE; ++i)
  483.         close(i);
  484.  
  485.     while (PerlExitCnt)
  486.         PerlExitFn[--PerlExitCnt]();
  487.  
  488.     UseResFile(gAppFile);
  489.  
  490.     reenter();
  491.  
  492.     freopen("Dev:Console", "r", stdin);
  493.     freopen("Dev:Console", "w", stdout);
  494.     freopen("Dev:Console", "w", stderr); 
  495.     
  496.     stderr->_flag |= _IOLBF;
  497. }
  498.  
  499. enum {
  500.     extractDone            = -4,
  501.     extractDir            = -3,
  502.     extractCpp            = -2,
  503.     extractDebug         = -1
  504. };
  505.  
  506. typedef char * (*ArgExtractor)(void * data, int index);
  507.  
  508. pascal Boolean RunScript(ArgExtractor extractor, void * data)
  509. {
  510.     int        ArgC;
  511.     char    *    res;
  512.     int        i;
  513.     int         DynamicArgs;
  514.     int        returnCode;
  515.     
  516.     ArgC            = 1;
  517.     PerlArgMax    = 20;
  518.     PerlArgs     = malloc(PerlArgMax * sizeof(char *));
  519.     PerlArgs[0]    = "MacPerl";
  520.     
  521.     {
  522.         char        path[256];
  523.     
  524.         strcpy(path, extractor(data, extractDir));
  525.         chdir(path);
  526.     }
  527.     
  528.     if ((res = extractor(data, extractDebug)) && *res == 'y')
  529.         PerlArgs[ArgC++] = "-d";
  530.  
  531.     if ((res = extractor(data, extractCpp)) && *res == 'y')
  532.         PerlArgs[ArgC++] = "-P";
  533.  
  534.     DynamicArgs = ArgC;
  535.     
  536.     if (res = extractor(data, 1)) {
  537.         if (gPerlPrefs.checkType && !gPseudoFile) 
  538.             PerlArgs[ArgC++] = "-x";
  539.         
  540.         DynamicArgs         = ArgC;
  541.         
  542.         PerlArgs[ArgC++]     = res;
  543.     
  544.         for (i=2; PerlArgs[ArgC] = extractor(data, i); ++i)
  545.             if (++ArgC == PerlArgMax) {
  546.                 PerlArgMax    += 20;
  547.                 PerlArgs     = realloc(PerlArgs, PerlArgMax * sizeof(char *));
  548.             }
  549.     }
  550.     
  551.     extractor(data, extractDone);
  552.     
  553.     UseResFile(gAppFile);
  554.     
  555.     PerlArgs[ArgC] =  nil;
  556.     gRunningPerl     =  true;
  557.     gPerlQuit        =    0;
  558.     gFirstErrorLine= -1;
  559.     
  560.     ShowWindowStatus();
  561.     
  562.     signal(SIGINT, exit);
  563.     
  564.     if (!(returnCode = setjmp(gExitPerl))) {
  565.         run_perl(ArgC, PerlArgs, PerlEnviron);
  566.         /* Noone here gets out alive */
  567.     }    
  568.  
  569.     for (i=DynamicArgs; PerlArgs[i]; ++i)
  570.         DisposPtr(PerlArgs[i]);
  571.  
  572.     free(PerlArgs);
  573.  
  574.     CleanupPerl();
  575.     gRunningPerl = false;
  576.     
  577.     if (gScriptFile != gAppFile) {
  578.         CloseResFile(gScriptFile);
  579.         
  580.         gScriptFile = gAppFile;
  581.     }
  582.     
  583.     ShowWindowStatus();
  584.     
  585.     ++gCompletedScripts;
  586.     
  587.     switch (gPerlQuit) {
  588.     case 3:
  589.         if (gCompletedScripts > 1)
  590.             break;
  591.         /* Otherwise, we were the cause of MacPerl being run, let's quit */
  592.     case 2:
  593. #ifdef RUNTIME
  594.     case 1:
  595. #endif
  596.         DoQuit(kAEAsk);
  597.     }
  598.     
  599.     return returnCode == -1;
  600. }
  601.  
  602. char * MakePath(char * path)
  603. {
  604.     char * retarg = NewPtr(strlen(path)+1);
  605.     
  606.     if (retarg)        
  607.         strcpy(retarg, path);
  608.             
  609.     return retarg;
  610. }
  611.  
  612. char * AEExtractor(void * data, int index)
  613. {
  614.     static Boolean            hasParams = false;
  615.     static AEDesc            params;
  616.     static AESubDesc        paramList;
  617.     static int                scriptIndex;
  618.     
  619.     AppleEvent *     event;
  620.     AESubDesc        sd;
  621.     AEKeyword        noKey;
  622.     AEDesc            desc;
  623.     FSSpec            script;
  624.     FSSpec            arg;
  625.     Size                size;
  626.     char *            retarg;
  627.     DescType            type;
  628.     Boolean            flag;
  629.     
  630.     event = (AppleEvent *) data;
  631.     
  632.     if (!hasParams) {
  633.         AEGetParamDesc(event, keyDirectObject, typeAEList, ¶ms);
  634.         AEDescToSubDesc(¶ms, ¶mList);
  635.         hasParams = true;
  636.         scriptIndex = 0; 
  637.         
  638.         if (gRuntimeScript)
  639.             gPseudoFile = gRuntimeScript;
  640.         else
  641.             while (!AEGetNthSubDesc(¶mList, ++scriptIndex, &noKey, &sd)) {
  642.                 if (!AESubDescToDesc(&sd, typeFSS, &desc)) {
  643.                     script = **(FSSpec **) desc.dataHandle;
  644.                     
  645.                     AEDisposeDesc(&desc);
  646.                     
  647.                     break;
  648.                 } 
  649.                 if (AESubDescToDesc(&sd, typeChar, &desc))
  650.                     continue;
  651.                 if ((*desc.dataHandle)[0] == '-') {
  652.                     AEDisposeDesc(&desc);
  653.                     
  654.                     continue;
  655.                 } else {
  656.                     if (!gPseudoFileName[0])
  657.                         strcpy(gPseudoFileName, "<AppleEvent>");
  658.                     gPseudoFile = desc.dataHandle;
  659.                     
  660.                     break;
  661.                 }
  662.             }
  663.     }
  664.     
  665.     switch (index) {
  666.     case extractDone:
  667.         gRuntimeScript = nil;
  668.  
  669.         if (hasParams)
  670.             AEDisposeDesc(¶ms);
  671.             
  672.         hasParams        = false;
  673.  
  674.         return nil;
  675.     case extractDir:
  676.         if (gPseudoFile) {
  677.             script.vRefNum    =    gAppVol;
  678.             script.parID    =    gAppDir;
  679.         } else {
  680.             short    res    = CurResFile();
  681.             
  682.             gScriptFile = HOpenResFile(script.vRefNum, script.parID, script.name, fsRdPerm);
  683.             
  684.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  685.                 strcpy(gPseudoFileName, FSp2FullPath(&script));
  686.                 
  687.                 DetachResource(gPseudoFile);
  688.             }
  689.  
  690.             UseResFile(res);
  691.         } 
  692.         
  693.         FSpUp(&script);
  694.         
  695.         return FSp2FullPath(&script);
  696.     case extractDebug:
  697.         if (AEGetParamPtr(event, 'DEBG', typeBoolean, &type, (Ptr) &flag, 1, &size))
  698.             return nil;
  699.         else
  700.             return flag ? "y" : "n";
  701.     case extractCpp:
  702.         if (AEGetParamPtr(event, 'PREP', typeBoolean, &type, (Ptr) &flag, 1, &size))
  703.             return nil;
  704.         else
  705.             return flag ? "y" : "n";
  706.     default:
  707.         /* A runtime script inserts itself at the beginning */
  708.         if (gRuntimeScript)
  709.             --index;
  710.         
  711.         if (index == scriptIndex && gPseudoFile)
  712.             return MakePath("Dev:Pseudo");
  713.         
  714.         /* End of list ? */
  715.         if (AEGetNthSubDesc(¶mList, index, &noKey, &sd))
  716.             return nil;
  717.  
  718.         if (!AESubDescToDesc(&sd, typeFSS, &desc)) {
  719.             arg = **(FSSpec **) desc.dataHandle;
  720.             
  721.             AEDisposeDesc(&desc);
  722.             
  723.             /* A file, convert to a path name */
  724.             retarg = FSp2FullPath(&arg);
  725.             
  726.             return MakePath(retarg);
  727.         } else if (!AESubDescToDesc(&sd, typeChar, &desc)) {
  728.             size         = GetHandleSize(desc.dataHandle);
  729.             retarg     = NewPtr(size+1);
  730.             
  731.             if (retarg) {
  732.                 retarg[size] = 0;
  733.             
  734.                 memcpy(retarg, *desc.dataHandle, size);
  735.             }
  736.                     
  737.             AEDisposeDesc(&desc);
  738.             
  739.             return retarg;
  740.         }
  741.         
  742.         return nil;
  743.     }            
  744. }
  745.  
  746. char * StupidExtractor(void * data, int index)
  747. {
  748.     FSSpec    *        spec;
  749.     FSSpec            dir;
  750.     char *            retarg;
  751.     char *            path;
  752.     
  753.     spec = (FSSpec *) data;
  754.     
  755.     switch (index) {
  756.     case extractDone:
  757.     case extractDebug:
  758.     case extractCpp:
  759.         return nil;
  760.     case extractDir:
  761.         dir = *spec;
  762.         
  763.         {
  764.             short    res    = CurResFile();
  765.             
  766.             gScriptFile = HOpenResFile(dir.vRefNum, dir.parID, dir.name, fsRdPerm);
  767.             
  768.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  769.                 strcpy(gPseudoFileName, FSp2FullPath(spec));
  770.                 
  771.                 DetachResource(gPseudoFile);
  772.             }
  773.             
  774.             UseResFile(res);
  775.         } 
  776.         
  777.         FSpUp(&dir);
  778.         
  779.         return FSp2FullPath(&dir);
  780.     default:
  781.         if (index > 1)
  782.             return nil;
  783.  
  784.         if (gPseudoFile)
  785.             return "Dev:Pseudo";
  786.             
  787.         path = FSp2FullPath(spec);
  788.         retarg = NewPtr(strlen(path)+1);
  789.             
  790.         strcpy(retarg, path);
  791.             
  792.         return retarg;
  793.     }            
  794. }
  795.  
  796. #ifdef RUNTIME
  797.  
  798. char * YeOldeExtractor(void * data, int index)
  799. {
  800.     long        count;
  801.     char *    retarg;
  802.     char *    path;
  803.     FSSpec    spec;
  804.     AppFile    arg;
  805.     
  806.     count = (long) data;
  807.     
  808.     switch (index) {
  809.     case extractDone:
  810.         gRuntimeScript = nil;
  811.     case extractDebug:
  812.     case extractCpp:
  813.         return nil;
  814.     case extractDir:
  815.         if (gRuntimeScript) {
  816.             spec.vRefNum = gAppVol;
  817.             spec.parID   = gAppDir;
  818.         } else {
  819.             short    res    =    CurResFile();
  820.             
  821.             GetAppFiles(1, &arg);
  822.     
  823.             WD2FSSpec(arg.vRefNum, arg.fName, &spec);
  824.             
  825.             gScriptFile    =    HOpenResFile(spec.vRefNum, spec.parID, spec.name, fsRdPerm);
  826.             
  827.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  828.                 strcpy(gPseudoFileName, FSp2FullPath(&spec));
  829.                 
  830.                 DetachResource(gPseudoFile);
  831.             }
  832.             
  833.             UseResFile(res);
  834.         }
  835.         
  836.         FSpUp(&spec);
  837.         
  838.         return FSp2FullPath(&spec);
  839.     default:
  840.         if (index - (gRuntimeScript != 0) > count)
  841.             return nil;
  842.  
  843.         if (gRuntimeScript)
  844.             --index;
  845.         else if (index == 1 && gPseudoFile)
  846.             return "Dev:Pseudo";
  847.             
  848.         if (!index) {
  849.             gPseudoFile = gRuntimeScript;
  850.             
  851.             return "Dev:Pseudo";
  852.         }
  853.  
  854.         GetAppFiles(index, &arg);
  855.     
  856.         WD2FSSpec(arg.vRefNum, arg.fName, &spec);
  857.         
  858.         path = FSp2FullPath(&spec);
  859.         retarg = NewPtr(strlen(path)+1);
  860.             
  861.         strcpy(retarg, path);
  862.             
  863.         return retarg;
  864.     }            
  865. }
  866. #endif
  867.  
  868. void AddErrorDescription(AppleEvent * reply)
  869. {
  870.     OSErr            err;
  871.     AliasHandle    file;
  872.     AEStream        aes;
  873.     AEDesc      newDesc;
  874.     short            line;
  875.  
  876.     if (gFirstErrorLine == -1 || reply->descriptorType == typeNull) 
  877.         return;
  878.     
  879.     line = (short) gFirstErrorLine;
  880.     
  881.     if (NewAlias(nil, &gFirstErrorFile, &file)) 
  882.         return;
  883.         
  884.     HLock((Handle) file);
  885.     err = AEPutParamPtr(
  886.                 reply, kOSAErrorOffendingObject, 
  887.                 typeAlias, (Ptr) *file, GetHandleSize((Handle) file));
  888.     DisposHandle((Handle) file);
  889.         
  890.     if (err)
  891.         return;
  892.         
  893.     if (AEStream_Open(&aes))
  894.         return;
  895.         
  896.     if (AEStream_OpenRecord(&aes, typeAERecord)
  897.     ||     AEStream_WriteKeyDesc(&aes, keyOSASourceStart, typeShortInteger, (Ptr) &line, 2)
  898.     ||     AEStream_WriteKeyDesc(&aes, keyOSASourceEnd, typeShortInteger, (Ptr) &line, 2)
  899.     ||     AEStream_CloseRecord(&aes)
  900.     ||     AEStream_Close(&aes, &newDesc)
  901.     ) {
  902.         AEStream_Close(&aes, nil);
  903.     } else {
  904.         AEPutParamDesc(reply, kOSAErrorRange, &newDesc)    ;
  905.         AEDisposeDesc(&newDesc);
  906.     }
  907. }
  908.  
  909. pascal OSErr DoScript(const AppleEvent *event, AppleEvent *reply, long refCon)
  910. {
  911. #if !defined(powerc) && !defined(__powerc)
  912. #pragma unused (refCon)
  913. #endif
  914.     Boolean    ranOK;
  915.     OSType    mode;
  916.     DescType    typeCode;
  917.     Size        size;
  918.     AEDesc    env;
  919.     
  920.     if (gRunningPerl) {
  921.         const AppleEvent * e[2];
  922.         
  923.         e[0] = event;
  924.         e[1] = reply;
  925.         
  926.         PtrAndHand((Ptr) e, (Handle) gWaitingScripts, 8);
  927.         
  928.         return AESuspendTheCurrentEvent(event);
  929.     }
  930.  
  931.     if (AEGetParamPtr(event, 'MODE', typeEnumerated, &typeCode, &mode, 4, &size))
  932.         mode = 'LOCL';
  933.     
  934.     switch (mode) {
  935.     case 'RCTL':                
  936.         if (reply) {    /* Return immediately from initial request */
  937.             AEDuplicateDesc(event, &gDelayedScript);
  938.             
  939.             return 0;
  940.         }
  941.  
  942.         /* Fall through on delayed request */ 
  943.     case 'BATC':
  944.         Relay(event, nil, mode);
  945.         
  946.         freopen("Dev:AEVT", "r", stdin);
  947.         freopen("Dev:AEVT", "w", stdout);
  948.         freopen("Dev:AEVT:diag", "w", stderr); 
  949.     
  950.         stderr->_flag |= _IOLBF;
  951.     }
  952.     
  953.     if (AEGetParamDesc(event, 'ENVT', typeAEList, &env))
  954.         MakePerlEnviron(nil);
  955.     else {
  956.         MakePerlEnviron(&env);
  957.         AEDisposeDesc(&env);
  958.     }
  959.         
  960.     ranOK = RunScript(AEExtractor, (void *) event);
  961.     
  962.     switch (mode) {
  963.     case 'RCTL':
  964.         /* Provoke controller to send last data event */
  965.         if (!gQuitting)
  966.             FlushAEVTs(nil);
  967.         break;
  968.     case 'BATC':
  969.     case 'LOCL':    
  970.         /* Get output data into reply event */
  971.         FlushAEVTs(reply);
  972.         
  973.         if (gPerlReply) {
  974.             HLock(gPerlReply);
  975.             AEPutParamPtr(
  976.                         reply, keyDirectObject,
  977.                         typeChar, *gPerlReply, GetHandleSize(gPerlReply));
  978.             DisposeHandle(gPerlReply);
  979.             gPerlReply = nil;
  980.         }
  981.         
  982.         AddErrorDescription(reply);
  983.     }
  984.     
  985.     return ranOK ? 0 : (gSyntaxError ? 1 : 2);
  986. }
  987.  
  988. #ifdef RUNTIME
  989.  
  990. pascal void DoScriptMenu(short theItem)
  991. {
  992.     switch (theItem) {
  993.     case pmRun:
  994.         {
  995.             Point         wh;
  996.             SFTypeList    types;
  997.             SFReply        reply;
  998.             FSSpec        spec;
  999.          
  1000.             wh.h = wh.v = 75;
  1001.             types[0]    = 'TEXT';
  1002.             types[1]    = 'APPL';
  1003.          
  1004.             SFGetFile(wh, "", (FileFilterUPP) GetScriptFilter, 2, types, (DlgHookProcPtr) nil, &reply);
  1005.         
  1006.             if (reply.good) {
  1007.                 WD2FSSpec(reply.vRefNum, reply.fName, &spec);
  1008.                     
  1009.                 MakePerlEnviron(nil);    
  1010.                 RunScript(StupidExtractor, &spec);
  1011.             }
  1012.         }
  1013.         break;
  1014.     case pmRunFront:
  1015.         {
  1016.             DPtr    doc = DPtrFromWindowPtr(FrontWindow());
  1017.             
  1018.             if (!doc || doc->kind != kDocumentWindow)
  1019.                 break;
  1020.             
  1021.             MakePerlEnviron(nil);
  1022.             
  1023.             if (doc->dirty || !doc->u.reg.everSaved) {
  1024.                 gRuntimeScript = (*doc->theText)->hText;
  1025.                 
  1026.                 HandToHand(&gRuntimeScript);
  1027.                 
  1028.                 if (doc->u.reg.everSaved)
  1029.                     strcpy(gPseudoFileName, FSp2FullPath(&doc->theFSSpec));
  1030.                 else
  1031.                     getwtitle(FrontWindow(), gPseudoFileName);
  1032.                 
  1033.                 RunScript(YeOldeExtractor, (void *) 0);
  1034.             } else
  1035.                 RunScript(StupidExtractor, &doc->theFSSpec);
  1036.         }
  1037.         break;
  1038.     }
  1039. }
  1040. #endif
  1041.  
  1042. pascal Boolean DoRuntime()
  1043. {
  1044.     short        message;
  1045.     short        count;
  1046.     FSSpec    spec;
  1047.     
  1048.     if (gRuntimeScript = Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  1049.         spec.vRefNum     =     gAppVol;
  1050.         spec.parID        =    gAppDir;
  1051.         PLstrcpy(spec.name, LMGetCurApName());
  1052.         strcpy(gPseudoFileName, FSp2FullPath(&spec));
  1053.         
  1054.         DetachResource(gRuntimeScript);
  1055.     }
  1056.  
  1057. #ifndef RUNTIME
  1058.     return false;
  1059. #else
  1060.     if (gAppleEventsImplemented)
  1061.         return false;
  1062.         
  1063.     CountAppFiles(&message, &count);
  1064.     
  1065.     if (count) {
  1066.         if (message == appPrint) {
  1067.             int        i;
  1068.            AppFile    arg;
  1069.         
  1070.             for (i=0; i++<count; ) {
  1071.                 GetAppFiles(i, &arg);
  1072.             
  1073.                 WD2FSSpec(arg.vRefNum, arg.fName, &spec);
  1074.                 
  1075.                 if (!IssueAEOpenDoc(spec)) {
  1076.                     IssuePrintWindow(FrontWindow());
  1077.                     IssueCloseCommand(FrontWindow());
  1078.                 }
  1079.             }
  1080.             
  1081.             return true;
  1082.         } 
  1083.     } else {
  1084.         if (!gRuntimeScript) {
  1085.             int        i;
  1086.            AppFile    arg;
  1087.         
  1088.             for (i=0; i++<count; ) {
  1089.                 GetAppFiles(i, &arg);
  1090.             
  1091.                 WD2FSSpec(arg.vRefNum, arg.fName, &spec);
  1092.                 
  1093.                 IssueAEOpenDoc(spec);
  1094.             }
  1095.             
  1096.             return false;
  1097.         }
  1098.     }
  1099.     
  1100.     MakePerlEnviron(nil);    
  1101.     RunScript(YeOldeExtractor, (void *) count);
  1102.     
  1103.     return gQuitting;
  1104. #endif
  1105. }
  1106.