summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2011-03-17 16:12:15 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2011-03-17 16:12:15 (GMT)
commitefac6ea792b9082ca65d083e4364b6f7fa7fddda (patch)
tree653e2ae70d56ce20eb304ce4743efcf2db328daf /generic
parent47ac20ba07df34632f15eb72eadfa99745d2e87a (diff)
downloadtcl-efac6ea792b9082ca65d083e4364b6f7fa7fddda.zip
tcl-efac6ea792b9082ca65d083e4364b6f7fa7fddda.tar.gz
tcl-efac6ea792b9082ca65d083e4364b6f7fa7fddda.tar.bz2
[Patch #3124683]: platform specific stuff in (tcl|tk)Main.c
Diffstat (limited to 'generic')
-rw-r--r--generic/tclMain.c285
1 files changed, 130 insertions, 155 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 1b3b091..26383b5 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -2,6 +2,11 @@
* tclMain.c --
*
* Main program for Tcl shells and other Tcl-based applications.
+ * This file contains a generic main program for Tcl shells and other
+ * Tcl-based applications. It can be used as-is for many applications,
+ * just by supplying a different appInitProc function for each specific
+ * application. Or, it can be used as a template for creating new main
+ * programs for Tcl applications.
*
* Copyright (c) 1988-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -45,23 +50,24 @@
# define TCHAR char
# define TEXT(arg) arg
# define _tcscmp strcmp
-# define _tcslen strlen
-# define _tcsncmp strncmp
#endif
/*
- * Further on, in UNICODE mode, we need to use functions like
- * Tcl_GetUnicodeFromObj, while otherwise Tcl_GetStringFromObj
- * is needed. Those macro's assure that the right functions
- * are used depending on the mode.
+ * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
+ * while otherwise NewNativeObj is needed (which provides proper
+ * conversion from native encoding to UTF-8).
*/
-#ifndef UNICODE
-# undef Tcl_GetUnicodeFromObj
-# define Tcl_GetUnicodeFromObj Tcl_GetStringFromObj
-# undef Tcl_NewUnicodeObj
-# define Tcl_NewUnicodeObj Tcl_NewStringObj
-# undef Tcl_WinTCharToUtf
-# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+#ifdef UNICODE
+# define NewNativeObj Tcl_NewUnicodeObj
+#else /* !UNICODE */
+ static Tcl_Obj *NewNativeObj(char *string, int length) {
+ Tcl_Obj *obj;
+ Tcl_DString ds;
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return obj;
+}
#endif /* !UNICODE */
/*
@@ -117,7 +123,7 @@ typedef struct InteractiveState {
*/
MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
-static void Prompt(Tcl_Interp *interp, PromptType *promptPtr);
+static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
static void StdinProc(ClientData clientData, int mask);
#ifndef TCL_ASCII_MAIN
@@ -229,7 +235,7 @@ Tcl_SourceRCFile(
{
Tcl_DString temp;
const char *fileName;
- Tcl_Channel errChannel;
+ Tcl_Channel chan;
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
@@ -253,10 +259,10 @@ Tcl_SourceRCFile(
if (c != NULL) {
Tcl_Close(NULL, c);
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
}
}
@@ -294,16 +300,19 @@ Tcl_MainEx(
* but before starting to execute commands. */
Tcl_Interp *interp)
{
- Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
+ Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
const char *encodingName = NULL;
- PromptType prompt = PROMPT_START;
- int code, length, tty, exitCode = 0;
+ int code, exitCode = 0;
Tcl_MainLoopProc *mainLoopProc;
- Tcl_Channel inChannel, outChannel, errChannel;
- Tcl_DString appName;
+ Tcl_Channel chan;
+ InteractiveState is;
Tcl_InitMemory(interp);
+ is.interp = interp;
+ is.prompt = PROMPT_START;
+ is.commandPtr = Tcl_NewObj();
+
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
@@ -320,13 +329,13 @@ Tcl_MainEx(
if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
&& (TEXT('-') != argv[3][0])) {
- Tcl_Obj *value = Tcl_NewUnicodeObj(argv[2], -1);
- Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[3], -1), Tcl_GetString(value));
+ Tcl_Obj *value = NewNativeObj(argv[2], -1);
+ Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value));
Tcl_DecrRefCount(value);
argc -= 3;
argv += 3;
} else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
- Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[1], -1), NULL);
+ Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
argc--;
argv++;
}
@@ -334,16 +343,11 @@ Tcl_MainEx(
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
- Tcl_WinTCharToUtf(argv[0], -1, &appName);
+ appName = NewNativeObj(argv[0], -1);
} else {
- const TCHAR *pathName = Tcl_GetUnicodeFromObj(path, &length);
-
- Tcl_WinTCharToUtf(pathName, length * sizeof(TCHAR), &appName);
- path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
- Tcl_SetStartupScript(path, encodingName);
+ appName = path;
}
- Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
- Tcl_DStringFree(&appName);
+ Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
@@ -351,12 +355,7 @@ Tcl_MainEx(
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
- Tcl_DString ds;
-
- Tcl_WinTCharToUtf(*argv++, -1, &ds);
- Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
- Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
- Tcl_DStringFree(&ds);
+ Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
@@ -364,9 +363,9 @@ Tcl_MainEx(
* Set the "tcl_interactive" variable.
*/
- tty = isatty(0);
- Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
- TCL_GLOBAL_ONLY);
+ is.tty = isatty(0);
+ Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
+ Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
@@ -374,12 +373,12 @@ Tcl_MainEx(
Tcl_Preserve(interp);
if (appInitProc(interp) != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
- Tcl_WriteChars(errChannel,
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteChars(chan,
"application-specific initialization failed: ", -1);
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
}
if (Tcl_InterpDeleted(interp)) {
@@ -390,16 +389,17 @@ Tcl_MainEx(
}
/*
- * If a script file was specified then just source that file and quit.
- * 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);
if (path != NULL) {
+ Tcl_ResetResult(interp);
code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
Tcl_Obj *keyPtr, *valuePtr;
@@ -409,9 +409,9 @@ Tcl_MainEx(
Tcl_DecrRefCount(keyPtr);
if (valuePtr) {
- Tcl_WriteObj(errChannel, valuePtr);
+ Tcl_WriteObj(chan, valuePtr);
}
- Tcl_WriteChars(errChannel, "\n", 1);
+ Tcl_WriteChars(chan, "\n", 1);
Tcl_DecrRefCount(options);
}
exitCode = 1;
@@ -435,40 +435,39 @@ Tcl_MainEx(
* may have been changed.
*/
- commandPtr = Tcl_NewObj();
- Tcl_IncrRefCount(commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
/*
* Get a new value for tty if anyone writes to ::tcl_interactive
*/
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) {
+ Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
mainLoopProc = TclGetMainLoop();
if (mainLoopProc == NULL) {
- if (tty) {
- Prompt(interp, &prompt);
+ int length;
+ if (is.tty) {
+ Prompt(interp, &is);
if (Tcl_InterpDeleted(interp)) {
break;
}
if (Tcl_LimitExceeded(interp)) {
break;
}
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- if (inChannel == NULL) {
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ if (is.input == NULL) {
break;
}
}
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
+ if (Tcl_IsShared(is.commandPtr)) {
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
}
- length = Tcl_GetsObj(inChannel, commandPtr);
+ length = Tcl_GetsObj(is.input, is.commandPtr);
if (length < 0) {
- if (Tcl_InputBlocked(inChannel)) {
+ if (Tcl_InputBlocked(is.input)) {
/*
* This can only happen if stdin has been set to
* non-blocking. In that case cycle back and try again.
@@ -493,45 +492,45 @@ Tcl_MainEx(
* a difference. [Bug 1775878]
*/
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
+ if (Tcl_IsShared(is.commandPtr)) {
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
}
- Tcl_AppendToObj(commandPtr, "\n", 1);
- if (!TclObjCommandComplete(commandPtr)) {
- prompt = PROMPT_CONTINUE;
+ Tcl_AppendToObj(is.commandPtr, "\n", 1);
+ if (!TclObjCommandComplete(is.commandPtr)) {
+ is.prompt = PROMPT_CONTINUE;
continue;
}
- prompt = PROMPT_START;
+ is.prompt = PROMPT_START;
/*
* The final newline is syntactically redundant, and causes some
* error messages troubles deeper in, so lop it back off.
*/
- Tcl_GetStringFromObj(commandPtr, &length);
- Tcl_SetObjLength(commandPtr, --length);
- code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_NewObj();
- Tcl_IncrRefCount(commandPtr);
+ Tcl_GetStringFromObj(is.commandPtr, &length);
+ Tcl_SetObjLength(is.commandPtr, --length);
+ code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(is.commandPtr);
if (code != TCL_OK) {
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
- } else if (tty) {
+ } else if (is.tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
Tcl_GetStringFromObj(resultPtr, &length);
- if ((length > 0) && outChannel) {
- Tcl_WriteObj(outChannel, resultPtr);
- Tcl_WriteChars(outChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if ((length > 0) && chan) {
+ Tcl_WriteObj(chan, resultPtr);
+ Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
@@ -542,45 +541,21 @@ Tcl_MainEx(
* channel handler for stdin.
*/
- InteractiveState *isPtr = NULL;
-
- if (inChannel) {
- if (tty) {
- Prompt(interp, &prompt);
+ if (is.input) {
+ if (is.tty) {
+ Prompt(interp, &is);
}
- isPtr = ckalloc(sizeof(InteractiveState));
- isPtr->input = inChannel;
- isPtr->tty = tty;
- isPtr->commandPtr = commandPtr;
- isPtr->prompt = prompt;
- isPtr->interp = interp;
-
- Tcl_UnlinkVar(interp, "tcl_interactive");
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &isPtr->tty,
- TCL_LINK_BOOLEAN);
-
- Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
- isPtr);
+
+ Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
}
mainLoopProc();
Tcl_SetMainLoop(NULL);
- if (inChannel) {
- tty = isPtr->tty;
- Tcl_UnlinkVar(interp, "tcl_interactive");
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
- TCL_LINK_BOOLEAN);
- prompt = isPtr->prompt;
- commandPtr = isPtr->commandPtr;
- if (isPtr->input != NULL) {
- Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr);
- }
- ckfree(isPtr);
+ if (is.input) {
+ Tcl_DeleteChannelHandler(is.input, StdinProc, &is);
}
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
}
#ifdef TCL_MEM_DEBUG
@@ -609,8 +584,8 @@ Tcl_MainEx(
mainLoopProc();
Tcl_SetMainLoop(NULL);
}
- if (commandPtr != NULL) {
- Tcl_DecrRefCount(commandPtr);
+ if (is.commandPtr != NULL) {
+ Tcl_DecrRefCount(is.commandPtr);
}
/*
@@ -746,11 +721,11 @@ StdinProc(
ClientData clientData, /* The state of interactive cmd line */
int mask) /* Not used. */
{
+ int code, length;
InteractiveState *isPtr = clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Obj *commandPtr = isPtr->commandPtr;
Tcl_Interp *interp = isPtr->interp;
- int code, length;
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
@@ -806,21 +781,21 @@ StdinProc(
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
}
if (code != TCL_OK) {
- Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel != NULL) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ if (chan != NULL) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
} else if (isPtr->tty) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
- Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
Tcl_GetStringFromObj(resultPtr, &length);
- if ((length >0) && (outChannel != NULL)) {
- Tcl_WriteObj(outChannel, resultPtr);
- Tcl_WriteChars(outChannel, "\n", 1);
+ if ((length > 0) && (chan != NULL)) {
+ Tcl_WriteObj(chan, resultPtr);
+ Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
@@ -831,7 +806,7 @@ StdinProc(
prompt:
if (isPtr->tty && (isPtr->input != NULL)) {
- Prompt(interp, &isPtr->prompt);
+ Prompt(interp, isPtr);
isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
}
}
@@ -856,20 +831,20 @@ StdinProc(
static void
Prompt(
Tcl_Interp *interp, /* Interpreter to use for prompting. */
- PromptType *promptPtr) /* Points to type of prompt to print. Filled
+ InteractiveState *isPtr) /* InteractiveState. Filled
* with PROMPT_NONE after a prompt is
* printed. */
{
Tcl_Obj *promptCmdPtr;
int code;
- Tcl_Channel outChannel, errChannel;
+ Tcl_Channel chan;
- if (*promptPtr == PROMPT_NONE) {
+ if (isPtr->prompt == PROMPT_NONE) {
return;
}
promptCmdPtr = Tcl_GetVar2Ex(interp,
- ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+ ((isPtr->prompt == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (Tcl_InterpDeleted(interp)) {
@@ -877,10 +852,10 @@ Prompt(
}
if (promptCmdPtr == NULL) {
defaultPrompt:
- if (*promptPtr == PROMPT_START) {
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if (outChannel != NULL) {
- Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT,
+ if (isPtr->prompt == PROMPT_START) {
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
strlen(DEFAULT_PRIMARY_PROMPT));
}
}
@@ -889,20 +864,20 @@ Prompt(
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel != NULL) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan != NULL) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
goto defaultPrompt;
}
}
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if (outChannel != NULL) {
- Tcl_Flush(outChannel);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_Flush(chan);
}
- *promptPtr = PROMPT_NONE;
+ isPtr->prompt = PROMPT_NONE;
}
/*