tix/win/tkConsole41.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  * SCCS: @(#) tkConsole.c 1.37 96/04/20 15:17:32
  14  */
  15
  16 #include "tkInt.h"
  17
  18 /*
  19  * A data structure of the following type holds information for each console
  20  * which a handler (i.e. a Tcl command) has been defined for a particular
  21  * top-level window.
  22  */
  23
  24 typedef struct ConsoleInfo {
  25     Tcl_Interp *consoleInterp;  /* Interpreter for the console. */
  26     Tcl_Interp *interp;         /* Interpreter to send console commands. */
  27 } ConsoleInfo;
  28
  29 static Tcl_Interp *gStdoutInterp = NULL;
  30
  31 /*
  32  * Forward declarations for procedures defined later in this file:
  33  */
  34
  35 static int      ConsoleCmd _ANSI_ARGS_((ClientData clientData,
  36                     Tcl_Interp *interp, int argc, char **argv));
  37 static void     ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
  38 static void     ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
  39                     XEvent *eventPtr));
  40 static int      InterpreterCmd _ANSI_ARGS_((ClientData clientData,
  41                     Tcl_Interp *interp, int argc, char **argv));
  42
  43 static int              ConsoleInput _ANSI_ARGS_((ClientData instanceData,
  44                             Tcl_File inFile, char *buf, int toRead,
  45                             int *errorCode));
  46 static int              ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
  47                             Tcl_File outFile, char *buf, int toWrite,
  48                             int *errorCode));
  49 static int              ConsoleClose _ANSI_ARGS_((ClientData instanceData,
  50                             Tcl_Interp *interp, Tcl_File inFile,
  51                             Tcl_File outFile));
  52
  53 /*
  54  * This structure describes the channel type structure for file based IO:
  55  */
  56
  57 static Tcl_ChannelType consoleChannelType = {
  58     "console",                  /* Type name. */
  59     NULL,                       /* Always non-blocking.*/
  60     ConsoleClose,               /* Close proc. */
  61     ConsoleInput,               /* Input proc. */
  62     ConsoleOutput,              /* Output proc. */
  63     NULL,                       /* Seek proc. */
  64     NULL,                       /* Set option proc. */
  65     NULL,                       /* Get option proc. */
  66 };
  67 \f
  68 /*
  69  *----------------------------------------------------------------------
  70  *
  71  * TkConsoleCreate --
  72  *
  73  *      Create the console channels and install them as the standard
  74  *      channels.  All I/O will be discarded until TkConsoleInit is
  75  *      called to attach the console to a text widget.
  76  *
  77  * Results:
  78  *      None.
  79  *
  80  * Side effects:
  81  *      Creates the console channel and installs it as the standard
  82  *      channels.
  83  *
  84  *----------------------------------------------------------------------
  85  */
  86
  87 void
  88 TkConsoleCreate()
  89 {
  90     Tcl_Channel consoleChannel;
  91     Tcl_File inFile, outFile, errFile;
  92
  93     inFile = Tcl_GetFile((ClientData) 0, 0);
  94     outFile = Tcl_GetFile((ClientData) 1, 0);
  95     errFile = Tcl_GetFile((ClientData) 2, 0);
  96
  97     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
  98             inFile, NULL, (ClientData) NULL);
  99     if (consoleChannel != NULL) {
 100         Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
 101         Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
 102     }
 103     Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
 104     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
 105             NULL, outFile, (ClientData) NULL);
 106     if (consoleChannel != NULL) {
 107         Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
 108         Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
 109     }
 110     Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
 111     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
 112             NULL, errFile, (ClientData) NULL);
 113     if (consoleChannel != NULL) {
 114         Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
 115         Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
 116     }
 117     Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
 118 }
 119 \f
 120 /*
 121  *----------------------------------------------------------------------
 122  *
 123  * TkConsoleInit --
 124  *
 125  *      Initialize the console.  This code actually creates a new
 126  *      application and associated interpreter.  This effectivly hides
 127  *      the implementation from the main application.
 128  *
 129  * Results:
 130  *      None.
 131  *
 132  * Side effects:
 133  *      A new console it created.
 134  *
 135  *----------------------------------------------------------------------
 136  */
 137
 138 int
 139 TkConsoleInit(interp)
 140     Tcl_Interp *interp;                 /* Interpreter to use for prompting. */
 141 {
 142     Tcl_Interp *consoleInterp;
 143     ConsoleInfo *info;
 144     Tk_Window mainWindow = Tk_MainWindow(interp);
 145 #ifdef MAC_TCL
 146     static char initCmd[] = "source -rsrc {Console}";
 147 #else
 148     static char initCmd[] = "source $tk_library/console.tcl";
 149 #endif
 150
 151     consoleInterp = Tcl_CreateInterp();
 152     if (consoleInterp == NULL) {
 153         goto error;
 154     }
 155
 156     /*
 157      * Initialized Tcl and Tk.
 158      */
 159
 160     if (Tcl_Init(consoleInterp) != TCL_OK) {
 161         goto error;
 162     }
 163     if (Tk_Init(consoleInterp) != TCL_OK) {
 164         goto error;
 165     }
 166     gStdoutInterp = interp;
 167
 168     /*
 169      * Add console commands to the interp
 170      */
 171     info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
 172     info->interp = interp;
 173     info->consoleInterp = consoleInterp;
 174     Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
 175             (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
 176     Tcl_CreateCommand(consoleInterp, "interp", InterpreterCmd,
 177             (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
 178
 179     Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
 180             (ClientData) info);
 181
 182     Tcl_Preserve((ClientData) consoleInterp);
 183     if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
 184         /* goto error; -- no problem for now... */
 185         printf("Eval error: %s", consoleInterp->result);
 186     }
 187     Tcl_Release((ClientData) consoleInterp);
 188     return TCL_OK;
 189
 190     error:
 191     if (consoleInterp != NULL) {
 192         Tcl_DeleteInterp(consoleInterp);
 193     }
 194     return TCL_ERROR;
 195 }
 196 \f
 197 /*
 198  *----------------------------------------------------------------------
 199  *
 200  * ConsoleOutput--
 201  *
 202  *      Writes the given output on the IO channel. Returns count of how
 203  *      many characters were actually written, and an error indication.
 204  *
 205  * Results:
 206  *      A count of how many characters were written is returned and an
 207  *      error indication is returned in an output argument.
 208  *
 209  * Side effects:
 210  *      Writes output on the actual channel.
 211  *
 212  *----------------------------------------------------------------------
 213  */
 214
 215         /* ARGSUSED */
 216 static int
 217 ConsoleOutput(instanceData, outFile, buf, toWrite, errorCode)
 218     ClientData instanceData;            /* Unused. */
 219     Tcl_File outFile;                   /* Output device for channel. */
 220     char *buf;                          /* The data buffer. */
 221     int toWrite;                        /* How many bytes to write? */
 222     int *errorCode;                     /* Where to store error code. */
 223 {
 224     *errorCode = 0;
 225     Tcl_SetErrno(0);
 226
 227     if (gStdoutInterp != NULL) {
 228         TkConsolePrint(gStdoutInterp, outFile, buf, toWrite);
 229     }
 230
 231     return toWrite;
 232 }
 233 \f
 234 /*
 235  *----------------------------------------------------------------------
 236  *
 237  * ConsoleInput --
 238  *
 239  *      Read input from the console.  Not currently implemented.
 240  *
 241  * Results:
 242  *      Always returns EOF.
 243  *
 244  * Side effects:
 245  *      None.
 246  *
 247  *----------------------------------------------------------------------
 248  */
 249
 250 static int
 251 ConsoleInput(instanceData, inFile, buf, bufSize, errorCode)
 252     ClientData instanceData;            /* Unused. */
 253     Tcl_File inFile;                    /* Input device for channel. */
 254     char *buf;                          /* Where to store data read. */
 255     int bufSize;                        /* How much space is available
 256                                          * in the buffer? */
 257     int *errorCode;                     /* Where to store error code. */
 258 {
 259     return 0;                   /* Always return EOF. */
 260 }
 261 \f
 262 /*
 263  *----------------------------------------------------------------------
 264  *
 265  * ConsoleClose --
 266  *
 267  *      Closes the IO channel.
 268  *
 269  * Results:
 270  *      Always returns 0 (success).
 271  *
 272  * Side effects:
 273  *      Frees the dummy file associated with the channel.
 274  *
 275  *----------------------------------------------------------------------
 276  */
 277
 278         /* ARGSUSED */
 279 static int
 280 ConsoleClose(instanceData, interp, inFile, outFile)
 281     ClientData instanceData;    /* Unused. */
 282     Tcl_Interp *interp; /* Unused. */
 283     Tcl_File inFile;            /* Input file to close. */
 284     Tcl_File outFile;           /* Output file to close. */
 285 {
 286     if (inFile) {
 287         Tcl_FreeFile(inFile);
 288     }
 289     if (outFile && (outFile != inFile)) {
 290         Tcl_FreeFile(outFile);
 291     }
 292     return 0;
 293 }
 294 \f
 295 /*
 296  *----------------------------------------------------------------------
 297  *
 298  * ConsoleCmd --
 299  *
 300  *      The console command implements a Tcl interface to the various console
 301  *      options.
 302  *
 303  * Results:
 304  *      None.
 305  *
 306  * Side effects:
 307  *      None.
 308  *
 309  *----------------------------------------------------------------------
 310  */
 311
 312 static int
 313 ConsoleCmd(clientData, interp, argc, argv)
 314     ClientData clientData;              /* Not used. */
 315     Tcl_Interp *interp;                 /* Current interpreter. */
 316     int argc;                           /* Number of arguments. */
 317     char **argv;                        /* Argument strings. */
 318 {
 319     ConsoleInfo *info = (ConsoleInfo *) clientData;
 320     char c;
 321     int length;
 322     int result;
 323     Tcl_Interp *consoleInterp;
 324
 325     if (argc < 2) {
 326         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 327                 " option ?arg arg ...?\"", (char *) NULL);
 328         return TCL_ERROR;
 329     }
 330
 331     c = argv[1][0];
 332     length = strlen(argv[1]);
 333     result = TCL_OK;
 334     consoleInterp = info->consoleInterp;
 335     Tcl_Preserve((ClientData) consoleInterp);
 336     if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
 337         Tcl_DString dString;
 338         char *wmCmd = "wm title . {";
 339
 340         Tcl_DStringInit(&dString);
 341         Tcl_DStringAppend(&dString, wmCmd, strlen(wmCmd));
 342         Tcl_DStringAppend(&dString, argv[2], strlen(argv[2]));
 343         Tcl_DStringAppend(&dString, "}", strlen("}"));
 344         Tcl_Eval(consoleInterp, dString.string);
 345         Tcl_DStringFree(&dString);
 346     } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
 347         Tcl_Eval(info->consoleInterp, "wm withdraw .");
 348     } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
 349         Tcl_Eval(info->consoleInterp, "wm deiconify .");
 350     } else {
 351         Tcl_AppendResult(interp, "bad option \"", argv[1],
 352                 "\": should be hide, show, or title",
 353                 (char *) NULL);
 354         result = TCL_ERROR;
 355     }
 356     Tcl_Release((ClientData) consoleInterp);
 357     return result;
 358 } /* ConsoleCmd */
 359 \f
 360 /*
 361  *----------------------------------------------------------------------
 362  *
 363  * InterpreterCmd --
 364  *
 365  *      This command allows the console interp to communicate with the
 366  *      main interpreter.
 367  *
 368  * Results:
 369  *      None.
 370  *
 371  * Side effects:
 372  *      None.
 373  *
 374  *----------------------------------------------------------------------
 375  */
 376
 377 static int
 378 InterpreterCmd(clientData, interp, argc, argv)
 379     ClientData clientData;              /* Not used. */
 380     Tcl_Interp *interp;                 /* Current interpreter. */
 381     int argc;                           /* Number of arguments. */
 382     char **argv;                        /* Argument strings. */
 383 {
 384     ConsoleInfo *info = (ConsoleInfo *) clientData;
 385     char c;
 386     int length;
 387     int result;
 388     Tcl_Interp *otherInterp;
 389
 390     if (argc < 2) {
 391         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 392                 " option ?arg arg ...?\"", (char *) NULL);
 393         return TCL_ERROR;
 394     }
 395
 396     c = argv[1][0];
 397     length = strlen(argv[1]);
 398     result = TCL_OK;
 399     otherInterp = info->interp;
 400     Tcl_Preserve((ClientData) otherInterp);
 401     if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
 402         result = Tcl_GlobalEval(otherInterp, argv[2]);
 403         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
 404     } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
 405         Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
 406         result = TCL_OK;
 407         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
 408     } else {
 409         Tcl_AppendResult(interp, "bad option \"", argv[1],
 410                 "\": should be eval or record",
 411                 (char *) NULL);
 412         result = TCL_ERROR;
 413     }
 414     Tcl_Release((ClientData) otherInterp);
 415     return result;
 416 }
 417 \f
 418 /*
 419  *----------------------------------------------------------------------
 420  *
 421  * ConsoleDeleteProc --
 422  *
 423  *      If the console command is deleted we destroy the console window
 424  *      and all associated data structures.
 425  *
 426  * Results:
 427  *      None.
 428  *
 429  * Side effects:
 430  *      A new console it created.
 431  *
 432  *----------------------------------------------------------------------
 433  */
 434
 435 void
 436 ConsoleDeleteProc(clientData)
 437     ClientData clientData;
 438 {
 439     ConsoleInfo *info = (ConsoleInfo *) clientData;
 440
 441     Tcl_DeleteInterp(info->consoleInterp);
 442     info->consoleInterp = NULL;
 443 }
 444 \f
 445 /*
 446  *----------------------------------------------------------------------
 447  *
 448  * ConsoleEventProc --
 449  *
 450  *      This event procedure is registered on the main window of the
 451  *      slave interpreter.  If the user or a running script causes the
 452  *      main window to be destroyed, then we need to inform the console
 453  *      interpreter by invoking "tkConsoleExit".
 454  *
 455  * Results:
 456  *      None.
 457  *
 458  * Side effects:
 459  *      Invokes the "tkConsoleExit" procedure in the console interp.
 460  *
 461  *----------------------------------------------------------------------
 462  */
 463
 464 static void
 465 ConsoleEventProc(clientData, eventPtr)
 466     ClientData clientData;
 467     XEvent *eventPtr;
 468 {
 469     ConsoleInfo *info = (ConsoleInfo *) clientData;
 470     Tcl_Interp *consoleInterp;
 471
 472     if (eventPtr->type == DestroyNotify) {
 473         consoleInterp = info->consoleInterp;
 474         Tcl_Preserve((ClientData) consoleInterp);
 475         Tcl_Eval(consoleInterp, "tkConsoleExit");
 476         Tcl_Release((ClientData) consoleInterp);
 477     }
 478 }
 479 \f
 480 /*
 481  *----------------------------------------------------------------------
 482  *
 483  * TkConsolePrint --
 484  *
 485  *      Prints to the give text to the console.  Given the main interp
 486  *      this functions find the appropiate console interp and forwards
 487  *      the text to be added to that console.
 488  *
 489  * Results:
 490  *      None.
 491  *
 492  * Side effects:
 493  *      None.
 494  *
 495  *----------------------------------------------------------------------
 496  */
 497
 498 void
 499 TkConsolePrint(interp, outFile, buffer, size)
 500     Tcl_Interp *interp;         /* Main interpreter. */
 501     Tcl_File outFile;           /* Should be stdout or stderr. */
 502     char *buffer;               /* Text buffer. */
 503     long size;                  /* Size of text buffer. */
 504 {
 505     Tcl_DString command, output;
 506     Tcl_CmdInfo cmdInfo;
 507     char *cmd;
 508     ConsoleInfo *info;
 509     Tcl_Interp *consoleInterp;
 510     int result;
 511     int fd = (int) Tcl_GetFileInfo(outFile, NULL);
 512
 513     if (interp == NULL) {
 514         return;
 515     }
 516
 517     if (fd == 2) {
 518         cmd = "tkConsoleOutput stderr ";
 519     } else {
 520         cmd = "tkConsoleOutput stdout ";
 521     }
 522
 523     result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
 524     if (result == 0) {
 525         return;
 526     }
 527     info = (ConsoleInfo *) cmdInfo.clientData;
 528
 529     Tcl_DStringInit(&output);
 530     Tcl_DStringAppend(&output, buffer, size);
 531
 532     Tcl_DStringInit(&command);
 533     Tcl_DStringAppend(&command, cmd, strlen(cmd));
 534     Tcl_DStringAppendElement(&command, output.string);
 535
 536     consoleInterp = info->consoleInterp;
 537     Tcl_Preserve((ClientData) consoleInterp);
 538     Tcl_Eval(consoleInterp, command.string);
 539     Tcl_Release((ClientData) consoleInterp);
 540
 541     Tcl_DStringFree(&command);
 542     Tcl_DStringFree(&output);
 543 }