tix/win/tkConsole80b1.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.51 97/04/25 16:52:39
  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      ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
  52                     int direction, ClientData *handlePtr));
  53
  54
  55 void TkConsolePrint (Tcl_Interp *interp, int devId, char *buffer, long size);                   /* Size of text buffer. */
  56
  57 /*
  58  * This structure describes the channel type structure for file based IO:
  59  */
  60
  61 static Tcl_ChannelType consoleChannelType = {
  62     "console",                  /* Type name. */
  63     NULL,                       /* Always non-blocking.*/
  64     ConsoleClose,               /* Close proc. */
  65     ConsoleInput,               /* Input proc. */
  66     ConsoleOutput,              /* Output proc. */
  67     NULL,                       /* Seek proc. */
  68     NULL,                       /* Set option proc. */
  69     NULL,                       /* Get option proc. */
  70     ConsoleWatch,               /* Watch for events on console. */
  71     ConsoleHandle,              /* Get a handle 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, "consoleinterp", 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  * ConsoleHandle --
 319  *
 320  *      Invoked by the generic IO layer to get a handle from a channel.
 321  *      Because console channels are not devices, this function always
 322  *      fails.
 323  *
 324  * Results:
 325  *      Always returns TCL_ERROR.
 326  *
 327  * Side effects:
 328  *      None.
 329  *
 330  *----------------------------------------------------------------------
 331  */
 332
 333         /* ARGSUSED */
 334 static int
 335 ConsoleHandle(instanceData, direction, handlePtr)
 336     ClientData instanceData;    /* Device ID for the channel. */
 337     int direction;              /* TCL_READABLE or TCL_WRITABLE to indicate
 338                                  * which direction of the channel is being
 339                                  * requested. */
 340     ClientData *handlePtr;      /* Where to store handle */
 341 {
 342     return TCL_ERROR;
 343 }
 344 \f
 345 /*
 346  *----------------------------------------------------------------------
 347  *
 348  * ConsoleCmd --
 349  *
 350  *      The console command implements a Tcl interface to the various console
 351  *      options.
 352  *
 353  * Results:
 354  *      None.
 355  *
 356  * Side effects:
 357  *      None.
 358  *
 359  *----------------------------------------------------------------------
 360  */
 361
 362 static int
 363 ConsoleCmd(clientData, interp, argc, argv)
 364     ClientData clientData;              /* Not used. */
 365     Tcl_Interp *interp;                 /* Current interpreter. */
 366     int argc;                           /* Number of arguments. */
 367     char **argv;                        /* Argument strings. */
 368 {
 369     ConsoleInfo *info = (ConsoleInfo *) clientData;
 370     char c;
 371     int length;
 372     int result;
 373     Tcl_Interp *consoleInterp;
 374
 375     if (argc < 2) {
 376         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 377                 " option ?arg arg ...?\"", (char *) NULL);
 378         return TCL_ERROR;
 379     }
 380
 381     c = argv[1][0];
 382     length = strlen(argv[1]);
 383     result = TCL_OK;
 384     consoleInterp = info->consoleInterp;
 385     Tcl_Preserve((ClientData) consoleInterp);
 386     if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
 387         Tcl_DString dString;
 388
 389         Tcl_DStringInit(&dString);
 390         Tcl_DStringAppend(&dString, "wm title . ", -1);
 391         if (argc == 3) {
 392             Tcl_DStringAppendElement(&dString, argv[2]);
 393         }
 394         Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
 395         Tcl_DStringFree(&dString);
 396     } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
 397         Tcl_Eval(info->consoleInterp, "wm withdraw .");
 398     } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
 399         Tcl_Eval(info->consoleInterp, "wm deiconify .");
 400     } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
 401         if (argc == 3) {
 402             Tcl_Eval(info->consoleInterp, argv[2]);
 403         } else {
 404             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 405                     " eval command\"", (char *) NULL);
 406             return TCL_ERROR;
 407         }
 408     } else {
 409         Tcl_AppendResult(interp, "bad option \"", argv[1],
 410                 "\": should be hide, show, or title",
 411                 (char *) NULL);
 412         result = TCL_ERROR;
 413     }
 414     Tcl_Release((ClientData) consoleInterp);
 415     return result;
 416 }
 417 \f
 418 /*
 419  *----------------------------------------------------------------------
 420  *
 421  * InterpreterCmd --
 422  *
 423  *      This command allows the console interp to communicate with the
 424  *      main interpreter.
 425  *
 426  * Results:
 427  *      None.
 428  *
 429  * Side effects:
 430  *      None.
 431  *
 432  *----------------------------------------------------------------------
 433  */
 434
 435 static int
 436 InterpreterCmd(clientData, interp, argc, argv)
 437     ClientData clientData;              /* Not used. */
 438     Tcl_Interp *interp;                 /* Current interpreter. */
 439     int argc;                           /* Number of arguments. */
 440     char **argv;                        /* Argument strings. */
 441 {
 442     ConsoleInfo *info = (ConsoleInfo *) clientData;
 443     char c;
 444     int length;
 445     int result;
 446     Tcl_Interp *otherInterp;
 447
 448     if (argc < 2) {
 449         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 450                 " option ?arg arg ...?\"", (char *) NULL);
 451         return TCL_ERROR;
 452     }
 453
 454     c = argv[1][0];
 455     length = strlen(argv[1]);
 456     otherInterp = info->interp;
 457     Tcl_Preserve((ClientData) otherInterp);
 458     if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
 459         result = Tcl_GlobalEval(otherInterp, argv[2]);
 460         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
 461     } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
 462         Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
 463         result = TCL_OK;
 464         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
 465     } else {
 466         Tcl_AppendResult(interp, "bad option \"", argv[1],
 467                 "\": should be eval or record",
 468                 (char *) NULL);
 469         result = TCL_ERROR;
 470     }
 471     Tcl_Release((ClientData) otherInterp);
 472     return result;
 473 }
 474 \f
 475 /*
 476  *----------------------------------------------------------------------
 477  *
 478  * ConsoleDeleteProc --
 479  *
 480  *      If the console command is deleted we destroy the console window
 481  *      and all associated data structures.
 482  *
 483  * Results:
 484  *      None.
 485  *
 486  * Side effects:
 487  *      A new console it created.
 488  *
 489  *----------------------------------------------------------------------
 490  */
 491
 492 void
 493 ConsoleDeleteProc(clientData)
 494     ClientData clientData;
 495 {
 496     ConsoleInfo *info = (ConsoleInfo *) clientData;
 497
 498     Tcl_DeleteInterp(info->consoleInterp);
 499     info->consoleInterp = NULL;
 500 }
 501 \f
 502 /*
 503  *----------------------------------------------------------------------
 504  *
 505  * ConsoleEventProc --
 506  *
 507  *      This event procedure is registered on the main window of the
 508  *      slave interpreter.  If the user or a running script causes the
 509  *      main window to be destroyed, then we need to inform the console
 510  *      interpreter by invoking "tkConsoleExit".
 511  *
 512  * Results:
 513  *      None.
 514  *
 515  * Side effects:
 516  *      Invokes the "tkConsoleExit" procedure in the console interp.
 517  *
 518  *----------------------------------------------------------------------
 519  */
 520
 521 static void
 522 ConsoleEventProc(clientData, eventPtr)
 523     ClientData clientData;
 524     XEvent *eventPtr;
 525 {
 526     ConsoleInfo *info = (ConsoleInfo *) clientData;
 527     Tcl_Interp *consoleInterp;
 528
 529     if (eventPtr->type == DestroyNotify) {
 530         consoleInterp = info->consoleInterp;
 531
 532         /*
 533          * It is possible that the console interpreter itself has
 534          * already been deleted. In that case the consoleInterp
 535          * field will be set to NULL. If the interpreter is already
 536          * gone, we do not have to do any work here.
 537          */
 538
 539         if (consoleInterp == (Tcl_Interp *) NULL) {
 540             return;
 541         }
 542         Tcl_Preserve((ClientData) consoleInterp);
 543         Tcl_Eval(consoleInterp, "tkConsoleExit");
 544         Tcl_Release((ClientData) consoleInterp);
 545     }
 546 }
 547 \f
 548 /*
 549  *----------------------------------------------------------------------
 550  *
 551  * TkConsolePrint --
 552  *
 553  *      Prints to the give text to the console.  Given the main interp
 554  *      this functions find the appropiate console interp and forwards
 555  *      the text to be added to that console.
 556  *
 557  * Results:
 558  *      None.
 559  *
 560  * Side effects:
 561  *      None.
 562  *
 563  *----------------------------------------------------------------------
 564  */
 565
 566 void
 567 TkConsolePrint(interp, devId, buffer, size)
 568     Tcl_Interp *interp;         /* Main interpreter. */
 569     int devId;                  /* TCL_STDOUT for stdout, TCL_STDERR for
 570                                  * stderr. */
 571     char *buffer;               /* Text buffer. */
 572     long size;                  /* Size of text buffer. */
 573 {
 574     Tcl_DString command, output;
 575     Tcl_CmdInfo cmdInfo;
 576     char *cmd;
 577     ConsoleInfo *info;
 578     Tcl_Interp *consoleInterp;
 579     int result;
 580
 581     if (interp == NULL) {
 582         return;
 583     }
 584
 585     if (devId == TCL_STDERR) {
 586         cmd = "tkConsoleOutput stderr ";
 587     } else {
 588         cmd = "tkConsoleOutput stdout ";
 589     }
 590
 591     result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
 592     if (result == 0) {
 593         return;
 594     }
 595     info = (ConsoleInfo *) cmdInfo.clientData;
 596
 597     Tcl_DStringInit(&output);
 598     Tcl_DStringAppend(&output, buffer, size);
 599
 600     Tcl_DStringInit(&command);
 601     Tcl_DStringAppend(&command, cmd, strlen(cmd));
 602     Tcl_DStringAppendElement(&command, output.string);
 603
 604     consoleInterp = info->consoleInterp;
 605     Tcl_Preserve((ClientData) consoleInterp);
 606     Tcl_Eval(consoleInterp, command.string);
 607     Tcl_Release((ClientData) consoleInterp);
 608
 609     Tcl_DStringFree(&command);
 610     Tcl_DStringFree(&output);
 611 }