diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclInitScript.h | 111 | ||||
| -rw-r--r-- | generic/tclInterp.c | 140 | ||||
| -rw-r--r-- | generic/tclMain.c | 62 | ||||
| -rw-r--r-- | library/init.tcl | 4 | ||||
| -rw-r--r-- | unix/Makefile.in | 4 | ||||
| -rw-r--r-- | unix/tclUnixInit.c | 109 | ||||
| -rw-r--r-- | win/tcl.dsp | 4 | ||||
| -rw-r--r-- | win/tclWinInit.c | 110 |
9 files changed, 213 insertions, 340 deletions
@@ -1,5 +1,14 @@ 2004-06-11 Don Porter <dgp@users.sourceforge.net> + * unix/tclUnixInit.c: The routines Tcl_Init() and TclSourceRCFile() + * win/tclWinInit.c: had identical implementations for both win and + * generic/tclInterp.c: unix. Moved to a single generic implementation. + * generic/tclMain.c: + * library/init.tcl: + * generic/tclInitScript.h (removed): + * unix/Makefile.in: + * win/tcl.dsp: + * unix/configure.in: Updated TCL_PACKAGE_PATH value to * win/configure.in: handle --libdir configuration. diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h deleted file mode 100644 index 18b8cb7..0000000 --- a/generic/tclInitScript.h +++ /dev/null @@ -1,111 +0,0 @@ -/* - * tclInitScript.h -- - * - * This file contains Unix & Windows common init script - * - * Copyright (c) 1998 Sun Microsystems, Inc. - * Copyright (c) 1999 by Scriptics Corporation. - * All rights reserved. - * - * RCS: @(#) $Id: tclInitScript.h,v 1.15 2004/03/17 18:14:13 das Exp $ - */ - -/* - * In order to find init.tcl during initialization, the following script - * is invoked by Tcl_Init(). It looks in several different directories: - * - * $tcl_library - can specify a primary location, if set - * no other locations will be checked - * - * $env(TCL_LIBRARY) - highest priority so user can always override - * the search path unless the application has - * specified an exact directory above - * - * $tclDefaultLibrary - this value is initialized by TclPlatformInit - * from a static C variable that was set at - * compile time - * - * $tcl_libPath - this value is initialized by a call to - * TclGetLibraryPath called from Tcl_Init. - * - * The first directory on this path that contains a valid init.tcl script - * will be set as the value of tcl_library. - * - * Note that this entire search mechanism can be bypassed by defining an - * alternate tclInit procedure before calling Tcl_Init(). - */ - -static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\ - proc tclInit {} {\n\ - global tcl_libPath tcl_library errorInfo\n\ - global env tclDefaultLibrary\n\ - rename tclInit {}\n\ - set errors {}\n\ - set dirs {}\n\ - if {[info exists tcl_library]} {\n\ - lappend dirs $tcl_library\n\ - } else {\n\ - if {[info exists env(TCL_LIBRARY)]} {\n\ - lappend dirs $env(TCL_LIBRARY)\n\ - }\n\ - catch {\n\ - lappend dirs $tclDefaultLibrary\n\ - unset tclDefaultLibrary\n\ - }\n\ - set dirs [concat $dirs $tcl_libPath]\n\ - }\n\ - foreach i $dirs {\n\ - set tcl_library $i\n\ - set tclfile [file join $i init.tcl]\n\ - if {[file exists $tclfile]} {\n\ - if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\ - return\n\ - } else {\n\ - append errors \"$tclfile: $msg\n$errorInfo\n\"\n\ - }\n\ - }\n\ - }\n\ - set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\ - append msg \" $dirs\n\n\"\n\ - append msg \"$errors\n\n\"\n\ - append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\ - error $msg\n\ - }\n\ -}\n\ -tclInit"; - - -/* - * A pointer to a string that holds an initialization script that if non-NULL - * is evaluated in Tcl_Init() prior to the built-in initialization script - * above. This variable can be modified by the procedure below. - */ - -static char * tclPreInitScript = NULL; - - -/* - *---------------------------------------------------------------------- - * - * TclSetPreInitScript -- - * - * This routine is used to change the value of the internal - * variable, tclPreInitScript. - * - * Results: - * Returns the current value of tclPreInitScript. - * - * Side effects: - * Changes the way Tcl_Init() routine behaves. - * - *---------------------------------------------------------------------- - */ - -char * -TclSetPreInitScript (string) - char *string; /* Pointer to a script. */ -{ - char *prevString = tclPreInitScript; - tclPreInitScript = string; - return(prevString); -} diff --git a/generic/tclInterp.c b/generic/tclInterp.c index fff810a..54f0cbc 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,11 +10,149 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.35 2004/05/30 12:18:26 dkf Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.36 2004/06/11 21:30:07 dgp Exp $ */ #include "tclInt.h" #include <stdio.h> + +/* + * In order to find init.tcl during initialization, the following script + * is invoked by Tcl_Init(). It looks in several different directories: + * + * $tcl_library - can specify a primary location, if set + * no other locations will be checked + * + * $env(TCL_LIBRARY) - highest priority so user can always override + * the search path unless the application has + * specified an exact directory above + * + * $tclDefaultLibrary - this value is initialized by TclPlatformInit + * from a static C variable that was set at + * compile time + * + * $tcl_libPath - this value is initialized by a call to + * TclGetLibraryPath called from Tcl_Init. + * + * The first directory on this path that contains a valid init.tcl script + * will be set as the value of tcl_library. + * + * Note that this entire search mechanism can be bypassed by defining an + * alternate tclInit procedure before calling Tcl_Init(). + */ + +static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\ + proc tclInit {} {\n\ + global tcl_libPath tcl_library errorInfo\n\ + global env tclDefaultLibrary\n\ + rename tclInit {}\n\ + set errors {}\n\ + set dirs {}\n\ + if {[info exists tcl_library]} {\n\ + lappend dirs $tcl_library\n\ + } else {\n\ + if {[info exists env(TCL_LIBRARY)]} {\n\ + lappend dirs $env(TCL_LIBRARY)\n\ + }\n\ + catch {\n\ + lappend dirs $tclDefaultLibrary\n\ + unset tclDefaultLibrary\n\ + }\n\ + set dirs [concat $dirs $tcl_libPath]\n\ + }\n\ + foreach i $dirs {\n\ + set tcl_library $i\n\ + set tclfile [file join $i init.tcl]\n\ + if {[file exists $tclfile]} {\n\ + if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\ + return\n\ + } else {\n\ + append errors \"$tclfile: $msg\n$errorInfo\n\"\n\ + }\n\ + }\n\ + }\n\ + set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\ + append msg \" $dirs\n\n\"\n\ + append msg \"$errors\n\n\"\n\ + append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\ + error $msg\n\ + }\n\ +}\n\ +tclInit"; + +/* + * A pointer to a string that holds an initialization script that if non-NULL + * is evaluated in Tcl_Init() prior to the built-in initialization script + * above. This variable can be modified by the procedure below. + */ + +static char * tclPreInitScript = NULL; + + +/* + *---------------------------------------------------------------------- + * + * TclSetPreInitScript -- + * + * This routine is used to change the value of the internal + * variable, tclPreInitScript. + * + * Results: + * Returns the current value of tclPreInitScript. + * + * Side effects: + * Changes the way Tcl_Init() routine behaves. + * + *---------------------------------------------------------------------- + */ + +char * +TclSetPreInitScript (string) + char *string; /* Pointer to a script. */ +{ + char *prevString = tclPreInitScript; + tclPreInitScript = string; + return(prevString); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_Init -- + * + * This procedure is typically invoked by Tcl_AppInit procedures + * to find and source the "init.tcl" script, which should exist + * somewhere on the Tcl library path. + * + * Results: + * Returns a standard Tcl completion code and sets the interp's + * result if there is an error. + * + * Side effects: + * Depends on what's in the init.tcl script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_Init(interp) + Tcl_Interp *interp; /* Interpreter to initialize. */ +{ + Tcl_Obj *pathPtr; + + if (tclPreInitScript != NULL) { + if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { + return (TCL_ERROR); + }; + } + + pathPtr = TclGetLibraryPath(); + if (pathPtr == NULL) { + pathPtr = Tcl_NewObj(); + } + Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); + return Tcl_Eval(interp, initScript); +} /* * Counter for how many aliases were created (global) diff --git a/generic/tclMain.c b/generic/tclMain.c index f1ca13f..1e736fe 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.26 2004/05/13 12:59:23 dkf Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.27 2004/06/11 21:30:08 dgp Exp $ */ #include "tclInt.h" @@ -237,10 +237,66 @@ CONST char *TclGetStartupScriptFileName() } return Tcl_GetString(path); } - -/* +/*---------------------------------------------------------------------- + * + * Tcl_SourceRCFile -- + * + * This procedure is typically invoked by Tcl_Main of Tk_Main + * procedure to source an application specific rc file into the + * interpreter at startup time. + * + * Results: + * None. + * + * Side effects: + * Depends on what's in the rc script. + * *---------------------------------------------------------------------- + */ + +void +Tcl_SourceRCFile(interp) + Tcl_Interp *interp; /* Interpreter to source rc file into. */ +{ + Tcl_DString temp; + CONST char *fileName; + Tcl_Channel errChannel; + + fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + if (fileName != NULL) { + Tcl_Channel c; + CONST char *fullName; + + Tcl_DStringInit(&temp); + fullName = Tcl_TranslateFileName(interp, fileName, &temp); + if (fullName == NULL) { + /* + * Couldn't translate the file name (e.g. it referred to a + * bogus user or there was no HOME environment variable). + * Just do nothing. + */ + } else { + /* + * Test for the existence of the rc file before trying to read it. + */ + c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); + if (c != (Tcl_Channel) 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); + } + } + } + } + Tcl_DStringFree(&temp); + } +} + +/*---------------------------------------------------------------------- * * Tcl_Main -- * diff --git a/library/init.tcl b/library/init.tcl index de2f8c6..d4002da 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.61 2004/05/03 14:28:35 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.62 2004/06/11 21:30:08 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -24,7 +24,7 @@ package require -exact Tcl 8.5 # The environment variable TCLLIBPATH # # tcl_library, which is the directory containing this init.tcl script. -# tclInitScript.h searches around for the directory containing this +# [tclInit] (Tcl_Init()) searches around for the directory containing this # init.tcl and defines tcl_library to that location before sourcing it. # # The parent directory of tcl_library. Adding the parent diff --git a/unix/Makefile.in b/unix/Makefile.in index 51a3c0c..f1d6f57 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.137 2004/05/26 22:51:55 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.138 2004/06/11 21:30:08 dgp Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -1083,7 +1083,7 @@ tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c -tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c $(GENERIC_DIR)/tclInitScript.h tclConfig.sh +tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \ -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \ $(UNIX_DIR)/tclUnixInit.c diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index a8732db..87b6412 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclUnixInit.c,v 1.42 2004/06/10 22:21:54 dgp Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.43 2004/06/11 21:30:08 dgp Exp $ */ #if defined(HAVE_CFBUNDLE) @@ -28,12 +28,6 @@ # endif #endif -/* - * The Init script (common to Windows and Unix platforms) is - * defined in tkInitScript.h - */ -#include "tclInitScript.h" - /* Used to store the encoding used for binary files */ static Tcl_Encoding binaryEncoding = NULL; /* Has the basic library path encoding issue been fixed */ @@ -940,107 +934,6 @@ TclpFindVariable(name, lengthPtr) /* *---------------------------------------------------------------------- * - * Tcl_Init -- - * - * This procedure is typically invoked by Tcl_AppInit procedures - * to find and source the "init.tcl" script, which should exist - * somewhere on the Tcl library path. - * - * Results: - * Returns a standard Tcl completion code and sets the interp's - * result if there is an error. - * - * Side effects: - * Depends on what's in the init.tcl script. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_Init(interp) - Tcl_Interp *interp; /* Interpreter to initialize. */ -{ - Tcl_Obj *pathPtr; - - if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { - return (TCL_ERROR); - }; - } - - pathPtr = TclGetLibraryPath(); - if (pathPtr == NULL) { - pathPtr = Tcl_NewObj(); - } - Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); - return Tcl_Eval(interp, initScript); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SourceRCFile -- - * - * This procedure is typically invoked by Tcl_Main of Tk_Main - * procedure to source an application specific rc file into the - * interpreter at startup time. - * - * Results: - * None. - * - * Side effects: - * Depends on what's in the rc script. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SourceRCFile(interp) - Tcl_Interp *interp; /* Interpreter to source rc file into. */ -{ - Tcl_DString temp; - CONST char *fileName; - Tcl_Channel errChannel; - - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); - - if (fileName != NULL) { - Tcl_Channel c; - CONST char *fullName; - - Tcl_DStringInit(&temp); - fullName = Tcl_TranslateFileName(interp, fileName, &temp); - if (fullName == NULL) { - /* - * Couldn't translate the file name (e.g. it referred to a - * bogus user or there was no HOME environment variable). - * Just do nothing. - */ - } else { - - /* - * Test for the existence of the rc file before trying to read it. - */ - - c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); - if (c != (Tcl_Channel) 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); - } - } - } - } - Tcl_DStringFree(&temp); - } -} - -/* - *---------------------------------------------------------------------- - * * TclpCheckStackSpace -- * * Detect if we are about to blow the stack. Called before an diff --git a/win/tcl.dsp b/win/tcl.dsp index 84ea5bc..23a4cc5 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1160,10 +1160,6 @@ SOURCE=..\generic\tclIndexObj.c # End Source File # Begin Source File -SOURCE=..\generic\tclInitScript.h -# End Source File -# Begin Source File - SOURCE=..\generic\tclInt.decls # End Source File # Begin Source File diff --git a/win/tclWinInit.c b/win/tclWinInit.c index d006115..f9c3e24 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.47 2004/06/10 22:21:54 dgp Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.48 2004/06/11 21:30:08 dgp Exp $ */ #include "tclWinInt.h" @@ -97,13 +97,6 @@ static Tcl_Encoding binaryEncoding = NULL; /* Has the basic library path encoding issue been fixed */ static int libraryPathEncodingFixed = 0; -/* - * The Init script (common to Windows and Unix platforms) is - * defined in tkInitScript.h - */ - -#include "tclInitScript.h" - static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule, CONST char *lib); @@ -818,104 +811,3 @@ TclpFindVariable(name, lengthPtr) ckfree(nameUpper); return result; } - -/* - *---------------------------------------------------------------------- - * - * Tcl_Init -- - * - * This procedure is typically invoked by Tcl_AppInit procedures - * to perform additional initialization for a Tcl interpreter, - * such as sourcing the "init.tcl" script. - * - * Results: - * Returns a standard Tcl completion code and sets the interp's - * result if there is an error. - * - * Side effects: - * Depends on what's in the init.tcl script. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_Init(interp) - Tcl_Interp *interp; /* Interpreter to initialize. */ -{ - Tcl_Obj *pathPtr; - - if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { - return (TCL_ERROR); - }; - } - - pathPtr = TclGetLibraryPath(); - if (pathPtr == NULL) { - pathPtr = Tcl_NewObj(); - } - Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); - return Tcl_Eval(interp, initScript); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SourceRCFile -- - * - * This procedure is typically invoked by Tcl_Main of Tk_Main - * procedure to source an application specific rc file into the - * interpreter at startup time. - * - * Results: - * None. - * - * Side effects: - * Depends on what's in the rc script. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SourceRCFile(interp) - Tcl_Interp *interp; /* Interpreter to source rc file into. */ -{ - Tcl_DString temp; - CONST char *fileName; - Tcl_Channel errChannel; - - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); - - if (fileName != NULL) { - Tcl_Channel c; - CONST char *fullName; - - Tcl_DStringInit(&temp); - fullName = Tcl_TranslateFileName(interp, fileName, &temp); - if (fullName == NULL) { - /* - * Couldn't translate the file name (e.g. it referred to a - * bogus user or there was no HOME environment variable). - * Just do nothing. - */ - } else { - - /* - * Test for the existence of the rc file before trying to read it. - */ - - c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); - if (c != (Tcl_Channel) 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); - } - } - } - } - Tcl_DStringFree(&temp); - } -} |