Changes On Branch dgp-zipfs-init
Not logged in
Home Timeline Branches Tags Tickets Wiki Login
Patch Side-by-Side Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch dgp-zipfs-init Excluding Merge-Ins

This is equivalent to a diff from 485ec1e499 to e497f19fcb

2023-11-30
19:25
Merge 8.6 check-in: 2d583b1bda user: oehhar tags: core-8-branch
2023-11-27
15:59
merge 8.7 Leaf check-in: e497f19fcb user: dgp tags: dgp-zipfs-init
12:13
Merge 8.7 check-in: 62df1603d4 user: jan.nijtmans tags: trunk, main
12:11
Merge 8.6. Remove out-of-date documentation (was skipped in documentation-generation anyway. check-in: 485ec1e499 user: jan.nijtmans tags: core-8-branch
12:01
(cherry-pick) Corrected synopsis of namespace manual page where the subcommand was wrongly declared ... check-in: e75a7804a1 user: jan.nijtmans tags: core-8-6-branch
2023-11-24
14:28
Need Tcl_Size #define a little earlier (for 8.6) check-in: 28d2363ed6 user: jan.nijtmans tags: core-8-branch
2023-11-20
14:25
merge 8.7 check-in: b1dc168e85 user: dgp tags: dgp-zipfs-init

Changes to generic/tclInterp.c.
︙
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412

398
399
400
401
402
403
404

405
406
407
408
409
410
411








-








"	if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
"	    lappend scripts {set env(TCL_LIBRARY)}\n"
"	    lappend scripts {\n"
"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n"
"if {$tail eq [info tclversion]} continue\n"
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
"	}\n"
"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
"	if {[info exists tclDefaultLibrary]} {\n"
"	    lappend scripts {set tclDefaultLibrary}\n"
"	} else {\n"
"	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
"	}\n"
"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
︙
Changes to generic/tclZipfs.c.
︙
87
88
89
90
91
92
93











94
95
96
97
98
99
100

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111








+
+
+
+
+
+
+
+
+
+
+








*/

#define ZIPFS_VOLUME	  "//zipfs:/"
#define ZIPFS_ROOTDIR_DEPTH 3 /* Number of / in root mount */
#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"

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4
︙
309
310
311
312
313
314
315

316
317
318
319
320
321
322

320
321
322
323
324
325
326
327
328
329
330
331
332
333
334








+








 */

static const char pwrot[17] =
    "\x00\x80\x40\xC0\x20\xA0\x60\xE0"
    "\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 */

static int		CopyImageFile(Tcl_Interp *interp, const char *imgName,
			    Tcl_Channel out);
static int		DescribeMounted(Tcl_Interp *interp,
			    const char *mountPoint);
︙
4226
4227
4228
4229
4230
4231
4232






















4233
4234
4235
4236
4237
4238
4239

4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








/* Utility routine to centralize housekeeping */
static Tcl_Obj *
ScriptLibrarySetup(
    const char *dirName)
{
    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);
    Tcl_ListObjAppendElement(NULL, searchPathObj,
	    Tcl_FSJoinToPath(libDirObj, 1, &subDirObj));
    Tcl_DecrRefCount(subDirObj);
︙
4264
4265
4266
4267
4268
4269
4270
4271

4272
4273
4274
4275
4276
4277

4278
4279
4280
4281
4282
4283
4284

4298
4299
4300
4301
4302
4303
4304

4305

4306
4307
4308
4309

4310
4311
4312
4313
4314
4315
4316
4317








-
+
-




-
+








	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }

    /*
     * Look for the library file system within the executable.
     */

    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
    vfsInitScript = Tcl_NewStringObj(ZIPFS_TCL_LIBRARY_1 "/init.tcl", -1);
	    -1);
    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";
	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }

    /*
     * Look for the library file system within the DLL/shared library.  Note
     * that we must mount the zip file and dll before releasing to search.
     */
︙
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366

4348
4349
4350
4351
4352
4353
4354






































4355
4356
4357
4358
4359
4360
4361








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








     */

    if (zipfs_literal_tcl_library) {
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * 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.
︙
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264

6244
6245
6246
6247
6248
6249
6250


6251
6252
6253
6254
6255
6256
6257








-
-








	/*
	 * Add the [zipfs find] subcommand.
	 */

	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;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
    return TCL_ERROR;
︙
6279
6280
6281
6282
6283
6284
6285
6286

6287
6288
6289
6290
6291

6292
6293
6294
6295

6296
6297
6298
6299
6300
6301

6302
6303
6304
6305
6306
6307
6308

6272
6273
6274
6275
6276
6277
6278

6279
6280
6281
6282
6283

6284
6285
6286
6287

6288

6289
6290
6291
6292

6293
6294
6295
6296
6297
6298
6299
6300








-
+




-
+



-
+
-




-
+








	return TCL_ERROR;
    }
    if (TclZipfs_Mount(NULL, archive, ZIPFS_ZIP_MOUNT, NULL)) {
	/* Either the file doesn't exist or it is not a zip archive */
	return TCL_ERROR;
    }

    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
    TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_2 "/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_2;
	return TCL_OK;
    }

    TclNewLiteralStringObj(vfsInitScript,
    TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "/init.tcl");
	    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_ZIP_MOUNT "/tcl_library";
	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_3;
	return TCL_OK;
    }

    return TCL_ERROR;
}
#endif
︙
6411
6412
6413
6414
6415
6416
6417
6418

6419
6420
6421
6422
6423


6424
6425
6426
6427
6428
6429
6430

6403
6404
6405
6406
6407
6408
6409

6410
6411
6412
6413
6414

6415
6416
6417
6418
6419
6420
6421
6422
6423








-
+




-
+
+









	/*
	 * Set Tcl Encodings
	 */

	if (!zipfs_literal_tcl_library) {
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
		    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_APP_MOUNT "/tcl_library";
		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
		Tcl_DecrRefCount(TclZipfs_TclLibrary());
		return version;
	    }
	}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    } else if (*argcPtr > 1) {
	/*
	 * If the first argument is "install", run the supplied installer
︙
6443
6444
6445
6446
6447
6448
6449
6450

6451
6452

6453
6454
6455
6456
6457
6458
6459
6460











6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473

6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487

6436
6437
6438
6439
6440
6441
6442

6443
6444

6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476

6477





6478

6479
6480
6481
6482
6483
6484
6485








-
+

-
+








+
+
+
+
+
+
+
+
+
+
+












-
+
-
-
-
-
-

-








	    Tcl_Obj *vfsInitScript;

	    /*
	     * Run this now to ensure the file is present by the time Tcl_Main
	     * wants it.
	     */

	    TclZipfs_TclLibrary();
	    Tcl_DecrRefCount(TclZipfs_TclLibrary());
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
		    ZIPFS_TCL_LIBRARY_3 "install.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		Tcl_SetStartupScript(vfsInitScript, NULL);
	    }
	    return version;
	} else if (!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) {
	    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) {
		/*
		 * Startup script should be set before calling Tcl_AppInit
		 */

		Tcl_SetStartupScript(vfsInitScript, NULL);
	    } 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;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
︙
This page was created in about 0.037s by Fossil version [1205ec86cb] 2025-04-30 16:57:32