diff options
author | Joe Mistachkin <joe@mistachkin.com> | 2012-11-13 20:03:42 (GMT) |
---|---|---|
committer | Joe Mistachkin <joe@mistachkin.com> | 2012-11-13 20:03:42 (GMT) |
commit | 41552a3de10d3861ea5aa312bef58918d99de3c2 (patch) | |
tree | 4ab00204aef4bc26bf81744426b7a619c2560c69 | |
parent | 4980b7bd80aaa2e11a6c4c5e2459aabe975a6150 (diff) | |
parent | a4d552f93c2ab129b82405cb45b7e2324a67cbd7 (diff) | |
download | tcl-41552a3de10d3861ea5aa312bef58918d99de3c2.zip tcl-41552a3de10d3861ea5aa312bef58918d99de3c2.tar.gz tcl-41552a3de10d3861ea5aa312bef58918d99de3c2.tar.bz2 |
also search for the library directory (init.tcl, encodings, etc) relative to the build directory associated with the source checkout.
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | win/tclWinInit.c | 64 |
2 files changed, 69 insertions, 1 deletions
@@ -1,3 +1,9 @@ +2012-11-13 Joe Mistachkin <joe@mistachkin.com> + + * win/tclWinInit.c: also search for the library directory (init.tcl, + encodings, etc) relative to the build directory associated with the + source checkout. + 2012-11-10 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c: re-enable bcc-tailcall, after fixing an diff --git a/win/tclWinInit.c b/win/tclWinInit.c index d89c98e..f552e2c 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -101,6 +101,10 @@ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; static ProcessGlobalValue defaultLibraryDir = {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; +static TclInitProcessGlobalValueProc InitializeSourceLibraryDir; +static ProcessGlobalValue sourceLibraryDir = + {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; + static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); static int ToUtf(const WCHAR *wSrc, char *dst); @@ -175,7 +179,7 @@ TclpInitLibraryPath( int *lengthPtr, Tcl_Encoding *encodingPtr) { -#define LIBRARY_SIZE 32 +#define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; @@ -206,6 +210,13 @@ TclpInitLibraryPath( Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&defaultLibraryDir)); + /* + * Look for the library in its source checkout location. + */ + + Tcl_ListObjAppendElement(NULL, pathPtr, + TclGetProcessGlobalValue(&sourceLibraryDir)); + *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); *valuePtr = ckalloc((*lengthPtr) + 1); @@ -360,6 +371,57 @@ InitializeDefaultLibraryDir( /* *--------------------------------------------------------------------------- * + * InitializeSourceLibraryDir -- + * + * Locate the Tcl script library default location relative to the + * location of the Tcl DLL as it exists in the build output directory + * associated with the source checkout. + * + * Results: + * None. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static void +InitializeSourceLibraryDir( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) +{ + HMODULE hModule = TclWinGetTclInstance(); + WCHAR wName[MAX_PATH + LIBRARY_SIZE]; + char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + char *end, *p; + + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, name, MAX_PATH); + } else { + ToUtf(wName, name); + } + + end = strrchr(name, '\\'); + *end = '\0'; + p = strrchr(name, '\\'); + if (p != NULL) { + end = p; + } + *end = '\\'; + + TclWinNoBackslash(name); + sprintf(end + 1, "../library"); + *lengthPtr = strlen(name); + *valuePtr = ckalloc(*lengthPtr + 1); + *encodingPtr = NULL; + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); +} + +/* + *--------------------------------------------------------------------------- + * * ToUtf -- * * Convert a char string to a UTF string. |