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: tkConsole.c,v 1.18.2.6 2006/09/25 17:28:20 andreas_kupries Exp $ 14 * 15 */ 16 17#include "tk.h" 18 19/* 20 * Each console is associated with an instance of the ConsoleInfo struct. 21 * It keeps track of what interp holds the Tk application that displays 22 * the console, and what interp is controlled by the interactions in that 23 * console. A refCount permits the struct to be shared as instance data 24 * by commands and by channels. 25 */ 26 27typedef struct ConsoleInfo { 28 Tcl_Interp *consoleInterp; /* Interpreter displaying the console. */ 29 Tcl_Interp *interp; /* Interpreter controlled by console. */ 30 int refCount; 31} ConsoleInfo; 32 33/* 34 * Each console channel holds an instance of the ChannelData struct as 35 * its instance data. It contains ConsoleInfo, so the channel can work 36 * with the appropriate console window, and a type value to distinguish 37 * the stdout channel from the stderr channel. 38 */ 39 40typedef struct ChannelData { 41 ConsoleInfo *info; 42 int type; /* TCL_STDOUT or TCL_STDERR */ 43} ChannelData; 44 45/* 46 * Prototypes for local procedures defined in this file: 47 */ 48 49static int ConsoleClose _ANSI_ARGS_((ClientData instanceData, 50 Tcl_Interp *interp)); 51static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData)); 52static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData, 53 XEvent *eventPtr)); 54static int ConsoleHandle _ANSI_ARGS_((ClientData instandeData, 55 int direction, ClientData *handlePtr)); 56static int ConsoleInput _ANSI_ARGS_((ClientData instanceData, 57 char *buf, int toRead, int *errorCode)); 58static int ConsoleObjCmd _ANSI_ARGS_((ClientData clientData, 59 Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); 60static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData, 61 CONST char *buf, int toWrite, int *errorCode)); 62static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData, 63 int mask)); 64static void DeleteConsoleInterp _ANSI_ARGS_((ClientData clientData)); 65static void InterpDeleteProc _ANSI_ARGS_((ClientData clientData, 66 Tcl_Interp *interp)); 67static int InterpreterObjCmd _ANSI_ARGS_((ClientData clientData, 68 Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); 69 70/* 71 * This structure describes the channel type structure for file based IO: 72 */ 73 74static Tcl_ChannelType consoleChannelType = { 75 "console", /* Type name. */ 76 TCL_CHANNEL_VERSION_4, /* v4 channel */ 77 ConsoleClose, /* Close proc. */ 78 ConsoleInput, /* Input proc. */ 79 ConsoleOutput, /* Output proc. */ 80 NULL, /* Seek proc. */ 81 NULL, /* Set option proc. */ 82 NULL, /* Get option proc. */ 83 ConsoleWatch, /* Watch for events on console. */ 84 ConsoleHandle, /* Get a handle from the device. */ 85 NULL, /* close2proc. */ 86 NULL, /* Always non-blocking.*/ 87 NULL, /* flush proc. */ 88 NULL, /* handler proc. */ 89 NULL, /* wide seek proc */ 90 NULL, /* thread action proc */ 91}; 92 93 94#ifdef __WIN32__ 95 96#include <windows.h> 97 98/* 99 *---------------------------------------------------------------------- 100 * 101 * ShouldUseConsoleChannel 102 * 103 * Check to see if console window should be used for a given 104 * standard channel 105 * 106 * Results: 107 * None. 108 * 109 * Side effects: 110 * Creates the console channel and installs it as the standard 111 * channels. 112 * 113 *---------------------------------------------------------------------- 114 */ 115static int ShouldUseConsoleChannel(type) 116 int type; 117{ 118 DWORD handleId; /* Standard handle to retrieve. */ 119 DCB dcb; 120 DWORD consoleParams; 121 DWORD fileType; 122 int mode; 123 char *bufMode; 124 HANDLE handle; 125 126 switch (type) { 127 case TCL_STDIN: 128 handleId = STD_INPUT_HANDLE; 129 mode = TCL_READABLE; 130 bufMode = "line"; 131 break; 132 case TCL_STDOUT: 133 handleId = STD_OUTPUT_HANDLE; 134 mode = TCL_WRITABLE; 135 bufMode = "line"; 136 break; 137 case TCL_STDERR: 138 handleId = STD_ERROR_HANDLE; 139 mode = TCL_WRITABLE; 140 bufMode = "none"; 141 break; 142 default: 143 return 0; 144 break; 145 } 146 147 handle = GetStdHandle(handleId); 148 149 /* 150 * Note that we need to check for 0 because Windows will return 0 if this 151 * is not a console mode application, even though this is not a valid 152 * handle. 153 */ 154 155 if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) { 156 return 1; 157 } 158 159 /* 160 * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears 161 * to be a valid handle. See TclpGetDefaultStdChannel() for this change 162 * implemented. We didn't change it here because GetFileType() [below] 163 * will catch this with FILE_TYPE_UNKNOWN and appropriately return a 164 * value of 1, anyways. 165 * 166 * char dummyBuff[1]; 167 * DWORD dummyWritten; 168 * 169 * if ((type == TCL_STDOUT) 170 * && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) { 171 * return 1; 172 * } 173 */ 174 175 fileType = GetFileType(handle); 176 177 /* 178 * If the file is a character device, we need to try to figure out 179 * whether it is a serial port, a console, or something else. We 180 * test for the console case first because this is more common. 181 */ 182 183 if (fileType == FILE_TYPE_CHAR) { 184 dcb.DCBlength = sizeof( DCB ) ; 185 if (!GetConsoleMode(handle, &consoleParams) && 186 !GetCommState(handle, &dcb)) { 187 /* 188 * Don't use a CHAR type channel for stdio, otherwise Tk 189 * runs into trouble with the MS DevStudio debugger. 190 */ 191 192 return 1; 193 } 194 } else if (fileType == FILE_TYPE_UNKNOWN) { 195 return 1; 196 } else if (Tcl_GetStdChannel(type) == NULL) { 197 return 1; 198 } 199 200 return 0; 201} 202#else 203/* 204 * Mac should always use a console channel, Unix should if it's trying to 205 */ 206 207#define ShouldUseConsoleChannel(chan) (1) 208#endif 209 210/* 211 *---------------------------------------------------------------------- 212 * 213 * Tk_InitConsoleChannels -- 214 * 215 * Create the console channels and install them as the standard 216 * channels. All I/O will be discarded until Tk_CreateConsoleWindow 217 * is called to attach the console to a text widget. 218 * 219 * Results: 220 * None. 221 * 222 * Side effects: 223 * Creates the console channel and installs it as the standard 224 * channels. 225 * 226 *---------------------------------------------------------------------- 227 */ 228 229void 230Tk_InitConsoleChannels(interp) 231 Tcl_Interp *interp; 232{ 233 static Tcl_ThreadDataKey consoleInitKey; 234 int *consoleInitPtr, doIn, doOut, doErr; 235 ConsoleInfo *info; 236 Tcl_Channel consoleChannel; 237 238 /* 239 * Ensure that we are getting the matching version of Tcl. This is 240 * really only an issue when Tk is loaded dynamically. 241 */ 242 243 if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { 244 return; 245 } 246 247 consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int)); 248 if (*consoleInitPtr) { 249 /* We've already initialized console channels in this thread. */ 250 return; 251 } 252 *consoleInitPtr = 1; 253 254 doIn = ShouldUseConsoleChannel(TCL_STDIN); 255 doOut = ShouldUseConsoleChannel(TCL_STDOUT); 256 doErr = ShouldUseConsoleChannel(TCL_STDERR); 257 258 if (!(doIn || doOut || doErr)) { 259 /* 260 * No std channels should be tied to the console; 261 * Thus, no need to create the console 262 */ 263 return; 264 } 265 266 /* 267 * At least one std channel wants to be tied to the console, 268 * so create the interp for it to live in. 269 */ 270 271 info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); 272 info->consoleInterp = NULL; 273 info->interp = NULL; 274 info->refCount = 0; 275 276 if (doIn) { 277 ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData)); 278 data->info = info; 279 data->info->refCount++; 280 data->type = TCL_STDIN; 281 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0", 282 (ClientData) data, TCL_READABLE); 283 if (consoleChannel != NULL) { 284 Tcl_SetChannelOption(NULL, consoleChannel, 285 "-translation", "lf"); 286 Tcl_SetChannelOption(NULL, consoleChannel, 287 "-buffering", "none"); 288 Tcl_SetChannelOption(NULL, consoleChannel, 289 "-encoding", "utf-8"); 290 } 291 Tcl_SetStdChannel(consoleChannel, TCL_STDIN); 292 Tcl_RegisterChannel(NULL, consoleChannel); 293 } 294 295 if (doOut) { 296 ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData)); 297 data->info = info; 298 data->info->refCount++; 299 data->type = TCL_STDOUT; 300 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1", 301 (ClientData) data, TCL_WRITABLE); 302 if (consoleChannel != NULL) { 303 Tcl_SetChannelOption(NULL, consoleChannel, 304 "-translation", "lf"); 305 Tcl_SetChannelOption(NULL, consoleChannel, 306 "-buffering", "none"); 307 Tcl_SetChannelOption(NULL, consoleChannel, 308 "-encoding", "utf-8"); 309 } 310 Tcl_SetStdChannel(consoleChannel, TCL_STDOUT); 311 Tcl_RegisterChannel(NULL, consoleChannel); 312 } 313 314 if (doErr) { 315 ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData)); 316 data->info = info; 317 data->info->refCount++; 318 data->type = TCL_STDERR; 319 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2", 320 (ClientData) data, TCL_WRITABLE); 321 if (consoleChannel != NULL) { 322 Tcl_SetChannelOption(NULL, consoleChannel, 323 "-translation", "lf"); 324 Tcl_SetChannelOption(NULL, consoleChannel, 325 "-buffering", "none"); 326 Tcl_SetChannelOption(NULL, consoleChannel, 327 "-encoding", "utf-8"); 328 } 329 Tcl_SetStdChannel(consoleChannel, TCL_STDERR); 330 Tcl_RegisterChannel(NULL, consoleChannel); 331 } 332} 333 334/* 335 *---------------------------------------------------------------------- 336 * 337 * Tk_CreateConsoleWindow -- 338 * 339 * Initialize the console. This code actually creates a new 340 * application and associated interpreter. This effectivly hides 341 * the implementation from the main application. 342 * 343 * Results: 344 * None. 345 * 346 * Side effects: 347 * A new console it created. 348 * 349 *---------------------------------------------------------------------- 350 */ 351 352int 353Tk_CreateConsoleWindow(interp) 354 Tcl_Interp *interp; /* Interpreter to use for prompting. */ 355{ 356 Tcl_Channel chan; 357 ConsoleInfo *info; 358 Tk_Window mainWindow; 359 Tcl_Command token; 360 int result = TCL_OK; 361 int haveConsoleChannel = 1; 362 363#ifdef MAC_TCL 364 static const char *initCmd = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}"; 365#else 366 static const char *initCmd = "source $tk_library/console.tcl"; 367#endif 368 369 /* Init an interp with Tcl and Tk */ 370 Tcl_Interp *consoleInterp = Tcl_CreateInterp(); 371 if (Tcl_Init(consoleInterp) != TCL_OK) { 372 goto error; 373 } 374 if (Tk_Init(consoleInterp) != TCL_OK) { 375 goto error; 376 } 377 378 /* 379 * Fetch the instance data from whatever std channel is a 380 * console channel. If none, create fresh instance data. 381 */ 382 383 if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN)) 384 == &consoleChannelType) { 385 } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT)) 386 == &consoleChannelType) { 387 } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR)) 388 == &consoleChannelType) { 389 } else { 390 haveConsoleChannel = 0; 391 } 392 393 if (haveConsoleChannel) { 394 ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan); 395 info = data->info; 396 if (info->consoleInterp) { 397 /* New ConsoleInfo for a new console window */ 398 info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); 399 info->refCount = 0; 400 401 /* Update any console channels to make use of the new console */ 402 if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN)) 403 == &consoleChannelType) { 404 data = (ChannelData *)Tcl_GetChannelInstanceData(chan); 405 data->info->refCount--; 406 data->info = info; 407 data->info->refCount++; 408 } 409 if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT)) 410 == &consoleChannelType) { 411 data = (ChannelData *)Tcl_GetChannelInstanceData(chan); 412 data->info->refCount--; 413 data->info = info; 414 data->info->refCount++; 415 } 416 if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR)) 417 == &consoleChannelType) { 418 data = (ChannelData *)Tcl_GetChannelInstanceData(chan); 419 data->info->refCount--; 420 data->info = info; 421 data->info->refCount++; 422 } 423 } 424 } else { 425 info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); 426 info->refCount = 0; 427 } 428 429 info->consoleInterp = consoleInterp; 430 info->interp = interp; 431 432 Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info); 433 info->refCount++; 434 Tcl_CreateThreadExitHandler(DeleteConsoleInterp, 435 (ClientData) consoleInterp); 436 437 /* 438 * Add console commands to the interp 439 */ 440 441 token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, 442 (ClientData) info, ConsoleDeleteProc); 443 info->refCount++; 444 445 /* 446 * We don't have to count the ref held by the [consoleinterp] command 447 * in the consoleInterp. The ref held by the consoleInterp delete 448 * handler takes care of us. 449 */ 450 Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd, 451 (ClientData) info, NULL); 452 453 mainWindow = Tk_MainWindow(interp); 454 if (mainWindow) { 455 Tk_CreateEventHandler(mainWindow, StructureNotifyMask, 456 ConsoleEventProc, (ClientData) info); 457 info->refCount++; 458 } 459 460 Tcl_Preserve((ClientData) consoleInterp); 461 result = Tcl_GlobalEval(consoleInterp, initCmd); 462 if (result == TCL_ERROR) { 463 Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode", NULL, 464 TCL_GLOBAL_ONLY); 465 Tcl_ResetResult(interp); 466 if (objPtr) { 467 Tcl_SetObjErrorCode(interp, objPtr); 468 } 469 470 objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo", NULL, 471 TCL_GLOBAL_ONLY); 472 if (objPtr) { 473 int numBytes; 474 CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes); 475 Tcl_AddObjErrorInfo(interp, message, numBytes); 476 } 477 Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); 478 } 479 Tcl_Release((ClientData) consoleInterp); 480 if (result == TCL_ERROR) { 481 Tcl_DeleteCommandFromToken(interp, token); 482 mainWindow = Tk_MainWindow(interp); 483 if (mainWindow) { 484 Tk_DeleteEventHandler(mainWindow, StructureNotifyMask, 485 ConsoleEventProc, (ClientData) info); 486 if (--info->refCount <= 0) { 487 ckfree((char *) info); 488 } 489 } 490 goto error; 491 } 492 return TCL_OK; 493 494 error: 495 Tcl_AddErrorInfo(interp, "\n (creating console window)"); 496 if (!Tcl_InterpDeleted(consoleInterp)) { 497 Tcl_DeleteInterp(consoleInterp); 498 } 499 return TCL_ERROR; 500} 501 502/* 503 *---------------------------------------------------------------------- 504 * 505 * ConsoleOutput-- 506 * 507 * Writes the given output on the IO channel. Returns count of how 508 * many characters were actually written, and an error indication. 509 * 510 * Results: 511 * A count of how many characters were written is returned and an 512 * error indication is returned in an output argument. 513 * 514 * Side effects: 515 * Writes output on the actual channel. 516 * 517 *---------------------------------------------------------------------- 518 */ 519 520static int 521ConsoleOutput(instanceData, buf, toWrite, errorCode) 522 ClientData instanceData; /* Indicates which device to use. */ 523 CONST char *buf; /* The data buffer. */ 524 int toWrite; /* How many bytes to write? */ 525 int *errorCode; /* Where to store error code. */ 526{ 527 ChannelData *data = (ChannelData *)instanceData; 528 ConsoleInfo *info = data->info; 529 530 *errorCode = 0; 531 Tcl_SetErrno(0); 532 533 if (info) { 534 Tcl_Interp *consoleInterp = info->consoleInterp; 535 536 if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { 537 Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1); 538 if (data->type == TCL_STDERR) { 539 Tcl_ListObjAppendElement(NULL, cmd, 540 Tcl_NewStringObj("stderr", -1)); 541 } else { 542 Tcl_ListObjAppendElement(NULL, cmd, 543 Tcl_NewStringObj("stdout", -1)); 544 } 545 Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj(buf, toWrite)); 546 Tcl_IncrRefCount(cmd); 547 Tcl_GlobalEvalObj(consoleInterp, cmd); 548 Tcl_DecrRefCount(cmd); 549 } 550 } 551 return toWrite; 552} 553 554/* 555 *---------------------------------------------------------------------- 556 * 557 * ConsoleInput -- 558 * 559 * Read input from the console. Not currently implemented. 560 * 561 * Results: 562 * Always returns EOF. 563 * 564 * Side effects: 565 * None. 566 * 567 *---------------------------------------------------------------------- 568 */ 569 570 /* ARGSUSED */ 571static int 572ConsoleInput(instanceData, buf, bufSize, errorCode) 573 ClientData instanceData; /* Unused. */ 574 char *buf; /* Where to store data read. */ 575 int bufSize; /* How much space is available 576 * in the buffer? */ 577 int *errorCode; /* Where to store error code. */ 578{ 579 return 0; /* Always return EOF. */ 580} 581 582/* 583 *---------------------------------------------------------------------- 584 * 585 * ConsoleClose -- 586 * 587 * Closes the IO channel. 588 * 589 * Results: 590 * Always returns 0 (success). 591 * 592 * Side effects: 593 * Frees the dummy file associated with the channel. 594 * 595 *---------------------------------------------------------------------- 596 */ 597 598 /* ARGSUSED */ 599static int 600ConsoleClose(instanceData, interp) 601 ClientData instanceData; /* Unused. */ 602 Tcl_Interp *interp; /* Unused. */ 603{ 604 ChannelData *data = (ChannelData *)instanceData; 605 ConsoleInfo *info = data->info; 606 607 if (info) { 608 if (--info->refCount <= 0) { 609 /* Assuming the Tcl_Interp * fields must already be NULL */ 610 ckfree((char *) info); 611 } 612 } 613 ckfree((char *) data); 614 return 0; 615} 616 617/* 618 *---------------------------------------------------------------------- 619 * 620 * ConsoleWatch -- 621 * 622 * Called by the notifier to set up the console device so that 623 * events will be noticed. Since there are no events on the 624 * console, this routine just returns without doing anything. 625 * 626 * Results: 627 * None. 628 * 629 * Side effects: 630 * None. 631 * 632 *---------------------------------------------------------------------- 633 */ 634 635 /* ARGSUSED */ 636static void 637ConsoleWatch(instanceData, mask) 638 ClientData instanceData; /* Device ID for the channel. */ 639 int mask; /* OR-ed combination of 640 * TCL_READABLE, TCL_WRITABLE and 641 * TCL_EXCEPTION, for the events 642 * we are interested in. */ 643{ 644} 645 646/* 647 *---------------------------------------------------------------------- 648 * 649 * ConsoleHandle -- 650 * 651 * Invoked by the generic IO layer to get a handle from a channel. 652 * Because console channels are not devices, this function always 653 * fails. 654 * 655 * Results: 656 * Always returns TCL_ERROR. 657 * 658 * Side effects: 659 * None. 660 * 661 *---------------------------------------------------------------------- 662 */ 663 664 /* ARGSUSED */ 665static int 666ConsoleHandle(instanceData, direction, handlePtr) 667 ClientData instanceData; /* Device ID for the channel. */ 668 int direction; /* TCL_READABLE or TCL_WRITABLE to indicate 669 * which direction of the channel is being 670 * requested. */ 671 ClientData *handlePtr; /* Where to store handle */ 672{ 673 return TCL_ERROR; 674} 675 676/* 677 *---------------------------------------------------------------------- 678 * 679 * ConsoleObjCmd -- 680 * 681 * The console command implements a Tcl interface to the various console 682 * options. 683 * 684 * Results: 685 * A standard Tcl result. 686 * 687 * Side effects: 688 * See the user documentation. 689 * 690 *---------------------------------------------------------------------- 691 */ 692 693static int 694ConsoleObjCmd(clientData, interp, objc, objv) 695 ClientData clientData; /* Access to the console interp */ 696 Tcl_Interp *interp; /* Current interpreter */ 697 int objc; /* Number of arguments */ 698 Tcl_Obj *CONST objv[]; /* Argument objects */ 699{ 700 int index, result; 701 static CONST char *options[] = {"eval", "hide", "show", "title", NULL}; 702 enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE}; 703 Tcl_Obj *cmd = NULL; 704 ConsoleInfo *info = (ConsoleInfo *) clientData; 705 Tcl_Interp *consoleInterp = info->consoleInterp; 706 707 if (objc < 2) { 708 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); 709 return TCL_ERROR; 710 } 711 if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) 712 != TCL_OK) { 713 return TCL_ERROR; 714 } 715 716 switch ((enum option) index) { 717 case CON_EVAL: 718 if (objc != 3) { 719 Tcl_WrongNumArgs(interp, 2, objv, "script"); 720 return TCL_ERROR; 721 } 722 cmd = objv[2]; 723 break; 724 case CON_HIDE: 725 if (objc != 2) { 726 Tcl_WrongNumArgs(interp, 2, objv, NULL); 727 return TCL_ERROR; 728 } 729 cmd = Tcl_NewStringObj("wm withdraw .", -1); 730 break; 731 case CON_SHOW: 732 if (objc != 2) { 733 Tcl_WrongNumArgs(interp, 2, objv, NULL); 734 return TCL_ERROR; 735 } 736 cmd = Tcl_NewStringObj("wm deiconify .", -1); 737 break; 738 case CON_TITLE: 739 if (objc > 3) { 740 Tcl_WrongNumArgs(interp, 2, objv, "?title?"); 741 return TCL_ERROR; 742 } 743 cmd = Tcl_NewStringObj("wm title .", -1); 744 if (objc == 3) { 745 Tcl_ListObjAppendElement(NULL, cmd, objv[2]); 746 } 747 break; 748 } 749 750 Tcl_IncrRefCount(cmd); 751 if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { 752 Tcl_Preserve((ClientData) consoleInterp); 753 result = Tcl_GlobalEvalObj(consoleInterp, cmd); 754 if (result == TCL_ERROR) { 755 Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode", 756 NULL, TCL_GLOBAL_ONLY); 757 Tcl_ResetResult(interp); 758 if (objPtr) { 759 Tcl_SetObjErrorCode(interp, objPtr); 760 } 761 762 objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo", 763 NULL, TCL_GLOBAL_ONLY); 764 if (objPtr) { 765 int numBytes; 766 CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes); 767 Tcl_AddObjErrorInfo(interp, message, numBytes); 768 } 769 } 770 Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); 771 Tcl_Release((ClientData) consoleInterp); 772 } else { 773 Tcl_AppendResult(interp, "no active console interp", NULL); 774 result = TCL_ERROR; 775 } 776 Tcl_DecrRefCount(cmd); 777 return result; 778} 779 780/* 781 *---------------------------------------------------------------------- 782 * 783 * InterpreterObjCmd -- 784 * 785 * This command allows the console interp to communicate with the 786 * main interpreter. 787 * 788 * Results: 789 * A standard Tcl result. 790 * 791 *---------------------------------------------------------------------- 792 */ 793 794static int 795InterpreterObjCmd(clientData, interp, objc, objv) 796 ClientData clientData; /* Not used */ 797 Tcl_Interp *interp; /* Current interpreter */ 798 int objc; /* Number of arguments */ 799 Tcl_Obj *CONST objv[]; /* Argument objects */ 800{ 801 int index, result = TCL_OK; 802 static CONST char *options[] = {"eval", "record", NULL}; 803 enum option {OTHER_EVAL, OTHER_RECORD}; 804 ConsoleInfo *info = (ConsoleInfo *) clientData; 805 Tcl_Interp *otherInterp = info->interp; 806 807 if (objc < 2) { 808 Tcl_WrongNumArgs(interp, 1, objv, "option arg"); 809 return TCL_ERROR; 810 } 811 if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) 812 != TCL_OK) { 813 return TCL_ERROR; 814 } 815 816 if (objc != 3) { 817 Tcl_WrongNumArgs(interp, 2, objv, "script"); 818 return TCL_ERROR; 819 } 820 821 if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) { 822 Tcl_AppendResult(interp, "no active master interp", NULL); 823 return TCL_ERROR; 824 } 825 826 Tcl_Preserve((ClientData) otherInterp); 827 switch ((enum option) index) { 828 case OTHER_EVAL: 829 result = Tcl_GlobalEvalObj(otherInterp, objv[2]); 830 /* 831 * TODO: Should exceptions be filtered here? 832 */ 833 if (result == TCL_ERROR) { 834 Tcl_Obj *objPtr = Tcl_GetVar2Ex(otherInterp, "errorCode", 835 NULL, TCL_GLOBAL_ONLY); 836 Tcl_ResetResult(interp); 837 if (objPtr) { 838 Tcl_SetObjErrorCode(interp, objPtr); 839 } 840 841 objPtr = Tcl_GetVar2Ex(otherInterp, "errorInfo", 842 NULL, TCL_GLOBAL_ONLY); 843 if (objPtr) { 844 int numBytes; 845 CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes); 846 Tcl_AddObjErrorInfo(interp, message, numBytes); 847 } 848 } 849 Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp)); 850 break; 851 case OTHER_RECORD: 852 Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL); 853 /* 854 * By not setting result, we discard any exceptions or errors here 855 * and always return TCL_OK. All the caller wants is the 856 * interp result to display, whether that's result or error message. 857 */ 858 Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp)); 859 break; 860 } 861 Tcl_Release((ClientData) otherInterp); 862 return result; 863} 864 865/* 866 *---------------------------------------------------------------------- 867 * 868 * DeleteConsoleInterp -- 869 * 870 * Thread exit handler to destroy a console interp when the 871 * thread it lives in gets torn down. 872 * 873 *---------------------------------------------------------------------- 874 */ 875 876static void 877DeleteConsoleInterp(clientData) 878 ClientData clientData; 879{ 880 Tcl_Interp *interp = (Tcl_Interp *)clientData; 881 Tcl_DeleteInterp(interp); 882} 883 884/* 885 *---------------------------------------------------------------------- 886 * 887 * InterpDeleteProc -- 888 * 889 * React when the interp in which the console is displayed is deleted 890 * for any reason. 891 * 892 * Results: 893 * None. 894 */ 895 896static void 897InterpDeleteProc(clientData, interp) 898 ClientData clientData; 899 Tcl_Interp *interp; 900{ 901 ConsoleInfo *info = (ConsoleInfo *) clientData; 902 903 if(info->consoleInterp == interp) { 904 Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, 905 (ClientData) info-> consoleInterp); 906 info->consoleInterp = NULL; 907 } 908 if (--info->refCount <= 0) { 909 ckfree((char *) info); 910 } 911} 912 913/* 914 *---------------------------------------------------------------------- 915 * 916 * ConsoleDeleteProc -- 917 * 918 * If the console command is deleted we destroy the console window and 919 * all associated data structures. 920 921 * Results: 922 * None. 923 * 924 * Side effects: 925 * A new console is created. 926 * 927 *---------------------------------------------------------------------- 928 */ 929 930static void 931ConsoleDeleteProc(clientData) 932 ClientData clientData; 933{ 934 ConsoleInfo *info = (ConsoleInfo *) clientData; 935 936 if (info->consoleInterp) { 937 Tcl_DeleteInterp(info->consoleInterp); 938 } 939 if (--info->refCount <= 0) { 940 ckfree((char *) info); 941 } 942} 943 944/* 945 *---------------------------------------------------------------------- 946 * 947 * ConsoleEventProc -- 948 * 949 * This event function is registered on the main window of the slave 950 * interpreter. If the user or a running script causes the main window to 951 * be destroyed, then we need to inform the console interpreter by 952 * invoking "::tk::ConsoleExit". 953 * Results: 954 * None. 955 * 956 * Side effects: 957 * Invokes the "::tk::ConsoleExit" command in the console interp. 958 * 959 *---------------------------------------------------------------------- 960 */ 961 962static void 963ConsoleEventProc(clientData, eventPtr) 964 ClientData clientData; 965 XEvent *eventPtr; 966{ 967 if (eventPtr->type == DestroyNotify) { 968 ConsoleInfo *info = (ConsoleInfo *) clientData; 969 Tcl_Interp *consoleInterp = info->consoleInterp; 970 971 if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { 972 Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit"); 973 } 974 975 if (--info->refCount <= 0) { 976 ckfree((char *) info); 977 } 978 } 979} 980