KitCreator
Check-in [e98c176999]
Login
HomeDownloadsSource CodeTicketsWiki
Overview
Comment:Updated to mount vfs::zip VFS from DLL into /.KITDLL_USER

Updated to mount vfs::zip VFS from application into /.KITDLL_APP

Minor cleanup and added comments

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e98c176999aa8cb963e567bac7b01e1365f8db7c
User & Date: rkeene on 2010-10-01 20:20:09
Other Links: manifest | tags
Context
2010-10-01
20:45
Updated to include a "package ifneeded" script for Tk on Win32 in addition to other platforms, if Tk built statically. check-in: d3373882b3 user: rkeene tags: trunk
20:20
Updated to mount vfs::zip VFS from DLL into /.KITDLL_USER

Updated to mount vfs::zip VFS from application into /.KITDLL_APP

Minor cleanup and added comments check-in: e98c176999 user: rkeene tags: trunk

20:18
Updated Tcl build to export DLL functionality when building KitDLL check-in: 07648651bc user: rkeene tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified kitdll/buildsrc/kitdll-0.0/Makefile.in from [0b69684cf7] to [1e7d1c5fcd].

︙
50
51
52
53
54
55
56

57
58
59
60

50
51
52
53
54
55
56
57
58
59
60
61








+





	rm -f tclsh.o tclsh tclsh.exe
	rm -f wish.o wish wish.exe

distclean: clean
	rm -f config.status config.log
	rm -f *~
	rm -f Makefile
	rm -rf starpack.vfs

mrproper: distclean

.PHONY: all clean distclean

Modified kitdll/buildsrc/kitdll-0.0/aclocal.m4 from [8720922151] to [5c684392af].

︙
252
253
254
255
256
257
258




























252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285








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


		AC_MSG_RESULT([${libfiles}])
	done

	AC_SUBST(WISH_CFLAGS)
	AC_SUBST(ARCHS)
])

AC_DEFUN(DC_CHECK_FOR_ACCEPTABLE_DLADDR, [
	AC_CHECK_HEADERS(dlfcn.h)
	AC_CHECK_FUNCS(dladdr)

	AC_MSG_CHECKING([for acceptable dladdr])

	AC_LINK_IFELSE(
		AC_LANG_PROGRAM([[
#ifdef HAVE_DLFCN_H
#include <dlfcn.h>
#endif
			]], [[
char *x;
Dl_info syminfo;
dladdr((void *) 0, &syminfo);
x = syminfo.dli_fname;
			]]
		),
		[
			AC_MSG_RESULT([found])
			AC_DEFINE(HAVE_ACCEPTABLE_DLADDR, [1], [Define to 1 if you have an acceptable dladdr implementation with dli_fname])
		], [
			AC_MSG_RESULT([not found])
		]
	)
])

Modified kitdll/buildsrc/kitdll-0.0/boot.tcl from [05bce6a79b] to [31a964e643]. 

1
2
3
4
5

6
7
8

9
10
11


12
13
14
15
16
17

18
19
20
21
22
23
24

1
2
3
4

5
6
7

8
9


10
11
12
13
14
15
16

17
18
19
20
21
22
23
24





-
+


-
+

-
-
+
+





-
+








proc tclInit {} {
	rename tclInit {}

	global auto_path tcl_library tcl_libPath
	global tcl_version tcl_rcFileName
	global tcl_version
  
	# Set path where to mount VFS
	set noe "/.KITDLL_TCL"
	set tcl_mountpoint "/.KITDLL_TCL"

	set tcl_library [file join $noe lib tcl$tcl_version]
	set tcl_libPath [list $tcl_library [file join $noe lib]]
	set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version]
	set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]]

	# get rid of a build residue
	unset -nocomplain ::tclDefaultLibrary

	# the following code only gets executed once on startup
	if {[info exists tcl_rcFileName]} {
	if {[info exists ::initVFS]} {
		set vfsHandler [list ::vfs::kitdll::vfshandler tcl]

		# alter path to find encodings
		if {[info tclversion] eq "8.4"} {
			load {} pwb
			librarypath [info library]
		} else {
︙
46
47
48
49
50
51
52
53

54
55
56


57
58
59
60




61
62
63

64
65
66
67
68
69
70
71
72
73
74































46
47
48
49
50
51
52

53
54


55
56
57



58
59
60
61
62
63

64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104








-
+

-
-
+
+

-
-
-
+
+
+
+


-
+










-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

			}
		}

		# now remount the executable with the correct encoding
		vfs::filesystem unmount [lindex [::vfs::filesystem info] 0]

		# Resolve symlinks
		set noe [file dirname [file normalize [file join $noe __dummy__]]]
		set tcl_mountpoint [file dirname [file normalize [file join $tcl_mountpoint __dummy__]]]

		set tcl_library [file join $noe lib tcl$tcl_version]
		set tcl_libPath [list $tcl_library [file join $noe lib]]
		set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version]
		set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]]

		vfs::filesystem mount $noe $vfsHandler
	}
  
		vfs::filesystem mount $tcl_mountpoint $vfsHandler

	}

	# load config settings file if present
	namespace eval ::vfs { variable tclkit_version 1 }
	catch { uplevel #0 [list source [file join $noe config.tcl]] }
	catch { uplevel #0 [list source [file join $tcl_mountpoint config.tcl]] }

	uplevel #0 [list source [file join $tcl_library init.tcl]]
  
	# reset auto_path, so that init.tcl's search outside of tclkit is cancelled
	set auto_path $tcl_libPath

	# This loads everything needed for "clock scan" to work
	# "clock scan" is used within "vfs::zip", which may be
	# loaded before this is run causing the root VFS to break
	catch { clock scan }
}

	# Load these, the original Tclkit does so it should be safe.
	uplevel #0 [list source [file join $tcl_mountpoint lib vfs vfsUtils.tcl]]

	# Now that the initialization is complete, mount the user VFS if needed
	## Mount the VFS from the Shared Object
	if {[info exists ::initVFS] && [info exists ::tclKitFilename]} {
		catch {
			package require vfs::zip

			vfs::zip::Mount $::tclKitFilename "/.KITDLL_USER"

			lappend auto_path [file normalize "/.KITDLL_USER/lib"]
		}
	}

	## Mount the VFS from executable
	if {[info exists ::initVFS]} {
		catch {
			package require vfs::zip

			vfs::zip::Mount [info nameofexecutable] "/.KITDLL_APP"

			lappend auto_path [file normalize "/.KITDLL_APP/lib"]
		}
	}

	# Clean up after the kitInit.c:preInitCmd
	unset -nocomplain ::initVFS ::tclKitFilename
}

Modified kitdll/buildsrc/kitdll-0.0/configure.ac from [b8d6fe9340] to [1f754d4d41].

︙
33
34
35
36
37
38
39






40
41
42

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+
+
+
+
+
+





dnl Find extra objects we need to link as a part of "libtclkit"
AC_SUBST(EXTRA_OBJS)

dnl Check for optional headers
AC_HEADER_STDC
AC_CHECK_HEADERS(unistd.h string.h strings.h)

dnl Check for optional system calls
AC_CHECK_FUNCS(readlink)

dnl Check for acceptable dladdr so we can find ourselves on UNIX
DC_CHECK_FOR_ACCEPTABLE_DLADDR

dnl Produce output
AC_OUTPUT(Makefile)

Modified kitdll/buildsrc/kitdll-0.0/kitInit.c from [6d34381c61] to [1913b3a1f3]. 

1
2
3
4
5
6
7
8
9
10
11










12
13
14
15
16



17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33





34
35
36
37
38
39
40
41

42



43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60



























































































































61


62
63
64
65
66









67
68
69
70
71
72
73
74
75
76
77
78






79
80
81
82
83
84
85
86
87
88
89
90
91
92




93
94
95
96
97
98
99

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264












+
+
+
+
+
+
+
+
+
+





+
+
+

















+
+
+
+
+








+
-
+
+
+


















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

+
+





+
+
+
+
+
+
+
+
+












+
+
+
+
+
+














+
+
+
+








#ifdef KIT_INCLUDES_TK
#  include <tk.h>
#else
#  include <tcl.h>
#endif /* KIT_INCLUDES_TK */

#ifdef _WIN32
#  define WIN32_LEAN_AND_MEAN
#  include <windows.h>
#  undef WIN32_LEAN_AND_MEAN
#endif /* _WIN32 */

#ifdef HAVE_STRING_H
#  include <string.h>
#endif
#ifdef HAVE_STRINGS_H
#  include <strings.h>
#endif
#ifdef HAVE_DLFCN_H
#  include <dlfcn.h>
#endif

#include "tclInt.h"

#if defined(HAVE_TCL_GETENCODINGNAMEFROMENVIRONMENT) && defined(HAVE_TCL_SETSYSTEMENCODING)
#  define TCLKIT_CAN_SET_ENCODING 1
#endif
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
#  define TCLKIT_REQUIRE_TCLEXECUTABLENAME 1
#endif
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
#  define KIT_INCLUDES_PWB 1
#endif

Tcl_AppInitProc Vfs_Init, Rechan_Init;
Tcl_AppInitProc Vfs_kitdll_data_tcl_Init;
#ifdef KIT_INCLUDES_PWB
Tcl_AppInitProc Pwb_Init;
#endif
#ifdef TCL_THREADS
Tcl_AppInitProc Thread_Init;
#endif
#ifdef _WIN32
Tcl_AppInitProc Dde_Init, Registry_Init;
#endif

/*
 * This Tcl code is invoked whenever Tcl_Init() is called on an
 * interpreter.  It should mount up the VFS and make everything ready for
 * that interpreter to do its job.
 */
static char *preInitCmd =
"proc tclKitInit {} {\n"
	"rename tclKitInit {}\n"
	"load {} tclkit::init\n"
	"load {} rechan\n"
	"load {} vfs\n"
	"load {} vfs_kitdll_data_tcl\n"
#include "vfs_kitdll.tcl.h"
	"if {![file exists \"/.KITDLL_TCL/boot.tcl\"]} {\n"
	"vfs::kitdll::Mount tcl /.KITDLL_TCL\n"
		"vfs::kitdll::Mount tcl /.KITDLL_TCL\n"
		"set ::initVFS 1\n"
	"}\n"
	"set f [open \"/.KITDLL_TCL/boot.tcl\"]\n"
	"set s [read $f]\n"
	"close $f\n"
	"::tclkit::init::initInterp\n"
	"rename ::tclkit::init::initInterp {}\n"
	"uplevel #0 $s\n"
#if defined(KIT_INCLUDES_TK) && defined(KIT_TK_VERSION)
	"package ifneeded Tk " KIT_TK_VERSION " {\n"
		"load {} Tk\n"
	"}\n"
#endif
#ifdef _WIN32
	"catch {load {} dde}\n"
	"catch {load {} registry}\n"
#endif /* _WIN32 */
"}\n"
"tclKitInit";

#ifdef HAVE_ACCEPTABLE_DLADDR
/* Symbol to resolve against dladdr() */
static void _tclkit_dummy_func(void) {
	return;
}

int main(int argc, char **argv);
#endif /* HAVE_ACCEPTABLE_DLADDR */

/*
 * This function will return a pathname we can open() to treat as a VFS,
 * hopefully
 */
static char *find_tclkit_dll_path(void) {
#ifdef HAVE_ACCEPTABLE_DLADDR
	Dl_info syminfo;
	int dladdr_ret;
#endif /* HAVE_ACCEPTABLE_DLADDR */
#ifdef _WIN32
	TCHAR modulename[8192];
	DWORD gmfn_ret;
#endif /* _WIN32 */

#ifdef HAVE_ACCEPTABLE_DLADDR
	dladdr_ret = dladdr(&_tclkit_dummy_func, &syminfo);
	if (dladdr_ret != 0) {
		if (syminfo.dli_fname && syminfo.dli_fname[0] != '\0') {
			return(strdup(syminfo.dli_fname));
		}
	}
#endif /* HAVE_ACCEPTABLE_DLADDR */

#ifdef _WIN32
	gmfn_ret = GetModuleFileName(TclWinGetTclInstance(), modulename, sizeof(modulename) / sizeof(modulename[0]) - 1);

	if (gmfn_ret != 0) {
		return(strdup(modulename));
	}
#endif /* _WIN32 */

	return(NULL);
}

/* SetExecName --
	
   Hack to get around Tcl bug 1224888.
*/
static void SetExecName(Tcl_Interp *interp, const char *path) {
#ifdef TCLKIT_REQUIRE_TCLEXECUTABLENAME
	tclExecutableName = strdup(path);
#endif  
	Tcl_FindExecutable(path);

	return;
}
	
static void FindAndSetExecName(Tcl_Interp *interp) {
	int len = 0;
	Tcl_Obj *execNameObj;
	Tcl_Obj *lobjv[1];
#ifdef HAVE_READLINK
	ssize_t readlink_ret;
	char exe_buf[4096];
#endif /* HAVE_READLINK */
#ifdef HAVE_ACCEPTABLE_DLADDR
	Dl_info syminfo;
	int dladdr_ret;
#endif /* HAVE_ACCEPTABLE_DLADDR */

#ifdef HAVE_READLINK
	if (Tcl_GetNameOfExecutable() == NULL) {
		readlink_ret = readlink("/proc/self/exe", exe_buf, sizeof(exe_buf) - 1);
		
		if (readlink_ret > 0 && readlink_ret < (sizeof(exe_buf) - 1)) {
			exe_buf[readlink_ret] = '\0';
			
			SetExecName(interp, exe_buf);
			
			return;
		}
	}
	
	if (Tcl_GetNameOfExecutable() == NULL) {
		readlink_ret = readlink("/proc/curproc/file", exe_buf, sizeof(exe_buf) - 1);												 

		if (readlink_ret > 0 && readlink_ret < (sizeof(exe_buf) - 1)) {
			exe_buf[readlink_ret] = '\0';

			if (strcmp(exe_buf, "unknown") != 0) {
				SetExecName(interp, exe_buf);

				return;
			}
		}
	}
#endif /* HAVE_READLINK */

#ifdef HAVE_ACCEPTABLE_DLADDR
	if (Tcl_GetNameOfExecutable() == NULL) {
		dladdr_ret = dladdr(&main, &syminfo);
		if (dladdr_ret != 0) {
			SetExecName(interp, syminfo.dli_fname);
		}
	}
#endif /* HAVE_ACCEPTABLE_DLADDR */

	if (Tcl_GetNameOfExecutable() == NULL) {
		lobjv[0] = Tcl_GetVar2Ex(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
		execNameObj = Tcl_FSJoinToPath(Tcl_FSGetCwd(interp), 1, lobjv);

		SetExecName(interp, Tcl_GetStringFromObj(execNameObj, &len));

		return;
	}

	return;
}


/*
 * This function exists to allow C code to initialize a particular
 * interpreter.
 */
static int tclkit_init_initinterp(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
	char *kitdll_path;

#ifdef _WIN32
	Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
#else   
	Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
#endif

	kitdll_path = find_tclkit_dll_path();
	if (kitdll_path != NULL) {
		Tcl_SetVar(interp, "tclKitFilename", kitdll_path, TCL_GLOBAL_ONLY);

		free(kitdll_path);
	}

	FindAndSetExecName(interp);

#ifdef TCLKIT_CAN_SET_ENCODING
	/* Set the encoding from the Environment */
	Tcl_GetEncodingNameFromEnvironment(&encodingName);
	Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
	Tcl_SetVar(interp, "tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
	Tcl_DStringFree(&encodingName);
#endif  

	return(TCL_OK);
}

/*
 * Create a package for initializing a particular interpreter.  This is
 * our hook to have Tcl invoke C commands when creating an interpreter.
 * The preInitCmd will load the package in the new interpreter and invoke
 * this function.
 */
int Tclkit_init_Init(Tcl_Interp *interp) {
	Tcl_Command tclCreatComm_ret;
	int tclPkgProv_ret;

	tclCreatComm_ret = Tcl_CreateObjCommand(interp, "::tclkit::init::initInterp", tclkit_init_initinterp, NULL, NULL);
	if (!tclCreatComm_ret) {
		return(TCL_ERROR);
	}

	tclPkgProv_ret = Tcl_PkgProvide(interp, "tclkit::init", "1.0");

	return(tclPkgProv_ret);
}

/*
 * Initialize the Tcl system when we are loaded, that way Tcl functions
 * are ready to be used when invoked.
 */
void __attribute__((constructor)) _Tclkit_Init(void) {
	Tcl_StaticPackage(0, "tclkit::init", Tclkit_init_Init, NULL);
	Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
	Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
	Tcl_StaticPackage(0, "vfs_kitdll_data_tcl", Vfs_kitdll_data_tcl_Init, NULL);
#ifdef KIT_INCLUDES_PWB
	Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);
︙

Powered by Fossil · RSS