summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog16
-rw-r--r--generic/tclEncoding.c84
-rw-r--r--generic/tclEvent.c83
-rw-r--r--generic/tclInt.decls8
-rw-r--r--generic/tclIntDecls.h17
-rw-r--r--generic/tclMain.c80
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--unix/tclAppInit.c31
-rw-r--r--win/tclAppInit.c46
9 files changed, 266 insertions, 103 deletions
diff --git a/ChangeLog b/ChangeLog
index e8d3327..56eba3d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+1999-12-01 Scott Redman <redman@scriptics.com>
+
+ * generic/tcl.decls :
+ * generic/tclMain.c :
+ * unix/tclAppInit.c:
+ * win/tclAppInit.c: Added two new internal functions,
+ TclSetStartupScriptFileName() and TclGetStartupScriptFileName()
+ and added hooks into the main() code for supporting TclPro and
+ other "big" shells more easily without requiring a copy of the
+ main() code.
+
+ * generic/tclEncoding.c:
+ * generic/tclEvent.c: Moved encoding-related startup code from
+ tclEvent.c into the more appropriate tclEncoding.c.
+
+
1999-11-30 Jeff Hobbs <hobbs@scriptics.com>
* generic/tclIO.c: fix from Kupries for Tcl_UnstackChannel that
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 40ded74..ad86495 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.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: tclEncoding.c,v 1.2 1999/04/16 00:46:45 stanton Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.3 1999/12/02 02:03:22 redman Exp $
*/
#include "tclInt.h"
@@ -143,6 +143,8 @@ typedef struct EscapeEncodingData {
char *tclDefaultEncodingDir = NULL;
+static int encodingsInitialized = 0;
+
/*
* Hash table that keeps track of all loaded Encodings. Keys are
* the string names that represent the encoding, values are (Encoding *).
@@ -311,6 +313,7 @@ TclFinalizeEncodingSubsystem()
Encoding *encodingPtr;
Tcl_MutexLock(&encodingMutex);
+ encodingsInitialized = 0;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
@@ -2682,4 +2685,83 @@ unilen(src)
return (char *) p - src;
}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclFindEncodings --
+ *
+ * Find and load the encoding file for this operating system.
+ * Before this is called, Tcl makes assumptions about the
+ * native string representation, but the true encoding is not
+ * assured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Varied, see the respective initialization routines.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclFindEncodings(argv0)
+ CONST char *argv0; /* Name of executable from argv[0] to main()
+ * in native multi-byte encoding. */
+{
+ char *native;
+ Tcl_Obj *pathPtr;
+ Tcl_DString libPath, buffer;
+
+ if (encodingsInitialized == 0) {
+ /*
+ * Double check inside the mutex. There may be calls
+ * back into this routine from some of the procedures below.
+ */
+
+ TclpInitLock();
+ if (encodingsInitialized == 0) {
+ /*
+ * Have to set this bit here to avoid deadlock with the
+ * routines below us that call into TclInitSubsystems.
+ */
+
+ encodingsInitialized = 1;
+
+ native = TclpFindExecutable(argv0);
+ TclpInitLibraryPath(native);
+
+ /*
+ * The library path was set in the TclpInitLibraryPath routine.
+ * The string set is a dirty UTF string. To preserve the value
+ * convert the UTF string back to native before setting the new
+ * default encoding.
+ */
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
+ &libPath);
+ }
+
+ TclpSetInitialEncodings();
+
+ /*
+ * Now convert the native string back to UTF.
+ */
+
+ if (pathPtr != NULL) {
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
+ &buffer);
+ pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
+ TclSetLibraryPath(pathPtr);
+
+ Tcl_DStringFree(&libPath);
+ Tcl_DStringFree(&buffer);
+ }
+ }
+ TclpInitUnlock();
+ }
+}
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 95f0abb..d81e3e6 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -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: tclEvent.c,v 1.6 1999/11/19 06:34:23 hobbs Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.7 1999/12/02 02:03:23 redman Exp $
*/
#include "tclInt.h"
@@ -87,7 +87,6 @@ TCL_DECLARE_MUTEX(exitMutex)
static int inFinalize = 0;
static int subsystemsInitialized = 0;
-static int encodingsInitialized = 0;
static Tcl_Obj *tclLibraryPath = NULL;
@@ -719,85 +718,6 @@ TclInitSubsystems(argv0)
}
/*
- *-------------------------------------------------------------------------
- *
- * TclFindEncodings --
- *
- * Find and load the encoding file for this operating system.
- * Before this is called, Tcl makes assumptions about the
- * native string representation, but the true encoding is not
- * assured.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Varied, see the respective initialization routines.
- *
- *-------------------------------------------------------------------------
- */
-
-void
-TclFindEncodings(argv0)
- CONST char *argv0; /* Name of executable from argv[0] to main()
- * in native multi-byte encoding. */
-{
- char *native;
- Tcl_Obj *pathPtr;
- Tcl_DString libPath, buffer;
-
- if (encodingsInitialized == 0) {
- /*
- * Double check inside the mutex. There may be calls
- * back into this routine from some of the procedures below.
- */
-
- TclpInitLock();
- if (encodingsInitialized == 0) {
- /*
- * Have to set this bit here to avoid deadlock with the
- * routines below us that call into TclInitSubsystems.
- */
-
- encodingsInitialized = 1;
-
- native = TclpFindExecutable(argv0);
- TclpInitLibraryPath(native);
-
- /*
- * The library path was set in the TclpInitLibraryPath routine.
- * The string set is a dirty UTF string. To preserve the value
- * convert the UTF string back to native before setting the new
- * default encoding.
- */
-
- pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
- &libPath);
- }
-
- TclpSetInitialEncodings();
-
- /*
- * Now convert the native string back to UTF.
- */
-
- if (pathPtr != NULL) {
- Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
- &buffer);
- pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
- TclSetLibraryPath(pathPtr);
-
- Tcl_DStringFree(&libPath);
- Tcl_DStringFree(&buffer);
- }
- }
- TclpInitUnlock();
- }
-}
-
-/*
*----------------------------------------------------------------------
*
* Tcl_Finalize --
@@ -824,7 +744,6 @@ Tcl_Finalize()
TclpInitLock();
if (subsystemsInitialized != 0) {
subsystemsInitialized = 0;
- encodingsInitialized = 0;
/*
* Invoke exit handlers first.
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 52604a6..f535e71 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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: tclInt.decls,v 1.17 1999/08/10 02:42:14 welch Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.18 1999/12/02 02:03:25 redman Exp $
library tcl
@@ -592,6 +592,12 @@ declare 156 generic {
declare 157 generic {
Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
}
+declare 158 generic {
+ void TclSetStartupScriptFileName(char *filename)
+}
+declare 159 generic {
+ char *TclGetStartupScriptFileName(void)
+}
##############################################################################
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index fea3857..7e96fee 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.17 1999/08/10 02:42:14 welch Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.18 1999/12/02 02:03:26 redman Exp $
*/
#ifndef _TCLINTDECLS
@@ -519,6 +519,11 @@ EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp,
/* 157 */
EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
char * varName));
+/* 158 */
+EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_((
+ char * filename));
+/* 159 */
+EXTERN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
typedef struct TclIntStubs {
int magic;
@@ -714,6 +719,8 @@ typedef struct TclIntStubs {
int (*tclTestChannelEventCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 155 */
void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
+ void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
+ char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
} TclIntStubs;
#ifdef __cplusplus
@@ -1355,6 +1362,14 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclVarTraceExists \
(tclIntStubsPtr->tclVarTraceExists) /* 157 */
#endif
+#ifndef TclSetStartupScriptFileName
+#define TclSetStartupScriptFileName \
+ (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
+#endif
+#ifndef TclGetStartupScriptFileName
+#define TclGetStartupScriptFileName \
+ (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 089452d..4c12fc7 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -9,7 +9,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.5 1999/04/16 00:46:50 stanton Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.6 1999/12/02 02:03:27 redman Exp $
*/
#include "tcl.h"
@@ -40,6 +40,57 @@ int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
extern int isatty _ANSI_ARGS_((int fd));
extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
+static char *tclStartupScriptFileName = NULL;
+
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetStartupScriptFileName --
+ *
+ * Primes the startup script file name, used to override the
+ * command line processing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure initializes the file name of the Tcl script to
+ * run at startup.
+ *
+ *----------------------------------------------------------------------
+ */
+void TclSetStartupScriptFileName(fileName)
+ char *fileName;
+{
+ tclStartupScriptFileName = fileName;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+char *TclGetStartupScriptFileName()
+{
+ return tclStartupScriptFileName;
+}
+
+
/*
*----------------------------------------------------------------------
@@ -53,7 +104,7 @@ extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
* it's done.
*
* Side effects:
- * This procedure initializes the Tk world and then starts
+ * This procedure initializes the Tcl world and then starts
* interpreting commands; almost anything could happen, depending
* on the script being interpreted.
*
@@ -72,7 +123,7 @@ Tcl_Main(argc, argv, appInitProc)
{
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
- char buffer[1000], *args, *fileName;
+ char buffer[1000], *args;
int code, gotPartial, tty, length;
int exitCode = 0;
Tcl_Channel inChannel, outChannel, errChannel;
@@ -91,11 +142,12 @@ Tcl_Main(argc, argv, appInitProc)
* strip it off and use it as the name of a script file to process.
*/
- fileName = NULL;
- if ((argc > 1) && (argv[1][0] != '-')) {
- fileName = argv[1];
- argc--;
- argv++;
+ if (tclStartupScriptFileName == NULL) {
+ if ((argc > 1) && (argv[1][0] != '-')) {
+ tclStartupScriptFileName = argv[1];
+ argc--;
+ argv++;
+ }
}
args = Tcl_Merge(argc-1, argv+1);
Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
@@ -103,10 +155,11 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_DStringFree(&argString);
ckfree(args);
- if (fileName == NULL) {
+ if (tclStartupScriptFileName == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
} else {
- fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString);
+ tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,
+ tclStartupScriptFileName, -1, &argString);
}
TclFormatInt(buffer, argc-1);
@@ -119,7 +172,8 @@ Tcl_Main(argc, argv, appInitProc)
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive",
- ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+ ((tclStartupScriptFileName == NULL) && tty) ? "1" : "0",
+ TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
@@ -140,8 +194,8 @@ Tcl_Main(argc, argv, appInitProc)
* and quit.
*/
- if (fileName != NULL) {
- code = Tcl_EvalFile(interp, fileName);
+ if (tclStartupScriptFileName != NULL) {
+ code = Tcl_EvalFile(interp, tclStartupScriptFileName);
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ad790d9..23f916b 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.28 1999/08/19 02:59:10 hobbs Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.29 1999/12/02 02:03:27 redman Exp $
*/
#include "tclInt.h"
@@ -233,6 +233,8 @@ TclIntStubs tclIntStubs = {
TclTestChannelEventCmd, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
+ TclSetStartupScriptFileName, /* 158 */
+ TclGetStartupScriptFileName, /* 159 */
};
TclIntPlatStubs tclIntPlatStubs = {
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 45d86eb..c1126ae 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -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: tclAppInit.c,v 1.7 1999/10/13 00:32:49 hobbs Exp $
+ * RCS: @(#) $Id: tclAppInit.c,v 1.8 1999/12/02 02:03:32 redman Exp $
*/
#include "tcl.h"
@@ -66,6 +66,28 @@ main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
+ /*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tcl_Main()
+ */
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+#endif
+
#ifdef TCL_TEST
/*
* Pass the build time location of the tcl library (to find init.tcl)
@@ -83,7 +105,12 @@ main(argc, argv)
XtToolkitInitialize();
#endif
- Tcl_Main(argc, argv, Tcl_AppInit);
+#ifdef TCL_LOCAL_MAIN_HOOK
+ TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+
return 0; /* Needed only to prevent compiler warning. */
}
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index d157656..b8f3e78 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -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: tclAppInit.c,v 1.5 1999/04/16 00:48:07 stanton Exp $
+ * RCS: @(#) $Id: tclAppInit.c,v 1.6 1999/12/02 02:03:37 redman Exp $
*/
#include "tcl.h"
@@ -54,6 +54,30 @@ main(argc, argv)
char **argv; /* Values of command-line arguments. */
{
/*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tcl_Main()
+ */
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+#endif
+
+ char buffer[MAX_PATH +1];
+ char *p;
+ /*
* Set up the default locale to be standard "C" locale so parsing
* is performed correctly.
*/
@@ -61,7 +85,25 @@ main(argc, argv)
setlocale(LC_ALL, "C");
setargv(&argc, &argv);
- Tcl_Main(argc, argv, Tcl_AppInit);
+ /*
+ * Replace argv[0] with full pathname of executable, and forward
+ * slashes substituted for backslashes.
+ */
+
+ GetModuleFileName(NULL, buffer, sizeof(buffer));
+ argv[0] = buffer;
+ for (p = buffer; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+
return 0; /* Needed only to prevent compiler warning. */
}