* 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.

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. */
 }