home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / src / AEtcl.c next >
Encoding:
C/C++ Source or Header  |  1993-11-18  |  28.0 KB  |  1,139 lines  |  [TEXT/MPS ]
  1.  
  2. /*
  3. ** This source code was written by Tim Endres
  4. ** Email: time@ice.com.
  5. ** USMail: 8840 Main Street, Whitmore Lake, MI  48189
  6. **
  7. ** Some portions of this application utilize sources
  8. ** that are copyrighted by ICE Engineering, Inc., and
  9. ** ICE Engineering retains all rights to those sources.
  10. **
  11. ** Neither ICE Engineering, Inc., nor Tim Endres, 
  12. ** warrants this source code for any reason, and neither
  13. ** party assumes any responsbility for the use of these
  14. ** sources, libraries, or applications. The user of these
  15. ** sources and binaries assumes all responsbilities for
  16. ** any resulting consequences.
  17. */
  18.  
  19. #include "tickle.h"
  20. #include "tcl.h"
  21. #include "tge.h"
  22. #include "tclMac.h"
  23. #include "stat.h"
  24.  
  25. #include <string.h>
  26.  
  27. #ifndef THINK_C
  28. #    include <AEBuild.h>
  29. #endif
  30.  
  31. #pragma segment AppleEvent
  32.  
  33. #define kMiscEventClass        'misc'
  34. #define kAEDoScript            'dosc'
  35.  
  36. #define MAX_AE_TARGETS        8
  37. #define AET_UNUSED            0
  38. #define AET_INUSE            1
  39.  
  40. struct
  41.     {
  42.     short            state;
  43.     char            name[32];
  44.     AEAddressDesc    target;
  45.     } _ae_targets [MAX_AE_TARGETS];
  46.  
  47.  
  48. static     char    *hexstr = "0123456789ABCDEF";
  49.  
  50. extern int macintoshErr;
  51.  
  52. int
  53. Cmd_OpenAETarget(clientData, interp, argc, argv)
  54.     char        *clientData;
  55.     Tcl_Interp    *interp;
  56.     int            argc;
  57.     char        **argv;
  58.     {
  59.     int                index, myerr;
  60.     TargetID        targetID;
  61.     PortInfoRec        targetPort;
  62.     WindowPtr        myWindow;
  63.     char            sigbuf[8], *a, *b, *c;
  64.     TargetID        targ;
  65. #pragma unused (clientData)
  66.     
  67.     for (index = 0 ; index < MAX_AE_TARGETS ; index++)
  68.         {
  69.         if (_ae_targets[index].state == AET_UNUSED)
  70.             break;
  71.         
  72.         if (strcmp(_ae_targets[index].name, argv[1]) == SAMESTR)
  73.             {
  74.             Tcl_AppendResult(interp, "\"", argv[0], "\" duplicate AETarget name '",
  75.                                     argv[1], "'", (char *) NULL);
  76.             return TCL_ERROR;
  77.             }
  78.         }
  79.  
  80.     if (index >= MAX_AE_TARGETS)
  81.         {
  82.         Tcl_AppendResult(interp, "\"", argv[0], "\" max AETargets open", (char *) NULL);
  83.         return TCL_ERROR;
  84.         }
  85.     else
  86.         {
  87.         if (argc > 3)
  88.             {
  89.             if ( (a=strchr(argv[2], ',')) &&
  90.                  (b=strchr(argv[3], ':')) &&
  91.                  (c=strchr(argv[3], '@')) )
  92.                 {
  93.                 targ.name.nameScript = smRoman;
  94.                 targ.name.portKindSelector = ppcByString;
  95.                 *a = '\0';
  96.                 strncpy((char *)targ.name.name, argv[2], 32);
  97.                 targ.name.name[32] = '\0';
  98.                 c2pstr(targ.name.name);
  99.                 strncpy((char *)targ.name.u.portTypeStr, a + 1, 32);
  100.                 targ.name.u.portTypeStr[32] = '\0';
  101.                 c2pstr(targ.name.u.portTypeStr);
  102.                 *a = ',';
  103.  
  104.                 *b = '\0'; *c = '\0';
  105.                 
  106.                 targ.location.locationKindSelector = ppcNBPLocation;
  107.                 
  108.                 strncpy((char *)targ.location.u.nbpEntity.objStr, argv[3], 32);
  109.                 strncpy((char *)targ.location.u.nbpEntity.typeStr, b + 1, 32);
  110.                 strncpy((char *)targ.location.u.nbpEntity.zoneStr, c + 1, 32);
  111.                 targ.location.u.nbpEntity.objStr[32] = '\0';
  112.                 targ.location.u.nbpEntity.typeStr[32] = '\0';
  113.                 targ.location.u.nbpEntity.zoneStr[32] = '\0';
  114.                 c2pstr(targ.location.u.nbpEntity.objStr);
  115.                 c2pstr(targ.location.u.nbpEntity.typeStr);
  116.                 c2pstr(targ.location.u.nbpEntity.zoneStr);
  117.                 
  118.                 *b = ':'; *c = '@';
  119.                 
  120.                 myerr = AECreateDesc(typeTargetID, (Ptr)&targ, sizeof(targ),
  121.                                             &_ae_targets[index].target);
  122.                 if (myerr == noErr)
  123.                     {
  124.                     _ae_targets[index].state = AET_INUSE;
  125.                     strcpy(_ae_targets[index].name, argv[1]);
  126.                     }
  127.                 else
  128.                     {
  129.                     macintoshErr = myerr;
  130.                     Tcl_AppendResult(interp, "\"", argv[0], "\" AECreateDesc() for ",
  131.                                             argv[1], ":", argv[2], ".", argv[3],
  132.                                             Tcl_MacError(interp), (char *) NULL);
  133.                     return TCL_ERROR;
  134.                     }
  135.                 }
  136.             else
  137.                 {
  138.                 Tcl_AppendResult(interp, "\"", argv[0], "\" error in port name syntax '",
  139.                                         argv[2], "' '", argv[3], "'", (char *) NULL);
  140.                 return TCL_ERROR;
  141.                 }
  142.             }
  143.         else if (argc > 2)                    /* APPL Signature or Name! */
  144.             {
  145.             if (argv[2][0] == '\'' && argv[2][5] == '\'')
  146.                 {
  147.                 sprintf(sigbuf, "%-4.4s", &argv[2][1]);
  148.                 myerr = AECreateDesc(typeApplSignature, (Ptr)sigbuf, 4, &_ae_targets[index].target);
  149.                 if (myerr == noErr)
  150.                     {
  151.                     _ae_targets[index].state = AET_INUSE;
  152.                     strcpy(_ae_targets[index].name, argv[1]);
  153.                     }
  154.                 else
  155.                     {
  156.                     macintoshErr = myerr;
  157.                     Tcl_AppendResult(interp, "\"", argv[0], "\" AECreateDesc() for '",
  158.                                             argv[1], ":", argv[2], "' ",
  159.                                             Tcl_MacError(interp), (char *) NULL);
  160.                     return TCL_ERROR;
  161.                     }
  162.                 }
  163.             else
  164.                 {
  165.                 char                name[256];
  166.                 FSSpec                spec;
  167.                 ProcessSerialNumber    process;
  168.                 ProcessInfoRec        infoRec;
  169.  
  170.                 process.highLongOfPSN        = 0;
  171.                 process.lowLongOfPSN        = kNoProcess;
  172.                 infoRec.processInfoLength    = sizeof(ProcessInfoRec);
  173.                 infoRec.processName            = (StringPtr)name;
  174.                 infoRec.processAppSpec        = &spec;
  175.                 c2pstr(argv[2]);
  176.                 for ( ; (myerr = GetNextProcess(&process)) == noErr ; )
  177.                     {
  178.                     if (GetProcessInformation(&process, &infoRec) == noErr)
  179.                         {
  180.                         if ( argv[2][0] == infoRec.processName[0]
  181.                                 && strncmp((char *)&argv[2][1], &infoRec.processName[1], argv[2][0])==0 )
  182.                             break;
  183.                         }
  184.                     }
  185.                 p2cstr(argv[2]);
  186.                 
  187.                 if (myerr != noErr) 
  188.                     {
  189.                     macintoshErr = myerr;
  190.                     Tcl_AppendResult(interp, "\"", argv[0], "\" no process named '",
  191.                                             argv[1], "' ", Tcl_MacError(interp), (char *) NULL);
  192.                     return TCL_ERROR;
  193.                     }
  194.                 else
  195.                     {
  196.                     myerr = AECreateDesc(typeProcessSerialNumber, (Ptr)&process, sizeof(process),
  197.                                             &_ae_targets[index].target);
  198.                     if (myerr == noErr)
  199.                         {
  200.                         _ae_targets[index].state = AET_INUSE;
  201.                         strcpy(_ae_targets[index].name, argv[1]);
  202.                         }
  203.                     else
  204.                         {
  205.                         macintoshErr = myerr;
  206.                         Tcl_AppendResult(interp, "\"", argv[0], "\" AECreateDesc() for '",
  207.                                                 argv[1], ":", argv[2], "' ",
  208.                                                 Tcl_MacError(interp), (char *) NULL);
  209.                         return TCL_ERROR;
  210.                         }
  211.                     }
  212.                 }
  213.             }
  214.         else                                /* PPC Browser... */
  215.             {
  216. #ifdef TCLAPPL
  217.             myWindow = FrontWindow();
  218.             if (WPeek->windowKind == tgeWKind)
  219.                 tge_activate(myWindow, 0);
  220.                 myerr = PPCBrowser("\pTarget", "\p", FALSE,
  221.                                 &targetID.location, &targetPort, (PPCFilterProcPtr)0, "\p");
  222.             if (myerr == noErr)
  223.                 {
  224.                 BlockMove(&targetPort.name, &targetID.name, sizeof(targetPort.name));
  225.                 myerr = AECreateDesc(typeTargetID, (Ptr)&targetID, sizeof(targetID),
  226.                                             &_ae_targets[index].target);
  227.                 if (myerr == noErr)
  228.                     {
  229.                     _ae_targets[index].state = AET_INUSE;
  230.                     strcpy(_ae_targets[index].name, argv[1]);
  231.                     }
  232.                 else
  233.                     {
  234.                     macintoshErr = myerr;
  235.                     Tcl_AppendResult(interp, "\"", argv[0], "\" AECreateDesc() for target: ",
  236.                                             Tcl_MacError(interp), (char *) NULL);
  237.                     return TCL_ERROR;
  238.                     }
  239.                 }
  240.             else
  241.                 {
  242.                 macintoshErr = myerr;
  243.                 Tcl_AppendResult(interp, "\"", argv[0], "\" PPCBrowser() getting target: ",
  244.                                         Tcl_MacError(interp), (char *) NULL);
  245.                 return TCL_ERROR;
  246.                 }
  247. #else
  248.             Tcl_AppendResult(interp, "\"", argv[0], "\" PPCBrowser unimplemented in engine",
  249.                                     (char *) NULL);
  250.             return TCL_ERROR;
  251. #endif /* TCLAPPL */
  252.             }
  253.         }
  254.     
  255.     return TCL_OK;
  256.     }
  257.  
  258. int
  259. Cmd_CloseAETarget(clientData, interp, argc, argv)
  260.     char        *clientData;
  261.     Tcl_Interp    *interp;
  262.     int            argc;
  263.     char        **argv;
  264.     {
  265.     int                index, result = TCL_OK;
  266. #pragma unused (clientData, argc)
  267.     
  268.     for (index = 0 ; index < MAX_AE_TARGETS ; index++)
  269.         {
  270.         if (_ae_targets[index].state == AET_INUSE)
  271.             if (strcmp(_ae_targets[index].name, argv[1]) == SAMESTR)
  272.                 break;
  273.         }
  274.  
  275.     if (index >= MAX_AE_TARGETS)
  276.         {
  277.         Tcl_AppendResult(interp, "\"", argv[0], "\" AE Target '",
  278.                                 argv[1], "' unknown", (char *) NULL);
  279.         return TCL_ERROR;
  280.         }
  281.     else
  282.         {
  283.         _ae_targets[index].state = AET_UNUSED;
  284.         AEDisposeDesc(&_ae_targets[index].target);
  285.         }
  286.     
  287.     return result;
  288.     }
  289.  
  290. int
  291. Cmd_ListAEOpenTargets(clientData, interp, argc, argv)
  292.     char        *clientData;
  293.     Tcl_Interp    *interp;
  294.     int            argc;
  295.     char        **argv;
  296.     {
  297.     int            index;
  298.     char        buffer[2048];
  299. #pragma unused (clientData, argc, argv)
  300.     
  301.     buffer[0] = '\0';
  302.     for (index = 0 ; index < MAX_AE_TARGETS ; index++)
  303.         {
  304.         if (_ae_targets[index].state == AET_INUSE) {
  305.             if ( (strlen(buffer) + strlen(_ae_targets[index].name) + 3) > 2048 )
  306.                 break;
  307.             strcat(buffer, _ae_targets[index].name);
  308.             strcat(buffer, " ");
  309.             }
  310.         }
  311.  
  312.     Tcl_SetResult(interp, buffer, TCL_VOLATILE);
  313.     return TCL_OK;
  314.     }
  315.  
  316. int
  317. Cmd_Coerce(clientData, interp, argc, argv)
  318.     char        *clientData;
  319.     Tcl_Interp    *interp;
  320.     int            argc;
  321.     char        **argv;
  322.     {
  323.     int            i, myerr, length, result = TCL_OK;
  324.     int            hexdata = 0, hexresult = 0;
  325.     DescType    toType;
  326.     unsigned char high, low, ch;
  327.     char        *arg0, *saveptr, *ptr, *hptr, tempstr[32];
  328.     AEDesc        fDesc, tDesc;
  329. #pragma unused (clientData, argc)
  330.     
  331.     arg0 = argv[0];
  332.     argc--; argv++;
  333.  
  334.     sprintf(tempstr, "%-4.4s", argv[0]);
  335.     strncpy((char *)&fDesc.descriptorType, tempstr, 4);
  336.     argc--; argv++;
  337.  
  338.     if (argv[0][0] == '-' && argv[0][1] == 'x' && argv[0][2] == '\0')
  339.         {
  340.         hexdata = 1;
  341.         argc--; argv++;
  342.         }
  343.     
  344.     length = strlen(argv[0]);
  345.     if (hexdata)
  346.         length >>= 1;
  347.     
  348.     fDesc.dataHandle = NewHandle(length);
  349.     if (fDesc.dataHandle != NULL)
  350.         {
  351.         if (hexdata)
  352.             {
  353.             ptr = argv[0];
  354.             hptr = *fDesc.dataHandle;
  355.             for (i = 0 ; i < length ; i++)
  356.                 {
  357.                 if ((ch = *ptr++) == '\0')
  358.                     break;
  359.                 high = ( (ch >= '0' && ch <= '9') ? (ch - '0') : (((ch|0x20) - 'a') + 10) );
  360.                 if ((ch = *ptr++) == '\0')
  361.                     break;
  362.                 low = ( (ch >= '0' && ch <= '9') ? (ch - '0') : (((ch|0x20) - 'a') + 10) );
  363.                 *hptr++ = ( (high << 4) & 0xF0 ) | ( low & 0x0F );
  364.                 }
  365.             }
  366.         else
  367.             {
  368.             BlockMove(argv[0], *fDesc.dataHandle, length);
  369.             }
  370.             
  371.         argc--; argv++;
  372.         
  373.         if (argv[0][0] == '-' && argv[0][1] == 'x' && argv[0][2] == '\0')
  374.             {
  375.             hexresult = 1;
  376.             argc--; argv++;
  377.             }
  378.         
  379.         sprintf(tempstr, "%-4.4s", argv[0]);
  380.         strncpy((char *)&toType, tempstr, 4);
  381.  
  382.         myerr = AECoerceDesc(&fDesc, toType, &tDesc);
  383.         if (myerr != noErr)
  384.             {
  385.             macintoshErr = myerr;
  386.             Tcl_AppendResult(interp, "\"", arg0, "\" coercing parm to '",
  387.                                     argv[0], "': ", Tcl_MacError(interp), (char *) NULL);
  388.             return TCL_ERROR;
  389.             }
  390.         else
  391.             {
  392.             length = GetHandleSize(tDesc.dataHandle);
  393.             saveptr = ptr = NewPtr( ( hexresult ? ((length << 1) + 2) : (length + 2) ) );
  394.             if (ptr != NULL)
  395.                 {
  396.                 HLock(tDesc.dataHandle);
  397.                 hptr = *tDesc.dataHandle;
  398.                 
  399.                 if (hexresult)
  400.                     {
  401.                     for (i=length; i > 0; i--, hptr++)
  402.                         {
  403.                         *ptr++ = *(hexstr + ((*hptr >> 4) & 0x0F));
  404.                         *ptr++ = *(hexstr + (*hptr & 0x0F));
  405.                         }
  406.                     }
  407.                 else
  408.                     {
  409.                     BlockMove(hptr, ptr, length);
  410.                     ptr += length;
  411.                     }
  412.                 *ptr = '\0';
  413.                 
  414.                 HUnlock(tDesc.dataHandle);
  415.                 Tcl_SetResult(interp, saveptr, TCL_VOLATILE);
  416.                 DisposPtr(saveptr);
  417.                 }
  418.             else
  419.                 {
  420.                 macintoshErr = myerr;
  421.                 Tcl_AppendResult(interp, "\"", arg0, "\" not enough memory coercing parm to '",
  422.                                         argv[0], "': ", Tcl_MacError(interp), (char *) NULL);
  423.                 return TCL_ERROR;
  424.                 }
  425.             
  426.             AEDisposeDesc(&tDesc);
  427.             }
  428.         
  429.         AEDisposeDesc(&fDesc);
  430.         }
  431.     else
  432.         {
  433.         macintoshErr = myerr;
  434.         Tcl_AppendResult(interp, "\"", arg0, "\" not enough memory coercing parm to '",
  435.                                 argv[0], "': ", Tcl_MacError(interp), (char *) NULL);
  436.         return TCL_ERROR;
  437.         }
  438.     
  439.     return result;
  440.     }
  441.  
  442. int
  443. Cmd_SendAppleEvent(clientData, interp, argc, argv)
  444.     char        *clientData;
  445.     Tcl_Interp    *interp;
  446.     int            argc;
  447.     char        **argv;
  448.     {
  449.     int                i, index, argi, myerr, length, result = TCL_OK, timeout = 120,
  450.                     want_stdout = 0, want_hexout = 0, want_longout = 0;
  451.     DescType        class_type, event_type, param_key, param_type, returnType;
  452.     AEDesc            theRDesc, aeBuildDesc;
  453.     AESendMode        sendmode = 0;
  454.     long            replyLong, actualSize;
  455.     char            state, *argv0, *buffer, *ptr, *hptr;
  456.     char            tempstr[32];
  457.     char            errorStr[128];
  458.     AppleEvent        theAEvent;
  459.     AppleEvent        theREvent;
  460. #pragma unused (clientData)
  461.  
  462.     argv0 = argv[0];
  463.     for (index = 0 ; index < MAX_AE_TARGETS ; index++)
  464.         {
  465.         if (_ae_targets[index].state == AET_INUSE)
  466.             if (strcmp(_ae_targets[index].name, argv[1]) == SAMESTR)
  467.                 break;
  468.         }
  469.  
  470.     if (index >= MAX_AE_TARGETS)
  471.         {
  472.         Tcl_AppendResult(interp, "\"", argv0, "\" target '",
  473.                                 argv[1], "' unknown", (char *) NULL);
  474.         return TCL_ERROR;
  475.         }
  476.     else
  477.         {
  478.         argc -= 2; argv += 2;
  479.         
  480.         sendmode = kAENoReply | kAENeverInteract;
  481.         for ( ; argc && argv[0][0] == '-' && argv[0][2] == '\0' ; )
  482.             {
  483.             if ((argv[0][1]|0x20) == 't')
  484.                 {
  485.                 timeout = atoi(argv[1]);
  486.                 if (timeout <= 0)
  487.                     timeout = 120;
  488.                 argc -= 2; argv += 2;
  489.                 }
  490.             else if ((argv[0][1]|0x20) == 'w')
  491.                 {
  492.                 sendmode |= kAEWaitReply;
  493.                 argc--; argv++;
  494.                 }
  495.             else if ((argv[0][1]|0x20) == 'i')
  496.                 {
  497.                 sendmode |= kAECanInteract;
  498.                 argc--; argv++;
  499.                 }
  500.             else if ((argv[0][1]|0x20) == 'o')
  501.                 {
  502.                 want_stdout = 1;
  503.                 argc--; argv++;
  504.                 }
  505.             else if ((argv[0][1]|0x20) == 'x')
  506.                 {
  507.                 want_hexout = 1;
  508.                 argc--; argv++;
  509.                 }
  510.             else if ((argv[0][1]|0x20) == 'l')
  511.                 {
  512.                 want_longout = 1;
  513.                 argc--; argv++;
  514.                 }
  515.             else
  516.                 break;
  517.             }
  518.         
  519.         sendmode |= kAEWantReceipt;
  520.         
  521.         sprintf(tempstr, "%-4.4s", argv[0]);
  522.         strncpy((char *)&class_type, tempstr, 4);
  523.         sprintf(tempstr, "%-4.4s", argv[1]);
  524.         strncpy((char *)&event_type, tempstr, 4);
  525.         
  526.         myerr = AECreateAppleEvent(class_type, event_type, &_ae_targets[index].target,
  527.                                     kAutoGenerateReturnID, kAnyTransactionID, &theAEvent);
  528.         if (myerr == noErr)
  529.             {
  530.             for (argi = 2 ; argi < argc ; argi++ )
  531.                 {
  532.                 if (argv[argi][0] != '-' && argv[argi][0] != '+')
  533.                     continue;
  534.                 
  535.                 if (argv[argi][0] == '-') 
  536.                     {
  537.                     /* -xxxxyyyy syntax.... */
  538.                     sprintf(tempstr, "%-4.4s", &argv[argi][1]);
  539.                     strncpy((char *)¶m_key, tempstr, 4);
  540.                     sprintf(tempstr, "%-4.4s", &argv[argi][5]);
  541.                     strncpy((char *)¶m_type, tempstr, 4);
  542.                     
  543.                     myerr = AEPutParamPtr(    &theAEvent, param_key, param_type,
  544.                                             (argv[argi+1][0] == '-' ? "" : argv[argi+1]),
  545.                                             (argv[argi+1][0] == '-' ? 0 : strlen(argv[argi+1])) );
  546.                     if (myerr != noErr)
  547.                         {
  548.                         macintoshErr = myerr;
  549.                         Tcl_AppendResult(interp, "\"", argv0, "\" error adding parameter '",
  550.                                             argv[argi], "': ", Tcl_MacError(interp), (char *) NULL);
  551.                         AEDisposeDesc(&theAEvent);
  552.                         return TCL_ERROR;
  553.                         break;
  554.                         }
  555.                     
  556.                     (argv[argi+1][0] == '-') ? argi : ++argi;
  557.                     }
  558.                 else
  559.                     {
  560.                     /* +xxxx[yyyy] syntax.... */
  561. #ifdef THINK_C
  562.                     Tcl_AppendResult(interp, "\"", argv0, "\" error AEBuild not supported under ThinkC '",
  563.                                             argv[argi+1], "'", (char *) NULL);
  564.                     AEDisposeDesc(&theAEvent);
  565.                     result = TCL_ERROR;
  566. #else
  567.                     sprintf(tempstr, "%-4.4s", &argv[argi][1]);
  568.                     strncpy((char *)¶m_key, tempstr, 4);
  569.                     
  570.                     myerr = AEBuild(&aeBuildDesc, argv[argi+1]);
  571.                     if (myerr != noErr)
  572.                         {
  573.                         macintoshErr = myerr;
  574.                         Tcl_AppendResult(interp, "\"", argv0, "\" building descriptor '",
  575.                                         argv[argi+1], "': ", Tcl_MacError(interp), (char *) NULL);
  576.                         AEDisposeDesc(&theAEvent);
  577.                         result = TCL_ERROR;
  578.                         break;
  579.                         }
  580.                     else
  581.                         {
  582.                         myerr = AEPutParamDesc(    &theAEvent, param_key, &aeBuildDesc);
  583.                         if (myerr != noErr)
  584.                             {
  585.                             macintoshErr = myerr;
  586.                             Tcl_AppendResult(interp, "\"", argv0, "\" error adding parameter '",
  587.                                             argv[argi+1], "': ", Tcl_MacError(interp), (char *) NULL);
  588.                             result = TCL_ERROR;
  589.                             break;
  590.                             }
  591.                         
  592.                         AEDisposeDesc(&aeBuildDesc);
  593.                         }
  594. #endif
  595.                     ++argi;
  596.                     }
  597.                 }
  598.             
  599.             if (myerr == noErr)
  600.                 {
  601.                 WatchCursorOn();
  602.                 myerr = AESend(&theAEvent, &theREvent, (kAEWaitReply | kAENeverInteract),
  603.                                 kAENormalPriority, timeout, (IdleProcPtr)0, (EventFilterProcPtr)0);
  604.                 if (myerr == noErr)
  605.                     {
  606.                     myerr = AEGetParamPtr(&theREvent, keyErrorNumber, typeLongInteger, &returnType,
  607.                                             (Ptr)&replyLong, sizeof(replyLong), &actualSize);
  608.                     if (myerr == errAEDescNotFound)
  609.                         {
  610.                         myerr = AEGetParamDesc(&theREvent,
  611.                                                 (want_stdout ? keyStdOutObject : keyDirectObject),
  612.                                                 typeWildCard, &theRDesc);
  613.                         if (myerr == noErr)
  614.                             {
  615.                             if (want_hexout)
  616.                                 length = (GetHandleSize(theRDesc.dataHandle) << 1) + 4;
  617.                             else
  618.                                 length = GetHandleSize(theRDesc.dataHandle) + 4;
  619.                             
  620.                             if (want_longout)
  621.                                 length += 7;
  622.                             
  623.                             buffer = NewPtr(length);
  624.                             if (buffer != NULL)
  625.                                 {
  626.                                 if (want_longout)
  627.                                     sprintf(buffer, "{%-4.4s} ", &theRDesc.descriptorType);
  628.                                 ptr = &buffer[(want_longout ? 7 : 0)];
  629.                                 if (want_hexout)
  630.                                     {
  631.                                     state = HGetState(theRDesc.dataHandle);
  632.                                     HLock(theRDesc.dataHandle);
  633.                                     hptr = *theRDesc.dataHandle;
  634.                                     *ptr++ = '{';
  635.                                     for (i=GetHandleSize(theRDesc.dataHandle); i > 0; i--,hptr++)
  636.                                         {
  637.                                         *ptr++ = *(hexstr + ((*hptr >> 4) & 0x0F));
  638.                                         *ptr++ = *(hexstr + (*hptr & 0x0F));
  639.                                         }
  640.                                     *ptr++ = '}';
  641.                                     *ptr = '\0';
  642.                                     HSetState(theRDesc.dataHandle, state);
  643.                                     }
  644.                                 else
  645.                                     {
  646.                                     state = HGetState(theRDesc.dataHandle);
  647.                                     HLock(theRDesc.dataHandle);
  648.                                     sprintf(ptr, "{%.*s}",
  649.                                                 GetHandleSize(theRDesc.dataHandle),
  650.                                                 *(theRDesc.dataHandle));
  651.                                     HSetState(theRDesc.dataHandle, state);
  652.                                     }
  653.                                 
  654.                                 Tcl_SetResult(interp, buffer, TCL_VOLATILE);
  655.                                 }
  656.                             else
  657.                                 {
  658.                                 macintoshErr = MemError();
  659.                                 Tcl_AppendResult(interp, "\"", argv0, "\" not enough memory for result: ",
  660.                                                     Tcl_MacError(interp), (char *) NULL);
  661.                                 result = TCL_ERROR;
  662.                                 }
  663.                             AEDisposeDesc(&theRDesc);
  664.                             }
  665.                         else
  666.                             {
  667.                             Tcl_SetResult(interp, NULL, TCL_VOLATILE);
  668.                             }
  669.                         }
  670.                     else
  671.                         {
  672.                         myerr = AEGetParamPtr(&theREvent, keyErrorString, typeChar, &returnType,
  673.                                             (Ptr)errorStr, sizeof(errorStr)-1, &actualSize);
  674.                         macintoshErr = replyLong;
  675.                         Tcl_AppendResult(interp, "\"", argv0, "\" Apple Event returns \"",
  676.                                             Tcl_MacError(interp), "\" ", (char *) NULL);
  677.                         result = TCL_ERROR;
  678.                         }
  679.                     }
  680.                 else
  681.                     {
  682.                     macintoshErr = myerr;
  683.                     Tcl_AppendResult(interp, "\"", argv0, "\" error sending Apple Event: ",
  684.                                         Tcl_MacError(interp), (char *) NULL);
  685.                     result = TCL_ERROR;
  686.                     }
  687.                     
  688.                 AEDisposeDesc(&theREvent);
  689.                 }
  690.             else
  691. #ifndef THINK_C
  692.             if (myerr != aeBuild_SyntaxErr)
  693. #endif
  694.                 {
  695.                 macintoshErr = myerr;
  696.                 Tcl_AppendResult(interp, "\"", argv0, "\" error inserting parameters: ",
  697.                                     Tcl_MacError(interp), (char *) NULL);
  698.                 result = TCL_ERROR;
  699.                 }
  700.             
  701.             AEDisposeDesc(&theAEvent);
  702.             }
  703.         else
  704.             {
  705.             macintoshErr = myerr;
  706.             Tcl_AppendResult(interp, "\"", argv0, "\" error creating Apple Event: ",
  707.                                 Tcl_MacError(interp), (char *) NULL);
  708.             result = TCL_ERROR;
  709.             }
  710.         
  711.         }
  712.     
  713.     return result;
  714.     }
  715.  
  716.  
  717. int
  718. Cmd_AEInterAct(clientData, interp, argc, argv)
  719.     char        *clientData;
  720.     Tcl_Interp    *interp;
  721.     int            argc;
  722.     char        **argv;
  723.     {
  724. #ifdef TCLAPPL
  725.     int        myerr;
  726.     extern int errno;
  727. #pragma unused (clientData, argc, argv)
  728.  
  729.     myerr = AEInteractWithUser(kAEDefaultTimeout, (NMRecPtr)0, (IdleProcPtr)0);
  730.     if (myerr != noErr)
  731.         {
  732.         macintoshErr = myerr;
  733.         Tcl_AppendResult(interp, "\"", argv[0], "\" error interating with user: ",
  734.                             Tcl_MacError(interp), (char *) NULL);
  735.         return TCL_ERROR;
  736.         }
  737.     else
  738.         {
  739.         Tcl_SetResult(interp, NULL, TCL_VOLATILE);
  740.         }
  741.  
  742.     return TCL_OK;
  743. #else
  744. #pragma unused (clientData, interp, argc, argv)
  745.  
  746.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  747.     return TCL_ERROR;
  748.  
  749. #endif
  750.     }
  751.  
  752. int
  753. Cmd_ListAETargets(clientData, interp, argc, argv)
  754.     char        *clientData;
  755.     Tcl_Interp    *interp;
  756.     int            argc;
  757.     char        **argv;
  758.     {
  759.     int                    index, myerr;
  760.     long                length;
  761.     Handle                myhandle;
  762.     PPCPortRec            pName;
  763.     LocationNameRec        lName;
  764.     PortInfoRec            myinfo;
  765.     IPCListPortsPBRec    pb;
  766.     
  767. #pragma unused (clientData, argc)
  768.     
  769.     myhandle = NewHandle(1);
  770.     if (myhandle == NULL)
  771.         {
  772.         macintoshErr = MemError();
  773.         Tcl_AppendResult(interp, "\"", argv[0], "\" not enough memory: ",
  774.                             Tcl_MacError(interp), (char *) NULL);
  775.         return TCL_ERROR;
  776.         }
  777.     **myhandle = '\0';
  778.     
  779.     pName.nameScript = smRoman;
  780.     pName.portKindSelector = ppcByString;
  781.     pName.name[0] = 1;
  782.     pName.name[1] = '=';
  783.     pName.u.portTypeStr[0] = 1;
  784.     pName.u.portTypeStr[1] = '=';
  785.  
  786.     lName.locationKindSelector = ppcNBPLocation;
  787.     
  788.     strncpy(lName.u.nbpEntity.objStr, argv[1], 32);
  789.     strncpy(lName.u.nbpEntity.typeStr, argv[2], 32);
  790.     strncpy(lName.u.nbpEntity.zoneStr, argv[3], 32);
  791.     lName.u.nbpEntity.objStr[32] = '\0';
  792.     lName.u.nbpEntity.typeStr[32] = '\0';
  793.     lName.u.nbpEntity.zoneStr[32] = '\0';
  794.     c2pstr(lName.u.nbpEntity.objStr);
  795.     c2pstr(lName.u.nbpEntity.typeStr);
  796.     c2pstr(lName.u.nbpEntity.zoneStr);
  797.     
  798.     for ( index = 0 ; ++index ; )
  799.         {
  800.         pb.ioCompletion            = 0;
  801.         pb.startIndex            = index;
  802.         pb.requestCount            = 1;
  803.         pb.portName                = &pName;
  804.         pb.locationName            = &lName;
  805.         pb.bufferPtr            = &myinfo;
  806.         
  807.         myerr = IPCListPorts(&pb, FALSE);
  808.         if (myerr != noErr)
  809.             {
  810.             DisposHandle(myhandle);
  811.             macintoshErr = myerr;
  812.             Tcl_AppendResult(interp, "\"", argv[0], "\" error from IPCListPorts(): ",
  813.                                 Tcl_MacError(interp), (char *) NULL);
  814.             return TCL_ERROR;
  815.             }
  816.         
  817.         if (pb.actualCount < 1)
  818.             break;
  819.         
  820.         length = GetHandleSize(myhandle);
  821.         SetHandleSize(myhandle, (length + myinfo.name.name[0] + myinfo.name.u.portTypeStr[0] + 6));
  822.         if (MemError() != noErr)
  823.             {
  824.             DisposHandle(myhandle);
  825.             macintoshErr = MemError();
  826.             Tcl_AppendResult(interp, "\"", argv[0], "\" error not enough memory: ",
  827.                                 Tcl_MacError(interp), (char *) NULL);
  828.             return TCL_ERROR;
  829.             }
  830.         else
  831.             {
  832.             HLock(myhandle);
  833.             sprintf(*myhandle + (length - 1), "{%.*s} {%.*s}\n",
  834.                     myinfo.name.name[0], &myinfo.name.name[1],
  835.                     myinfo.name.u.portTypeStr[0], &myinfo.name.u.portTypeStr[1]);
  836.             HUnlock(myhandle);
  837.             }
  838.         }
  839.  
  840.     HLock(myhandle);
  841.     Tcl_SetResult(interp, *myhandle, TCL_VOLATILE);
  842.     HUnlock(myhandle);
  843.     DisposHandle(myhandle);
  844.     
  845.     return TCL_OK;
  846.     }
  847.  
  848. run_AE_tcl_script(theFSS, result_handle, stdout_handle)
  849.     FSSpec        *theFSS;
  850.     Handle        result_handle;
  851.     Handle        stdout_handle;
  852.     {
  853.     int            result = noErr, wderr;
  854.     short        wdrefnum;
  855.     Handle        saveH, myhandle = NULL;
  856.     PFI            saveproc;
  857.     Tcl_Interp    *interp;
  858.     char        command[128];
  859.     
  860.     WatchCursorOn();
  861.     
  862.     /* create a Tcl interpreter for the session */
  863.     interp = g_interp;
  864.     
  865.     saveproc = Tcl_SetPrintProcedure(tcl_dev_null_output);
  866.     sprintf(command, "set AEVENT 1\n");
  867.     result = Tcl_Eval(interp, command, 0, (char **)0);
  868.     if (result != TCL_OK)
  869.         Feedback("ERROR %d on <%s>", result, command);
  870.         
  871.     wderr = OpenWD(theFSS->vRefNum, theFSS->parID, 'ERIK', &wdrefnum);
  872.     if (wderr == noErr)
  873.         SetVol(NULL, wdrefnum);
  874.     else
  875.         Feedback("Error %d OpenWD().", wderr);
  876.     
  877.     if (stdout_handle == NULL)
  878.         {
  879.         myhandle = NewHandle(0);
  880.         if (myhandle == NULL)
  881.             {
  882.             Feedback("Error #%d allocating a stdout handle.", MemError());
  883.             return -1770;
  884.             }
  885.         else
  886.             saveH = tcl_Houtput_sethdl(myhandle);
  887.         }
  888.     else
  889.         saveH = tcl_Houtput_sethdl(stdout_handle);
  890.     
  891.     Tcl_SetPrintProcedure(tcl_handle_output);
  892.  
  893.     sprintf(command, "source \"%.*s\"\n", theFSS->name[0], &theFSS->name[1]);
  894.     result = Tcl_Eval(interp, command, 0, (char **)0);
  895.  
  896.     if (wderr == noErr)
  897.         wderr = CloseWD(wdrefnum);
  898.     
  899.     if (result == TCL_OK)
  900.         {
  901.         result = noErr;
  902.         if (result_handle != NULL)
  903.             {
  904.             tcl_Houtput_sethdl(result_handle);
  905.             if (interp->result != NULL && *(interp->result) != '\0')
  906.                 (* Tcl_GetPrintProcedure()) (interp->result);
  907.             }
  908.         }
  909.      else
  910.         {
  911.         result = -1771;
  912.         (* Tcl_GetPrintProcedure()) ( (result == TCL_ERROR) ? "\015Error: " : "\015Bad Result: " );
  913.         (* Tcl_GetPrintProcedure()) ( (interp->result == NULL) ? "<NULL>" : interp->result );
  914.         }
  915.     
  916.     Tcl_SetPrintProcedure(tcl_dev_null_output);
  917.     sprintf(command, "set AEVENT 0\n");
  918.     Tcl_Eval(interp, command, 0, (char **)0);
  919.  
  920.     Tcl_SetPrintProcedure(saveproc);
  921.     tcl_Houtput_sethdl(saveH);
  922.     
  923.     if (myhandle != NULL)
  924.         DisposHandle(myhandle);
  925.  
  926.     UInitCursor();
  927.  
  928.     return result;
  929.     }
  930.  
  931. run_DoScript(script_handle, result_handle, stdout_handle)
  932.     Handle        script_handle;
  933.     Handle        result_handle;
  934.     Handle        stdout_handle;
  935.     {
  936.     int            result;
  937.     int            delete_interp = 0;
  938.     PFI            saveproc;
  939.     Handle        myhandle = NULL;
  940.     char        command[128];
  941.     Tcl_Interp    *interp;
  942.  
  943.     TclTickle_BegYield();
  944.     WatchCursorOn();
  945.     
  946.     /* create a Tcl interpreter for the session */
  947.     interp = g_interp;
  948.     
  949.     saveproc = Tcl_SetPrintProcedure(tcl_dev_null_output);
  950.     sprintf(command, "set AEVENT 1\n");
  951.     result = Tcl_Eval(interp, command, 0, (char **)0);
  952.     if (result != TCL_OK)
  953.         Feedback("ERROR %d on <%s>", result, command);
  954.     Tcl_SetPrintProcedure(saveproc);
  955.  
  956.     result = Tcl_Interp_Handle(interp, script_handle, result_handle, stdout_handle);
  957.     if (result == TCL_OK)
  958.         {
  959.         result = noErr;
  960.         }
  961.     
  962.     saveproc = Tcl_SetPrintProcedure(tcl_dev_null_output);
  963.     sprintf(command, "set AEVENT 0\n");
  964.     result = Tcl_Eval(interp, command, 0, (char **)0);
  965.     Tcl_SetPrintProcedure(saveproc);
  966.  
  967.     TclTickle_EndYield();
  968.     UInitCursor();
  969.     
  970.     return result;
  971.     }
  972.  
  973. int
  974. XPROC_Eval_CallBack(cpb, script_handle, result_handle, stdout_handle)
  975.     XPROCPBPtr    cpb;
  976.     Handle        script_handle;
  977.     Handle        result_handle;
  978.     Handle        stdout_handle;
  979.     {
  980.     return Tcl_Interp_Handle(cpb->interp, script_handle, result_handle, stdout_handle);
  981.     }
  982.  
  983. int
  984. Cmd_InstallXPROCS(clientData, interp, argc, argv)
  985.     char        *clientData;
  986.     Tcl_Interp    *interp;
  987.     int            argc;
  988.     char        **argv;
  989.     {
  990.     Handle        myhandle = NULL,
  991.                 result_handle = NULL;
  992.     int            index, myerr, result = TCL_OK;
  993.     short        saveref, proc_ref = -1, proctype;
  994.     short        rsrcID;
  995.     ResType        rsrcType;
  996.     DescType    from_type, to_type, class_type, event_type;
  997.     char        name[256], *ptr;
  998.     struct stat    statbuf;
  999. #pragma unused (clientData, argc, interp)
  1000.  
  1001.     saveref = CurResFile();
  1002.  
  1003.     if ( stat( argv[1], &statbuf ) < 0 )
  1004.         {
  1005.         Tcl_AppendResult(interp, "could not locate resource file \"",
  1006.                             argv[1], "\" ", Tcl_PosixError(interp), NULL);
  1007.         return TCL_ERROR;
  1008.         }
  1009.     
  1010.     ptr = strrchr( argv[1], ':');
  1011.     if (ptr != NULL)
  1012.         strcpy(name, ptr+1);
  1013.     else
  1014.         strcpy(name, argv[1]);
  1015.     
  1016.     c2pstr(name);
  1017.     proc_ref = HOpenResFile( statbuf.st_dev, statbuf.st_parid,
  1018.                             (unsigned char *)name, fsRdPerm);
  1019.     p2cstr(name);
  1020.                             
  1021.     if (proc_ref == -1)
  1022.         {
  1023.         macintoshErr = ResError();
  1024.         Tcl_AppendResult(interp, "\"", argv[0], "\" error opening '",
  1025.                             argv[1], "': ", Tcl_MacError(interp), (char *) NULL);
  1026.         return TCL_ERROR;
  1027.         }
  1028.     
  1029.     UseResFile(proc_ref);
  1030.     for (index = 1 ; ; index++)
  1031.         {
  1032.         myhandle = Get1IndResource((ResType)'PROC', index);
  1033.         if (myhandle == NULL)
  1034.             break;
  1035.  
  1036.         GetResInfo(myhandle, &rsrcID, &rsrcType, name);
  1037.         if (name[0] < 8)
  1038.             {
  1039.             Feedback("Coercion resource <%.*s> INVALID.", name[0], &name[1]);
  1040.             continue;
  1041.             }
  1042.         p2cstr(name);
  1043.         
  1044.         if (strncmp(name, "CSPT", 4) == SAMESTR)
  1045.             {
  1046.             proctype = 'c';
  1047.             strncpy((char *)&from_type, &name[4], 4);
  1048.             strncpy((char *)&to_type, &name[8], 4);
  1049.             }
  1050.         else if (strncmp(name, "CSDS", 4) == SAMESTR)
  1051.             {
  1052.             proctype = 'C';
  1053.             strncpy((char *)&from_type, &name[4], 4);
  1054.             strncpy((char *)&to_type, &name[8], 4);
  1055.             }
  1056.         else if (strncmp(name, "AEVT", 4) == SAMESTR)
  1057.             {
  1058.             proctype = 'A';
  1059.             strncpy((char *)&class_type, &name[4], 4);
  1060.             strncpy((char *)&event_type, &name[8], 4);
  1061.             }
  1062.         else {
  1063.             Feedback("Error unknown PROC type '%-4.4s' ", name);
  1064.             continue;
  1065.             }
  1066.         
  1067.         LoadResource(myhandle);
  1068.         DetachResource(myhandle);
  1069.         MoveHHi(myhandle);
  1070.         HNoPurge(myhandle);
  1071.         HLock(myhandle);
  1072.  
  1073.         if (proctype == 'C' || proctype == 'c')
  1074.             {
  1075.             myerr = AEInstallCoercionHandler(from_type, to_type, (ProcPtr)(*myhandle),
  1076.                                                 (long)&g_cbpb, (proctype == 'C'), FALSE);
  1077.             
  1078.             if (myerr != noErr)
  1079.                 {
  1080.                 Feedback("Error %d installing coercion <%s> ", name);
  1081.                 }
  1082.             else
  1083.                 {
  1084.                 Feedback("Coercion resource FROM '%-4.4s' TO '%-4.4s' installed. ",
  1085.                             &from_type, &to_type);
  1086.                 }
  1087.             }
  1088.         else if (proctype == 'A')
  1089.             {
  1090.             myerr = AEInstallEventHandler(class_type, event_type, (ProcPtr)(*myhandle),
  1091.                                             (long)&g_cbpb, FALSE);
  1092.  
  1093.             if (myerr != noErr)
  1094.                 {
  1095.                 Feedback("Error %d installing event handler <%s> ", name);
  1096.                 }
  1097.             else
  1098.                 {
  1099.                 Feedback("Apple Event '%-4.4s' '%-4.4s' installed. ",
  1100.                             &class_type, &event_type);
  1101.                 }
  1102.             }
  1103.         }
  1104.     
  1105.     CloseResFile(proc_ref);
  1106.     UseResFile(saveref);
  1107.     
  1108.     return TCL_OK;
  1109.     }
  1110.  
  1111. InitAEtcl(interp)
  1112.     Tcl_Interp    *interp;
  1113.     {
  1114.     int            i;
  1115.     
  1116.     for (i = 0 ; i < MAX_AE_TARGETS ; i++)
  1117.         {
  1118.         _ae_targets[i].name[0] = '\0';
  1119.         _ae_targets[i].state = AET_UNUSED;
  1120.         }
  1121.     
  1122.     Tcl_CreateCommand(interp, "aeinteract", Cmd_AEInterAct,
  1123.                         (ClientData)NULL, (void (*)())NULL);
  1124.     Tcl_CreateCommand(interp, "aeopen", Cmd_OpenAETarget,
  1125.                         (ClientData)NULL, (void (*)())NULL);
  1126.     Tcl_CreateCommand(interp, "aesend", Cmd_SendAppleEvent,
  1127.                         (ClientData)NULL, (void (*)())NULL);
  1128.     Tcl_CreateCommand(interp, "aeclose", Cmd_CloseAETarget,
  1129.                         (ClientData)NULL, (void (*)())NULL);
  1130.     Tcl_CreateCommand(interp, "aelist", Cmd_ListAEOpenTargets,
  1131.                         (ClientData)NULL, (void (*)())NULL);
  1132.     Tcl_CreateCommand(interp, "aeload", Cmd_InstallXPROCS,
  1133.                         (ClientData)NULL, (void (*)())NULL);
  1134.     Tcl_CreateCommand(interp, "aecoerce", Cmd_Coerce,
  1135.                         (ClientData)NULL, (void (*)())NULL);
  1136.     Tcl_CreateCommand(interp, "aetargets", Cmd_ListAETargets,
  1137.                         (ClientData)NULL, (void (*)())NULL);
  1138.     }
  1139.