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