summaryrefslogtreecommitdiffstats
path: root/generic/tclZipfs.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclZipfs.c')
-rw-r--r--generic/tclZipfs.c116
1 files changed, 59 insertions, 57 deletions
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index adabcda..5df300a 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -91,17 +91,6 @@ static const z_crc_t* crc32tab;
#define ZIPFS_VOLUME_LEN 9
#define ZIPFS_APP_MOUNT ZIPFS_VOLUME "app"
#define ZIPFS_ZIP_MOUNT ZIPFS_VOLUME "lib/tcl"
-
-#define ZIPFS_SCRIPT_PREFIX "set ::tcl_library "
-#define ZIPFS_TCL_LIBRARY_1 ZIPFS_APP_MOUNT "/tcl_library"
-#define ZIPFS_INIT_SCRIPT_1 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_1
-
-#define ZIPFS_TCL_LIBRARY_2 ZIPFS_ZIP_MOUNT
-#define ZIPFS_INIT_SCRIPT_2 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_2
-
-#define ZIPFS_TCL_LIBRARY_3 ZIPFS_ZIP_MOUNT "/tcl_library"
-#define ZIPFS_INIT_SCRIPT_3 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_3
-
#define ZIPFS_FALLBACK_ENCODING "cp437"
/*
@@ -324,7 +313,6 @@ static const char pwrot[17] =
"\x10\x90\x50\xD0\x30\xB0\x70\xF0";
static const char *zipfs_literal_tcl_library = NULL;
-static const char *zipfs_init_script = NULL;
/* Function prototypes */
@@ -4243,28 +4231,6 @@ ScriptLibrarySetup(
Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, -1);
Tcl_Obj *subDirObj, *searchPathObj;
- /*
- * We know where the init.tcl is located in the attached script library
- * archive. Use a pre-init script to tell every Tcl interp as it gets
- * created where that is, so none of them need to construct and then
- * iterate through some search path. That's the literal documented
- * purpose of Tcl_SetPreInitScript(). Use it.
- *
- * TODO: Examine why we need so many variations and eliminate as many
- * as possible.
- */
-
- if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_1)) {
- zipfs_init_script = ZIPFS_INIT_SCRIPT_1;
- } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_2)) {
- zipfs_init_script = ZIPFS_INIT_SCRIPT_2;
- } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_3)) {
- zipfs_init_script = ZIPFS_INIT_SCRIPT_3;
- }
- if (zipfs_init_script) {
- Tcl_SetPreInitScript(zipfs_init_script);
- }
-
TclNewLiteralStringObj(subDirObj, "encoding");
Tcl_IncrRefCount(subDirObj);
TclNewObj(searchPathObj);
@@ -4302,12 +4268,13 @@ TclZipfs_TclLibrary(void)
* Look for the library file system within the executable.
*/
- vfsInitScript = Tcl_NewStringObj(ZIPFS_TCL_LIBRARY_1 "/init.tcl", -1);
+ vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
+ -1);
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
- zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
+ zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return ScriptLibrarySetup(zipfs_literal_tcl_library);
}
@@ -4356,6 +4323,44 @@ TclZipfs_TclLibrary(void)
/*
*-------------------------------------------------------------------------
*
+ * ZipFSTclLibraryObjCmd --
+ *
+ * This procedure is invoked to process the
+ * [::tcl::zipfs::tcl_library_init] command, usually called during the
+ * execution of Tcl's interpreter startup. It returns the root that Tcl's
+ * library files are mounted under.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May initialise the cache of where such library files are to be found.
+ * This cache is never cleared.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSTclLibraryObjCmd(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp, /* Current interpreter. */
+ TCL_UNUSED(int) /*objc*/,
+ TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
+{
+ if (!Tcl_IsSafe(interp)) {
+ Tcl_Obj *pResult = TclZipfs_TclLibrary();
+
+ if (!pResult) {
+ TclNewObj(pResult);
+ }
+ Tcl_SetObjResult(interp, pResult);
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
* ZipChannelClose --
*
* This function is called to close a channel.
@@ -6248,6 +6253,8 @@ TclZipfs_Init(
Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
Tcl_NewStringObj("::tcl::zipfs::find", -1));
+ Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
+ ZipFSTclLibraryObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "tcl::zipfs", "2.0");
}
return TCL_OK;
@@ -6276,21 +6283,22 @@ ZipfsAppHookFindTclInit(
return TCL_ERROR;
}
- TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_2 "/init.tcl");
+ TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == 0) {
- zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_2;
+ zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
return TCL_OK;
}
- TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "/init.tcl");
+ TclNewLiteralStringObj(vfsInitScript,
+ ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == 0) {
- zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_3;
+ zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
return TCL_OK;
}
@@ -6407,13 +6415,12 @@ TclZipfs_AppHook(
if (!zipfs_literal_tcl_library) {
TclNewLiteralStringObj(vfsInitScript,
- ZIPFS_TCL_LIBRARY_1 "/init.tcl");
+ ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
- zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
- Tcl_DecrRefCount(TclZipfs_TclLibrary());
+ zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return version;
}
}
@@ -6440,9 +6447,9 @@ TclZipfs_AppHook(
* wants it.
*/
- Tcl_DecrRefCount(TclZipfs_TclLibrary());
+ TclZipfs_TclLibrary();
TclNewLiteralStringObj(vfsInitScript,
- ZIPFS_TCL_LIBRARY_3 "install.tcl");
+ ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Tcl_SetStartupScript(vfsInitScript, NULL);
@@ -6452,17 +6459,6 @@ TclZipfs_AppHook(
int found;
Tcl_Obj *vfsInitScript;
- /* Set Tcl Encodings */
- TclNewLiteralStringObj(vfsInitScript,
- ZIPFS_TCL_LIBRARY_1 "/init.tcl");
- Tcl_IncrRefCount(vfsInitScript);
- found = Tcl_FSAccess(vfsInitScript, F_OK);
- Tcl_DecrRefCount(vfsInitScript);
- if (found == TCL_OK) {
- zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
- Tcl_DecrRefCount(TclZipfs_TclLibrary());
- }
-
TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -6474,8 +6470,14 @@ TclZipfs_AppHook(
} else {
Tcl_DecrRefCount(vfsInitScript);
}
-
+ /* Set Tcl Encodings */
+ TclNewLiteralStringObj(vfsInitScript,
+ ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ found = Tcl_FSAccess(vfsInitScript, F_OK);
+ Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
+ zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return version;
}
}
generated by cgit v0.12 at 2025-12-04 17:09:37 (GMT)