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