1/* 2 * tkMain.c -- 3 * 4 * This file contains a generic main program for Tk-based applications. 5 * It can be used as-is for many applications, just by supplying a 6 * different appInitProc function for each specific application. Or, it 7 * can be used as a template for creating new main programs for Tk 8 * applications. 9 * 10 * Copyright (c) 1990-1994 The Regents of the University of California. 11 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 12 * 13 * See the file "license.terms" for information on usage and redistribution of 14 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 15 * 16 * RCS: @(#) $Id$ 17 */ 18 19#include "tclInt.h" 20#include "tkInt.h" 21#ifdef __WIN32__ 22#include "tkWinInt.h" 23#endif 24#ifdef MAC_OSX_TK 25#include "tkMacOSXInt.h" 26#endif 27 28 29typedef struct ThreadSpecificData { 30 Tcl_Interp *interp; /* Interpreter for this thread. */ 31 Tcl_DString command; /* Used to assemble lines of terminal input 32 * into Tcl commands. */ 33 Tcl_DString line; /* Used to read the next line from the 34 * terminal input. */ 35 int tty; /* Non-zero means standard input is a 36 * terminal-like device. Zero means it's a 37 * file. */ 38} ThreadSpecificData; 39static Tcl_ThreadDataKey dataKey; 40 41/* 42 * Declarations for various library functions and variables (don't want to 43 * include tkInt.h or tkPort.h here, because people might copy this file out 44 * of the Tk source directory to make their own modified versions). Note: do 45 * not declare "exit" here even though a declaration is really needed, because 46 * it will conflict with a declaration elsewhere on some systems. 47 */ 48 49#if !defined(__WIN32__) && !defined(_WIN32) 50extern int isatty(int fd); 51extern char * strrchr(CONST char *string, int c); 52#endif 53 54/* 55 * Forward declarations for functions defined later in this file. 56 */ 57 58static void Prompt(Tcl_Interp *interp, int partial); 59static void StdinProc(ClientData clientData, int mask); 60 61/* 62 *---------------------------------------------------------------------- 63 * 64 * Tk_MainEx -- 65 * 66 * Main program for Wish and most other Tk-based applications. 67 * 68 * Results: 69 * None. This function never returns (it exits the process when it's 70 * done. 71 * 72 * Side effects: 73 * This function initializes the Tk world and then starts interpreting 74 * commands; almost anything could happen, depending on the script being 75 * interpreted. 76 * 77 *---------------------------------------------------------------------- 78 */ 79 80void 81Tk_MainEx( 82 int argc, /* Number of arguments. */ 83 char **argv, /* Array of argument strings. */ 84 Tcl_AppInitProc *appInitProc, 85 /* Application-specific initialization 86 * function to call after most initialization 87 * but before starting to execute commands. */ 88 Tcl_Interp *interp) 89{ 90 Tcl_Obj *path, *argvPtr; 91 CONST char *encodingName; 92 int code, nullStdin = 0; 93 Tcl_Channel inChannel, outChannel; 94 ThreadSpecificData *tsdPtr; 95#ifdef __WIN32__ 96 HANDLE handle; 97#endif 98 Tcl_DString appName; 99 100 /* 101 * Ensure that we are getting the matching version of Tcl. This is really 102 * only an issue when Tk is loaded dynamically. 103 */ 104 105 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { 106 abort(); 107 } 108 109 tsdPtr = (ThreadSpecificData *) 110 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 111 112 Tcl_FindExecutable(argv[0]); 113 tsdPtr->interp = interp; 114 Tcl_Preserve((ClientData) interp); 115 116#if defined(__WIN32__) 117 Tk_InitConsoleChannels(interp); 118#endif 119 120#ifdef MAC_OSX_TK 121 if (Tcl_GetStartupScript(NULL) == NULL) { 122 TkMacOSXDefaultStartupScript(); 123 } 124#endif 125 126#ifdef TCL_MEM_DEBUG 127 Tcl_InitMemory(interp); 128#endif 129 130 /* 131 * If the application has not already set a startup script, parse the 132 * first few command line arguments to determine the script path and 133 * encoding. 134 */ 135 136 if (NULL == Tcl_GetStartupScript(NULL)) { 137 size_t length; 138 139 /* 140 * Check whether first 3 args (argv[1] - argv[3]) look like 141 * -encoding ENCODING FILENAME 142 * or like 143 * FILENAME 144 * or like 145 * -file FILENAME (ancient history support only) 146 */ 147 148 if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) 149 && ('-' != argv[3][0])) { 150 Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); 151 argc -= 3; 152 argv += 3; 153 } else if ((argc > 1) && ('-' != argv[1][0])) { 154 Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); 155 argc--; 156 argv++; 157 } else if ((argc > 2) && (length = strlen(argv[1])) 158 && (length > 1) && (0 == strncmp("-file", argv[1], length)) 159 && ('-' != argv[2][0])) { 160 Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL); 161 argc -= 2; 162 argv += 2; 163 } 164 } 165 166 path = Tcl_GetStartupScript(&encodingName); 167 if (NULL == path) { 168 Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); 169 } else { 170 int numBytes; 171 CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes); 172 173 Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &appName); 174 path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); 175 Tcl_SetStartupScript(path, encodingName); 176 } 177 Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); 178 Tcl_DStringFree(&appName); 179 argc--; 180 argv++; 181 182 Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); 183 184 argvPtr = Tcl_NewListObj(0, NULL); 185 while (argc--) { 186 Tcl_DString ds; 187 188 Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); 189 Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( 190 Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); 191 Tcl_DStringFree(&ds); 192 } 193 Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); 194 195 /* 196 * Set the "tcl_interactive" variable. 197 */ 198 199#ifdef __WIN32__ 200 /* 201 * For now, under Windows, we assume we are not running as a console mode 202 * app, so we need to use the GUI console. In order to enable this, we 203 * always claim to be running on a tty. This probably isn't the right way 204 * to do it. 205 */ 206 207 handle = GetStdHandle(STD_INPUT_HANDLE); 208 209 if ((handle == INVALID_HANDLE_VALUE) || (handle == 0) 210 || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) { 211 /* 212 * If it's a bad or closed handle, then it's been connected to a wish 213 * console window. 214 */ 215 216 tsdPtr->tty = 1; 217 } else if (GetFileType(handle) == FILE_TYPE_CHAR) { 218 /* 219 * A character file handle is a tty by definition. 220 */ 221 222 tsdPtr->tty = 1; 223 } else { 224 tsdPtr->tty = 0; 225 } 226 227#else 228 tsdPtr->tty = isatty(0); 229#endif 230#if defined(MAC_OSX_TK) 231 /* 232 * On TkAqua, if we don't have a TTY and stdin is a special character file 233 * of length 0, (e.g. /dev/null, which is what Finder sets when double 234 * clicking Wish) then use the GUI console. 235 */ 236 237 if (!tsdPtr->tty) { 238 struct stat st; 239 240 nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks); 241 } 242#endif 243 Tcl_SetVar(interp, "tcl_interactive", 244 ((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0", 245 TCL_GLOBAL_ONLY); 246 247 /* 248 * Invoke application-specific initialization. 249 */ 250 251 if ((*appInitProc)(interp) != TCL_OK) { 252 TkpDisplayWarning(Tcl_GetStringResult(interp), 253 "Application initialization failed"); 254 } 255 256 /* 257 * Invoke the script specified on the command line, if any. Must fetch it 258 * again, as the appInitProc might have reset it. 259 */ 260 261 path = Tcl_GetStartupScript(&encodingName); 262 if (path != NULL) { 263 Tcl_ResetResult(interp); 264 code = Tcl_FSEvalFileEx(interp, path, encodingName); 265 if (code != TCL_OK) { 266 /* 267 * The following statement guarantees that the errorInfo variable 268 * is set properly. 269 */ 270 271 Tcl_AddErrorInfo(interp, ""); 272 TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo", 273 TCL_GLOBAL_ONLY), "Error in startup script"); 274 Tcl_DeleteInterp(interp); 275 Tcl_Exit(1); 276 } 277 tsdPtr->tty = 0; 278 } else { 279 280 /* 281 * Evaluate the .rc file, if one has been specified. 282 */ 283 284 Tcl_SourceRCFile(interp); 285 286 /* 287 * Establish a channel handler for stdin. 288 */ 289 290 inChannel = Tcl_GetStdChannel(TCL_STDIN); 291 if (inChannel) { 292 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, 293 (ClientData) inChannel); 294 } 295 if (tsdPtr->tty) { 296 Prompt(interp, 0); 297 } 298 } 299 300 outChannel = Tcl_GetStdChannel(TCL_STDOUT); 301 if (outChannel) { 302 Tcl_Flush(outChannel); 303 } 304 Tcl_DStringInit(&tsdPtr->command); 305 Tcl_DStringInit(&tsdPtr->line); 306 Tcl_ResetResult(interp); 307 308 /* 309 * Loop infinitely, waiting for commands to execute. When there are no 310 * windows left, Tk_MainLoop returns and we exit. 311 */ 312 313 Tk_MainLoop(); 314 Tcl_DeleteInterp(interp); 315 Tcl_Release((ClientData) interp); 316 Tcl_SetStartupScript(NULL, NULL); 317 Tcl_Exit(0); 318} 319 320/* 321 *---------------------------------------------------------------------- 322 * 323 * StdinProc -- 324 * 325 * This function is invoked by the event dispatcher whenever standard 326 * input becomes readable. It grabs the next line of input characters, 327 * adds them to a command being assembled, and executes the command if 328 * it's complete. 329 * 330 * Results: 331 * None. 332 * 333 * Side effects: 334 * Could be almost arbitrary, depending on the command that's typed. 335 * 336 *---------------------------------------------------------------------- 337 */ 338 339 /* ARGSUSED */ 340static void 341StdinProc( 342 ClientData clientData, /* Not used. */ 343 int mask) /* Not used. */ 344{ 345 static int gotPartial = 0; 346 char *cmd; 347 int code, count; 348 Tcl_Channel chan = (Tcl_Channel) clientData; 349 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 350 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 351 Tcl_Interp *interp = tsdPtr->interp; 352 353 count = Tcl_Gets(chan, &tsdPtr->line); 354 355 if (count < 0 && !gotPartial) { 356 if (tsdPtr->tty) { 357 Tcl_Exit(0); 358 } else { 359 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); 360 } 361 return; 362 } 363 364 (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( 365 &tsdPtr->line), -1); 366 cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); 367 Tcl_DStringFree(&tsdPtr->line); 368 if (!Tcl_CommandComplete(cmd)) { 369 gotPartial = 1; 370 goto prompt; 371 } 372 gotPartial = 0; 373 374 /* 375 * Disable the stdin channel handler while evaluating the command; 376 * otherwise if the command re-enters the event loop we might process 377 * commands from stdin before the current command is finished. Among other 378 * things, this will trash the text of the command being evaluated. 379 */ 380 381 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); 382 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); 383 384 chan = Tcl_GetStdChannel(TCL_STDIN); 385 if (chan) { 386 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, 387 (ClientData) chan); 388 } 389 Tcl_DStringFree(&tsdPtr->command); 390 if (Tcl_GetStringResult(interp)[0] != '\0') { 391 if ((code != TCL_OK) || (tsdPtr->tty)) { 392 chan = Tcl_GetStdChannel(TCL_STDOUT); 393 if (chan) { 394 Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); 395 Tcl_WriteChars(chan, "\n", 1); 396 } 397 } 398 } 399 400 /* 401 * Output a prompt. 402 */ 403 404 prompt: 405 if (tsdPtr->tty) { 406 Prompt(interp, gotPartial); 407 } 408 Tcl_ResetResult(interp); 409} 410 411/* 412 *---------------------------------------------------------------------- 413 * 414 * Prompt -- 415 * 416 * Issue a prompt on standard output, or invoke a script to issue the 417 * prompt. 418 * 419 * Results: 420 * None. 421 * 422 * Side effects: 423 * A prompt gets output, and a Tcl script may be evaluated in interp. 424 * 425 *---------------------------------------------------------------------- 426 */ 427 428static void 429Prompt( 430 Tcl_Interp *interp, /* Interpreter to use for prompting. */ 431 int partial) /* Non-zero means there already exists a 432 * partial command, so use the secondary 433 * prompt. */ 434{ 435 Tcl_Obj *promptCmd; 436 int code; 437 Tcl_Channel outChannel, errChannel; 438 439 promptCmd = Tcl_GetVar2Ex(interp, 440 partial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY); 441 if (promptCmd == NULL) { 442 defaultPrompt: 443 if (!partial) { 444 /* 445 * We must check that outChannel is a real channel - it is 446 * possible that someone has transferred stdout out of this 447 * interpreter with "interp transfer". 448 */ 449 450 outChannel = Tcl_GetChannel(interp, "stdout", NULL); 451 if (outChannel != (Tcl_Channel) NULL) { 452 Tcl_WriteChars(outChannel, "% ", 2); 453 } 454 } 455 } else { 456 code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL); 457 if (code != TCL_OK) { 458 Tcl_AddErrorInfo(interp, 459 "\n (script that generates prompt)"); 460 461 /* 462 * We must check that errChannel is a real channel - it is 463 * possible that someone has transferred stderr out of this 464 * interpreter with "interp transfer". 465 */ 466 467 errChannel = Tcl_GetChannel(interp, "stderr", NULL); 468 if (errChannel != (Tcl_Channel) NULL) { 469 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 470 Tcl_WriteChars(errChannel, "\n", 1); 471 } 472 goto defaultPrompt; 473 } 474 } 475 outChannel = Tcl_GetChannel(interp, "stdout", NULL); 476 if (outChannel != (Tcl_Channel) NULL) { 477 Tcl_Flush(outChannel); 478 } 479} 480 481/* 482 * Local Variables: 483 * mode: c 484 * c-basic-offset: 4 485 * fill-column: 78 486 * End: 487 */ 488