tkConsole.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:26k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tkConsole.c --
  3.  *
  4.  * This file implements a Tcl console for systems that may not
  5.  * otherwise have access to a console.  It uses the Text widget
  6.  * and provides special access via a console command.
  7.  *
  8.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * RCS: @(#) $Id: tkConsole.c,v 1.18.2.6 2006/09/25 17:28:20 andreas_kupries Exp $
  14.  *    
  15.  */
  16. #include "tk.h"
  17. /*
  18.  * Each console is associated with an instance of the ConsoleInfo struct.
  19.  * It keeps track of what interp holds the Tk application that displays
  20.  * the console, and what interp is controlled by the interactions in that
  21.  * console.  A refCount permits the struct to be shared as instance data
  22.  * by commands and by channels.
  23.  */
  24. typedef struct ConsoleInfo {
  25.     Tcl_Interp *consoleInterp;        /* Interpreter displaying the console. */
  26.     Tcl_Interp *interp;               /* Interpreter controlled by console. */
  27.     int refCount;
  28. } ConsoleInfo;
  29. /*
  30.  * Each console channel holds an instance of the ChannelData struct as
  31.  * its instance data.  It contains ConsoleInfo, so the channel can work
  32.  * with the appropriate console window, and a type value to distinguish
  33.  * the stdout channel from the stderr channel.
  34.  */
  35. typedef struct ChannelData {
  36.     ConsoleInfo *info;
  37.     int type; /* TCL_STDOUT or TCL_STDERR */
  38. } ChannelData;
  39. /* 
  40.  * Prototypes for local procedures defined in this file:
  41.  */
  42. static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
  43.     Tcl_Interp *interp));
  44. static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
  45. static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
  46.     XEvent *eventPtr));
  47. static int ConsoleHandle _ANSI_ARGS_((ClientData instandeData,
  48.     int direction, ClientData *handlePtr));
  49. static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
  50.     char *buf, int toRead, int *errorCode));
  51. static int ConsoleObjCmd _ANSI_ARGS_((ClientData clientData,
  52.     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
  53. static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
  54.     CONST char *buf, int toWrite, int *errorCode));
  55. static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
  56.     int mask));
  57. static void DeleteConsoleInterp _ANSI_ARGS_((ClientData clientData));
  58. static void InterpDeleteProc _ANSI_ARGS_((ClientData clientData,
  59.     Tcl_Interp *interp));
  60. static int InterpreterObjCmd _ANSI_ARGS_((ClientData clientData,
  61.     Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
  62. /*
  63.  * This structure describes the channel type structure for file based IO:
  64.  */
  65. static Tcl_ChannelType consoleChannelType = {
  66.     "console", /* Type name. */
  67.     TCL_CHANNEL_VERSION_4, /* v4 channel */
  68.     ConsoleClose, /* Close proc. */
  69.     ConsoleInput, /* Input proc. */
  70.     ConsoleOutput, /* Output proc. */
  71.     NULL, /* Seek proc. */
  72.     NULL, /* Set option proc. */
  73.     NULL, /* Get option proc. */
  74.     ConsoleWatch, /* Watch for events on console. */
  75.     ConsoleHandle, /* Get a handle from the device. */
  76.     NULL, /* close2proc. */
  77.     NULL, /* Always non-blocking.*/
  78.     NULL, /* flush proc. */
  79.     NULL, /* handler proc. */
  80.     NULL,                       /* wide seek proc */
  81.     NULL,                       /* thread action proc */
  82. };
  83. #ifdef __WIN32__
  84. #include <windows.h>
  85. /*
  86.  *----------------------------------------------------------------------
  87.  *
  88.  * ShouldUseConsoleChannel
  89.  *
  90.  *  Check to see if console window should be used for a given
  91.  *      standard channel
  92.  *
  93.  * Results:
  94.  * None.
  95.  *
  96.  * Side effects:
  97.  * Creates the console channel and installs it as the standard
  98.  * channels.
  99.  *
  100.  *----------------------------------------------------------------------
  101.  */
  102. static int ShouldUseConsoleChannel(type)
  103.     int type;
  104. {
  105.     DWORD handleId; /* Standard handle to retrieve. */
  106.     DCB dcb;
  107.     DWORD consoleParams;
  108.     DWORD fileType;
  109.     int mode;
  110.     char *bufMode;
  111.     HANDLE handle;
  112.     switch (type) {
  113. case TCL_STDIN:
  114.     handleId = STD_INPUT_HANDLE;
  115.     mode = TCL_READABLE;
  116.     bufMode = "line";
  117.     break;
  118. case TCL_STDOUT:
  119.     handleId = STD_OUTPUT_HANDLE;
  120.     mode = TCL_WRITABLE;
  121.     bufMode = "line";
  122.     break;
  123. case TCL_STDERR:
  124.     handleId = STD_ERROR_HANDLE;
  125.     mode = TCL_WRITABLE;
  126.     bufMode = "none";
  127.     break;
  128. default:
  129.     return 0;
  130.     break;
  131.     }
  132.     handle = GetStdHandle(handleId);
  133.     /*
  134.      * Note that we need to check for 0 because Windows will return 0 if this
  135.      * is not a console mode application, even though this is not a valid
  136.      * handle. 
  137.      */
  138.     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
  139. return 1;
  140.     }
  141.     /*
  142.      * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
  143.      * to be a valid handle.  See TclpGetDefaultStdChannel() for this change
  144.      * implemented.  We didn't change it here because GetFileType() [below]
  145.      * will catch this with FILE_TYPE_UNKNOWN and appropriately return a
  146.      * value of 1, anyways.
  147.      *
  148.      *    char dummyBuff[1];
  149.      *    DWORD dummyWritten;
  150.      *
  151.      *    if ((type == TCL_STDOUT)
  152.      *     && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
  153.      * return 1;
  154.      *    }
  155.      */
  156.     fileType = GetFileType(handle);
  157.     /*
  158.      * If the file is a character device, we need to try to figure out
  159.      * whether it is a serial port, a console, or something else.  We
  160.      * test for the console case first because this is more common.
  161.      */
  162.     if (fileType == FILE_TYPE_CHAR) {
  163. dcb.DCBlength = sizeof( DCB ) ;
  164. if (!GetConsoleMode(handle, &consoleParams) &&
  165. !GetCommState(handle, &dcb)) {
  166.     /*
  167.      * Don't use a CHAR type channel for stdio, otherwise Tk
  168.      * runs into trouble with the MS DevStudio debugger.
  169.      */
  170.     
  171.     return 1;
  172. }
  173.     } else if (fileType == FILE_TYPE_UNKNOWN) {
  174. return 1;
  175.     } else if (Tcl_GetStdChannel(type) == NULL) {
  176. return 1;
  177.     }
  178.     return 0;
  179. }
  180. #else
  181. /*
  182.  * Mac should always use a console channel, Unix should if it's trying to
  183.  */
  184. #define ShouldUseConsoleChannel(chan) (1)
  185. #endif
  186. /*
  187.  *----------------------------------------------------------------------
  188.  *
  189.  * Tk_InitConsoleChannels --
  190.  *
  191.  *  Create the console channels and install them as the standard
  192.  *  channels.  All I/O will be discarded until Tk_CreateConsoleWindow
  193.  * is called to attach the console to a text widget.
  194.  *
  195.  * Results:
  196.  * None.
  197.  *
  198.  * Side effects:
  199.  * Creates the console channel and installs it as the standard
  200.  * channels.
  201.  *
  202.  *----------------------------------------------------------------------
  203.  */
  204. void
  205. Tk_InitConsoleChannels(interp)
  206.     Tcl_Interp *interp;
  207. {
  208.     static Tcl_ThreadDataKey consoleInitKey;
  209.     int *consoleInitPtr, doIn, doOut, doErr;
  210.     ConsoleInfo *info;
  211.     Tcl_Channel consoleChannel;
  212.     /*
  213.      * Ensure that we are getting the matching version of Tcl.  This is
  214.      * really only an issue when Tk is loaded dynamically.
  215.      */
  216.     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
  217.         return;
  218.     }
  219.     consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
  220.     if (*consoleInitPtr) {
  221. /* We've already initialized console channels in this thread. */
  222. return;
  223.     }
  224.     *consoleInitPtr = 1;
  225.     doIn = ShouldUseConsoleChannel(TCL_STDIN);
  226.     doOut = ShouldUseConsoleChannel(TCL_STDOUT);
  227.     doErr = ShouldUseConsoleChannel(TCL_STDERR);
  228.     if (!(doIn || doOut || doErr)) {
  229. /*
  230.  * No std channels should be tied to the console;
  231.  * Thus, no need to create the console
  232.  */
  233. return;
  234.     }
  235.     /*
  236.      * At least one std channel wants to be tied to the console,
  237.      * so create the interp for it to live in.
  238.      */
  239.     info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
  240.     info->consoleInterp = NULL;
  241.     info->interp = NULL;
  242.     info->refCount = 0;
  243.     if (doIn) {
  244. ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
  245. data->info = info;
  246. data->info->refCount++;
  247. data->type = TCL_STDIN;
  248. consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
  249. (ClientData) data, TCL_READABLE);
  250. if (consoleChannel != NULL) {
  251.     Tcl_SetChannelOption(NULL, consoleChannel,
  252.     "-translation", "lf");
  253.     Tcl_SetChannelOption(NULL, consoleChannel,
  254.     "-buffering", "none");
  255.     Tcl_SetChannelOption(NULL, consoleChannel,
  256.     "-encoding", "utf-8");
  257. }
  258. Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
  259. Tcl_RegisterChannel(NULL, consoleChannel);
  260.     }
  261.     if (doOut) {
  262. ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
  263. data->info = info;
  264. data->info->refCount++;
  265. data->type = TCL_STDOUT;
  266. consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
  267. (ClientData) data, TCL_WRITABLE);
  268. if (consoleChannel != NULL) {
  269.     Tcl_SetChannelOption(NULL, consoleChannel,
  270.     "-translation", "lf");
  271.     Tcl_SetChannelOption(NULL, consoleChannel,
  272.     "-buffering", "none");
  273.     Tcl_SetChannelOption(NULL, consoleChannel,
  274.     "-encoding", "utf-8");
  275. }
  276. Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
  277. Tcl_RegisterChannel(NULL, consoleChannel);
  278.     }
  279.     if (doErr) {
  280. ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
  281. data->info = info;
  282. data->info->refCount++;
  283. data->type = TCL_STDERR;
  284. consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
  285. (ClientData) data, TCL_WRITABLE);
  286. if (consoleChannel != NULL) {
  287.     Tcl_SetChannelOption(NULL, consoleChannel,
  288.     "-translation", "lf");
  289.     Tcl_SetChannelOption(NULL, consoleChannel,
  290.     "-buffering", "none");
  291.     Tcl_SetChannelOption(NULL, consoleChannel,
  292.     "-encoding", "utf-8");
  293. }
  294. Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
  295. Tcl_RegisterChannel(NULL, consoleChannel);
  296.     }
  297. }
  298. /*
  299.  *----------------------------------------------------------------------
  300.  *
  301.  * Tk_CreateConsoleWindow --
  302.  *
  303.  * Initialize the console.  This code actually creates a new
  304.  * application and associated interpreter.  This effectivly hides
  305.  * the implementation from the main application.
  306.  *
  307.  * Results:
  308.  * None.
  309.  *
  310.  * Side effects:
  311.  * A new console it created.
  312.  *
  313.  *----------------------------------------------------------------------
  314.  */
  315. int 
  316. Tk_CreateConsoleWindow(interp)
  317.     Tcl_Interp *interp; /* Interpreter to use for prompting. */
  318. {
  319.     Tcl_Channel chan;
  320.     ConsoleInfo *info;
  321.     Tk_Window mainWindow;
  322.     Tcl_Command token;
  323.     int result = TCL_OK;
  324.     int haveConsoleChannel = 1;
  325. #ifdef MAC_TCL
  326.     static const char *initCmd = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
  327. #else
  328.     static const char *initCmd = "source $tk_library/console.tcl";
  329. #endif
  330.     /* Init an interp with Tcl and Tk */
  331.     Tcl_Interp *consoleInterp = Tcl_CreateInterp();
  332.     if (Tcl_Init(consoleInterp) != TCL_OK) {
  333.       goto error;
  334.     }
  335.     if (Tk_Init(consoleInterp) != TCL_OK) {
  336. goto error;
  337.     }
  338.     
  339.     /*
  340.      * Fetch the instance data from whatever std channel is a
  341.      * console channel.  If none, create fresh instance data.
  342.      */
  343.     if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
  344.           == &consoleChannelType) {
  345.     } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
  346.           == &consoleChannelType) {
  347.     } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
  348.           == &consoleChannelType) {
  349.     } else {
  350. haveConsoleChannel = 0;
  351.     }
  352.     if (haveConsoleChannel) {
  353. ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
  354. info = data->info;
  355. if (info->consoleInterp) {
  356.     /* New ConsoleInfo for a new console window */
  357.     info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
  358.     info->refCount = 0;
  359.     /* Update any console channels to make use of the new console */
  360.     if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
  361.     == &consoleChannelType) {
  362. data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
  363. data->info->refCount--;
  364. data->info = info;
  365. data->info->refCount++;
  366.     }
  367.     if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
  368.     == &consoleChannelType) {
  369. data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
  370. data->info->refCount--;
  371. data->info = info;
  372. data->info->refCount++;
  373.     }
  374.     if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
  375.     == &consoleChannelType) {
  376. data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
  377. data->info->refCount--;
  378. data->info = info;
  379. data->info->refCount++;
  380.     }
  381. }
  382.     } else {
  383. info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
  384. info->refCount = 0;
  385.     }
  386.     info->consoleInterp = consoleInterp;
  387.     info->interp = interp;
  388.     Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info);
  389.     info->refCount++;
  390.     Tcl_CreateThreadExitHandler(DeleteConsoleInterp,
  391. (ClientData) consoleInterp);
  392.     
  393.     /* 
  394.      * Add console commands to the interp 
  395.      */
  396.     token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd,
  397.           (ClientData) info, ConsoleDeleteProc);
  398.     info->refCount++;
  399.     /*
  400.      * We don't have to count the ref held by the [consoleinterp] command
  401.      * in the consoleInterp.  The ref held by the consoleInterp delete
  402.      * handler takes care of us.
  403.      */
  404.     Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
  405.     (ClientData) info, NULL);
  406.     mainWindow = Tk_MainWindow(interp);
  407.     if (mainWindow) {
  408. Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
  409. ConsoleEventProc, (ClientData) info);
  410. info->refCount++;
  411.     }
  412.     Tcl_Preserve((ClientData) consoleInterp);
  413.     result = Tcl_GlobalEval(consoleInterp, initCmd);
  414.     if (result == TCL_ERROR) {
  415. Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode", NULL,
  416. TCL_GLOBAL_ONLY);
  417. Tcl_ResetResult(interp);
  418. if (objPtr) {
  419.     Tcl_SetObjErrorCode(interp, objPtr);
  420. }
  421. objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo", NULL,
  422. TCL_GLOBAL_ONLY);
  423. if (objPtr) {
  424.     int numBytes;
  425.     CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
  426.     Tcl_AddObjErrorInfo(interp, message, numBytes);
  427. }
  428. Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
  429.     }
  430.     Tcl_Release((ClientData) consoleInterp);
  431.     if (result == TCL_ERROR) {
  432. Tcl_DeleteCommandFromToken(interp, token);
  433. mainWindow = Tk_MainWindow(interp);
  434. if (mainWindow) {
  435.     Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
  436.     ConsoleEventProc, (ClientData) info);
  437.     if (--info->refCount <= 0) {
  438. ckfree((char *) info);
  439.     }
  440. }
  441. goto error;
  442.     }
  443.     return TCL_OK;
  444.     
  445.     error:
  446.     Tcl_AddErrorInfo(interp, "n    (creating console window)");
  447.     if (!Tcl_InterpDeleted(consoleInterp)) {
  448. Tcl_DeleteInterp(consoleInterp);
  449.     }
  450.     return TCL_ERROR;
  451. }
  452. /*
  453.  *----------------------------------------------------------------------
  454.  *
  455.  * ConsoleOutput--
  456.  *
  457.  * Writes the given output on the IO channel. Returns count of how
  458.  * many characters were actually written, and an error indication.
  459.  *
  460.  * Results:
  461.  * A count of how many characters were written is returned and an
  462.  * error indication is returned in an output argument.
  463.  *
  464.  * Side effects:
  465.  * Writes output on the actual channel.
  466.  *
  467.  *----------------------------------------------------------------------
  468.  */
  469. static int
  470. ConsoleOutput(instanceData, buf, toWrite, errorCode)
  471.     ClientData instanceData; /* Indicates which device to use. */
  472.     CONST char *buf; /* The data buffer. */
  473.     int toWrite; /* How many bytes to write? */
  474.     int *errorCode; /* Where to store error code. */
  475. {
  476.     ChannelData *data = (ChannelData *)instanceData;
  477.     ConsoleInfo *info = data->info;
  478.     *errorCode = 0;
  479.     Tcl_SetErrno(0);
  480.     if (info) {
  481. Tcl_Interp *consoleInterp = info->consoleInterp;
  482. if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
  483.     Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);
  484.     if (data->type == TCL_STDERR) {
  485. Tcl_ListObjAppendElement(NULL, cmd,
  486. Tcl_NewStringObj("stderr", -1));
  487.     } else {
  488. Tcl_ListObjAppendElement(NULL, cmd,
  489. Tcl_NewStringObj("stdout", -1));
  490.     }
  491.     Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj(buf, toWrite));
  492.     Tcl_IncrRefCount(cmd);
  493.     Tcl_GlobalEvalObj(consoleInterp, cmd);
  494.     Tcl_DecrRefCount(cmd);
  495. }
  496.     }
  497.     return toWrite;
  498. }
  499. /*
  500.  *----------------------------------------------------------------------
  501.  *
  502.  * ConsoleInput --
  503.  *
  504.  * Read input from the console.  Not currently implemented.
  505.  *
  506.  * Results:
  507.  * Always returns EOF.
  508.  *
  509.  * Side effects:
  510.  * None.
  511.  *
  512.  *----------------------------------------------------------------------
  513.  */
  514. /* ARGSUSED */
  515. static int
  516. ConsoleInput(instanceData, buf, bufSize, errorCode)
  517.     ClientData instanceData; /* Unused. */
  518.     char *buf; /* Where to store data read. */
  519.     int bufSize; /* How much space is available
  520.                                          * in the buffer? */
  521.     int *errorCode; /* Where to store error code. */
  522. {
  523.     return 0; /* Always return EOF. */
  524. }
  525. /*
  526.  *----------------------------------------------------------------------
  527.  *
  528.  * ConsoleClose --
  529.  *
  530.  * Closes the IO channel.
  531.  *
  532.  * Results:
  533.  * Always returns 0 (success).
  534.  *
  535.  * Side effects:
  536.  * Frees the dummy file associated with the channel.
  537.  *
  538.  *----------------------------------------------------------------------
  539.  */
  540. /* ARGSUSED */
  541. static int
  542. ConsoleClose(instanceData, interp)
  543.     ClientData instanceData; /* Unused. */
  544.     Tcl_Interp *interp; /* Unused. */
  545. {
  546.     ChannelData *data = (ChannelData *)instanceData;
  547.     ConsoleInfo *info = data->info;
  548.     if (info) {
  549. if (--info->refCount <= 0) {
  550.     /* Assuming the Tcl_Interp * fields must already be NULL */
  551.     ckfree((char *) info);
  552. }
  553.     }
  554.     ckfree((char *) data);
  555.     return 0;
  556. }
  557. /*
  558.  *----------------------------------------------------------------------
  559.  *
  560.  * ConsoleWatch --
  561.  *
  562.  * Called by the notifier to set up the console device so that
  563.  * events will be noticed. Since there are no events on the
  564.  * console, this routine just returns without doing anything.
  565.  *
  566.  * Results:
  567.  * None.
  568.  *
  569.  * Side effects:
  570.  * None.
  571.  *
  572.  *----------------------------------------------------------------------
  573.  */
  574. /* ARGSUSED */
  575. static void
  576. ConsoleWatch(instanceData, mask)
  577.     ClientData instanceData; /* Device ID for the channel. */
  578.     int mask; /* OR-ed combination of
  579.                                          * TCL_READABLE, TCL_WRITABLE and
  580.                                          * TCL_EXCEPTION, for the events
  581.                                          * we are interested in. */
  582. {
  583. }
  584. /*
  585.  *----------------------------------------------------------------------
  586.  *
  587.  * ConsoleHandle --
  588.  *
  589.  * Invoked by the generic IO layer to get a handle from a channel.
  590.  * Because console channels are not devices, this function always
  591.  * fails.
  592.  *
  593.  * Results:
  594.  * Always returns TCL_ERROR.
  595.  *
  596.  * Side effects:
  597.  * None.
  598.  *
  599.  *----------------------------------------------------------------------
  600.  */
  601. /* ARGSUSED */
  602. static int
  603. ConsoleHandle(instanceData, direction, handlePtr)
  604.     ClientData instanceData; /* Device ID for the channel. */
  605.     int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
  606.  * which direction of the channel is being
  607.  * requested. */
  608.     ClientData *handlePtr; /* Where to store handle */
  609. {
  610.     return TCL_ERROR;
  611. }
  612. /*
  613.  *----------------------------------------------------------------------
  614.  *
  615.  * ConsoleObjCmd --
  616.  *
  617.  * The console command implements a Tcl interface to the various console
  618.  * options.
  619.  *
  620.  * Results:
  621.  * A standard Tcl result.
  622.  *
  623.  * Side effects:
  624.  * See the user documentation.
  625.  *
  626.  *----------------------------------------------------------------------
  627.  */
  628. static int
  629. ConsoleObjCmd(clientData, interp, objc, objv)
  630.     ClientData clientData; /* Access to the console interp */
  631.     Tcl_Interp *interp; /* Current interpreter */
  632.     int objc; /* Number of arguments */
  633.     Tcl_Obj *CONST objv[]; /* Argument objects */
  634. {
  635.     int index, result;
  636.     static CONST char *options[] = {"eval", "hide", "show", "title", NULL};
  637.     enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE};
  638.     Tcl_Obj *cmd = NULL;
  639.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  640.     Tcl_Interp *consoleInterp = info->consoleInterp;
  641.     if (objc < 2) {
  642. Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
  643. return TCL_ERROR;
  644.     }
  645.     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
  646.     != TCL_OK) {
  647. return TCL_ERROR;
  648.     }
  649.     switch ((enum option) index) {
  650.     case CON_EVAL:
  651. if (objc != 3) {
  652.     Tcl_WrongNumArgs(interp, 2, objv, "script");
  653.     return TCL_ERROR;
  654. }
  655. cmd = objv[2];
  656. break;
  657.     case CON_HIDE:
  658. if (objc != 2) {
  659.     Tcl_WrongNumArgs(interp, 2, objv, NULL);
  660.     return TCL_ERROR;
  661. }
  662. cmd = Tcl_NewStringObj("wm withdraw .", -1);
  663. break;
  664.     case CON_SHOW:
  665. if (objc != 2) {
  666.     Tcl_WrongNumArgs(interp, 2, objv, NULL);
  667.     return TCL_ERROR;
  668. }
  669. cmd = Tcl_NewStringObj("wm deiconify .", -1);
  670. break;
  671.     case CON_TITLE:
  672. if (objc > 3) {
  673.     Tcl_WrongNumArgs(interp, 2, objv, "?title?");
  674.     return TCL_ERROR;
  675. }
  676. cmd = Tcl_NewStringObj("wm title .", -1);
  677. if (objc == 3) {
  678.     Tcl_ListObjAppendElement(NULL, cmd, objv[2]);
  679. }
  680. break;
  681.     }
  682.     Tcl_IncrRefCount(cmd);
  683.     if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
  684. Tcl_Preserve((ClientData) consoleInterp);
  685. result = Tcl_GlobalEvalObj(consoleInterp, cmd);
  686. if (result == TCL_ERROR) {
  687.     Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode",
  688.     NULL, TCL_GLOBAL_ONLY);
  689.     Tcl_ResetResult(interp);
  690.     if (objPtr) {
  691. Tcl_SetObjErrorCode(interp, objPtr);
  692.     }
  693.     objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo",
  694.     NULL, TCL_GLOBAL_ONLY);
  695.     if (objPtr) {
  696. int numBytes;
  697. CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
  698. Tcl_AddObjErrorInfo(interp, message, numBytes);
  699.     }
  700. }
  701. Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
  702. Tcl_Release((ClientData) consoleInterp);
  703.     } else {
  704. Tcl_AppendResult(interp, "no active console interp", NULL);
  705. result = TCL_ERROR;
  706.     }
  707.     Tcl_DecrRefCount(cmd);
  708.     return result;
  709. }
  710. /*
  711.  *----------------------------------------------------------------------
  712.  *
  713.  * InterpreterObjCmd --
  714.  *
  715.  * This command allows the console interp to communicate with the
  716.  * main interpreter.
  717.  *
  718.  * Results:
  719.  * A standard Tcl result.
  720.  *
  721.  *----------------------------------------------------------------------
  722.  */
  723. static int
  724. InterpreterObjCmd(clientData, interp, objc, objv)
  725.     ClientData clientData; /* Not used */
  726.     Tcl_Interp *interp; /* Current interpreter */
  727.     int objc; /* Number of arguments */
  728.     Tcl_Obj *CONST objv[]; /* Argument objects */
  729. {
  730.     int index, result = TCL_OK;
  731.     static CONST char *options[] = {"eval", "record", NULL};
  732.     enum option {OTHER_EVAL, OTHER_RECORD};
  733.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  734.     Tcl_Interp *otherInterp = info->interp;
  735.     if (objc < 2) {
  736. Tcl_WrongNumArgs(interp, 1, objv, "option arg");
  737. return TCL_ERROR;
  738.     }
  739.     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
  740. != TCL_OK) {
  741. return TCL_ERROR;
  742.     }
  743.     if (objc != 3) {
  744. Tcl_WrongNumArgs(interp, 2, objv, "script");
  745. return TCL_ERROR;
  746.     }
  747.     if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) {
  748. Tcl_AppendResult(interp, "no active master interp", NULL);
  749. return TCL_ERROR;
  750.     }
  751.     Tcl_Preserve((ClientData) otherInterp);
  752.     switch ((enum option) index) {
  753.     case OTHER_EVAL:
  754. result = Tcl_GlobalEvalObj(otherInterp, objv[2]);
  755. /*
  756.  * TODO: Should exceptions be filtered here?
  757.  */
  758. if (result == TCL_ERROR) {
  759.     Tcl_Obj *objPtr = Tcl_GetVar2Ex(otherInterp, "errorCode",
  760.     NULL, TCL_GLOBAL_ONLY);
  761.     Tcl_ResetResult(interp);
  762.     if (objPtr) {
  763. Tcl_SetObjErrorCode(interp, objPtr);
  764.     }
  765.     objPtr = Tcl_GetVar2Ex(otherInterp, "errorInfo",
  766.     NULL, TCL_GLOBAL_ONLY);
  767.     if (objPtr) {
  768. int numBytes;
  769. CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
  770. Tcl_AddObjErrorInfo(interp, message, numBytes);
  771.     }
  772. }
  773. Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
  774. break;
  775.     case OTHER_RECORD:
  776. Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL);
  777. /*
  778.  * By not setting result, we discard any exceptions or errors here
  779.  * and always return TCL_OK.  All the caller wants is the
  780.  * interp result to display, whether that's result or error message.
  781.  */
  782. Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
  783. break;
  784.     }
  785.     Tcl_Release((ClientData) otherInterp);
  786.     return result;
  787. }
  788. /*
  789.  *----------------------------------------------------------------------
  790.  *
  791.  * DeleteConsoleInterp --
  792.  *
  793.  * Thread exit handler to destroy a console interp when the
  794.  * thread it lives in gets torn down.
  795.  *
  796.  *----------------------------------------------------------------------
  797.  */
  798. static void
  799. DeleteConsoleInterp(clientData)
  800.     ClientData clientData;
  801. {
  802.     Tcl_Interp *interp = (Tcl_Interp *)clientData;
  803.     Tcl_DeleteInterp(interp);
  804. }
  805. /*
  806.  *----------------------------------------------------------------------
  807.  *
  808.  * InterpDeleteProc --
  809.  *
  810.  *    React when the interp in which the console is displayed is deleted
  811.  *    for any reason.
  812.  *
  813.  * Results:
  814.  * None.
  815.  */
  816. static void
  817. InterpDeleteProc(clientData, interp)
  818.     ClientData clientData;
  819.     Tcl_Interp *interp;
  820. {
  821.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  822.     if(info->consoleInterp == interp) {
  823. Tcl_DeleteThreadExitHandler(DeleteConsoleInterp,
  824. (ClientData) info-> consoleInterp);
  825. info->consoleInterp = NULL;
  826.     }
  827.     if (--info->refCount <= 0) {
  828. ckfree((char *) info);
  829.     }
  830. }
  831. /*
  832.  *----------------------------------------------------------------------
  833.  *
  834.  * ConsoleDeleteProc --
  835.  *
  836.  * If the console command is deleted we destroy the console window and
  837.  *  all associated data structures.
  838.  * Results:
  839.  * None.
  840.  *
  841.  * Side effects:
  842.  * A new console is created.
  843.  *
  844.  *----------------------------------------------------------------------
  845.  */
  846. static void
  847. ConsoleDeleteProc(clientData)
  848.     ClientData clientData;
  849. {
  850.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  851.     if (info->consoleInterp) {
  852. Tcl_DeleteInterp(info->consoleInterp);
  853.     }
  854.     if (--info->refCount <= 0) {
  855. ckfree((char *) info);
  856.     }
  857. }
  858. /*
  859.  *----------------------------------------------------------------------
  860.  *
  861.  * ConsoleEventProc --
  862.  *
  863.  *  This event function is registered on the main window of the slave
  864.  * interpreter.  If the user or a running script causes the main window to
  865.  *  be destroyed, then we need to inform the console interpreter by
  866.  * invoking "::tk::ConsoleExit".
  867.  * Results:
  868.  * None.
  869.  *
  870.  * Side effects:
  871.  * Invokes the "::tk::ConsoleExit" command in the console interp.
  872.  *
  873.  *----------------------------------------------------------------------
  874.  */
  875. static void
  876. ConsoleEventProc(clientData, eventPtr)
  877.     ClientData clientData;
  878.     XEvent *eventPtr;
  879. {
  880.     if (eventPtr->type == DestroyNotify) {
  881. ConsoleInfo *info = (ConsoleInfo *) clientData;
  882. Tcl_Interp *consoleInterp = info->consoleInterp;
  883. if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
  884.     Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
  885. }
  886. if (--info->refCount <= 0) {
  887.     ckfree((char *) info);
  888. }
  889.     }
  890. }