home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / online / source / c / compilers / Tickle-4.0.sit.hqx / Tickle-4.0 / src / tcl.c < prev    next >
Text File  |  1993-11-21  |  60KB  |  2,915 lines
  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.  
  20. #pragma segment TCL2
  21.  
  22. #include "tickle.h"
  23. #include "tge.h"
  24. #include "tcl.h"
  25. #include "tclExtend.h"
  26. #include "tclMac.h"
  27. #include "XTCL.h"
  28. #include "version.h"
  29. #include <stdarg.h>
  30. #include "stat.h"
  31.  
  32. #define YIELD_MAC_COMMAND_NAME    "yield_mac"
  33.  
  34.  
  35. extern int errno;
  36. extern int macintoshErr;
  37.  
  38. extern char *tcl_getenv();
  39.  
  40. tcl_feedback_output(str)
  41.     char    *str;
  42.     {
  43.     char    *ptr, *save;
  44.     
  45.     for ( ptr = str ; *ptr ; )
  46.         {
  47.         for ( save = ptr ; *ptr && *ptr != '\015' && *ptr != '\012' ; ++ptr )
  48.             ;
  49.         
  50.         Feedback("%.*s", (int)(save - ptr), save);
  51.         
  52.         if (*ptr != '\0')
  53.             ++ptr;
  54.         }
  55.     }
  56.  
  57. run_named_tcl_script(filename, interp, print_proc)
  58.     char        *filename;    /* Pascal */
  59.     Tcl_Interp    *interp;
  60.     PFI            print_proc;
  61.     {
  62.     int            result = noErr;
  63.     int            delete_interp = 0;
  64.     PFI            saveproc;
  65.     char        command[128];
  66.  
  67.     TclTickle_BegYield();
  68.     WatchCursorOn();
  69.     
  70.     if (interp == (Tcl_Interp *)0)
  71.         {
  72.         interp = g_interp;
  73.         }
  74.     
  75.     if (print_proc != (PFI)0)
  76.         saveproc = Tcl_SetPrintProcedure(print_proc);
  77.  
  78.     sprintf(command, "source \"%.*s\"\n", filename[0], &filename[1]);
  79.     result = Tcl_Eval(interp, command, 0, (char **)0);
  80.  
  81.     if (result == TCL_OK)
  82.         {
  83.         result = noErr;
  84.         if (interp->result != NULL && *(interp->result) != '\0')
  85.             (* Tcl_GetPrintProcedure()) (interp->result);
  86.         }
  87.      else
  88.         {
  89.         (* Tcl_GetPrintProcedure()) ( (result == TCL_ERROR) ? "Error: " : "Bad Result: " );
  90.         (* Tcl_GetPrintProcedure()) ( (interp->result == NULL) ? "<NULL>" : interp->result );
  91.         }
  92.     
  93.     if (print_proc != (PFI)0)
  94.         Tcl_SetPrintProcedure(saveproc);
  95.     
  96.     TclTickle_EndYield();
  97.     UInitCursor();
  98.  
  99.     return result;
  100.     }
  101.  
  102. #ifdef TCLAPPL
  103.  
  104. run_tcl_script(interp, print_proc)
  105.     Tcl_Interp    *interp;
  106.     PFI            print_proc;
  107.     {
  108.     int            result;
  109.     int            delete_interp = 0;
  110.     PFI            saveproc;
  111.     char        command[128];
  112.     Point        mypoint;
  113.     SFReply        myreply;
  114.     SFTypeList    mytypes;
  115.  
  116.     mypoint.h = mypoint.v = 75;
  117.     mytypes[0] = 'TEXT';
  118.     MyGetFile(mypoint, "\pScript:", NULL, (CheckOption()?-1:1), mytypes, NULL, &myreply);
  119.     if (myreply.good)
  120.         {
  121.  
  122.         TclTickle_BegYield();
  123.         WatchCursorOn();
  124.         
  125.         if (interp == (Tcl_Interp *)0)
  126.             {
  127.             interp = g_interp;
  128.             }
  129.         
  130.         if (print_proc != (PFI)0)
  131.             saveproc = Tcl_SetPrintProcedure(print_proc);
  132.  
  133.         SetVol(NULL, myreply.vRefNum);
  134.         sprintf(command, "source \"%.*s\"\n", myreply.fName[0], &myreply.fName[1]);
  135.         
  136.         result = Tcl_Eval(interp, command, 0, (char **)0);
  137.  
  138.         if (result == TCL_OK)
  139.             {
  140.             if (interp->result != NULL && *(interp->result) != '\0')
  141.                 (* Tcl_GetPrintProcedure()) (interp->result);
  142.             }
  143.          else
  144.             {
  145.             (* Tcl_GetPrintProcedure()) ( (result == TCL_ERROR) ? "Error: " : "Bad Result: " );
  146.             (* Tcl_GetPrintProcedure()) ( (interp->result == NULL) ? "<NULL>" : interp->result );
  147.             }
  148.         
  149.         if (print_proc != (PFI)0)
  150.             Tcl_SetPrintProcedure(saveproc);
  151.         
  152.         TclTickle_EndYield();
  153.         UInitCursor();
  154.         }
  155.     
  156.     }
  157.  
  158. #endif
  159.  
  160. /*
  161.  *----------------------------------------------------------------------
  162.  *
  163.  * Cmd_DoMenuCmd --
  164.  *     Implements the TCL cd command:
  165.  *         cd [directory]
  166.  *     See the oscmds(TCL) manual page.
  167.  *
  168.  * Results:
  169.  *      Standard TCL results, may return the UNIX system error message.
  170.  *
  171.  *----------------------------------------------------------------------
  172.  */
  173. int
  174. Cmd_DoMenuCmd(clientData, interp, argc, argv)
  175. char        *clientData;
  176. Tcl_Interp    *interp;
  177. int            argc;
  178. char        **argv;
  179. {
  180. #ifdef TCLAPPL
  181. int        menu, item;
  182. long    menu_select;
  183. #pragma unused (clientData)
  184.  
  185.     if (argc != 3)
  186.         {
  187.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  188.             " menuName menuItemNum\"", (char *) NULL);
  189.         return TCL_ERROR;
  190.         }
  191.     
  192.     UInitCursor();
  193.     
  194.     if (strcmp(argv[1], "Apple") == SAMESTR)
  195.         menu = 1;
  196.     else if (strcmp(argv[1], "File") == SAMESTR)
  197.         menu = 256;
  198.     else if (strcmp(argv[1], "Edit") == SAMESTR)
  199.         menu = 257;
  200.     else if (strcmp(argv[1], "Mac") == SAMESTR)
  201.         menu = 258;
  202.     else if (strcmp(argv[1], "Tcl") == SAMESTR)
  203.         menu = 269;
  204.     else if (strcmp(argv[1], "Text") == SAMESTR)
  205.         menu = 259;
  206.     else if (strcmp(argv[1], "UNIX") == SAMESTR)
  207.         menu = 260;
  208.     else if (strcmp(argv[1], "Tar") == SAMESTR)
  209.         menu = 296;
  210.     else if (strcmp(argv[1], "Tar!Options") == SAMESTR)
  211.         menu = 96;
  212.     else if (strcmp(argv[1], "ASD") == SAMESTR)
  213.         menu = 262;
  214.     else if (strcmp(argv[1], "StuffIt") == SAMESTR)
  215.         menu = 261;
  216.     else {
  217.         Tcl_AppendResult(interp, "unknown menu name \"", argv[1],
  218.             "\"", (char *) NULL);
  219.         return TCL_ERROR;
  220.         }
  221.     
  222.     item = atoi(argv[2]);
  223.     if (item == 0)
  224.         {
  225.         Tcl_AppendResult(interp, "non-numeric menu item \"", argv[2],
  226.             "\"", (char *) NULL);
  227.         return TCL_ERROR;
  228.         }
  229.     
  230.     /* UNDONE - check item# against CountMItems() */
  231.     menu_select = ((menu << 16) & 0xFFFF0000);
  232.     menu_select |= (item & 0x0000FFFF);
  233.     
  234.     /* UNDONE - do I have to check for "active"? */
  235.     do_command(menu_select);
  236.     
  237.     return TCL_OK;
  238. #else
  239. #pragma unused (clientData, interp, argc, argv)
  240.  
  241.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  242.     return TCL_ERROR;
  243.  
  244. #endif
  245.     }
  246.  
  247. int
  248. Cmd_DebugStr(clientData, interp, argc, argv)
  249.     char        *clientData;
  250.     Tcl_Interp    *interp;
  251.     int            argc;
  252.     char        **argv;
  253.     {
  254.     int        length;
  255.     Str255    pascal_str;
  256. #pragma unused (clientData)
  257.  
  258.     if (argc != 2)
  259.         {
  260.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  261.                             " message\"", (char *) NULL);
  262.         return TCL_ERROR;
  263.         }
  264.     
  265.     if (tcl_getenv("noMACdebugger") == NULL)
  266.         {
  267.         length = strlen(argv[1]);
  268.         strncpy(pascal_str, argv[1], 254);
  269.         pascal_str[0] = (length < 254 ? length : 254);
  270.         DebugStr(pascal_str);
  271.         }
  272.     else
  273.         {
  274.         Tcl_AppendResult(interp, "MACDEBUG - \"", argv[1], "\" ", NULL);
  275.         }
  276.         
  277.     return TCL_OK;
  278.     }
  279.  
  280. int
  281. Cmd_AskYesNoCancel(clientData, interp, argc, argv)
  282. char        *clientData;
  283. Tcl_Interp    *interp;
  284. int            argc;
  285. char        **argv;
  286. {
  287. #ifdef TCLAPPL
  288. int            result;
  289. #pragma unused (clientData, argc)
  290.     
  291.     if ( argc != 2 )
  292.         {
  293.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  294.                             argv[0], " question\"", NULL);
  295.         return TCL_ERROR;
  296.         }
  297.     
  298.     UInitCursor();
  299.     c2pstr(argv[1]);
  300.     ParamText(argv[1], NULL, NULL, NULL);
  301.     result = Alert(1015, (ModalFilterProcPtr)/*0*/UniversalFilter);
  302.     p2cstr(argv[1]);
  303.     if (result == 1) {
  304.         Tcl_SetResult(interp, "yes", TCL_VOLATILE);
  305.         }
  306.     else if (result == 2) {
  307.         Tcl_SetResult(interp, "no", TCL_VOLATILE);
  308.         }
  309.     else if (result == 3) {
  310.         Tcl_SetResult(interp, "cancel", TCL_VOLATILE);
  311.         }
  312.     return TCL_OK;
  313. #else
  314. #pragma unused (clientData, interp, argc, argv)
  315.  
  316.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  317.     return TCL_ERROR;
  318.  
  319. #endif
  320.     }
  321.  
  322. int
  323. Cmd_GetInputLine(clientData, interp, argc, argv)
  324. char        *clientData;
  325. Tcl_Interp    *interp;
  326. int            argc;
  327. char        **argv;
  328. {
  329. #ifdef TCLAPPL
  330. DialogPtr    myDialog;
  331. short        itemhit;
  332. char        mystr[256];
  333. #pragma unused (clientData, argc)
  334.  
  335.     UInitCursor();
  336.     myDialog = GetNewDialog(2007, NULL, (WindowPtr)-1);
  337.     if (myDialog == NULL) {
  338.         Tcl_AppendResult(interp, "\"", argv[0], "\" can not load dialog 2007", (char *) NULL);
  339.         return TCL_ERROR;
  340.         }
  341.     
  342.     if (argc > 1)
  343.         MySetText(myDialog, 3, argv[1]);
  344.         
  345.     if (argc > 2) {
  346.         MySetText(myDialog, 4, argv[2]);
  347.         SelIText(myDialog, 4, 0, 1023);
  348.         }
  349.     
  350.     for ( ; ; ) {
  351.         SetPort(myDialog);
  352.         FrameButton(myDialog, ok);
  353.         ModalDialog((ModalFilterProcPtr)/*0*/UniversalFilter, &itemhit);
  354.         if (itemhit == ok) {
  355.             MyGetText(myDialog, 4, mystr);
  356.             Tcl_SetResult(interp, mystr, TCL_VOLATILE);
  357.             break;
  358.             }
  359.         else if (itemhit == cancel) {
  360.             Tcl_SetResult(interp, "", TCL_VOLATILE);
  361.             break;
  362.             }
  363.         }
  364.     
  365.     CloseDialog(myDialog);
  366.     return TCL_OK;
  367. #else
  368. #pragma unused (clientData, interp, argc, argv)
  369.  
  370.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  371.     return TCL_ERROR;
  372.  
  373. #endif
  374.     }
  375.  
  376. int
  377. Cmd_GetDirectory(clientData, interp, argc, argv)
  378.     char        *clientData;
  379.     Tcl_Interp    *interp;
  380.     int            argc;
  381.     char        **argv;
  382.     {
  383. #ifdef TCLAPPL
  384.  
  385.     char    path[256];
  386.     short    vRefNum;
  387.     long    dirID;
  388.     
  389. #    pragma unused (clientData)
  390.     
  391.     if (argc != 2)
  392.         {
  393.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  394.                             argv[0], " prompt\"", NULL);
  395.         return TCL_ERROR;
  396.         }
  397.     
  398.     path[0] = '\0';
  399.     if ( ! GetFolderPathName(argv[1], path, &vRefNum, &dirID ) )
  400.         Tcl_SetResult(interp, "", TCL_VOLATILE);
  401.     else {
  402.         Tcl_SetResult(interp, path, TCL_VOLATILE);
  403.         }
  404.  
  405.     return TCL_OK;
  406.  
  407. #else
  408. #pragma unused (clientData, argc)
  409.  
  410.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  411.     return TCL_ERROR;
  412.  
  413. #endif
  414.     }
  415.  
  416. int
  417. Cmd_GetFile(clientData, interp, argc, argv)
  418.     char        *clientData;
  419.     Tcl_Interp    *interp;
  420.     int            argc;
  421.     char        **argv;
  422.     {
  423.  
  424. #ifdef TCLAPPL
  425.  
  426.     char    path[256], prompt[256], *ptr, *ptr2;
  427.     int        i, j;
  428.     Point    mypoint;
  429.     SFReply    myreply;
  430.     SFTypeList mytypes;
  431. #pragma unused (clientData, argc, argv)
  432.  
  433.     if ( argc < 2)
  434.         {
  435.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  436.                             argv[0], " prompt ?types...?\"", NULL);
  437.         return TCL_ERROR;
  438.         }
  439.     
  440.     i = -1;
  441.     strcpy(prompt, argv[1]);
  442.     c2pstr(prompt);
  443.     
  444.     if (argc > 2)
  445.         {
  446.         for ( ptr=argv[2],i=0 ; i < 4 && *ptr ; ++i )
  447.             {
  448.             ptr2 = (char *) &mytypes[i];
  449.             for ( j = 0 ; j < 4 ; ++j )
  450.                 {
  451.                 *ptr2++ = (*ptr) ? *ptr++ : ' ';
  452.                 }
  453.             }
  454.         
  455.         if (i == 0)
  456.             i = -1;
  457.         }
  458.     
  459.     mypoint.h = mypoint.v = 75;
  460.     
  461.     MyGetFile(mypoint, prompt, NULL, i, mytypes, NULL, &myreply);
  462.     if (myreply.good)
  463.         {
  464.         p2cstr(myreply.fName);
  465.         fullname(path, myreply.vRefNum, myreply.fName);
  466.         Tcl_SetResult(interp, path, TCL_VOLATILE);
  467.         }
  468.     else {
  469.         Tcl_SetResult(interp, "", TCL_VOLATILE);
  470.         }
  471.  
  472.     return TCL_OK;
  473.  
  474. #else
  475. #pragma unused (clientData, argc)
  476.  
  477.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  478.     return TCL_ERROR;
  479.  
  480. #endif
  481.     }
  482.  
  483. int
  484. Cmd_PutFile(clientData, interp, argc, argv)
  485.     char        *clientData;
  486.     Tcl_Interp    *interp;
  487.     int            argc;
  488.     char        **argv;
  489.     {
  490.  
  491. #ifdef TCLAPPL
  492.  
  493.     char    path[256], prompt[256], original[128];
  494.     int        i;
  495.     Point    mypoint;
  496.     SFReply    myreply;
  497. #pragma unused (clientData, argc, argv)
  498.  
  499.     if ( argc != 3 )
  500.         {
  501.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  502.                             argv[0], " prompt default\"", NULL);
  503.         return TCL_ERROR;
  504.         }
  505.  
  506.     path[0] = '\0';
  507.     original[0] = '\0';
  508.     i = -1;
  509.  
  510.     strcpy(prompt, argv[1]);
  511.     c2pstr(prompt);
  512.  
  513.     strcpy(original, argv[2]);
  514.     c2pstr(original);
  515.     
  516.     mypoint.h = mypoint.v = 75;
  517.  
  518.     MyPutFile(mypoint, prompt, original, NULL, &myreply);
  519.     if (myreply.good)
  520.         {
  521.         p2cstr(myreply.fName);
  522.         fullname(path, myreply.vRefNum, myreply.fName);
  523.         Tcl_SetResult(interp, path, TCL_VOLATILE);
  524.         }
  525.     else
  526.         {
  527.         Tcl_SetResult(interp, "", TCL_VOLATILE);
  528.         }
  529.  
  530.     return TCL_OK;
  531.  
  532. #else
  533. #pragma unused (clientData, argc)
  534.  
  535.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  536.     return TCL_ERROR;
  537.  
  538. #endif
  539.     }
  540.  
  541.  
  542. #ifdef TCLAPPL
  543.  
  544. static ListHandle    picklist = NULL;
  545. static char            string_reply[256];
  546.  
  547. #define SetCell(cell, row, column)    { (cell).h = column; (cell).v = row; }
  548. #define ROW(cell)                     (cell).v
  549.  
  550. pascal void
  551. MacListUpdate(myDialog, myItem)
  552.     DialogPtr        myDialog;
  553.     short            myItem;
  554.     {
  555.     Rect            myrect;
  556. #pragma unused (myItem)
  557.  
  558.     LUpdate(myDialog->visRgn, picklist);
  559.     myrect = (**(picklist)).rView;
  560.     InsetRect(&myrect, -1, -1);
  561.     FrameRect(&myrect);
  562.     }
  563.  
  564. pascal Boolean
  565. MacListFilter(myDialog, myEvent, myItem)
  566.     DialogPtr        myDialog;
  567.     EventRecord        *myEvent;
  568.     short            *myItem;
  569.     {
  570.     Rect    listrect;
  571.     short    myascii;
  572.     Handle    myhandle;
  573.     Point    mypoint;
  574.     short    mytype;
  575.  
  576.     SetPort(myDialog);
  577.     if (myEvent->what == keyDown) {
  578.         myascii = myEvent->message % 256;
  579.         if (myascii == '\015' || myascii == '\003') {    /* This is return or enter... */
  580.             *myItem = 1;
  581.             return true;
  582.             }
  583.         }
  584.     else if (myEvent->what == mouseDown) {
  585.         mypoint = myEvent->where;
  586.         GlobalToLocal(&mypoint);
  587.         GetDItem(myDialog, 4, &mytype, &myhandle, &listrect);
  588.         if (PtInRect(mypoint, &listrect) && picklist != NULL) {
  589.             if (LClick(mypoint, (short)myEvent->modifiers, picklist)) {
  590.                 /* User double-clicked in cell... */
  591.                 *myItem = 1;
  592.                 return true;
  593.                 }
  594.             }
  595.         }
  596.     else if (myEvent->what == updateEvt) {
  597.         wind_parse((WindowPtr) myEvent->message, myEvent, wUpdate);
  598.         }
  599.     else if (myEvent->what == activateEvt) {
  600.         if (picklist != NULL && (WindowPtr)myEvent->message == myDialog)
  601.             LActivate((Boolean)((myEvent->modifiers & 0x01) != 0), picklist);
  602.         wind_parse((WindowPtr) myEvent->message, myEvent, wActivate);
  603.         }
  604.     
  605.     return false;
  606.     }
  607.  
  608. #endif
  609.  
  610.  
  611. int
  612. Cmd_MacListPick(clientData, interp, argc, argv)
  613.     char        *clientData;
  614.     Tcl_Interp    *interp;
  615.     int            argc;
  616.     char        **argv;
  617.     {
  618. #ifdef TCLAPPL
  619.     short        itemhit, done, row, result, length;
  620.     DialogPtr    mydialog;
  621.     ListHandle    mylist;
  622.     Cell        mycell;
  623.     short        mytype;
  624.     Handle        myhandle;
  625.     Point        cellsize;
  626.     Rect        listrect, dbounds;
  627.     int            listArgc;
  628.     char        **listArgv;
  629. #pragma unused (clientData)
  630.  
  631.     if ( argc != 3 )
  632.         {
  633.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  634.                             argv[0], " prompt itemlist\"", NULL);
  635.         return TCL_ERROR;
  636.         }
  637.  
  638.     InitCursor();
  639.     mydialog = GetNewDialog(3030, NULL, (WindowPtr)-1);
  640.     if (mydialog == NULL)
  641.         {
  642.         Tcl_AppendResult(interp, "error \"", argv[0],
  643.                             "\" can not load dialog 3030", NULL);
  644.         return TCL_ERROR;
  645.         }
  646.     
  647.     MySetText(mydialog, 3, argv[1]);
  648.     
  649.     if (Tcl_SplitList (interp, argv[1], &listArgc, &listArgv) != TCL_OK)
  650.         {
  651.         return TCL_ERROR;
  652.         }
  653.  
  654.     GetDItem(mydialog, 4, &mytype, &myhandle, &listrect);
  655.     SetDItem(mydialog, 4, mytype, (Handle)MacListUpdate, &listrect);
  656.     
  657.     SetPort(mydialog);
  658.     InsetRect(&listrect, 1, 1);
  659.     SetRect(&dbounds, 0, 0, (short)1, (short)0);
  660.     cellsize.h = (listrect.right - listrect.left);
  661.     cellsize.v = 17;
  662.  
  663.     listrect.right -= 15;
  664.  
  665.     picklist = LNew(&listrect, &dbounds, cellsize, (short)0,
  666.                             mydialog, true, false, (Boolean)0, (Boolean)1);
  667.     if (picklist == NULL) {
  668.         DisposDialog(mydialog);
  669.         Tcl_AppendResult(interp, "\"", argv[0], "\" could not create dialog list", (char *) NULL);
  670.         ckfree((char *) listArgv);
  671.         return TCL_ERROR;
  672.         }
  673.  
  674.     mylist = picklist;
  675.     LDoDraw(FALSE, mylist);
  676.     
  677.     for (row=0 ; listArgc > 0 ; row++, listArgc--) {
  678.         LAddRow(1, row, mylist);
  679.         SetCell(mycell, (short)row, 0);
  680.         LSetCell((Ptr)listArgv[row], (short)strlen(listArgv[row]), mycell, mylist);
  681.         }
  682.  
  683.     ckfree((char *) listArgv);
  684.  
  685.     LDoDraw(TRUE, mylist);
  686.     /* CenterWindow(mydialog); */
  687.     ShowWindow(mydialog);
  688.     
  689.     for (done=0; ! done; )    {
  690.         SetPort(mydialog);
  691.         FrameButton(mydialog, ok);
  692.         ModalDialog(MacListFilter, &itemhit);
  693.         switch (itemhit) {
  694.             case ok:
  695.                 SetCell(mycell, 0, 0);
  696.                 done = 1; result = 0;
  697.                 if (LGetSelect((short)true, &mycell, picklist)) {
  698.                     length = 255;
  699.                     LGetCell(string_reply, &length, mycell, picklist);
  700.                     string_reply[length] = '\0';
  701.                     result = 1;
  702.                     }
  703.                 break;
  704.             case cancel:
  705.                 done = 1; result = 0;
  706.                 break;
  707.             }
  708.  
  709.         }    /* Modal Loop */
  710.     
  711.     if (result) {
  712.         Tcl_SetResult(interp, string_reply, TCL_VOLATILE);
  713.         }
  714.     else {
  715.         Tcl_SetResult(interp, "", TCL_VOLATILE);
  716.         }
  717.     
  718.     SetPort(mydialog);
  719.     
  720.     LDispose(mylist);
  721.     picklist = (ListHandle)0;
  722.     DisposDialog(mydialog);
  723.     
  724.     return TCL_OK;
  725. #else
  726. #pragma unused (clientData, interp, argc, argv)
  727.  
  728.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  729.     return TCL_ERROR;
  730.  
  731. #endif
  732.     }
  733.  
  734. int
  735. Cmd_DoAlertNote(clientData, interp, argc, argv)
  736.     char        *clientData;
  737.     Tcl_Interp    *interp;
  738.     int            argc;
  739.     char        **argv;
  740.     {
  741.     int        length;
  742.     char    pascal_str[256];
  743. #pragma unused (clientData)
  744.  
  745.     if (argc != 2)
  746.         {
  747.         Tcl_AppendResult(interp, "wrong # args: usage - \"", argv[0],
  748.                             " message\" ", (char *) NULL);
  749.         return TCL_ERROR;
  750.         }
  751.     
  752.     message_note("%.254s", argv[1]);
  753.     
  754.     return TCL_OK;
  755.     }
  756.  
  757. int
  758. Cmd_DoDeCompress(clientData, interp, argc, argv)
  759. char        *clientData;
  760. Tcl_Interp    *interp;
  761. int            argc;
  762. char        **argv;
  763. {
  764. int        result;
  765. FILE    *infile, *outfile;
  766. #pragma unused (clientData)
  767.  
  768.     if (argc != 3)
  769.         {
  770.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  771.             " compressedfilename newfilename\"", (char *) NULL);
  772.         return TCL_ERROR;
  773.         }
  774.  
  775.     infile = fopen(argv[1], "r");
  776.     if (infile == NULL)
  777.         {
  778.         Tcl_AppendResult(interp, "\"", argv[0], "\" could not open '", argv[1], "' ",
  779.                                 Tcl_UnixError(interp), (char *) NULL);
  780.         return TCL_ERROR;
  781.         }
  782.  
  783.     outfile = fopen(argv[2], "w");
  784.     if (outfile == NULL) {
  785.         fclose(infile);
  786.         Tcl_AppendResult(interp, "\"", argv[0], "\" could not open '", argv[2], "' ",
  787.                                 Tcl_UnixError(interp), (char *) NULL);
  788.         return TCL_ERROR;
  789.         }
  790.  
  791.     result = cunbatch(infile, outfile);
  792.     
  793.     WatchCursorOn();
  794.     
  795.     fclose(infile);
  796.     fclose(outfile);
  797.     
  798.     free_compress_memory();
  799.  
  800.     UInitCursor();
  801.     
  802.     if (result)
  803.         return TCL_OK;
  804.     else
  805.         {
  806.         Tcl_AppendResult(interp, "de-compress failed", (char *) NULL);
  807.         return TCL_ERROR;
  808.         }
  809.     }
  810.  
  811. int
  812. Cmd_DoCompress(clientData, interp, argc, argv)
  813. char        *clientData;
  814. Tcl_Interp    *interp;
  815. int            argc;
  816. char        **argv;
  817. {
  818. int        result, getbits;
  819. FILE    *infile, *outfile;
  820. #pragma unused (clientData)
  821.  
  822.     if (argc != 4)
  823.         {
  824.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  825.             " bits infile outfile\"", (char *) NULL);
  826.         return TCL_ERROR;
  827.         }
  828.     
  829.     getbits = atoi(argv[1]);
  830.     if (getbits == 0)
  831.         {
  832.         Tcl_AppendResult(interp, "non-numeric compress bits argument \"", argv[1],
  833.                             "\"", (char *) NULL);
  834.         return TCL_ERROR;
  835.         }
  836.     
  837.     infile = fopen(argv[2], "r");
  838.     if (infile == NULL)
  839.         {
  840.         Tcl_AppendResult(interp, "\"", argv[0], "\" could not open '", argv[2], "' ",
  841.                                 Tcl_UnixError(interp), (char *) NULL);
  842.         return TCL_ERROR;
  843.         }
  844.     
  845.     outfile = fopen(argv[3], "w");
  846.     if (outfile == NULL)
  847.         {
  848.         fclose(infile);
  849.         Tcl_AppendResult(interp, "\"", argv[0], "\" could not open '", argv[3], "' ",
  850.                                 Tcl_UnixError(interp), (char *) NULL);
  851.         return TCL_ERROR;
  852.         }
  853.  
  854.     if (! get_compress_memory(getbits))
  855.         {
  856.         SetZone(ApplicZone());
  857.         Tcl_AppendResult(interp, "not enough memory for decompress", NULL);
  858.         return TCL_ERROR;
  859.         }
  860.     
  861.     result = compress(infile, outfile);
  862.     
  863.     WatchCursorOn();
  864.     
  865.     fclose(infile);
  866.     fclose(outfile);
  867.     
  868.     set_file_type(argv[3], 0, APPL_TYPE, (OSType)'ZIVU');
  869.     
  870.     free_compress_memory();
  871.  
  872.     UInitCursor();
  873.  
  874.     if (result)
  875.         return TCL_OK;
  876.     else
  877.         {
  878.         Tcl_AppendResult(interp, "compress failed", (char *) NULL);
  879.         return TCL_ERROR;
  880.         }
  881.     }
  882.  
  883. int
  884. Cmd_EncodeHQX(clientData, interp, argc, argv)
  885.     char        *clientData;
  886.     Tcl_Interp    *interp;
  887.     int            argc;
  888.     char        **argv;
  889.     {
  890.     short    wdRefNum, push_err;
  891.     int        result;
  892. #pragma unused (clientData)
  893.  
  894.     if (argc != 3)
  895.         {
  896.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  897.             " mac_filename hqx_filename\"", (char *) NULL);
  898.         return TCL_ERROR;
  899.         }
  900.  
  901.     result = TclMac_CWDCreateWD(&wdRefNum);
  902.     if (result != noErr)
  903.         {
  904.         Tcl_AppendResult(interp, "could not create working directory - ",
  905.                             Tcl_MacGetError(interp, result), NULL);
  906.         return TCL_ERROR;
  907.         }
  908.     
  909.     push_err = TclMac_CWDPushVol();
  910.  
  911.     result = do_encode_hqx(wdRefNum, argv[1], wdRefNum, argv[2]);
  912.     
  913.     if (push_err == noErr)
  914.         TclMac_CWDPopVol();
  915.     
  916.     TclMac_CWDDisposeWD(wdRefNum);
  917.     
  918.     if (result == noErr)
  919.         {
  920.         return TCL_OK;
  921.         }
  922.     else
  923.         {
  924.         Tcl_AppendResult(interp, "binhex of \"", argv[1], "\" failed", (char *) NULL);
  925.         return TCL_ERROR;
  926.         }
  927.     }
  928.  
  929. int
  930. Cmd_DecodeHQX(clientData, interp, argc, argv)
  931.     char        *clientData;
  932.     Tcl_Interp    *interp;
  933.     int            argc;
  934.     char        **argv;
  935.     {
  936.     int        result, push_err;
  937.     short    wdRefNum;
  938. #pragma unused (clientData)
  939.  
  940.     if (argc != 3)
  941.         {
  942.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  943.             " infile outfile\"", (char *) NULL);
  944.         return TCL_ERROR;
  945.         }
  946.  
  947.     result = TclMac_CWDCreateWD(&wdRefNum);
  948.     if (result != noErr)
  949.         {
  950.         Tcl_AppendResult(interp, "could not create working directory - ",
  951.                             Tcl_MacGetError(interp, result), NULL);
  952.         return TCL_ERROR;
  953.         }
  954.     
  955.     push_err = TclMac_CWDPushVol();
  956.  
  957.     result = do_decode_hqx(wdRefNum, argv[1], wdRefNum, argv[2]);
  958.     
  959.     if (push_err == noErr)
  960.         TclMac_CWDPopVol();
  961.     
  962.     TclMac_CWDDisposeWD(wdRefNum);
  963.  
  964.     if (result == noErr)
  965.         return TCL_OK;
  966.     else
  967.         {
  968.         Tcl_AppendResult(interp, "unbinhex of \"", argv[1], "\" failed", (char *) NULL);
  969.         return TCL_ERROR;
  970.         }
  971.     }
  972.  
  973. int
  974. Cmd_UUEncode(clientData, interp, argc, argv)
  975.     char        *clientData;
  976.     Tcl_Interp    *interp;
  977.     int            argc;
  978.     char        **argv;
  979.     {
  980.     int            result, push_err;
  981.     short        wdRefNum;
  982.     SFReply        inreply;
  983.     SFReply        outreply;
  984. #pragma unused (clientData)
  985.  
  986.     if (argc != 3)
  987.         {
  988.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  989.             " infile uufile\"", (char *) NULL);
  990.         return TCL_ERROR;
  991.         }
  992.     
  993.     result = TclMac_CWDCreateWD(&wdRefNum);
  994.     if (result != noErr)
  995.         {
  996.         Tcl_AppendResult(interp, "could not create working directory - ",
  997.                             Tcl_MacGetError(interp, result), NULL);
  998.         return TCL_ERROR;
  999.         }
  1000.     
  1001.     push_err = TclMac_CWDPushVol();
  1002.  
  1003.     inreply.vRefNum = wdRefNum;
  1004.     strcpy(inreply.fName, argv[1]);
  1005.     c2pstr(inreply.fName);
  1006.     
  1007.     outreply.vRefNum = wdRefNum;
  1008.     strcpy(outreply.fName, argv[2]);
  1009.     c2pstr(outreply.fName);
  1010.     
  1011.     result = uuencode(&inreply, &outreply, FALSE);
  1012.     
  1013.     if (push_err == noErr)
  1014.         TclMac_CWDPopVol();
  1015.     
  1016.     TclMac_CWDDisposeWD(wdRefNum);
  1017.  
  1018.     if (result == SUCCESS)
  1019.         {
  1020.         result = TCL_OK;
  1021.         }
  1022.     else {
  1023.         Tcl_AppendResult(interp, "uuencode of \"", argv[1], "\" failed", (char *) 0);
  1024.         result = TCL_ERROR;
  1025.         }
  1026.     
  1027.     return result;
  1028.     }
  1029.  
  1030. int
  1031. Cmd_Mac_To_AS(clientData, interp, argc, argv)
  1032.     char        *clientData;
  1033.     Tcl_Interp    *interp;
  1034.     int            argc;
  1035.     char        **argv;
  1036.     {
  1037.     short        wdRefNum;
  1038.     int            result, push_err;
  1039. #pragma unused (clientData)
  1040.  
  1041.     if (argc != 3)
  1042.         {
  1043.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1044.             " macfile asfile\"", (char *) NULL);
  1045.         return TCL_ERROR;
  1046.         }
  1047.     
  1048.     UBegYield();
  1049.  
  1050.     result = TclMac_CWDCreateWD(&wdRefNum);
  1051.     if (result != noErr)
  1052.         {
  1053.         Tcl_AppendResult(interp, "could not create working directory - ",
  1054.                             Tcl_MacGetError(interp, result), NULL);
  1055.         return TCL_ERROR;
  1056.         }
  1057.     
  1058.     push_err = TclMac_CWDPushVol();
  1059.     
  1060.     result = do_mac_to_asingle(
  1061.                     argv[1], wdRefNum,
  1062.                     argv[2], wdRefNum,
  1063.                     FALSE, FALSE );
  1064.     
  1065.     WatchCursorOn();
  1066.     
  1067.     if (push_err == noErr)
  1068.         TclMac_CWDPopVol();
  1069.     
  1070.     TclMac_CWDDisposeWD(wdRefNum);
  1071.  
  1072.     UEndYield();
  1073.     UInitCursor();
  1074.     
  1075.     if (result == noErr)
  1076.         {
  1077.         result = TCL_OK;
  1078.         }
  1079.     else {
  1080.         Tcl_AppendResult(interp, "AS encode of \"", argv[1], "\" failed", (char *) 0);
  1081.         result = TCL_ERROR;
  1082.         }
  1083.     
  1084.     return result;
  1085.     }
  1086.  
  1087. int
  1088. Cmd_Mac_To_MB(clientData, interp, argc, argv)
  1089.     char        *clientData;
  1090.     Tcl_Interp    *interp;
  1091.     int            argc;
  1092.     char        **argv;
  1093.     {
  1094.     short        refnum, wdRefNum;
  1095.     int            result = TCL_OK, myerr, push_err;
  1096. #pragma unused (clientData)
  1097.  
  1098.     if (argc != 3)
  1099.         {
  1100.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1101.             " macfile mbfile\"", (char *) NULL);
  1102.         return TCL_ERROR;
  1103.         }
  1104.     
  1105.     myerr = TclMac_CWDCreateWD(&wdRefNum);
  1106.     if (myerr != noErr)
  1107.         {
  1108.         Tcl_AppendResult(interp, "could not create working directory - ",
  1109.                             Tcl_MacGetError(interp, result), NULL);
  1110.         return TCL_ERROR;
  1111.         }
  1112.     
  1113.     push_err = TclMac_CWDPushVol();
  1114.     
  1115.     SetVol( NULL, wdRefNum );
  1116.     c2pstr(argv[2]);
  1117.     myerr = Create(argv[2], wdRefNum, APPL_TYPE, (ResType)'MacB');
  1118.     p2cstr(argv[2]);
  1119.  
  1120.     if (myerr == dupFNErr)
  1121.         {
  1122.         file_type(argv[2], (ResType)'MacB', APPL_TYPE);
  1123.         }
  1124.     
  1125.     c2pstr(argv[2]);
  1126.     myerr = FSOpen(argv[2], wdRefNum, &refnum);
  1127.     p2cstr(argv[2]);
  1128.     
  1129.     if (myerr != noErr)
  1130.         {
  1131.         Tcl_AppendResult(interp, "error opening macintosh file \"",
  1132.                             argv[2], "\"", Tcl_MacGetError(interp, myerr),
  1133.                             (char *) 0);
  1134.         result = TCL_ERROR;
  1135.         }
  1136.     else
  1137.         {
  1138.         UBegYield();
  1139.         
  1140.         c2pstr(argv[1]);
  1141.         myerr = insert_macbinary( refnum, argv[1],
  1142.                                     TclMac_CWDVRefNum(), TclMac_CWDDirID() );
  1143.         p2cstr(argv[1]);
  1144.         
  1145.         if (myerr != noErr)
  1146.             {
  1147.             Tcl_AppendResult(interp, "MacBinary encode of \"", argv[1],
  1148.                             "\" failed ", Tcl_MacGetError(interp, myerr),
  1149.                             (char *) 0);
  1150.             result = TCL_ERROR;
  1151.             }
  1152.  
  1153.         WatchCursorOn();
  1154.  
  1155.         FSClose(refnum);
  1156.         UEndYield();
  1157.         }
  1158.     
  1159.     if (push_err == noErr)
  1160.         TclMac_CWDPopVol();
  1161.     
  1162.     TclMac_CWDDisposeWD(wdRefNum);
  1163.  
  1164.     UInitCursor();
  1165.     
  1166.     return result;
  1167.     }
  1168.  
  1169. int
  1170. Cmd_Mac_To_AD(clientData, interp, argc, argv)
  1171.     char        *clientData;
  1172.     Tcl_Interp    *interp;
  1173.     int            argc;
  1174.     char        **argv;
  1175.     {
  1176.     short        wdRefNum;
  1177.     int            result, push_err, myerr;
  1178. #pragma unused (clientData)
  1179.  
  1180.     if (argc != 4)
  1181.         {
  1182.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1183.             " macfile adfile datafile\"", (char *) NULL);
  1184.         return TCL_ERROR;
  1185.         }
  1186.     
  1187.     UBegYield();
  1188.  
  1189.     myerr = TclMac_CWDCreateWD(&wdRefNum);
  1190.     if (myerr != noErr)
  1191.         {
  1192.         Tcl_AppendResult(interp, "could not create working directory - ",
  1193.                             Tcl_MacGetError(interp, result), NULL);
  1194.         return TCL_ERROR;
  1195.         }
  1196.     
  1197.     push_err = TclMac_CWDPushVol();
  1198.  
  1199.     result = do_mac_to_adouble(
  1200.                     argv[1], wdRefNum,
  1201.                     argv[2], wdRefNum,
  1202.                     argv[3], wdRefNum,
  1203.                     FALSE, FALSE );
  1204.     
  1205.     WatchCursorOn();
  1206.     
  1207.     if (push_err == noErr)
  1208.         TclMac_CWDPopVol();
  1209.     
  1210.     TclMac_CWDDisposeWD(wdRefNum);
  1211.  
  1212.     UEndYield();
  1213.     UInitCursor();
  1214.     
  1215.     if (result == noErr)
  1216.         {
  1217.         result = TCL_OK;
  1218.         }
  1219.     else {
  1220.         Tcl_AppendResult(interp, "ASD decode of \"", argv[1], "\" failed", (char *) 0);
  1221.         result = TCL_ERROR;
  1222.         }
  1223.     
  1224.     return result;
  1225.     }
  1226.  
  1227. int
  1228. Cmd_ASD_To_Mac(clientData, interp, argc, argv)
  1229.     char        *clientData;
  1230.     Tcl_Interp    *interp;
  1231.     int            argc;
  1232.     char        **argv;
  1233.     {
  1234.     short        wdRefNum;
  1235.     int            result, push_err, myerr;
  1236.     char        asd_fname[64], *ptr, mac_fname[256];
  1237.     FILE        *asdfile;
  1238. #pragma unused (clientData)
  1239.  
  1240.     if (argc != 3)
  1241.         {
  1242.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1243.             " asdfile macfile\"", (char *) NULL);
  1244.         return TCL_ERROR;
  1245.         }
  1246.     
  1247.     asdfile = fopen(argv[1], "r");
  1248.     if (asdfile == NULL)
  1249.         {
  1250.         Feedback("Error #%d opening Apple Single/Double file '%s'",
  1251.                     errno, argv[1]);
  1252.         return FAILURE;
  1253.         }
  1254.     
  1255.     ptr = strrchr(argv[1], ':');
  1256.     if (ptr != NULL)
  1257.         {
  1258.         strcpy(asd_fname, ptr + 1);
  1259.         }
  1260.     else
  1261.         {
  1262.         strcpy(asd_fname, argv[1]);
  1263.         }
  1264.     
  1265.     strcpy(mac_fname, argv[2]);
  1266.     c2pstr(mac_fname);
  1267.     
  1268.     myerr = TclMac_CWDCreateWD(&wdRefNum);
  1269.     if (myerr != noErr)
  1270.         {
  1271.         Tcl_AppendResult(interp, "could not create working directory - ",
  1272.                             Tcl_MacGetError(interp, result), NULL);
  1273.         return TCL_ERROR;
  1274.         }
  1275.     
  1276.     push_err = TclMac_CWDPushVol();
  1277.  
  1278.     UBegYield();
  1279.  
  1280.     result = do_asd_to_mac( asd_fname, asdfile,
  1281.                             mac_fname, wdRefNum, FALSE );
  1282.     
  1283.     WatchCursorOn();
  1284.     
  1285.     fclose(asdfile);
  1286.     
  1287.     if (push_err == noErr)
  1288.         TclMac_CWDPopVol();
  1289.     
  1290.     TclMac_CWDDisposeWD(wdRefNum);
  1291.  
  1292.     UEndYield();
  1293.     UInitCursor();
  1294.     
  1295.     if (result == noErr)
  1296.         {
  1297.         result = TCL_OK;
  1298.         }
  1299.     else {
  1300.         Tcl_AppendResult(interp, "ASD decode of \"", argv[1], "\" failed", (char *) 0);
  1301.         result = TCL_ERROR;
  1302.         }
  1303.     
  1304.     return result;
  1305.     }
  1306.  
  1307. int
  1308. Cmd_UUDecode(clientData, interp, argc, argv)
  1309.     char        *clientData;
  1310.     Tcl_Interp    *interp;
  1311.     int            argc;
  1312.     char        **argv;
  1313.     {
  1314.     short        wdRefNum;
  1315.     int            result, push_err, myerr;
  1316.     SFReply        myreply;
  1317. #pragma unused (clientData)
  1318.  
  1319.     if (argc != 2)
  1320.         {
  1321.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1322.             " uufile\"", (char *) NULL);
  1323.         return TCL_ERROR;
  1324.         }
  1325.         
  1326.     myerr = TclMac_CWDCreateWD(&wdRefNum);
  1327.     if (myerr != noErr)
  1328.         {
  1329.         Tcl_AppendResult(interp, "could not create working directory - ",
  1330.                             Tcl_MacGetError(interp, result), NULL);
  1331.         return TCL_ERROR;
  1332.         }
  1333.     
  1334.     push_err = TclMac_CWDPushVol();
  1335.  
  1336.     myreply.vRefNum = wdRefNum;
  1337.     strcpy(myreply.fName, argv[1]);
  1338.     c2pstr(myreply.fName);
  1339.     
  1340.     result = uudecode(&myreply, FALSE);
  1341.     
  1342.     if (push_err == noErr)
  1343.         TclMac_CWDPopVol();
  1344.     
  1345.     TclMac_CWDDisposeWD(wdRefNum);
  1346.  
  1347.     if (result == SUCCESS)
  1348.         {
  1349.         result = TCL_OK;
  1350.         }
  1351.     else {
  1352.         Tcl_AppendResult(interp, "uudecode of \"", argv[1], "\" failed", (char *) 0);
  1353.         result = TCL_ERROR;
  1354.         }
  1355.     
  1356.     return result;
  1357.     }
  1358.  
  1359. int
  1360. Cmd_Feedback(clientData, interp, argc, argv)
  1361.     char        *clientData;
  1362.     Tcl_Interp    *interp;
  1363.     int            argc;
  1364.     char        **argv;
  1365.     {
  1366.     int        i;
  1367.     char    output[256];
  1368. #pragma unused (interp, clientData, argc)
  1369.  
  1370.     output[0] = '\0';
  1371.     for (i = 1 ; i < argc && (strlen(output) + strlen(argv[i]) + 2) < 256 ; ++i)
  1372.         {
  1373.         strcat(output, argv[i]);
  1374.         strcat(output, " ");
  1375.         }
  1376.  
  1377.     Feedback("%.256s", output);
  1378.     
  1379.     return TCL_OK;
  1380.     }
  1381.  
  1382. Cmd_LogControl(clientData, interp, argc, argv)
  1383.     char        *clientData;
  1384.     Tcl_Interp    *interp;
  1385.     int            argc;
  1386.     char        *argv[];
  1387.     {
  1388. #pragma unused (clientData)
  1389.  
  1390.     if (argc < 2 || argc > 3)
  1391.         {
  1392.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1393.             " on|off ?file?\"", (char *) NULL);
  1394.         return TCL_ERROR;
  1395.         }
  1396.     
  1397.     if (strcmp(argv[1], "on") == 0)
  1398.         {
  1399.         if (logfile == NULL)
  1400.             {
  1401.             extern int errno;
  1402.             
  1403.             if (argc == 3)
  1404.                 strcpy(g_log_filename, argv[2]);
  1405.  
  1406.             SetVol(NULL, g_log_wdref);
  1407.             logfile = fopen(g_log_filename, "a");
  1408.             if (logfile == NULL)
  1409.                 {
  1410.                 Tcl_AppendResult(interp, "error opening logfile \"", g_log_filename,
  1411.                                     "\"", (char *) NULL);
  1412.                 return TCL_ERROR;
  1413.                 }
  1414.             else
  1415.                 {
  1416.                 SetItem(file_menu_hdl, log_item, "\pEnd Logging");
  1417.                 }
  1418.             }
  1419.         }
  1420.     else
  1421.         {
  1422.         if (logfile != NULL)
  1423.             {
  1424.             fclose(logfile);
  1425.             FlushVol(NULL, g_log_wdref);
  1426.             logfile = (FILE *)0;
  1427.             SetItem(file_menu_hdl, log_item, "\pBegin Logging");
  1428.             }
  1429.         }
  1430.     }
  1431.  
  1432. space_cnt(str)
  1433.     char    *str;
  1434.     {
  1435.     int        count;
  1436.  
  1437.     for (count=0 ; *str ; str++)
  1438.         if (*str == ' ')
  1439.             count++;
  1440.     
  1441.     return count;
  1442.     }
  1443.  
  1444. int
  1445. Cmd_EscapeSpaces(clientData, interp, argc, argv)
  1446. char        *clientData;
  1447. Tcl_Interp    *interp;
  1448. int            argc;
  1449. char        **argv;
  1450. {
  1451. int        i, length;
  1452. char    *save, *ptr, *ptr2;
  1453. #pragma unused (clientData)
  1454.  
  1455.     if (argc < 2)
  1456.         {
  1457.         Tcl_SetResult(interp, "", TCL_VOLATILE);
  1458.         return TCL_OK;
  1459.         }
  1460.     
  1461.     for (length = 0, i = 1 ; i < argc ; i++)
  1462.         {
  1463.         length += strlen(argv[i]) + 2;    /* 2 for "\ " */
  1464.         length += ( 2 * space_cnt(argv[i]) );
  1465.         }
  1466.     length += 8;    /* terminator + */
  1467.     
  1468.     save = ptr = malloc(length);
  1469.     if (ptr == NULL)
  1470.         {
  1471.         Tcl_AppendResult(interp, "\"", argv[0], "\" out of memory", (char *) NULL);
  1472.         return TCL_ERROR;
  1473.         }
  1474.     else {
  1475.         for (length = 0, i = 1 ; i < argc ; i++)
  1476.             {
  1477.             if (i > 1) {
  1478.                 *ptr++ = '\\';
  1479.                 *ptr++ = ' ';
  1480.                 }
  1481.             for (ptr2 = argv[i] ; *ptr2 ; )
  1482.                 {
  1483.                 if (*ptr2 == ' ' && ptr2 > argv[i] && *(ptr2-1) != '\\')
  1484.                     *ptr++ = '\\';
  1485.                 *ptr++ = *ptr2++;
  1486.                 }
  1487.             }
  1488.         
  1489.         *ptr = '\0';
  1490.         Tcl_SetResult(interp, save, TCL_VOLATILE);
  1491.         free(save);
  1492.         }
  1493.  
  1494.     return TCL_OK;
  1495.     }
  1496.  
  1497. int
  1498. TclTickle_YieldMac(clientData, interp, argc, argv)
  1499.     char        *clientData;
  1500.     Tcl_Interp    *interp;
  1501.     int            argc;
  1502.     char        **argv;
  1503.     {
  1504.     short        emask;
  1505.     int            i,
  1506.                 got_event,
  1507.                 do_spin = 0,
  1508.                 do_event = 0,
  1509.                 event_ticks = 1;
  1510.     WindowPtr    whichwindow;
  1511.         
  1512. #pragma unused (clientData, interp)
  1513.     
  1514.     if ( argc < 1 || argc > 4 )
  1515.         {
  1516.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1517.                             argv[0], " ?-spin? ?-event ticks?\"", NULL);
  1518.         return TCL_ERROR;
  1519.         }
  1520.     
  1521.     for ( i = 1 ; i < argc ; ++i )
  1522.         {
  1523.         if ( strcmp(argv[i], "-spin") == 0 )
  1524.             {
  1525.             do_spin = 1;
  1526.             }
  1527.         else if ( strcmp(argv[i], "-event") == 0 )
  1528.             {
  1529.             do_event = 1;
  1530.             if ( sscanf(argv[i+1], "%d", &event_ticks) != 1 )
  1531.                 {
  1532.                 Tcl_AppendResult(interp, "invalid ticks argument \"",
  1533.                                     argv[i+1], "\"", NULL);
  1534.                 return TCL_ERROR;
  1535.                 }
  1536.             ++i;
  1537.             }
  1538.         else
  1539.             {
  1540.             Tcl_AppendResult(interp, "invalid argument \"",
  1541.                                 argv[i], "\"", NULL);
  1542.             return TCL_ERROR;
  1543.             }
  1544.         }
  1545.     
  1546.     if (do_spin)
  1547.         {
  1548.         RotateCursor(32);
  1549.         }
  1550.     
  1551.     if (do_event)
  1552.         {
  1553.         DoYield();
  1554.         if (cancel_current_op)
  1555.             {
  1556.             _tclmac_user_interrupt_ = 1;
  1557.             }
  1558.         else if (pause_op)
  1559.             {
  1560.             while (pause_op)
  1561.                 pausing();
  1562.             }
  1563.         }
  1564.     
  1565.     return TCL_OK;
  1566.     }
  1567.  
  1568. char        *progress_expr = NULL;
  1569. Tcl_Interp    *progress_interp = NULL;
  1570.  
  1571. void
  1572. SPTclProgress(message, start, end, pos)
  1573.     char    *message;
  1574.     int        start;
  1575.     int        end;
  1576.     int        pos;
  1577.     {
  1578.     int        result = TCL_ERROR;
  1579.     
  1580.     if (progress_expr != NULL && progress_interp != (Tcl_Interp *)0)
  1581.         {
  1582.         result = Tcl_Eval(progress_interp, progress_expr, 0, (char **)0);
  1583.         }
  1584.     
  1585.     if (result == TCL_OK)
  1586.         {
  1587.         strncpy(message, progress_interp->result, 254);
  1588.         message[255] = '\0';
  1589.         }
  1590.     else
  1591.         {
  1592.         sprintf(message, "Completed %d of %d...", pos - start, end - start);
  1593.         }
  1594.     }
  1595.  
  1596. int
  1597. Cmd_StartProgress(clientData, interp, argc, argv)
  1598.     char        *clientData;
  1599.     Tcl_Interp    *interp;
  1600.     int            argc;
  1601.     char        **argv;
  1602.     {
  1603.     int        result, start, end, pos;
  1604. #pragma unused (clientData)
  1605.  
  1606.     if (argc != 6)
  1607.         {
  1608.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1609.                         " title start end pos msgexpr\"", (char *) NULL);
  1610.         result = TCL_ERROR;
  1611.         }
  1612.     else
  1613.         {
  1614.         start = atoi(argv[2]);
  1615.         end = atoi(argv[3]);
  1616.         pos = atoi(argv[4]);
  1617.         
  1618.         c2pstr(argv[1]);
  1619.         StartProgressWindow(argv[1], start, end, pos, SPTclProgress);
  1620.         p2cstr(argv[1]);
  1621.         
  1622.         if (progress_expr != NULL)
  1623.             free(progress_expr);
  1624.         progress_expr = malloc(strlen(argv[5]) + 2);
  1625.         if (progress_expr != NULL)
  1626.             strcpy(progress_expr, argv[5]);
  1627.         
  1628.         progress_interp = interp;
  1629.         
  1630.         result = TCL_OK;
  1631.         }
  1632.     
  1633.     return result;
  1634.     }
  1635.  
  1636. int
  1637. Cmd_UpdateProgress(clientData, interp, argc, argv)
  1638.     char        *clientData;
  1639.     Tcl_Interp    *interp;
  1640.     int            argc;
  1641.     char        **argv;
  1642.     {
  1643.     int        result, pos;
  1644. #pragma unused (clientData)
  1645.  
  1646.     if (argc != 2)
  1647.         {
  1648.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1649.                         " position\"", (char *) NULL);
  1650.         result = TCL_ERROR;
  1651.         }
  1652.     else
  1653.         {
  1654.         pos = atoi(argv[1]);
  1655.         UpdateProgress(pos);
  1656.         result = TCL_OK;
  1657.         }
  1658.     
  1659.     return result;
  1660.     }
  1661.  
  1662. int
  1663. Cmd_StopProgress(clientData, interp, argc, argv)
  1664.     char        *clientData;
  1665.     Tcl_Interp    *interp;
  1666.     int            argc;
  1667.     char        **argv;
  1668.     {
  1669. #pragma unused (clientData, interp, argc, argv)
  1670.  
  1671.     if ( argc != 1 )
  1672.         {
  1673.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1674.                             argv[0], "\"", NULL);
  1675.         return TCL_ERROR;
  1676.         }
  1677.  
  1678.     StopProgressWindow();
  1679.     if (progress_expr != NULL)
  1680.         free(progress_expr);
  1681.     
  1682.     progress_expr = NULL;
  1683.     progress_interp = (Tcl_Interp *)0;
  1684.     
  1685.     return TCL_OK;
  1686.     }
  1687.  
  1688. int
  1689. XTCL_Eval_CallBack(cpb, script_handle, result_handle, stdout_handle)
  1690.     XTCLParmBlk    *cpb;
  1691.     Handle        script_handle;
  1692.     Handle        result_handle;
  1693.     Handle        stdout_handle;
  1694.     {
  1695.     return Tcl_Interp_Handle(cpb->interp, script_handle, result_handle, stdout_handle);
  1696.     }
  1697.  
  1698. int
  1699. Cmd_CallExternalCMD(clientData, interp, argc, argv)
  1700.     char        *clientData;
  1701.     Tcl_Interp    *interp;
  1702.     int            argc;
  1703.     char        **argv;
  1704.     {
  1705.     Handle        myhandle = NULL,
  1706.                 result_handle = NULL;
  1707.     int            myerr, result = TCL_OK, push_err;
  1708.     short        saveref, the_refnum = -1, user_ref = -1, wdRefNum;
  1709.     char        name[256];
  1710.     XTCLParmBlk    cbpb;
  1711. #pragma unused (clientData)
  1712.  
  1713.     saveref = CurResFile();
  1714.     
  1715.     if (argv[1][0] == '-' && argv[1][1] == 'f' && argv[1][2] == '\0')
  1716.         {
  1717.         myerr = TclMac_CWDCreateWD(&wdRefNum);
  1718.         if (myerr != noErr)
  1719.             {
  1720.             Tcl_AppendResult(interp, "could not create working directory - ",
  1721.                                 Tcl_MacGetError(interp, result), NULL);
  1722.             return TCL_ERROR;
  1723.             }
  1724.         
  1725.         push_err = TclMac_CWDPushVol();
  1726.         
  1727.         SetVol(NULL, wdRefNum);
  1728.         
  1729.         c2pstr(argv[2]);
  1730.         user_ref = OpenResFile(argv[2]);
  1731.         p2cstr(argv[2]);
  1732.         
  1733.         if (push_err == noErr)
  1734.             TclMac_CWDPopVol();
  1735.         
  1736.         TclMac_CWDDisposeWD(wdRefNum);
  1737.  
  1738.         if (user_ref == -1)
  1739.             {
  1740.             macintoshErr = ResError();
  1741.             Tcl_AppendResult(interp, "\"", argv[0], "\" OpenResfile(", argv[2], ") ",
  1742.                                     Tcl_MacError(interp), (char *) NULL);
  1743.             return TCL_ERROR;
  1744.             }
  1745.         else
  1746.             the_refnum = user_ref;
  1747.         
  1748.         strcpy(name, argv[3]);
  1749.         argc -= 3;
  1750.         argv += 3;
  1751.         }
  1752.     else
  1753.         {
  1754.         strcpy(name, argv[1]);
  1755.         argc--;
  1756.         argv++;
  1757.         }
  1758.     c2pstr(name);
  1759.  
  1760.     if (user_ref != -1)
  1761.         {
  1762.         UseResFile(user_ref);
  1763.         myhandle = GetNamedResource((ResType)'XTCL', name);
  1764.         }
  1765.     if (myhandle == NULL)
  1766.         {
  1767.         UseResFile(app_refnum);
  1768.         the_refnum = app_refnum;
  1769.         myhandle = GetNamedResource((ResType)'XTCL', name);
  1770.         if (myhandle == NULL && xtcl_refnum != -1)
  1771.             {
  1772.             UseResFile(xtcl_refnum);
  1773.             the_refnum = xtcl_refnum;
  1774.             myhandle = GetNamedResource((ResType)'XTCL', name);
  1775.             }
  1776.         }
  1777.     
  1778.     if (myhandle != NULL)
  1779.         {
  1780.         LoadResource(myhandle);
  1781.         DetachResource(myhandle);
  1782.         
  1783.         result_handle = NewHandle(1);
  1784.         if (result_handle != NULL)
  1785.             {
  1786.             **result_handle = '\0';
  1787.  
  1788.             cbpb.version = XTCL_CB_VERSION;
  1789.             cbpb.result = noErr;
  1790.             cbpb.resultH = result_handle;
  1791.             cbpb.interp = interp;
  1792.             cbpb.eval = XTCL_Eval_CallBack;
  1793.             cbpb.cmdRefNum = the_refnum;
  1794.             cbpb.cmdHandle = myhandle;
  1795.             cbpb.modalproc = UniversalFilter;
  1796.     
  1797.             UseResFile(the_refnum);
  1798.             /* CallXTCL(argc, argv, &cbpb, *myhandle); */
  1799.             
  1800.             HLock(myhandle);
  1801.  
  1802. #ifdef THINK_C
  1803.             {
  1804.             void (*proc)();
  1805.             proc = *myhandle;
  1806.             ( * proc ) (argc, argv, &cbpb);
  1807.             }
  1808. #else
  1809.             ( * ((ProcPtr) *myhandle) )(argc, argv, &cbpb);
  1810. #endif
  1811.  
  1812.             HUnlock(myhandle);
  1813.             
  1814.             UseResFile(saveref);
  1815.  
  1816.             if (*result_handle != NULL && **result_handle != '\0')
  1817.                 {
  1818.                 HLock(result_handle);
  1819.                 Tcl_SetResult(interp, *result_handle, TCL_VOLATILE);
  1820.                 HUnlock(result_handle);
  1821.                 }
  1822.             
  1823.             DisposHandle(result_handle);
  1824.  
  1825.             result = cbpb.result;
  1826.             }
  1827.         else
  1828.             {
  1829.             char    msg[64];
  1830.             
  1831.             sprintf(msg, "error #%d getting result handle", MemError());
  1832.             Tcl_AppendResult(interp, "\"", argv[0], "\" ", msg, (char *) NULL);
  1833.             result = TCL_ERROR;
  1834.             }
  1835.         
  1836.         DisposHandle(myhandle);
  1837.         }
  1838.     else
  1839.         {
  1840.         char    msg[96];
  1841.         
  1842.         sprintf(msg, "error %d:%d:%d loading XTCL '%.*s'",
  1843.                 ResError(), MemError(), xtcl_refnum, name[0], &name[1]);
  1844.         Tcl_AppendResult(interp, "\"", argv[0], "\" ", msg, (char *) NULL);
  1845.         if (user_ref != -1)
  1846.             CloseResFile(user_ref);
  1847.         result = TCL_ERROR;
  1848.         }
  1849.     
  1850.     if (user_ref != -1)
  1851.         CloseResFile(user_ref);
  1852.  
  1853.     UseResFile(saveref);
  1854.     return result;
  1855.     }
  1856.  
  1857. tcl_dev_null_output(str)
  1858.     char    *str;
  1859.     {
  1860. #pragma unused (str)
  1861.  
  1862.     }
  1863.  
  1864. int
  1865. Cmd_GotoWindowLine(clientData, interp, argc, argv)
  1866.     char        *clientData;
  1867.     Tcl_Interp    *interp;
  1868.     int            argc;
  1869.     char        **argv;
  1870.     {
  1871. #ifdef TCLAPPL
  1872.     int            linenum;
  1873.     WindowPtr    myWindow;
  1874.     
  1875. #    pragma unused (clientData, argc, argv)
  1876.  
  1877.     if (! ( (argc == 2) ||
  1878.             (argc == 3 && strcmp(argv[1], "-nocomplain") == 0 ) ) )
  1879.         {
  1880.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1881.                             "\" ?-nocomplain? linenum ", NULL);
  1882.         return TCL_ERROR;
  1883.         }
  1884.     
  1885.     if ( sscanf( argv[(argc==2 ? 1 : 2)], "%d", &linenum ) != 1 )
  1886.         {
  1887.         Tcl_AppendResult(interp, "invalid line number \"",
  1888.                             argv[(argc==2 ? 1 : 2)], "\" ", NULL);
  1889.         return TCL_ERROR;
  1890.         }
  1891.  
  1892.     myWindow = FrontWindow();
  1893.     if (myWindow != NULL && WPeek->windowKind == tgeWKind)
  1894.         {
  1895.         tge_goto_line(myWindow, linenum);
  1896.         }
  1897.     else if (argc == 2)
  1898.         {
  1899.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1900.                             "\" ?-nocomplain? linenum ", NULL);
  1901.         return TCL_ERROR;
  1902.         }
  1903.         
  1904.     return TCL_OK;
  1905.  
  1906. #else
  1907. #pragma unused (clientData, argc)
  1908.  
  1909.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  1910.     return TCL_ERROR;
  1911.  
  1912. #endif
  1913.     }
  1914.  
  1915. int
  1916. Cmd_OpenTextWindow(clientData, interp, argc, argv)
  1917.     ClientData    clientData;
  1918.     Tcl_Interp    *interp;
  1919.     int            argc;
  1920.     char        **argv;
  1921.     {
  1922. #ifdef TCLAPPL
  1923.     int                type_selector;
  1924.     Rect            myrect;
  1925.     WindowPtr        myWindow;
  1926.     
  1927.     extern WindowPtr    MakeTextTGE();
  1928.     
  1929.     if ( argc != 4 )
  1930.         {
  1931.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1932.                         " wTitle text [local|global|text]\" ", NULL);
  1933.         return TCL_ERROR;
  1934.         }
  1935.     
  1936.     if ( strcmp(argv[3], "local") == 0 )
  1937.         type_selector = 0;
  1938.     else if ( strcmp(argv[3], "global") == 0 )
  1939.         type_selector = 1;
  1940.     else if ( strcmp(argv[3], "text") == 0 )
  1941.         type_selector = -1;
  1942.     else
  1943.         {
  1944.         Tcl_AppendResult(interp, "bad type selector \"", argv[2],
  1945.                         "\" should be one of \"local global text\" ", NULL);
  1946.         return TCL_ERROR;
  1947.         }
  1948.     
  1949.     {
  1950.     WindowPtr fWindow;
  1951.     fWindow = FrontWindow();
  1952.     if (fWindow != NULL && ((WindowPeek)fWindow)->windowKind == tgeWKind)
  1953.         {
  1954.         tge_activate(fWindow, 0);
  1955.         }
  1956.     }
  1957.  
  1958.     SetRect(&myrect, 10, 40, 480, 280);
  1959.     myWindow = MakeTextTGE( &myrect, argv[1], argv[2], strlen(argv[2]) );
  1960.     if (myWindow != NULL)
  1961.         {
  1962.         TGEWPtr->fobject = (void *)0;
  1963.         T_UNSETSTATE(TGEWPtr->state, T_TCL_STATE);
  1964.         if (type_selector >= 0)
  1965.             {
  1966.             if ( type_selector == 0 || g_interp == NULL )
  1967.                 {
  1968.                 /* LOCAL */
  1969.                 T_UNSETSTATE(TGEWPtr->state, T_GLOBAL_TCL_STATE);
  1970.                 interp = Tcl_CreateTickleInterp();
  1971.                 if (interp != NULL)
  1972.                     TickleInitLocalShell(interp, myWindow);
  1973.                 }
  1974.             else
  1975.                 {
  1976.                 /* GLOBAL */
  1977.                 T_SETSTATE(TGEWPtr->state, T_GLOBAL_TCL_STATE);
  1978.                 interp = g_interp;
  1979.                 }
  1980.                 
  1981.             TGEWPtr->fobject = (void *)interp;
  1982.             if (interp != NULL)
  1983.                 T_SETSTATE(TGEWPtr->state, T_TCL_STATE);
  1984.             }
  1985.         }
  1986. #else
  1987. #pragma unused (clientData, argc)
  1988.  
  1989.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  1990.     return TCL_ERROR;
  1991.  
  1992. #endif
  1993.     }
  1994.  
  1995. int
  1996. Cmd_OpenFileWindow(clientData, interp, argc, argv)
  1997.     ClientData    clientData;
  1998.     Tcl_Interp    *interp;
  1999.     int            argc;
  2000.     char        **argv;
  2001.     {
  2002. #ifdef TCLAPPL
  2003.     int            type_selector = 0;
  2004.     char        *ptr;
  2005.     FSSpec        fileFSS;
  2006.     struct stat    statbuf;
  2007.     
  2008.     if ( argc != 3 )
  2009.         {
  2010.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  2011.                         " fileName [local|global|text]\" ", NULL);
  2012.         return TCL_ERROR;
  2013.         }
  2014.     
  2015.     if ( strcmp(argv[2], "local") == 0 )
  2016.         type_selector = 0;
  2017.     else if ( strcmp(argv[2], "global") == 0 )
  2018.         type_selector = 1;
  2019.     else if ( strcmp(argv[2], "text") == 0 )
  2020.         type_selector = -1;
  2021.     else
  2022.         {
  2023.         Tcl_AppendResult(interp, "bad type selector \"", argv[2],
  2024.                         "\" should be one of \"local global text\" ", NULL);
  2025.         return TCL_ERROR;
  2026.         }
  2027.     
  2028.     if ( stat( argv[1], &statbuf ) < 0 )
  2029.         {
  2030.         Tcl_AppendResult(interp, "error locating file \"", argv[1],
  2031.                         "\" - ", Tcl_PosixError(), NULL);
  2032.         return TCL_ERROR;
  2033.         }
  2034.     
  2035.     fileFSS.parID = statbuf.st_parid;
  2036.     fileFSS.vRefNum = statbuf.st_dev;
  2037.     
  2038.     ptr = strrchr( argv[1], ':' );
  2039.     if (ptr == NULL)
  2040.         ptr = argv[1];
  2041.     else
  2042.         ++ptr;
  2043.     
  2044.     strcpy(fileFSS.name, ptr);
  2045.     c2pstr(fileFSS.name);
  2046.     
  2047.     {
  2048.     GrafPtr        saveport;
  2049.     WindowPtr    myWindow;
  2050.  
  2051.     myWindow = FrontWindow();
  2052.     if (myWindow != NULL && WPeek->windowKind == tgeWKind)
  2053.         {
  2054.         GetPort(&saveport);
  2055.         SetPort(myWindow);
  2056.         
  2057.         tge_activate(myWindow, 0);
  2058.         tge_update(myWindow);
  2059.         
  2060.         SetPort(saveport);
  2061.         }
  2062.     }
  2063.  
  2064.     do_tge_file_open(&fileFSS, type_selector);
  2065.     
  2066.     /* UNDONE - error handling... */
  2067. #else
  2068. #pragma unused (clientData, argc)
  2069.  
  2070.     Tcl_AppendResult(interp, "\"", argv[0], "\" unimplemented in engine", (char *) NULL);
  2071.     return TCL_ERROR;
  2072.  
  2073. #endif
  2074.     }
  2075.  
  2076. static Handle        _tcl_Houtput_handle = NULL;
  2077.  
  2078. Handle
  2079. tcl_Houtput_sethdl(handle)
  2080.     Handle    handle;
  2081.     {
  2082.     Handle    result = _tcl_Houtput_handle;
  2083.  
  2084.     _tcl_Houtput_handle = handle;
  2085.     return result;
  2086.     }
  2087.  
  2088. Handle
  2089. tcl_Houtput_gethdl()
  2090.     {
  2091.     return _tcl_Houtput_handle;
  2092.     }
  2093.  
  2094. tcl_handle_output(str)
  2095.     char    *str;
  2096.     {
  2097.     long    length;
  2098.  
  2099.     length = GetHandleSize(_tcl_Houtput_handle);
  2100.     SetHandleSize(_tcl_Houtput_handle, length + strlen(str));
  2101.     if (MemError() == noErr)
  2102.         {
  2103.         memcpy( (*_tcl_Houtput_handle + length), str, strlen(str) );
  2104.         }
  2105.     }
  2106.  
  2107.  
  2108. int
  2109. Tcl_Interp_Handle(interp, script_handle, result_handle, stdout_handle)
  2110.     Tcl_Interp    *interp;
  2111.     Handle        script_handle;
  2112.     Handle        result_handle;
  2113.     Handle        stdout_handle;
  2114.     {
  2115.     int        result;
  2116.     PFI        saveproc;
  2117.     Handle    saveH, myhandle = NULL;
  2118.     char    result_str[64]/*, *save, *ptr*/;
  2119.  
  2120.     if (stdout_handle == NULL)
  2121.         {
  2122.         myhandle = NewHandle(0);
  2123.         if (myhandle == NULL)
  2124.             {
  2125.             Feedback("Error #%d allocating a stdout handle.", MemError());
  2126.             return -1770;
  2127.             }
  2128.         else
  2129.             {
  2130.             saveH = tcl_Houtput_sethdl(myhandle);
  2131.             }
  2132.         }
  2133.     else
  2134.         {
  2135.         saveH = tcl_Houtput_sethdl(stdout_handle);
  2136.         }
  2137.  
  2138.     saveproc = Tcl_SetPrintProcedure(tcl_handle_output);
  2139.     
  2140.     HLock(script_handle);
  2141.     
  2142.     result = Tcl_RecordAndEval(interp, *script_handle, 0);
  2143.  
  2144.     HUnlock(script_handle);
  2145.         
  2146.     if (result != TCL_OK)
  2147.         {
  2148.         sprintf(result_str, "\015# Result = %d.\015", result);
  2149.         tcl_handle_output(result_str);
  2150.         tcl_handle_output("# ");
  2151.         tcl_handle_output(interp->result);
  2152.         }
  2153.     else if (interp->result[0] != '\0' && result_handle != NULL)
  2154.         {
  2155.         tcl_Houtput_sethdl(result_handle);
  2156.         tcl_handle_output(interp->result);
  2157.         }
  2158.     
  2159.     Tcl_SetPrintProcedure(saveproc);
  2160.     tcl_Houtput_sethdl(saveH);
  2161.     
  2162.     if (myhandle != NULL)
  2163.         DisposHandle(myhandle);
  2164.         
  2165.     return result;
  2166.     }
  2167.  
  2168. #ifdef TCLAPPL
  2169.  
  2170. TGETCLInterp(myWindow, selector)
  2171.     WindowPtr    myWindow;
  2172.     int            selector;
  2173.     {
  2174.     int        result, rerr, hargc;
  2175.     long    line;
  2176.     Point    cursorpt;
  2177.     Rect    myrect;
  2178.     Handle    myHandle, saveH, hargv[4];
  2179.     int        save_start, save_end;
  2180.     int        script_start, script_end;
  2181.     Handle    resultHandle, stdoutHandle;
  2182.     PFI        saveproc;
  2183.  
  2184.     if (TGEWPtr->v_length == 0)
  2185.         return;
  2186.     
  2187.     WatchCursorOn();
  2188.     TclTickle_BegYield();
  2189.     
  2190.     SetPort(myWindow);
  2191.     
  2192.     save_start = TGEWPtr->sel_start;
  2193.     save_end = TGEWPtr->sel_end;
  2194.     
  2195.     tge_kill_caret(myWindow);
  2196.  
  2197.     line = tge_find_pos_line(myWindow, TGEWPtr->sel_end);
  2198.     if (TGEWPtr->sel_start != TGEWPtr->sel_end)
  2199.         {
  2200.         script_start = TGEWPtr->sel_start;
  2201.         script_end = TGEWPtr->sel_end;
  2202.         }
  2203.     else {
  2204.         script_start = TGEWPtr->lines[line];
  2205.         TGEWPtr->sel_start = script_start;
  2206.         if (line >= TGEWPtr->num_lines - 1)
  2207.             script_end = TGE_LAST_POSITION(myWindow) + 1;
  2208.         else
  2209.             script_end = TGEWPtr->lines[line + 1];
  2210.         TGEWPtr->sel_end = script_end;
  2211.         }
  2212.  
  2213.     myHandle = tge_selection_handle(myWindow);
  2214.  
  2215.     TGEWPtr->sel_start = save_start;
  2216.     TGEWPtr->sel_end = save_end;
  2217.  
  2218.     if (myHandle != NULL)
  2219.         {
  2220.         resultHandle = NewHandle(0);
  2221.         rerr = MemError();
  2222.         if (line >= TGEWPtr->num_lines - 1)
  2223.             {
  2224.             stdoutHandle = NewHandle(1);
  2225.             if (MemError() == noErr && stdoutHandle != NULL)
  2226.                 **stdoutHandle = '\015';
  2227.             }
  2228.         else
  2229.             {
  2230.             stdoutHandle = NewHandle(0);
  2231.             }
  2232.         
  2233.         if (MemError() == noErr && rerr == noErr &&
  2234.                 resultHandle != NULL && stdoutHandle != NULL)
  2235.             {        
  2236.             if (selector == TGE_SCRIPT)
  2237.                 {
  2238.                 saveH = tcl_Houtput_sethdl(stdoutHandle);
  2239.                 saveproc = Tcl_SetPrintProcedure(tcl_handle_output);
  2240.         
  2241.                 run_tcl_script((Tcl_Interp *)TGEWPtr->fobject, NULL);
  2242.                 
  2243.                 Tcl_SetPrintProcedure(saveproc);
  2244.                 tcl_Houtput_sethdl(saveH);
  2245.                 }
  2246.             else
  2247.                 {
  2248.                 result = Tcl_Interp_Handle( (Tcl_Interp *)TGEWPtr->fobject,
  2249.                                             myHandle, resultHandle, stdoutHandle );
  2250.                 }
  2251.             
  2252.             WatchCursorOn();
  2253.  
  2254.             DoYield();    /* This picks up the activate event! */
  2255.             DoYield();    /* Make sure.... :) */
  2256.             DoYield();    /* Make certain.... */
  2257.             
  2258.             SetPort(myWindow);
  2259.             if (TGEWPtr->active)
  2260.                 {
  2261.                 tge_invert_selection(myWindow);
  2262.                 }
  2263.             else {
  2264.                 tge_invert_selection(myWindow);
  2265.                 tge_activate_selection(myWindow);
  2266.                 }
  2267.             
  2268.             TGEWPtr->sel_start = 
  2269.                 tge_selection_line_append_pos(myWindow, line);
  2270.             TGEWPtr->sel_end = TGEWPtr->sel_start;
  2271.                 
  2272.             if ( GetHandleSize(stdoutHandle) > 0 )
  2273.             if (*(*stdoutHandle + GetHandleSize(stdoutHandle) - 1) != '\015')
  2274.                 {
  2275.                 SetHandleSize(stdoutHandle, GetHandleSize(stdoutHandle) + 1);
  2276.                 if (MemError() == noErr)
  2277.                     *(*stdoutHandle + GetHandleSize(stdoutHandle) - 1) = '\015';
  2278.                 }
  2279.                 
  2280.             if ( GetHandleSize(resultHandle) > 0 )
  2281.             if (*(*resultHandle + GetHandleSize(resultHandle) - 1) != '\015')
  2282.                 {
  2283.                 SetHandleSize(resultHandle, GetHandleSize(resultHandle) + 1);
  2284.                 if (MemError() == noErr)
  2285.                     *(*resultHandle + GetHandleSize(resultHandle) - 1) = '\015';
  2286.                 }
  2287.             
  2288.             hargc = 0;
  2289.             if (GetHandleSize(stdoutHandle) > 0)
  2290.                 {
  2291.                 hargv[hargc++] = stdoutHandle;
  2292.                 }
  2293.             
  2294.             if (GetHandleSize(resultHandle) > 0)
  2295.                 {
  2296.                 hargv[hargc++] = resultHandle;
  2297.                 }
  2298.                 
  2299.             if (hargc > 0)
  2300.                 {
  2301.                 hargv[hargc++] = (Handle)0;
  2302.                 tge_paste_handles(myWindow, hargc, hargv);
  2303.                 }
  2304.  
  2305.             TGEWPtr->sel_start = TGEWPtr->sel_end -
  2306.                         ( GetHandleSize(stdoutHandle) + GetHandleSize(resultHandle) );
  2307.             
  2308.             DisposHandle(stdoutHandle);
  2309.             DisposHandle(resultHandle);
  2310.             }
  2311.         else
  2312.             {
  2313.             message_alert("Not enough memory to store result.");
  2314.             }
  2315.                 
  2316.         DisposHandle(myHandle);
  2317.         }
  2318.     else
  2319.         {
  2320.         message_alert("Not enough memory to execute selection.");
  2321.         }
  2322.     
  2323.     tge_compute_selection(myWindow);
  2324.     
  2325.     tge_caret_on(myWindow);
  2326.     tge_undo_start_typing(myWindow, TGEWPtr->sel_start);
  2327.     SetPort(myWindow);
  2328.     if (TGEWPtr->active)
  2329.         {
  2330.         tge_invert_selection(myWindow);
  2331.         }
  2332.     else {
  2333.         tge_invert_selection(myWindow);
  2334.         tge_activate_selection(myWindow);
  2335.         }
  2336.     
  2337.     myrect = myWindow->portRect;
  2338.     myrect.right -= 15;
  2339.     myrect.bottom -= 15;
  2340.     SetPort(myWindow);
  2341.     GetMouse(&cursorpt);
  2342.     
  2343.     TclTickle_EndYield();
  2344.  
  2345.     if (PtInRect(cursorpt, &myrect))
  2346.         SetCursor(*GetCursor(iBeamCursor));
  2347.     else
  2348.         UInitCursor();
  2349.     }
  2350.  
  2351. #endif
  2352.  
  2353. check_environment_set_of_globals(name, value)
  2354.     char    *name;
  2355.     char    *value;
  2356.     {
  2357.     if (strcmp("LOGLEVEL", name) == 0)
  2358.         {
  2359.         g_log_level = atoi(value);
  2360.         Feedback("Log level now: %d.", g_log_level);
  2361.         }
  2362.     else if (strcmp("CRON_TICKS", name) == 0)
  2363.         {
  2364.         g_cron_interval = atol(value);
  2365.         g_next_cron_time = TickCount() + g_cron_interval;
  2366.         Feedback("Cron ticks now: %ld. Next task time: %ld.",
  2367.                     g_cron_interval, g_next_cron_time);
  2368.         }
  2369.     else if (strcmp("TEXT_CREATOR", name) == 0)
  2370.         {
  2371.         char    tempstr[8];
  2372.         
  2373.         sprintf(tempstr, "%-4.4s", value);
  2374.         memcpy(&def_text_file_creator, tempstr, 4);
  2375.         Feedback("Default text creator now: '%-4.4s'.", &def_text_file_creator);
  2376.         }
  2377. #ifdef TCLENGINE
  2378.     else if (strcmp("ENGINE_NOISE", name) == 0)
  2379.         {
  2380.         engine_verbosity = atoi(value);
  2381.         if (engine_verbosity < 0 || engine_verbosity > 2)
  2382.             engine_verbosity = 1;
  2383.         }
  2384. #endif
  2385.     }
  2386.  
  2387.  
  2388. char *
  2389. csavestr(str)
  2390.     char    *str;
  2391.     {
  2392.     char    *ptr;
  2393.  
  2394.     ptr = ckalloc(strlen(str) + 1);
  2395.     if (ptr)
  2396.         strcpy(ptr, str);
  2397.     return ptr;
  2398.     }
  2399.  
  2400. int
  2401. TclTickle_InitializeOnce(app_vrefnum)
  2402.     short    app_vrefnum;
  2403.     {
  2404.     extern int XPROC_Eval_CallBack();
  2405.  
  2406.     TclMac_CWDPushVol();
  2407.     SetVol(NULL, app_vrefnum);
  2408.  
  2409.     xtcl_refnum = OpenResFile(XTCLFileName);
  2410.     
  2411.     TclMac_CWDPopVol();
  2412.     
  2413.     tar_initialize();
  2414.     
  2415.     init_tcl_ctb();
  2416.     
  2417. #ifndef THINK_C
  2418.     init_tcl_dbm();
  2419.     
  2420.     init_tcl_cbtree();
  2421. #endif
  2422.     
  2423.     g_interp = Tcl_CreateTickleInterp();
  2424.     
  2425.     if (g_interp != NULL)
  2426.         {        
  2427.         TickleInitGlobalShell(g_interp);
  2428.         
  2429.         g_cbpb.version        = XPROC_CB_VERSION;
  2430.         g_cbpb.interp        = g_interp;
  2431.         g_cbpb.eval            = XPROC_Eval_CallBack;
  2432.         }
  2433.     else
  2434.         {
  2435.         Feedback("ERROR Could not create global interpreter!");
  2436.         }
  2437.  
  2438.     return TCL_OK;
  2439.     }
  2440.  
  2441. int
  2442. TclTickle_ShutDown()
  2443.     {
  2444.     tar_close();
  2445.  
  2446.     close_tcl_ctb();
  2447.     
  2448. #ifndef THINK_C
  2449.     close_tcl_dbm();
  2450.     
  2451.     close_tcl_cbtree();
  2452. #endif
  2453.  
  2454.     return TCL_OK;
  2455.     }
  2456.  
  2457. Tcl_Interp *
  2458. Tcl_CreateTickleInterp()
  2459.     {
  2460.     Tcl_Interp    *interp;
  2461.     PFI            saveproc;
  2462.     
  2463.     extern Tcl_Interp *Tcl_CreateExtendedInterp();
  2464.     
  2465.     interp = Tcl_CreateExtendedInterp();
  2466.     if (interp != NULL)
  2467.         {
  2468.         Tcl_AddTickleCmds(interp);
  2469.         
  2470.         Tcl_AddMacintoshCmds(interp);
  2471.  
  2472.         Tcl_InitCTB(interp);
  2473.  
  2474. #ifndef THINK_C
  2475.         Tcl_InitDBM(interp);
  2476.         
  2477.         Tcl_InitCBTREE(interp);
  2478. #endif
  2479.  
  2480.         if (gHasAppleEvents)
  2481.             InitAEtcl(interp);
  2482.  
  2483.         init_lcompare(interp);
  2484.         
  2485.         TclTickle_AddTickleTracer(interp);
  2486.         
  2487.         /*
  2488.         ** Above this point should be only command adds.
  2489.         ** Below this point perform initialization scripting.
  2490.         */
  2491.         
  2492.         Tcl_InitMacintosh(interp);
  2493.         
  2494.         Tcl_InitTickle(interp);
  2495.         }
  2496.     
  2497.     return interp;
  2498.     }
  2499.  
  2500. int
  2501. Tcl_AddTickleCmds(interp)
  2502.     Tcl_Interp    *interp;
  2503.     {
  2504.     extern int    Cmd_UnMacBinary();
  2505.     extern int    Cmd_ScriptMenu();
  2506.     extern int    Cmd_ASD_info();
  2507.     extern int    Cmd_UnMacBinary();
  2508.     extern int    Cmd_Extract();
  2509.     extern int    Cmd_Archive();
  2510.     extern int    Cmd_ListArchive();
  2511.     
  2512.     Tcl_CreateCommand(interp, "mac_debug_str", Cmd_DebugStr,
  2513.                         (ClientData)NULL, (void (*)())NULL);
  2514.  
  2515.     Tcl_CreateCommand(interp, "open_text_window", Cmd_OpenTextWindow,
  2516.                         (ClientData)NULL, (void (*)())NULL);
  2517.     Tcl_CreateCommand(interp, "open_file_window", Cmd_OpenFileWindow,
  2518.                         (ClientData)NULL, (void (*)())NULL);
  2519.     Tcl_CreateCommand(interp, "goto_window_line", Cmd_GotoWindowLine,
  2520.                         (ClientData)NULL, (void (*)())NULL);
  2521.  
  2522.     Tcl_CreateCommand(interp, "alertnote", Cmd_DoAlertNote,
  2523.                         (ClientData)NULL, (void (*)())NULL);
  2524.     Tcl_CreateCommand(interp, "askyesno", Cmd_AskYesNoCancel,
  2525.                         (ClientData)NULL, (void (*)())NULL);
  2526.     Tcl_CreateCommand(interp, "get_directory", Cmd_GetDirectory,
  2527.                         (ClientData)NULL, (void (*)())NULL);
  2528.     Tcl_CreateCommand(interp, "getfile", Cmd_GetFile,
  2529.                         (ClientData)NULL, (void (*)())NULL);
  2530.     Tcl_CreateCommand(interp, "getline", Cmd_GetInputLine,
  2531.                         (ClientData)NULL, (void (*)())NULL);
  2532.     Tcl_CreateCommand(interp, "listpick", Cmd_MacListPick,
  2533.                         (ClientData)NULL, (void (*)())NULL);
  2534.     Tcl_CreateCommand(interp, "putfile", Cmd_PutFile,
  2535.                         (ClientData)NULL, (void (*)())NULL);
  2536.  
  2537.     Tcl_CreateCommand(interp, "asdinfo", Cmd_ASD_info,
  2538.                         (ClientData)NULL, (void (*)())NULL);
  2539.     Tcl_CreateCommand(interp, "asd2mac", Cmd_ASD_To_Mac,
  2540.                         (ClientData)NULL, (void (*)())NULL);
  2541.  
  2542.     Tcl_CreateCommand(interp, "compress", Cmd_DoCompress,
  2543.                         (ClientData)NULL, (void (*)())NULL);
  2544.     Tcl_CreateCommand(interp, "decompress", Cmd_DoDeCompress,
  2545.                         (ClientData)NULL, (void (*)())NULL);
  2546.  
  2547.     Tcl_CreateCommand(interp, "hqx2mac", Cmd_DecodeHQX,
  2548.                         (ClientData)NULL, (void (*)())NULL);
  2549.     Tcl_CreateCommand(interp, "mac2hqx", Cmd_EncodeHQX,
  2550.                         (ClientData)NULL, (void (*)())NULL);
  2551.  
  2552.     Tcl_CreateCommand(interp, "mac2as", Cmd_Mac_To_AS,
  2553.                         (ClientData)NULL, (void (*)())NULL);
  2554.     Tcl_CreateCommand(interp, "mac2ad", Cmd_Mac_To_AD,
  2555.                         (ClientData)NULL, (void (*)())NULL);
  2556.  
  2557.     Tcl_CreateCommand(interp, "mb2mac", Cmd_UnMacBinary,
  2558.                         (ClientData)NULL, (void (*)())NULL);
  2559.     Tcl_CreateCommand(interp, "mac2mb", Cmd_Mac_To_MB,
  2560.                         (ClientData)NULL, (void (*)())NULL);
  2561.  
  2562.     Tcl_CreateCommand(interp, "tar", Cmd_Archive,
  2563.                         (ClientData)NULL, (void (*)())NULL);
  2564.     Tcl_CreateCommand(interp, "untar", Cmd_Extract,
  2565.                         (ClientData)NULL, (void (*)())NULL);
  2566.     Tcl_CreateCommand(interp, "listtar", Cmd_ListArchive,
  2567.                         (ClientData)NULL, (void (*)())NULL);
  2568.  
  2569.     Tcl_CreateCommand(interp, "uudecode", Cmd_UUDecode,
  2570.                         (ClientData)NULL, (void (*)())NULL);
  2571.     Tcl_CreateCommand(interp, "uuencode", Cmd_UUEncode,
  2572.                         (ClientData)NULL, (void (*)())NULL);
  2573.  
  2574.     Tcl_CreateCommand(interp, "menucmd", Cmd_DoMenuCmd,
  2575.                         (ClientData)NULL, (void (*)())NULL);
  2576.  
  2577. #ifdef TCLAPPL
  2578.     Tcl_CreateCommand(interp, "script_menu", Cmd_ScriptMenu,
  2579.                         (ClientData)NULL, (void (*)())NULL);
  2580. #endif
  2581.  
  2582.     Tcl_CreateCommand(interp, "xtclcmd", Cmd_CallExternalCMD,
  2583.                         (ClientData)NULL, (void (*)())NULL);
  2584.                         
  2585.     Tcl_CreateCommand(interp, "espace", Cmd_EscapeSpaces,
  2586.                         (ClientData)NULL, (void (*)())NULL);
  2587.     Tcl_CreateCommand(interp, "feedback", Cmd_Feedback,
  2588.                         (ClientData)NULL, (void (*)())NULL);
  2589.                         
  2590.     Tcl_CreateCommand(interp, "start_progress", Cmd_StartProgress,
  2591.                         (ClientData)NULL, (void (*)())NULL);
  2592.     Tcl_CreateCommand(interp, "update_progress", Cmd_UpdateProgress,
  2593.                         (ClientData)NULL, (void (*)())NULL);
  2594.     Tcl_CreateCommand(interp, "stop_progress", Cmd_StopProgress,
  2595.                         (ClientData)NULL, (void (*)())NULL);
  2596.                         
  2597.     Tcl_CreateCommand(interp, YIELD_MAC_COMMAND_NAME, TclTickle_YieldMac,
  2598.                         (ClientData)NULL, (void (*)())NULL);
  2599.     Tcl_CreateCommand(interp, "logging", Cmd_LogControl,
  2600.                         (ClientData)NULL, (void (*)())NULL);
  2601.  
  2602.     return TCL_OK;
  2603.     }
  2604.  
  2605. Tcl_InitTickle(interp)
  2606. Tcl_Interp    *interp;
  2607.     {
  2608.     int        result;
  2609.     char    command[128];
  2610.  
  2611.     strcpy(command, "set TICKLE 1\n");
  2612.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2613.     if (result != TCL_OK)
  2614.         Feedback("ERROR %d on <%s>", result, command);
  2615.         
  2616.     sprintf(command, "set TICKLEVERS {%s}\n", SHORT_VERSION_STR);
  2617.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2618.     if (result != TCL_OK)
  2619.         Feedback("ERROR %d on <%s>", result, command);
  2620.         
  2621.     sprintf(command, "set AEVENT 0\n");
  2622.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2623.     if (result != TCL_OK)
  2624.         Feedback("ERROR %d on <%s>", result, command);
  2625.         
  2626. #ifdef TCLENGINE
  2627.     sprintf(command, "set ENGINE 1\n");
  2628. #else
  2629.     sprintf(command, "set ENGINE 0\n");
  2630. #endif
  2631.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2632.     if (result != TCL_OK)
  2633.         Feedback("ERROR %d on <%s>", result, command);
  2634.  
  2635. #ifdef TCLENGINE
  2636.     sprintf(command, "set tcl_interactive 0\n");
  2637. #else
  2638.     sprintf(command, "set tcl_interactive 1\n");
  2639. #endif
  2640.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2641.     if (result != TCL_OK)
  2642.         Feedback("ERROR %d on <%s>", result, command);
  2643.     }
  2644.  
  2645. #ifdef TCLAPPL
  2646.  
  2647. TickleInitLocalShell(interp, myWindow)
  2648.     Tcl_Interp    *interp;
  2649.     WindowPtr    myWindow;
  2650.     {
  2651.     int        result;
  2652.     char    command[256];
  2653.     PFI        saveproc;
  2654.     Handle    saveH, stdoutH;
  2655.     extern int tcl_dev_null_output();
  2656.     
  2657.     stdoutH = NewHandle(0);
  2658.     
  2659.     saveH = tcl_Houtput_sethdl(stdoutH);
  2660.     saveproc = Tcl_SetPrintProcedure(
  2661.                     (stdoutH == NULL ? tcl_dev_null_output : tcl_handle_output) );                
  2662.     
  2663.     sprintf(command, "set GLOBALTCL 0\n");
  2664.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2665.     if (result != TCL_OK)
  2666.         Feedback("ERROR %d on <%s>", result, command);
  2667.  
  2668.     /*
  2669.     ** Source init.tcl
  2670.     */
  2671.     if (Tcl_Init( interp ) != TCL_OK)
  2672.         {
  2673.         Feedback("Initialization of tcl core failed. (init.tcl) ");
  2674.         Feedback("%s", (interp->result==NULL ? "" : interp->result) );
  2675.         }
  2676.     
  2677.     /*
  2678.     ** Source TclInit.tcl
  2679.     */
  2680.     if (Tcl_ShellEnvInit( interp, TCLSH_INTERACTIVE ) != TCL_OK)
  2681.         {
  2682.         Feedback("Initialization of tcl extensions failed. (TclInit.tcl) ");
  2683.         Feedback("%s", (interp->result==NULL ? "" : interp->result) );
  2684.         }
  2685.     
  2686.     /*
  2687.     ** Source the global tclshrc...
  2688.     */
  2689.     sprintf(command,
  2690. "if [file exists \"[info library]:tclshrc\"] {source \"[info library]:tclshrc\"};"
  2691.                 );
  2692.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2693.     if (result != TCL_OK)
  2694.         {
  2695.         Feedback("ERROR %d on <%s>", result, command);
  2696.         if (interp->result != NULL)
  2697.             Feedback("   %s", interp->result);
  2698.         }
  2699.     
  2700.     /*
  2701.     ** Second, perform the user's tclshrc...
  2702.     */
  2703.     sprintf(command,
  2704. "if [file exists \"$env(HOME):tclshrc\"] {source \"$env(HOME):tclshrc\"};"
  2705.                 );
  2706.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2707.     if (result != TCL_OK)
  2708.         {
  2709.         Feedback("ERROR %d on <%s>", result, command);
  2710.         if (interp->result != NULL)
  2711.             Feedback("   %s", interp->result);
  2712.         }
  2713.     
  2714.     Tcl_SetPrintProcedure(saveproc);
  2715.     tcl_Houtput_sethdl(saveH);
  2716.     
  2717.     if (myWindow != NULL)
  2718.         {
  2719.         SetPort(myWindow);
  2720.         
  2721.         if (stdoutH != NULL)
  2722.             if (GetHandleSize(stdoutH) > 0)
  2723.                 tge_paste_handle( myWindow, stdoutH );
  2724.         
  2725.         if (interp->result != NULL)
  2726.             tge_paste_buffer( myWindow, interp->result, strlen(interp->result) );
  2727.         
  2728.         if ( GetHandleSize(stdoutH) > 0 ||
  2729.                 (interp->result != NULL && interp->result[0] != '\0') )
  2730.             tge_paste_buffer( myWindow, "\015", 1 );
  2731.  
  2732.         SetPort(myWindow);
  2733.         tge_inval_all_text(myWindow);
  2734.         }
  2735.     
  2736.     if (stdoutH != NULL)
  2737.         DisposHandle(stdoutH);
  2738.     
  2739.     return result;
  2740.     }
  2741.  
  2742. #endif /* TCLAPPL */
  2743.  
  2744. TickleInitGlobalShell(interp)
  2745.     Tcl_Interp    *interp;
  2746.     {
  2747.     int        result;
  2748.     char    command[256];
  2749.     PFI        saveproc;
  2750.     extern int tcl_dev_null_output();
  2751.     
  2752.     saveproc = Tcl_SetPrintProcedure(tcl_dev_null_output);
  2753.     
  2754.     sprintf(command, "set GLOBALTCL 1\n");
  2755.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2756.     if (result != TCL_OK)
  2757.         Feedback("ERROR %d on <%s>", result, command);
  2758.     
  2759.     /*
  2760.     ** Source init.tcl
  2761.     */
  2762.     if (Tcl_Init( interp ) != TCL_OK)
  2763.         {
  2764.         Feedback("Initialization of tcl core failed. (init.tcl) ");
  2765.         Feedback("%s", (interp->result==NULL ? "" : interp->result) );
  2766.         }
  2767.     
  2768.     /*
  2769.     ** Source TclInit.tcl
  2770.     */
  2771.     if (Tcl_ShellEnvInit( interp, TCLSH_INTERACTIVE ) != TCL_OK)
  2772.         {
  2773.         Feedback("Initialization of tcl extensions failed. (TclInit.tcl) ");
  2774.         Feedback("%s", (interp->result==NULL ? "" : interp->result) );
  2775.         }
  2776.     
  2777.     /*
  2778.     ** Source the "global" rc file...
  2779.     */
  2780.     sprintf(command, "source •tclrc\n");
  2781.     result = Tcl_Eval(interp, command, 0, (char **)0);
  2782.     if (result != TCL_OK)
  2783.         {
  2784.         Feedback("ERROR %d on <%s>", result, command);
  2785.         if (interp->result != NULL)
  2786.             Feedback("   %s", interp->result);
  2787.         }
  2788.     
  2789.     Tcl_SetPrintProcedure(saveproc);
  2790.     
  2791.     return result;
  2792.     }
  2793.  
  2794. TclTickle_BegYield()
  2795.     {
  2796.     _tclmac_user_interrupt_ = 0;
  2797.     cancel_current_op = 0;
  2798.     pause_op = 0;
  2799.     
  2800.     UBegYield();
  2801.     }
  2802.  
  2803. TclTickle_EndYield()
  2804.     {
  2805.     _tclmac_user_interrupt_ = 0;
  2806.     cancel_current_op = 0;
  2807.     pause_op = 0;
  2808.     
  2809.     UEndYield();
  2810.     }
  2811.  
  2812. static int        spin_increment = 0;
  2813. void
  2814. TickleTracer(
  2815.             ClientData    clientData,
  2816.             Tcl_Interp    *interp,
  2817.             int            level,
  2818.             char        *command,
  2819.             int            (*cmdProc)(),
  2820.             ClientData    cmdClientData,
  2821.             int            argc,
  2822.             char        **argv
  2823.             )
  2824.     {
  2825.     int        myargc = 0;
  2826.     char    *myargv[8];
  2827.     
  2828.     if ( (++spin_increment & 0x001F) == 0 )
  2829.         {
  2830.         myargv[myargc++] = YIELD_MAC_COMMAND_NAME;
  2831.         myargv[myargc++] = "-spin";
  2832.     
  2833.         myargv[myargc++] = "-event";
  2834.         myargv[myargc++] = "1";
  2835.     
  2836.         myargv[myargc] = NULL;
  2837.     
  2838.         TclTickle_YieldMac( clientData, interp, myargc, myargv );
  2839.         }
  2840.     }
  2841.  
  2842.  
  2843. TclTickle_AddTickleTracer(interp)
  2844.     Tcl_Interp    *interp;
  2845.     {
  2846.     Tcl_Trace    tracer;
  2847.     
  2848.     /* UNDONE - what level should we trace to? */
  2849.     tracer = Tcl_CreateTrace( interp, 999, TickleTracer, NULL );
  2850.     }
  2851.  
  2852.  
  2853. /*
  2854. ** This function is substituted for any "printf()" in
  2855. ** the tcl libraries allowing you to control the output
  2856. ** of all stdio use inside the tcl libraries. Most "normal"
  2857. ** output is handled by the "print procedure", however there
  2858. ** is significant debugging output that still wants to go to stdio.
  2859. */
  2860.  
  2861. int
  2862. mac_printf( char *format_str, ... )
  2863.     {
  2864.     int            result;
  2865.     va_list        varg;
  2866.     char        buffer[1024];
  2867.     
  2868.     va_start(varg, format_str);
  2869.     
  2870.     buffer[sizeof(buffer)-1] = '\0';
  2871.     result = vsprintf(buffer, format_str, varg);
  2872.     if (buffer[sizeof(buffer)-1] != '\0')
  2873.         {
  2874.         message_alert("FATAL: OVERFLOW On mac_printf() buffer!");
  2875.         ExitToShell();
  2876.         }
  2877.     
  2878.     va_end(varg);
  2879.     
  2880.     Feedback("%.256s", buffer);
  2881.     
  2882.     return result;
  2883.     }
  2884.  
  2885. /*
  2886. ** This function is substituted for any "fprintf()" in
  2887. ** the tcl libraries allowing you to control the output
  2888. ** of all stdio use inside the tcl libraries.
  2889. */
  2890.  
  2891. int
  2892. mac_fprintf( FILE *fp, char *format_str, ... )
  2893.     {
  2894.     int            result;
  2895.     va_list        varg;
  2896.     char        buffer[1024];
  2897.     
  2898.     va_start(varg, format_str);
  2899.     
  2900.     buffer[sizeof(buffer)-1] = '\0';
  2901.     result = vsprintf(buffer, format_str, varg);
  2902.     if (buffer[sizeof(buffer)-1] != '\0')
  2903.         {
  2904.         message_alert("FATAL: OVERFLOW On mac_fprintf() buffer!");
  2905.         ExitToShell();
  2906.         }
  2907.     
  2908.     va_end(varg);
  2909.     
  2910.     Feedback("%.256s", buffer);
  2911.     
  2912.     return result;
  2913.     }
  2914.  
  2915.