diff options
Diffstat (limited to 'generic/tkMain.c')
| -rw-r--r-- | generic/tkMain.c | 255 |
1 files changed, 130 insertions, 125 deletions
diff --git a/generic/tkMain.c b/generic/tkMain.c index 1ca6370..9def321 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -1,19 +1,19 @@ -/* +/* * tkMain.c -- * * This file contains a generic main program for Tk-based applications. * It can be used as-is for many applications, just by supplying a - * different appInitProc procedure for each specific application. - * Or, it can be used as a template for creating new main programs - * for Tk applications. + * different appInitProc function for each specific application. Or, it + * can be used as a template for creating new main programs for Tk + * applications. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMain.c,v 1.19 2005/10/18 14:51:58 dgp Exp $ + * RCS: @(#) $Id: tkMain.c,v 1.20 2005/12/12 22:33:27 dkf Exp $ */ #include <ctype.h> @@ -37,38 +37,36 @@ typedef struct ThreadSpecificData { - Tcl_Interp *interp; /* Interpreter for this thread. */ - Tcl_DString command; /* Used to assemble lines of terminal input + Tcl_Interp *interp; /* Interpreter for this thread. */ + Tcl_DString command; /* Used to assemble lines of terminal input * into Tcl commands. */ - Tcl_DString line; /* Used to read the next line from the + Tcl_DString line; /* Used to read the next line from the * terminal input. */ - int tty; /* Non-zero means standard input is a - * terminal-like device. Zero means it's - * a file. */ + int tty; /* Non-zero means standard input is a + * terminal-like device. Zero means it's a + * file. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* - * Declarations for various library procedures and variables (don't want - * to include tkInt.h or tkPort.h here, because people might copy this - * file out of the Tk source directory to make their own modified versions). - * Note: don't declare "exit" here even though a declaration is really - * needed, because it will conflict with a declaration elsewhere on - * some systems. + * Declarations for various library functions and variables (don't want to + * include tkInt.h or tkPort.h here, because people might copy this file out + * of the Tk source directory to make their own modified versions). Note: do + * not declare "exit" here even though a declaration is really needed, because + * it will conflict with a declaration elsewhere on some systems. */ #if !defined(__WIN32__) && !defined(_WIN32) -extern int isatty _ANSI_ARGS_((int fd)); -extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); +extern int isatty(int fd); +extern char * strrchr(CONST char *string, int c); #endif /* - * Forward declarations for procedures defined later in this file. + * Forward declarations for functions defined later in this file. */ -static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial)); -static void StdinProc _ANSI_ARGS_((ClientData clientData, - int mask)); +static void Prompt(Tcl_Interp *interp, int partial); +static void StdinProc(ClientData clientData, int mask); /* *---------------------------------------------------------------------- @@ -78,25 +76,26 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData, * Main program for Wish and most other Tk-based applications. * * Results: - * None. This procedure never returns (it exits the process when - * it's done. + * None. This function never returns (it exits the process when it's + * done. * * Side effects: - * This procedure initializes the Tk world and then starts - * interpreting commands; almost anything could happen, depending - * on the script being interpreted. + * This function initializes the Tk world and then starts interpreting + * commands; almost anything could happen, depending on the script being + * interpreted. * *---------------------------------------------------------------------- */ + void -Tk_MainEx(argc, argv, appInitProc, interp) - int argc; /* Number of arguments. */ - char **argv; /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc; /* Application-specific initialization - * procedure to call after most - * initialization but before starting - * to execute commands. */ - Tcl_Interp *interp; +Tk_MainEx( + int argc, /* Number of arguments. */ + char **argv, /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc, + /* Application-specific initialization + * function to call after most initialization + * but before starting to execute commands. */ + Tcl_Interp *interp) { Tcl_Obj *path, *argvPtr; CONST char *encodingName; @@ -109,17 +108,17 @@ Tk_MainEx(argc, argv, appInitProc, interp) Tcl_DString appName; /* - * Ensure that we are getting the matching version of Tcl. This is - * really only an issue when Tk is loaded dynamically. + * Ensure that we are getting the matching version of Tcl. This is really + * only an issue when Tk is loaded dynamically. */ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { abort(); } - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - + tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_FindExecutable(argv[0]); tsdPtr->interp = interp; @@ -129,24 +128,25 @@ Tk_MainEx(argc, argv, appInitProc, interp) #ifdef MAC_OSX_TK if (Tcl_GetStartupScript(NULL) == NULL) { - TkMacOSXDefaultStartupScript(); + TkMacOSXDefaultStartupScript(); } #endif - + #ifdef TCL_MEM_DEBUG Tcl_InitMemory(interp); #endif /* - * If the application has not already set a startup script, parse - * the first few command line arguments to determine the script - * path and encoding. + * If the application has not already set a startup script, parse the + * first few command line arguments to determine the script path and + * encoding. */ if (NULL == Tcl_GetStartupScript(NULL)) { size_t length; - /* Check whether first 3 args (argv[1] - argv[3]) look like + /* + * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME @@ -177,10 +177,11 @@ Tk_MainEx(argc, argv, appInitProc, interp) Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); } else { int numBytes; - CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes); - Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &appName); - path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); - Tcl_SetStartupScript(path, encodingName); + CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes); + + Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &appName); + path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); + Tcl_SetStartupScript(path, encodingName); } Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); Tcl_DStringFree(&appName); @@ -192,32 +193,33 @@ Tk_MainEx(argc, argv, appInitProc, interp) argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { Tcl_DString ds; + Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); - + /* * Set the "tcl_interactive" variable. */ /* * For now, under Windows, we assume we are not running as a console mode - * app, so we need to use the GUI console. In order to enable this, we - * always claim to be running on a tty. This probably isn't the right - * way to do it. + * app, so we need to use the GUI console. In order to enable this, we + * always claim to be running on a tty. This probably isn't the right way + * to do it. */ #ifdef __WIN32__ handle = GetStdHandle(STD_INPUT_HANDLE); - if ((handle == INVALID_HANDLE_VALUE) || (handle == 0) + if ((handle == INVALID_HANDLE_VALUE) || (handle == 0) || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) { /* - * If it's a bad or closed handle, then it's been connected - * to a wish console window. + * If it's a bad or closed handle, then it's been connected to a wish + * console window. */ tsdPtr->tty = 1; @@ -247,8 +249,8 @@ Tk_MainEx(argc, argv, appInitProc, interp) } /* - * Invoke the script specified on the command line, if any. - * Must fetch it again, as the appInitProc might have reset it. + * Invoke the script specified on the command line, if any. Must fetch it + * again, as the appInitProc might have reset it. */ path = Tcl_GetStartupScript(&encodingName); @@ -257,8 +259,8 @@ Tk_MainEx(argc, argv, appInitProc, interp) code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { /* - * The following statement guarantees that the errorInfo - * variable is set properly. + * The following statement guarantees that the errorInfo variable + * is set properly. */ Tcl_AddErrorInfo(interp, ""); @@ -299,8 +301,8 @@ Tk_MainEx(argc, argv, appInitProc, interp) Tcl_ResetResult(interp); /* - * Loop infinitely, waiting for commands to execute. When there - * are no windows left, Tk_MainLoop returns and we exit. + * Loop infinitely, waiting for commands to execute. When there are no + * windows left, Tk_MainLoop returns and we exit. */ Tk_MainLoop(); @@ -314,69 +316,65 @@ Tk_MainEx(argc, argv, appInitProc, interp) * * StdinProc -- * - * This procedure is invoked by the event dispatcher whenever - * standard input becomes readable. It grabs the next line of - * input characters, adds them to a command being assembled, and - * executes the command if it's complete. + * This function is invoked by the event dispatcher whenever standard + * input becomes readable. It grabs the next line of input characters, + * adds them to a command being assembled, and executes the command if + * it's complete. * * Results: * None. * * Side effects: - * Could be almost arbitrary, depending on the command that's - * typed. + * Could be almost arbitrary, depending on the command that's typed. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void -StdinProc(clientData, mask) - ClientData clientData; /* Not used. */ - int mask; /* Not used. */ +StdinProc( + ClientData clientData, /* Not used. */ + int mask) /* Not used. */ { static int gotPartial = 0; char *cmd; int code, count; Tcl_Channel chan = (Tcl_Channel) clientData; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Interp *interp = tsdPtr->interp; count = Tcl_Gets(chan, &tsdPtr->line); - if (count < 0) { - if (!gotPartial) { - if (tsdPtr->tty) { - Tcl_Exit(0); - } else { - Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); - } - return; - } + if (count < 0 && !gotPartial) { + if (tsdPtr->tty) { + Tcl_Exit(0); + } else { + Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); + } + return; } (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( - &tsdPtr->line), -1); + &tsdPtr->line), -1); cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); Tcl_DStringFree(&tsdPtr->line); if (!Tcl_CommandComplete(cmd)) { - gotPartial = 1; - goto prompt; + gotPartial = 1; + goto prompt; } gotPartial = 0; /* * Disable the stdin channel handler while evaluating the command; - * otherwise if the command re-enters the event loop we might - * process commands from stdin before the current command is - * finished. Among other things, this will trash the text of the - * command being evaluated. + * otherwise if the command re-enters the event loop we might process + * commands from stdin before the current command is finished. Among other + * things, this will trash the text of the command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); - + chan = Tcl_GetStdChannel(TCL_STDIN); if (chan) { Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, @@ -397,7 +395,7 @@ StdinProc(clientData, mask) * Output a prompt. */ - prompt: + prompt: if (tsdPtr->tty) { Prompt(interp, gotPartial); } @@ -409,25 +407,24 @@ StdinProc(clientData, mask) * * Prompt -- * - * Issue a prompt on standard output, or invoke a script - * to issue the prompt. + * Issue a prompt on standard output, or invoke a script to issue the + * prompt. * * Results: * None. * * Side effects: - * A prompt gets output, and a Tcl script may be evaluated - * in interp. + * A prompt gets output, and a Tcl script may be evaluated in interp. * *---------------------------------------------------------------------- */ static void -Prompt(interp, partial) - Tcl_Interp *interp; /* Interpreter to use for prompting. */ - int partial; /* Non-zero means there already - * exists a partial command, so use - * the secondary prompt. */ +Prompt( + Tcl_Interp *interp, /* Interpreter to use for prompting. */ + int partial) /* Non-zero means there already exists a + * partial command, so use the secondary + * prompt. */ { Tcl_Obj *promptCmd; int code; @@ -436,41 +433,49 @@ Prompt(interp, partial) promptCmd = Tcl_GetVar2Ex(interp, partial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY); if (promptCmd == NULL) { -defaultPrompt: + defaultPrompt: if (!partial) { - - /* - * We must check that outChannel is a real channel - it - * is possible that someone has transferred stdout out of - * this interpreter with "interp transfer". - */ + /* + * We must check that outChannel is a real channel - it is + * possible that someone has transferred stdout out of this + * interpreter with "interp transfer". + */ outChannel = Tcl_GetChannel(interp, "stdout", NULL); - if (outChannel != (Tcl_Channel) NULL) { - Tcl_WriteChars(outChannel, "% ", 2); - } + if (outChannel != (Tcl_Channel) NULL) { + Tcl_WriteChars(outChannel, "% ", 2); + } } } else { code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); - /* - * We must check that errChannel is a real channel - it - * is possible that someone has transferred stderr out of - * this interpreter with "interp transfer". - */ - + + /* + * We must check that errChannel is a real channel - it is + * possible that someone has transferred stderr out of this + * interpreter with "interp transfer". + */ + errChannel = Tcl_GetChannel(interp, "stderr", NULL); - if (errChannel != (Tcl_Channel) NULL) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); - } + if (errChannel != (Tcl_Channel) NULL) { + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); + Tcl_WriteChars(errChannel, "\n", 1); + } goto defaultPrompt; } } outChannel = Tcl_GetChannel(interp, "stdout", NULL); if (outChannel != (Tcl_Channel) NULL) { - Tcl_Flush(outChannel); + Tcl_Flush(outChannel); } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |