diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 5 | ||||
| -rw-r--r-- | generic/tclInt.decls | 43 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 81 | ||||
| -rw-r--r-- | generic/tclMain.c | 147 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 14 |
5 files changed, 83 insertions, 207 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 7ff25c7..844dbcb 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.281 2008/12/11 01:21:52 dkf Exp $ + * RCS: @(#) $Id: tcl.h,v 1.282 2008/12/15 15:48:33 dgp Exp $ */ #ifndef _TCL @@ -2339,6 +2339,9 @@ EXTERN const char * TclTomMathInitializeStubs (Tcl_Interp *interp, EXTERN void Tcl_Main (int argc, char **argv, Tcl_AppInitProc *appInitProc); +EXTERN void Tcl_SetStartupScript(Tcl_Obj *path, + const char *encoding); +EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr); EXTERN const char * Tcl_PkgInitStubsCheck (Tcl_Interp *interp, const char *version, int exact); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index bdc71ad..54f8948 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.131 2008/12/09 21:47:08 nijtmans Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.132 2008/12/15 15:48:33 dgp Exp $ library tcl @@ -624,12 +624,14 @@ declare 156 generic { declare 157 generic { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -declare 158 generic { - void TclSetStartupScriptFileName(const char *filename) -} -declare 159 generic { - CONST84_RETURN char *TclGetStartupScriptFileName(void) -} +# REMOVED - use public Tcl_SetStartupPath() +#declare 158 generic { +# void TclSetStartupScriptFileName(const char *filename) +#} +# REMOVED - use public Tcl_GetStartupPath() +#declare 159 generic { +# CONST84_RETURN char *TclGetStartupScriptFileName(void) +#} #declare 160 generic { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, @@ -674,12 +676,14 @@ declare 166 generic { } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) -declare 167 generic { - void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -} -declare 168 generic { - Tcl_Obj *TclGetStartupScriptPath(void) -} +# REMOVED - use public Tcl_SetStartupPath() +#declare 167 generic { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +# REMOVED - use public Tcl_GetStartupPath() +#declare 168 generic { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 generic { int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) @@ -725,12 +729,13 @@ declare 177 generic { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -declare 178 generic { - void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char* encodingName) -} -declare 179 generic { - Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) -} +# TIP 338 made these public - now declared in tcl.h +#declare 178 generic { +# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char* encodingName) +#} +#declare 179 generic { +# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) +#} # REMOVED # Allocate lists without copying arrays diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index b2f45b1..6367064 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.127 2008/12/09 21:47:08 nijtmans Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.128 2008/12/15 15:48:33 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -741,16 +741,8 @@ EXTERN void TclRegError (Tcl_Interp * interp, const char * msg, EXTERN Var * TclVarTraceExists (Tcl_Interp * interp, const char * varName); #endif -#ifndef TclSetStartupScriptFileName_TCL_DECLARED -#define TclSetStartupScriptFileName_TCL_DECLARED -/* 158 */ -EXTERN void TclSetStartupScriptFileName (const char * filename); -#endif -#ifndef TclGetStartupScriptFileName_TCL_DECLARED -#define TclGetStartupScriptFileName_TCL_DECLARED -/* 159 */ -EXTERN CONST84_RETURN char * TclGetStartupScriptFileName (void); -#endif +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ #ifndef TclChannelTransform_TCL_DECLARED #define TclChannelTransform_TCL_DECLARED @@ -786,16 +778,8 @@ EXTERN int TclListObjSetElement (Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj * valuePtr); #endif -#ifndef TclSetStartupScriptPath_TCL_DECLARED -#define TclSetStartupScriptPath_TCL_DECLARED -/* 167 */ -EXTERN void TclSetStartupScriptPath (Tcl_Obj * pathPtr); -#endif -#ifndef TclGetStartupScriptPath_TCL_DECLARED -#define TclGetStartupScriptPath_TCL_DECLARED -/* 168 */ -EXTERN Tcl_Obj * TclGetStartupScriptPath (void); -#endif +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ #ifndef TclpUtfNcmp2_TCL_DECLARED #define TclpUtfNcmp2_TCL_DECLARED /* 169 */ @@ -851,17 +835,8 @@ EXTERN void TclVarErrMsg (Tcl_Interp * interp, const char * part1, const char * part2, const char * operation, const char * reason); #endif -#ifndef Tcl_SetStartupScript_TCL_DECLARED -#define Tcl_SetStartupScript_TCL_DECLARED -/* 178 */ -EXTERN void Tcl_SetStartupScript (Tcl_Obj * pathPtr, - const char* encodingName); -#endif -#ifndef Tcl_GetStartupScript_TCL_DECLARED -#define Tcl_GetStartupScript_TCL_DECLARED -/* 179 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript (const char ** encodingNamePtr); -#endif +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ #ifndef TclpLocaltime_TCL_DECLARED @@ -1294,8 +1269,8 @@ typedef struct TclIntStubs { void *reserved155; void (*tclRegError) (Tcl_Interp * interp, const char * msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp * interp, const char * varName); /* 157 */ - void (*tclSetStartupScriptFileName) (const char * filename); /* 158 */ - CONST84_RETURN char * (*tclGetStartupScriptFileName) (void); /* 159 */ + void *reserved158; + void *reserved159; void *reserved160; int (*tclChannelTransform) (Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr); /* 161 */ void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ @@ -1303,8 +1278,8 @@ typedef struct TclIntStubs { void (*tclExpandCodeArray) (void * envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj * valuePtr); /* 166 */ - void (*tclSetStartupScriptPath) (Tcl_Obj * pathPtr); /* 167 */ - Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ + void *reserved167; + void *reserved168; int (*tclpUtfNcmp2) (const char * s1, const char * s2, unsigned long n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp * interp, const char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp * interp, const char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ @@ -1314,8 +1289,8 @@ typedef struct TclIntStubs { int (*tclCallVarTraces) (Interp * iPtr, Var * arrayPtr, Var * varPtr, const char * part1, const char * part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var * varPtr, Var * arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp * interp, const char * part1, const char * part2, const char * operation, const char * reason); /* 177 */ - void (*tcl_SetStartupScript) (Tcl_Obj * pathPtr, const char* encodingName); /* 178 */ - Tcl_Obj * (*tcl_GetStartupScript) (const char ** encodingNamePtr); /* 179 */ + void *reserved178; + void *reserved179; void *reserved180; void *reserved181; struct tm * (*tclpLocaltime) (const time_t * clock); /* 182 */ @@ -1885,14 +1860,8 @@ extern const TclIntStubs *tclIntStubsPtr; #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ #endif -#ifndef TclSetStartupScriptFileName -#define TclSetStartupScriptFileName \ - (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ -#endif -#ifndef TclGetStartupScriptFileName -#define TclGetStartupScriptFileName \ - (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ -#endif +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ #ifndef TclChannelTransform #define TclChannelTransform \ @@ -1918,14 +1887,8 @@ extern const TclIntStubs *tclIntStubsPtr; #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ #endif -#ifndef TclSetStartupScriptPath -#define TclSetStartupScriptPath \ - (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ -#endif -#ifndef TclGetStartupScriptPath -#define TclGetStartupScriptPath \ - (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ -#endif +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ #ifndef TclpUtfNcmp2 #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ @@ -1959,14 +1922,8 @@ extern const TclIntStubs *tclIntStubsPtr; #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ #endif -#ifndef Tcl_SetStartupScript -#define Tcl_SetStartupScript \ - (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */ -#endif -#ifndef Tcl_GetStartupScript -#define Tcl_GetStartupScript \ - (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ -#endif +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ #ifndef TclpLocaltime diff --git a/generic/tclMain.c b/generic/tclMain.c index 4326c3a..f735493 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMain.c,v 1.46 2008/10/02 23:36:12 dkf Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.47 2008/12/15 15:48:33 dgp Exp $ */ #include "tclInt.h" @@ -32,8 +32,15 @@ extern CRTIMPORT int isatty(int fd); -static Tcl_Obj *tclStartupScriptPath = NULL; -static Tcl_Obj *tclStartupScriptEncoding = NULL; +typedef struct StartupScript { + Tcl_Obj *path; /* The filename of the script for *_Main() routines + * to [source] as a startup script, or NULL for + * none set, meaning enter interactive mode. */ + Tcl_Obj *encoding; /* The encoding of the startup script file. */ +} StartupScript; + +static Tcl_ThreadDataKey startupScriptKey; + static Tcl_MainLoopProc *mainLoopProc = NULL; /* @@ -89,25 +96,28 @@ Tcl_SetStartupScript( Tcl_Obj *path, /* Filesystem path of startup script file */ const char *encoding) /* Encoding of the data in that file */ { + StartupScript *scriptPtr = Tcl_GetThreadData(&startupScriptKey, + (int) sizeof(StartupScript)); Tcl_Obj *newEncoding = NULL; + if (encoding != NULL) { newEncoding = Tcl_NewStringObj(encoding, -1); } - if (tclStartupScriptPath != NULL) { - Tcl_DecrRefCount(tclStartupScriptPath); + if (scriptPtr->path != NULL) { + Tcl_DecrRefCount(scriptPtr->path); } - tclStartupScriptPath = path; - if (tclStartupScriptPath != NULL) { - Tcl_IncrRefCount(tclStartupScriptPath); + scriptPtr->path = path; + if (scriptPtr->path != NULL) { + Tcl_IncrRefCount(scriptPtr->path); } - if (tclStartupScriptEncoding != NULL) { - Tcl_DecrRefCount(tclStartupScriptEncoding); + if (scriptPtr->encoding != NULL) { + Tcl_DecrRefCount(scriptPtr->encoding); } - tclStartupScriptEncoding = newEncoding; - if (tclStartupScriptEncoding != NULL) { - Tcl_IncrRefCount(tclStartupScriptEncoding); + scriptPtr->encoding = newEncoding; + if (scriptPtr->encoding != NULL) { + Tcl_IncrRefCount(scriptPtr->encoding); } } @@ -138,116 +148,17 @@ Tcl_GetStartupScript( * registered encoding name for the startup * script */ { + StartupScript *scriptPtr = Tcl_GetThreadData(&startupScriptKey, + (int) sizeof(StartupScript)); + if (encodingPtr != NULL) { - if (tclStartupScriptEncoding == NULL) { + if (scriptPtr->encoding == NULL) { *encodingPtr = NULL; } else { - *encodingPtr = Tcl_GetString(tclStartupScriptEncoding); + *encodingPtr = Tcl_GetString(scriptPtr->encoding); } } - return tclStartupScriptPath; -} - -/* - *---------------------------------------------------------------------- - * - * TclSetStartupScriptPath -- - * - * Primes the startup script VFS path, used to override the command line - * processing. - * - * Results: - * None. - * - * Side effects: - * This function initializes the VFS path of the Tcl script to run at - * startup. - * - *---------------------------------------------------------------------- - */ - -void -TclSetStartupScriptPath( - Tcl_Obj *path) -{ - Tcl_SetStartupScript(path, NULL); -} - -/* - *---------------------------------------------------------------------- - * - * TclGetStartupScriptPath -- - * - * Gets the startup script VFS path, used to override the command line - * processing. - * - * Results: - * The startup script VFS path, NULL if none has been set. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclGetStartupScriptPath(void) -{ - return Tcl_GetStartupScript(NULL); -} - -/* - *---------------------------------------------------------------------- - * - * TclSetStartupScriptFileName -- - * - * Primes the startup script file name, used to override the command line - * processing. - * - * Results: - * None. - * - * Side effects: - * This function initializes the file name of the Tcl script to run at - * startup. - * - *---------------------------------------------------------------------- - */ - -void -TclSetStartupScriptFileName( - const char *fileName) -{ - Tcl_Obj *path = Tcl_NewStringObj(fileName,-1); - Tcl_SetStartupScript(path, NULL); -} - -/* - *---------------------------------------------------------------------- - * - * TclGetStartupScriptFileName -- - * - * Gets the startup script file name, used to override the command line - * processing. - * - * Results: - * The startup script file name, NULL if none has been set. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -const char * -TclGetStartupScriptFileName(void) -{ - Tcl_Obj *path = Tcl_GetStartupScript(NULL); - - if (path == NULL) { - return NULL; - } - return Tcl_GetString(path); + return scriptPtr->path; } /*---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d953edf..d64f061 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.173 2008/12/11 14:17:23 dkf Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.174 2008/12/15 15:48:33 dgp Exp $ */ #include "tclInt.h" @@ -227,8 +227,8 @@ static const TclIntStubs tclIntStubs = { NULL, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - TclSetStartupScriptFileName, /* 158 */ - TclGetStartupScriptFileName, /* 159 */ + NULL, /* 158 */ + NULL, /* 159 */ NULL, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ @@ -236,8 +236,8 @@ static const TclIntStubs tclIntStubs = { TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - TclSetStartupScriptPath, /* 167 */ - TclGetStartupScriptPath, /* 168 */ + NULL, /* 167 */ + NULL, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ @@ -247,8 +247,8 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - Tcl_SetStartupScript, /* 178 */ - Tcl_GetStartupScript, /* 179 */ + NULL, /* 178 */ + NULL, /* 179 */ NULL, /* 180 */ NULL, /* 181 */ TclpLocaltime, /* 182 */ |