diff options
| -rw-r--r-- | ChangeLog | 18 | ||||
| -rw-r--r-- | doc/AppInit.3 | 10 | ||||
| -rw-r--r-- | doc/Tcl_Main.3 | 82 | ||||
| -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 |
8 files changed, 172 insertions, 228 deletions
@@ -1,3 +1,19 @@ +2008-12-15 Don Porter <dgp@users.sourceforge.net> + + TIP #338 IMPLEMENTATION + + * doc/AppInit.c: Made routines Tcl_SetStartupScript and + * doc/Tcl_Main.3: Tcl_GetStartupScript public. Removed all + * generic/tcl.h: internal stub access to Tcl*Startup* routines, + * generic/tclInt.decls: and removed their implementations. Their + * generic/tclMain.c: function can now be completely performed with + the new public interface. + *** POTENTIAL INCOMPATIBILITY for callers of the internal + Tcl*Startup* routines. *** + + * generic/tclIntDecls.h: make genstubs + * generic/tclStubInit.c: + 2008-12-14 Donal K. Fellows <dkf@users.sf.net> * tests/zlib.test: Added constraint so that tests don't fail where @@ -152,7 +168,7 @@ * generic/tclInterp.c: * generic/tclTimer.c: *** POTENTIAL INCOMPATIBILITY only for extensions using the converted - internal routine *** + internal routine *** 2008-12-09 Donal K. Fellows <dkf@users.sf.net> diff --git a/doc/AppInit.3 b/doc/AppInit.3 index 15d5635..bd3c665 100644 --- a/doc/AppInit.3 +++ b/doc/AppInit.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: AppInit.3,v 1.10 2008/10/15 10:43:37 dkf Exp $ +'\" RCS: @(#) $Id: AppInit.3,v 1.11 2008/12/15 15:48:33 dgp Exp $ '\" .so man.macros .TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures" @@ -50,6 +50,11 @@ Process command-line arguments, which can be accessed from the Tcl variables \fBargv\fR and \fBargv0\fR in \fIinterp\fR. .IP [3] Invoke a startup script to initialize the application. +.IP [4] +Use the routines \fBTcl_SetStartupScript\fR and +\fBTcl_GetStartupScript\fR to set or query the file and encoding +that the active \fBTcl_Main\fR or \fBTk_Main\fR routine will +use as a startup script. .LP \fBTcl_AppInit\fR returns \fBTCL_OK\fR or \fBTCL_ERROR\fR. If it returns \fBTCL_ERROR\fR then it must leave an error message in @@ -73,5 +78,8 @@ The best way to get started is to make a copy of the file It already contains a \fBmain\fR procedure and a template for \fBTcl_AppInit\fR that you can modify for your application. +.SH "SEE ALSO" +Tcl_Main(3) + .SH KEYWORDS application, argument, command, initialization, interpreter diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index 462a4de..cca8158 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -6,19 +6,24 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Tcl_Main.3,v 1.18 2008/10/17 10:22:25 dkf Exp $ +'\" RCS: @(#) $Id: Tcl_Main.3,v 1.19 2008/12/15 15:48:33 dgp Exp $ '\" .so man.macros .TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_Main, Tcl_SetMainLoop \- main program and event loop definition for Tcl-based applications +Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp \fBTcl_Main\fR(\fIargc, argv, appInitProc\fR) .sp +\fBTcl_SetStartupScript\fR(\fIpath, encoding\fR) +.sp +Tcl_Obj * +\fBTcl_GetStartupScript\fR(\fIencodingPtr\fR) +.sp \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc @@ -29,6 +34,13 @@ Array of strings containing command-line arguments. .AP Tcl_AppInitProc *appInitProc in Address of an application-specific initialization procedure. The value for this argument is usually \fBTcl_AppInit\fR. +.AP Tcl_Obj *path in +Name of file to use as startup script, or NULL. +.AP "const char" *encoding in +Encoding of file to use as startup script, or NULL. +.AP "const char" **encodingPtr out +If non-NULL, location to write a copy of the (const char *) +pointing to the encoding name. .AP Tcl_MainLoopProc *mainLoopProc in Address of an application-specific event loop procedure. .BE @@ -76,17 +88,46 @@ restriction is not a problem with normal use described above. channels to their default values. See \fBTcl_StandardChannels\fR for more information. .PP -\fBTcl_Main\fR supports two modes of operation, depending on the -values of \fIargc\fR and \fIargv\fR. If the first few arguments -in \fIargv\fR match ?\fB\-encoding \fIname\fR? ?\fIfileName\fR?, +\fBTcl_Main\fR supports two modes of operation, depending on +whether the filename and encoding of a startup script has been +established. The routines \fBTcl_SetStartupScript\fR and +\fBTcl_GetStartupScript\fR are the tools for controlling this +configuration of \fBTcl_Main\fR. +.PP +\fBTcl_SetStartupScript\fR registers the value \fIpath\fR +as the name of the file for \fBTcl_Main\fR to evaluate as +its startup script. The value \fIencoding\fR is Tcl's name +for the encoding used to store the text in that file. A +value of \fBNULL\fR for \fIencoding\fR is a signal to use +the system encoding. A value of \fBNULL\fR for \fIpath\fR +erases any existing registration so that \fBTcl_Main\fR +will not evaluate any startup script. +.PP +\fBTcl_GetStartupScript\fR queries the registered file name +and encoding set by the most recent \fBTcl_SetStartupScript\fR +call in the same thread. The stored file name is returned, +and the stored encoding name is written to space pointed to +by \fIencodingPtr\fR, when that is not NULL. +.PP +The file name and encoding values managed by the routines +\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR +are stored per-thread. Although the storage and retrieval +functions of these routines work in any thread, only those +calls in the same master thread as \fBTcl_Main\fR can have +any influence on it. +.PP +The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR +first to establish its desired startup script. If \fBTcl_Main\fR +finds that no such startup script has been established, it consults +the first few arguments in \fIargv\fR. If they match +?\fB\-encoding \fIname\fR? \fIfileName\fR, where \fIfileName\fR does not begin with the character \fI\-\fR, then \fIfileName\fR is taken to be the name of a file containing a \fIstartup script\fR, and \fIname\fR is taken to be the name -of the encoding of the contents of that file, which \fBTcl_Main\fR -will attempt to evaluate. Otherwise, \fBTcl_Main\fR will enter an -interactive mode. +of the encoding of the contents of that file. \fBTcl_Main\fR +then calls \fRTcl_SetStartupScript\fR with these values. .PP -In either mode, \fBTcl_Main\fR will define in its master interpreter +\fBTcl_Main\fR then defines in its master interpreter the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and \fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR. .PP @@ -96,8 +137,10 @@ commands, \fBTcl_Main\fR calls the procedure given by the .QW hook for the application to perform its own initialization of the interpreter created by \fBTcl_Main\fR, such as defining application-specific -commands. The procedure must have an interface that matches the -type \fBTcl_AppInitProc\fR: +commands. The application initialization routine might also +call \fBTcl_SetStartupScript\fR to (re-)set the file and encoding +to be used as a startup script. The procedure must have an interface +that matches the type \fBTcl_AppInitProc\fR: .PP .CS typedef int \fBTcl_AppInitProc\fR( @@ -107,13 +150,14 @@ typedef int \fBTcl_AppInitProc\fR( \fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR; for more details on this procedure, see the documentation for \fBTcl_AppInit\fR. .PP -When the \fIappInitProc\fR is finished, \fBTcl_Main\fR enters one -of its two modes. If a startup script has been provided, \fBTcl_Main\fR -attempts to evaluate it. Otherwise, interactive mode begins with -examination of the variable \fItcl_rcFileName\fR in the master -interpreter. If that variable exists and holds the name of a readable -file, the contents of that file are evaluated in the master interpreter. -Then interactive operations begin, +When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls +\fBTcl_GetStartupScript\fR to determine what startup script has +been requested, if any. If a startup script has been provided, +\fBTcl_Main\fR attempts to evaluate it. Otherwise, interactive +mode begins with examination of the variable \fItcl_rcFileName\fR +in the master interpreter. If that variable exists and holds the +name of a readable file, the contents of that file are evaluated +in the master interpreter. Then interactive operations begin, with prompts and command evaluation results written to the standard output channel, and commands read from the standard input channel and then evaluated. The prompts written to the standard output @@ -148,6 +192,6 @@ procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .SH "SEE ALSO" tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3), -exit(n) +exit(n), encoding(n) .SH KEYWORDS application-specific initialization, command-line arguments, main program 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 */ |