tk/generic/tkConsole.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$
  14  */
  15
  16 #include "tk.h"
  17 #include <string.h>
  18
  19 #include "tkInt.h"
  20
  21 /*
  22  * A data structure of the following type holds information for each console
  23  * which a handler (i.e. a Tcl command) has been defined for a particular
  24  * top-level window.
  25  */
  26
  27 typedef struct ConsoleInfo {
  28     Tcl_Interp *consoleInterp;  /* Interpreter for the console. */
  29     Tcl_Interp *interp;         /* Interpreter to send console commands. */
  30 } ConsoleInfo;
  31
  32 typedef struct ThreadSpecificData {
  33     Tcl_Interp *gStdoutInterp;
  34 } ThreadSpecificData;
  35 static Tcl_ThreadDataKey dataKey;
  36 static int consoleInitialized = 0;
  37
  38 /*
  39  * The Mutex below is used to lock access to the consoleIntialized flag
  40  */
  41
  42 TCL_DECLARE_MUTEX(consoleMutex)
  43
  44 /*
  45  * Forward declarations for procedures defined later in this file:
  46  *
  47  * The first three will be used in the tk app shells...
  48  */
  49
  50 void    TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
  51                             int devId, char *buffer, long size));
  52
  53 static int      ConsoleCmd _ANSI_ARGS_((ClientData clientData,
  54                     Tcl_Interp *interp, int argc, char **argv));
  55 static void     ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
  56 static void     ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
  57                     XEvent *eventPtr));
  58 static int      InterpreterCmd _ANSI_ARGS_((ClientData clientData,
  59                     Tcl_Interp *interp, int argc, char **argv));
  60
  61 static int      ConsoleInput _ANSI_ARGS_((ClientData instanceData,
  62                     char *buf, int toRead, int *errorCode));
  63 static int      ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
  64                     char *buf, int toWrite, int *errorCode));
  65 static int      ConsoleClose _ANSI_ARGS_((ClientData instanceData,
  66                     Tcl_Interp *interp));
  67 static void     ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
  68                     int mask));
  69 static int      ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
  70                     int direction, ClientData *handlePtr));
  71
  72 /*
  73  * This structure describes the channel type structure for file based IO:
  74  */
  75
  76 static Tcl_ChannelType consoleChannelType = {
  77     "console",                  /* Type name. */
  78     NULL,                       /* Always non-blocking.*/
  79     ConsoleClose,               /* Close proc. */
  80     ConsoleInput,               /* Input proc. */
  81     ConsoleOutput,              /* Output proc. */
  82     NULL,                       /* Seek proc. */
  83     NULL,                       /* Set option proc. */
  84     NULL,                       /* Get option proc. */
  85     ConsoleWatch,               /* Watch for events on console. */
  86     ConsoleHandle,              /* Get a handle from the device. */
  87 };
  88
  89 \f
  90 #ifdef __WIN32__
  91
  92 #include <windows.h>
  93
  94 /*
  95  *----------------------------------------------------------------------
  96  *
  97  * ShouldUseConsoleChannel
  98  *
  99  *      Check to see if console window should be used for a given
 100  *      standard channel
 101  *
 102  * Results:
 103  *      None.
 104  *
 105  * Side effects:
 106  *      Creates the console channel and installs it as the standard
 107  *      channels.
 108  *
 109  *----------------------------------------------------------------------
 110  */
 111 static int ShouldUseConsoleChannel(type)
 112     int type;
 113 {
 114     DWORD handleId;             /* Standard handle to retrieve. */
 115     DCB dcb;
 116     DWORD consoleParams;
 117     DWORD fileType;
 118     int mode;
 119     char *bufMode;
 120     HANDLE handle;
 121
 122     switch (type) {
 123         case TCL_STDIN:
 124             handleId = STD_INPUT_HANDLE;
 125             mode = TCL_READABLE;
 126             bufMode = "line";
 127             break;
 128         case TCL_STDOUT:
 129             handleId = STD_OUTPUT_HANDLE;
 130             mode = TCL_WRITABLE;
 131             bufMode = "line";
 132             break;
 133         case TCL_STDERR:
 134             handleId = STD_ERROR_HANDLE;
 135             mode = TCL_WRITABLE;
 136             bufMode = "none";
 137             break;
 138         default:
 139             return 0;
 140             break;
 141     }
 142
 143     handle = GetStdHandle(handleId);
 144
 145     /*
 146      * Note that we need to check for 0 because Windows will return 0 if this
 147      * is not a console mode application, even though this is not a valid
 148      * handle.
 149      */
 150
 151     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
 152         return 1;
 153     }
 154     fileType = GetFileType(handle);
 155
 156     /*
 157      * If the file is a character device, we need to try to figure out
 158      * whether it is a serial port, a console, or something else.  We
 159      * test for the console case first because this is more common.
 160      */
 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
 179     return 0;
 180 }
 181 #else
 182 /*
 183  * Mac should always use a console channel, Unix should if it's trying to
 184  */
 185
 186 #define ShouldUseConsoleChannel(chan) (1)
 187 #endif
 188 \f
 189 /*
 190  *----------------------------------------------------------------------
 191  *
 192  * Tk_InitConsoleChannels --
 193  *
 194  *      Create the console channels and install them as the standard
 195  *      channels.  All I/O will be discarded until TkConsoleInit is
 196  *      called to attach the console to a text widget.
 197  *
 198  * Results:
 199  *      None.
 200  *
 201  * Side effects:
 202  *      Creates the console channel and installs it as the standard
 203  *      channels.
 204  *
 205  *----------------------------------------------------------------------
 206  */
 207
 208 void
 209 Tk_InitConsoleChannels(interp)
 210     Tcl_Interp *interp;
 211 {
 212     Tcl_Channel consoleChannel;
 213
 214     /*
 215      * Ensure that we are getting the matching version of Tcl.  This is
 216      * really only an issue when Tk is loaded dynamically.
 217      */
 218
 219     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
 220         return;
 221     }
 222
 223     Tcl_MutexLock(&consoleMutex);
 224     if (!consoleInitialized) {
 225
 226         consoleInitialized = 1;
 227
 228         /*
 229          * check for STDIN, otherwise create it
 230          *
 231          * Don't do this check on the Mac, because it is hard to prevent
 232          * callbacks from the SIOUX layer from opening stdout & stdin, but
 233          * we don't want to use the SIOUX console.  Since the console is not
 234          * actually created till something is written to the channel, it is
 235          * okay to just ignore it here.
 236          *
 237          * This is still a bit of a hack, however, and should be cleaned up
 238          * when we have a better abstraction for the console.
 239          */
 240
 241         if (ShouldUseConsoleChannel(TCL_STDIN)) {
 242             consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
 243                     (ClientData) TCL_STDIN, TCL_READABLE);
 244             if (consoleChannel != NULL) {
 245                 Tcl_SetChannelOption(NULL, consoleChannel,
 246                         "-translation", "lf");
 247                 Tcl_SetChannelOption(NULL, consoleChannel,
 248                         "-buffering", "none");
 249                 Tcl_SetChannelOption(NULL, consoleChannel,
 250                         "-encoding", "utf-8");
 251             }
 252             Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
 253         }
 254
 255         /*
 256          * check for STDOUT, otherwise create it
 257          */
 258
 259         if (ShouldUseConsoleChannel(TCL_STDOUT)) {
 260             consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
 261                     (ClientData) TCL_STDOUT, TCL_WRITABLE);
 262             if (consoleChannel != NULL) {
 263                 Tcl_SetChannelOption(NULL, consoleChannel,
 264                         "-translation", "lf");
 265                 Tcl_SetChannelOption(NULL, consoleChannel,
 266                         "-buffering", "none");
 267                 Tcl_SetChannelOption(NULL, consoleChannel,
 268                         "-encoding", "utf-8");
 269             }
 270             Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
 271         }
 272
 273         /*
 274          * check for STDERR, otherwise create it
 275          */
 276
 277         if (ShouldUseConsoleChannel(TCL_STDERR)) {
 278             consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
 279                     (ClientData) TCL_STDERR, TCL_WRITABLE);
 280             if (consoleChannel != NULL) {
 281                 Tcl_SetChannelOption(NULL, consoleChannel,
 282                         "-translation", "lf");
 283                 Tcl_SetChannelOption(NULL, consoleChannel,
 284                         "-buffering", "none");
 285                 Tcl_SetChannelOption(NULL, consoleChannel,
 286                         "-encoding", "utf-8");
 287             }
 288             Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
 289         }
 290     }
 291     Tcl_MutexUnlock(&consoleMutex);
 292 }
 293 \f
 294 /*
 295  *----------------------------------------------------------------------
 296  *
 297  * Tk_CreateConsoleWindow --
 298  *
 299  *      Initialize the console.  This code actually creates a new
 300  *      application and associated interpreter.  This effectivly hides
 301  *      the implementation from the main application.
 302  *
 303  * Results:
 304  *      None.
 305  *
 306  * Side effects:
 307  *      A new console it created.
 308  *
 309  *----------------------------------------------------------------------
 310  */
 311
 312 int
 313 Tk_CreateConsoleWindow(interp)
 314     Tcl_Interp *interp;                 /* Interpreter to use for prompting. */
 315 {
 316     Tcl_Interp *consoleInterp;
 317     ConsoleInfo *info;
 318     Tk_Window mainWindow = Tk_MainWindow(interp);
 319     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 320             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 321 #ifdef MAC_TCL
 322     static char initCmd[] = "source -rsrc {Console}";
 323 #else
 324     static char initCmd[] = "source $tk_library/console.tcl";
 325 #endif
 326
 327     consoleInterp = Tcl_CreateInterp();
 328     if (consoleInterp == NULL) {
 329         goto error;
 330     }
 331
 332     /*
 333      * Initialized Tcl and Tk.
 334      */
 335
 336     if (Tcl_Init(consoleInterp) != TCL_OK) {
 337         goto error;
 338     }
 339     if (Tk_Init(consoleInterp) != TCL_OK) {
 340         goto error;
 341     }
 342     tsdPtr->gStdoutInterp = interp;
 343
 344     /*
 345      * Add console commands to the interp
 346      */
 347     info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
 348     info->interp = interp;
 349     info->consoleInterp = consoleInterp;
 350     Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
 351             (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
 352     Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
 353             (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
 354
 355     Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
 356             (ClientData) info);
 357
 358     Tcl_Preserve((ClientData) consoleInterp);
 359     if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
 360         /* goto error; -- no problem for now... */
 361         printf("Eval error: %s", consoleInterp->result);
 362     }
 363     Tcl_Release((ClientData) consoleInterp);
 364     return TCL_OK;
 365
 366     error:
 367     if (consoleInterp != NULL) {
 368         Tcl_DeleteInterp(consoleInterp);
 369     }
 370     return TCL_ERROR;
 371 }
 372 \f
 373 /*
 374  *----------------------------------------------------------------------
 375  *
 376  * ConsoleOutput--
 377  *
 378  *      Writes the given output on the IO channel. Returns count of how
 379  *      many characters were actually written, and an error indication.
 380  *
 381  * Results:
 382  *      A count of how many characters were written is returned and an
 383  *      error indication is returned in an output argument.
 384  *
 385  * Side effects:
 386  *      Writes output on the actual channel.
 387  *
 388  *----------------------------------------------------------------------
 389  */
 390
 391 static int
 392 ConsoleOutput(instanceData, buf, toWrite, errorCode)
 393     ClientData instanceData;            /* Indicates which device to use. */
 394     char *buf;                          /* The data buffer. */
 395     int toWrite;                        /* How many bytes to write? */
 396     int *errorCode;                     /* Where to store error code. */
 397 {
 398     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 399             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 400
 401     *errorCode = 0;
 402     Tcl_SetErrno(0);
 403
 404     if (tsdPtr->gStdoutInterp != NULL) {
 405         TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf,
 406                 toWrite);
 407     }
 408
 409     return toWrite;
 410 }
 411 \f
 412 /*
 413  *----------------------------------------------------------------------
 414  *
 415  * ConsoleInput --
 416  *
 417  *      Read input from the console.  Not currently implemented.
 418  *
 419  * Results:
 420  *      Always returns EOF.
 421  *
 422  * Side effects:
 423  *      None.
 424  *
 425  *----------------------------------------------------------------------
 426  */
 427
 428         /* ARGSUSED */
 429 static int
 430 ConsoleInput(instanceData, buf, bufSize, errorCode)
 431     ClientData instanceData;            /* Unused. */
 432     char *buf;                          /* Where to store data read. */
 433     int bufSize;                        /* How much space is available
 434                                          * in the buffer? */
 435     int *errorCode;                     /* Where to store error code. */
 436 {
 437     return 0;                   /* Always return EOF. */
 438 }
 439 \f
 440 /*
 441  *----------------------------------------------------------------------
 442  *
 443  * ConsoleClose --
 444  *
 445  *      Closes the IO channel.
 446  *
 447  * Results:
 448  *      Always returns 0 (success).
 449  *
 450  * Side effects:
 451  *      Frees the dummy file associated with the channel.
 452  *
 453  *----------------------------------------------------------------------
 454  */
 455
 456         /* ARGSUSED */
 457 static int
 458 ConsoleClose(instanceData, interp)
 459     ClientData instanceData;    /* Unused. */
 460     Tcl_Interp *interp;         /* Unused. */
 461 {
 462     return 0;
 463 }
 464 \f
 465 /*
 466  *----------------------------------------------------------------------
 467  *
 468  * ConsoleWatch --
 469  *
 470  *      Called by the notifier to set up the console device so that
 471  *      events will be noticed. Since there are no events on the
 472  *      console, this routine just returns without doing anything.
 473  *
 474  * Results:
 475  *      None.
 476  *
 477  * Side effects:
 478  *      None.
 479  *
 480  *----------------------------------------------------------------------
 481  */
 482
 483         /* ARGSUSED */
 484 static void
 485 ConsoleWatch(instanceData, mask)
 486     ClientData instanceData;            /* Device ID for the channel. */
 487     int mask;                           /* OR-ed combination of
 488                                          * TCL_READABLE, TCL_WRITABLE and
 489                                          * TCL_EXCEPTION, for the events
 490                                          * we are interested in. */
 491 {
 492 }
 493 \f
 494 /*
 495  *----------------------------------------------------------------------
 496  *
 497  * ConsoleHandle --
 498  *
 499  *      Invoked by the generic IO layer to get a handle from a channel.
 500  *      Because console channels are not devices, this function always
 501  *      fails.
 502  *
 503  * Results:
 504  *      Always returns TCL_ERROR.
 505  *
 506  * Side effects:
 507  *      None.
 508  *
 509  *----------------------------------------------------------------------
 510  */
 511
 512         /* ARGSUSED */
 513 static int
 514 ConsoleHandle(instanceData, direction, handlePtr)
 515     ClientData instanceData;    /* Device ID for the channel. */
 516     int direction;              /* TCL_READABLE or TCL_WRITABLE to indicate
 517                                  * which direction of the channel is being
 518                                  * requested. */
 519     ClientData *handlePtr;      /* Where to store handle */
 520 {
 521     return TCL_ERROR;
 522 }
 523 \f
 524 /*
 525  *----------------------------------------------------------------------
 526  *
 527  * ConsoleCmd --
 528  *
 529  *      The console command implements a Tcl interface to the various console
 530  *      options.
 531  *
 532  * Results:
 533  *      None.
 534  *
 535  * Side effects:
 536  *      None.
 537  *
 538  *----------------------------------------------------------------------
 539  */
 540
 541 static int
 542 ConsoleCmd(clientData, interp, argc, argv)
 543     ClientData clientData;              /* Not used. */
 544     Tcl_Interp *interp;                 /* Current interpreter. */
 545     int argc;                           /* Number of arguments. */
 546     char **argv;                        /* Argument strings. */
 547 {
 548     ConsoleInfo *info = (ConsoleInfo *) clientData;
 549     char c;
 550     size_t length;
 551     int result;
 552     Tcl_Interp *consoleInterp;
 553     Tcl_DString dString;
 554
 555     if (argc < 2) {
 556         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 557                 " option ?arg arg ...?\"", (char *) NULL);
 558         return TCL_ERROR;
 559     }
 560
 561     c = argv[1][0];
 562     length = strlen(argv[1]);
 563     result = TCL_OK;
 564     consoleInterp = info->consoleInterp;
 565     Tcl_Preserve((ClientData) consoleInterp);
 566     Tcl_DStringInit(&dString);
 567
 568     if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
 569         Tcl_DStringAppend(&dString, "wm title . ", -1);
 570         if (argc == 3) {
 571             Tcl_DStringAppendElement(&dString, argv[2]);
 572         }
 573         Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
 574     } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
 575         Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
 576         Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
 577     } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
 578         Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
 579         Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
 580     } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
 581         if (argc == 3) {
 582             result = Tcl_Eval(consoleInterp, argv[2]);
 583             Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
 584                     (char *) NULL);
 585         } else {
 586             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 587                     " eval command\"", (char *) NULL);
 588             return TCL_ERROR;
 589         }
 590     } else {
 591         Tcl_AppendResult(interp, "bad option \"", argv[1],
 592                 "\": should be hide, show, or title",
 593                 (char *) NULL);
 594         result = TCL_ERROR;
 595     }
 596     Tcl_DStringFree(&dString);
 597     Tcl_Release((ClientData) consoleInterp);
 598     return result;
 599 }
 600 \f
 601 /*
 602  *----------------------------------------------------------------------
 603  *
 604  * InterpreterCmd --
 605  *
 606  *      This command allows the console interp to communicate with the
 607  *      main interpreter.
 608  *
 609  * Results:
 610  *      None.
 611  *
 612  * Side effects:
 613  *      None.
 614  *
 615  *----------------------------------------------------------------------
 616  */
 617
 618 static int
 619 InterpreterCmd(clientData, interp, argc, argv)
 620     ClientData clientData;              /* Not used. */
 621     Tcl_Interp *interp;                 /* Current interpreter. */
 622     int argc;                           /* Number of arguments. */
 623     char **argv;                        /* Argument strings. */
 624 {
 625     ConsoleInfo *info = (ConsoleInfo *) clientData;
 626     char c;
 627     size_t length;
 628     int result;
 629     Tcl_Interp *otherInterp;
 630
 631     if (argc < 2) {
 632         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 633                 " option ?arg arg ...?\"", (char *) NULL);
 634         return TCL_ERROR;
 635     }
 636
 637     c = argv[1][0];
 638     length = strlen(argv[1]);
 639     otherInterp = info->interp;
 640     Tcl_Preserve((ClientData) otherInterp);
 641     if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
 642         result = Tcl_GlobalEval(otherInterp, argv[2]);
 643         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
 644     } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
 645         Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
 646         result = TCL_OK;
 647         Tcl_ResetResult(interp);
 648         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
 649     } else {
 650         Tcl_AppendResult(interp, "bad option \"", argv[1],
 651                 "\": should be eval or record",
 652                 (char *) NULL);
 653         result = TCL_ERROR;
 654     }
 655     Tcl_Release((ClientData) otherInterp);
 656     return result;
 657 }
 658 \f
 659 /*
 660  *----------------------------------------------------------------------
 661  *
 662  * ConsoleDeleteProc --
 663  *
 664  *      If the console command is deleted we destroy the console window
 665  *      and all associated data structures.
 666  *
 667  * Results:
 668  *      None.
 669  *
 670  * Side effects:
 671  *      A new console it created.
 672  *
 673  *----------------------------------------------------------------------
 674  */
 675
 676 static void
 677 ConsoleDeleteProc(clientData)
 678     ClientData clientData;
 679 {
 680     ConsoleInfo *info = (ConsoleInfo *) clientData;
 681
 682     Tcl_DeleteInterp(info->consoleInterp);
 683     info->consoleInterp = NULL;
 684 }
 685 \f
 686 /*
 687  *----------------------------------------------------------------------
 688  *
 689  * ConsoleEventProc --
 690  *
 691  *      This event procedure is registered on the main window of the
 692  *      slave interpreter.  If the user or a running script causes the
 693  *      main window to be destroyed, then we need to inform the console
 694  *      interpreter by invoking "tkConsoleExit".
 695  *
 696  * Results:
 697  *      None.
 698  *
 699  * Side effects:
 700  *      Invokes the "tkConsoleExit" procedure in the console interp.
 701  *
 702  *----------------------------------------------------------------------
 703  */
 704
 705 static void
 706 ConsoleEventProc(clientData, eventPtr)
 707     ClientData clientData;
 708     XEvent *eventPtr;
 709 {
 710     ConsoleInfo *info = (ConsoleInfo *) clientData;
 711     Tcl_Interp *consoleInterp;
 712     Tcl_DString dString;
 713
 714     if (eventPtr->type == DestroyNotify) {
 715
 716         Tcl_DStringInit(&dString);
 717
 718         consoleInterp = info->consoleInterp;
 719
 720         /*
 721          * It is possible that the console interpreter itself has
 722          * already been deleted. In that case the consoleInterp
 723          * field will be set to NULL. If the interpreter is already
 724          * gone, we do not have to do any work here.
 725          */
 726
 727         if (consoleInterp == (Tcl_Interp *) NULL) {
 728             return;
 729         }
 730         Tcl_Preserve((ClientData) consoleInterp);
 731         Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
 732         Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
 733         Tcl_DStringFree(&dString);
 734         Tcl_Release((ClientData) consoleInterp);
 735     }
 736 }
 737 \f
 738 /*
 739  *----------------------------------------------------------------------
 740  *
 741  * TkConsolePrint --
 742  *
 743  *      Prints to the give text to the console.  Given the main interp
 744  *      this functions find the appropiate console interp and forwards
 745  *      the text to be added to that console.
 746  *
 747  * Results:
 748  *      None.
 749  *
 750  * Side effects:
 751  *      None.
 752  *
 753  *----------------------------------------------------------------------
 754  */
 755
 756 void
 757 TkConsolePrint(interp, devId, buffer, size)
 758     Tcl_Interp *interp;         /* Main interpreter. */
 759     int devId;                  /* TCL_STDOUT for stdout, TCL_STDERR for
 760                                  * stderr. */
 761     char *buffer;               /* Text buffer. */
 762     long size;                  /* Size of text buffer. */
 763 {
 764     Tcl_DString command, output;
 765     Tcl_CmdInfo cmdInfo;
 766     char *cmd;
 767     ConsoleInfo *info;
 768     Tcl_Interp *consoleInterp;
 769     int result;
 770
 771     if (interp == NULL) {
 772         return;
 773     }
 774
 775     if (devId == TCL_STDERR) {
 776         cmd = "tkConsoleOutput stderr ";
 777     } else {
 778         cmd = "tkConsoleOutput stdout ";
 779     }
 780
 781     result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
 782     if (result == 0) {
 783         return;
 784     }
 785     info = (ConsoleInfo *) cmdInfo.clientData;
 786
 787     Tcl_DStringInit(&output);
 788     Tcl_DStringAppend(&output, buffer, size);
 789
 790     Tcl_DStringInit(&command);
 791     Tcl_DStringAppend(&command, cmd, (int) strlen(cmd));
 792     Tcl_DStringAppendElement(&command, output.string);
 793
 794     consoleInterp = info->consoleInterp;
 795     Tcl_Preserve((ClientData) consoleInterp);
 796     Tcl_Eval(consoleInterp, command.string);
 797     Tcl_Release((ClientData) consoleInterp);
 798
 799     Tcl_DStringFree(&command);
 800     Tcl_DStringFree(&output);
 801 }
 802