summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--unix/tclAppInit.c14
-rw-r--r--win/Makefile.in16
-rw-r--r--win/tclAppInit.c9
-rw-r--r--win/tclKitInit.c324
4 files changed, 339 insertions, 24 deletions
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 55e0452..9bbc88b 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -15,7 +15,7 @@
#undef BUILD_tcl
#undef STATIC_BUILD
#include "tcl.h"
-#include "tclInt.h"
+
#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
@@ -80,11 +80,7 @@ main(
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#endif
-#ifdef TCL_KIT
- /* This voodoo ensures that Tcl_Main does not eat the first argument */
- Tcl_FindExecutable(argv[0]);
- Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL);
-#endif
+
Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
return 0; /* Needed only to prevent compiler warning. */
}
@@ -112,10 +108,6 @@ int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
-#ifdef TCL_KIT
- Tcl_Zvfs_Boot(interp);
-#endif
-
if ((Tcl_Init)(interp) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -132,7 +124,7 @@ Tcl_AppInit(
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
#endif /* TCL_TEST */
-
+
/*
* Call the init procedures for included packages. Each call should look
* like this:
diff --git a/win/Makefile.in b/win/Makefile.in
index 3e44cff..e85cc16 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -433,13 +433,19 @@ null.zip:
touch .empty
zip -q null.zip .empty
-$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip
- $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+# Rather than force an install, pack the files we need into a
+# file system under our control
+tclkit.vfs:
+ make install-libraries DESTDIR=tclkit.vfs
+ make install-tzdata DESTDIR=tclkit.vfs
+ make install-packages DESTDIR=tclkit.vfs
+
+$(TCLKIT): $(TCLKIT_OBJS) $(TCL_OBJS) $(TOMMATH_OBJS) $(ZLIB_OBJS) tclsh.$(RES) null.zip tclkit.vfs
+ $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_OBJS) $(TOMMATH_OBJS) $(ZLIB_OBJS) \
+ $(LIBS) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
@VC_MANIFEST_EMBED_EXE@
- PWD=`pwd`
cat null.zip >> $(TCLKIT)
- cd ${prefix}/lib ; zip -rAq ${PWD}/$(TCLKIT) tcl8 tcl8.6
+ cd tclkit.vfs${prefix}/lib ; zip -rAq $(WIN_DIR)/$(TCLKIT) tcl8 tcl8.6
cat32.$(OBJEXT): cat.c
$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index c6b3b44..a6c1a67 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -123,11 +123,7 @@ _tmain(
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#endif
-#if defined TCL_KIT
- /* This voodoo ensures that Tcl_Main does not eat the first argument */
- Tcl_FindExecutable(argv[0]);
- Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL);
-#endif
+
Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
return 0; /* Needed only to prevent compiler warning. */
}
@@ -155,9 +151,6 @@ int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
-#if defined TCL_KIT
- Tcl_Zvfs_Boot(interp);
-#endif
if ((Tcl_Init)(interp) == TCL_ERROR) {
return TCL_ERROR;
}
diff --git a/win/tclKitInit.c b/win/tclKitInit.c
new file mode 100644
index 0000000..69a298c
--- /dev/null
+++ b/win/tclKitInit.c
@@ -0,0 +1,324 @@
+/*
+ * tclAppInit.c --
+ *
+ * Provides a default version of the main program and TclKit_AppInit
+ * procedure for tclsh and other Tcl-based applications (without Tk).
+ * Note that this program must be built in Win32 console mode to work
+ * properly.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tcl.h"
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+#include <locale.h>
+#include <stdlib.h>
+#include <tchar.h>
+
+extern Tcl_PackageInitProc Registry_Init;
+extern Tcl_PackageInitProc Dde_Init;
+extern Tcl_PackageInitProc Dde_SafeInit;
+
+#ifdef TCL_BROKEN_MAINARGS
+int _CRT_glob = 0;
+static void setargv(int *argcPtr, TCHAR ***argvPtr);
+#endif /* TCL_BROKEN_MAINARGS */
+
+/*
+ * The following #if block allows you to change the AppInit function by using
+ * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
+ * #if checks for that #define and uses TclKit_AppInit if it does not exist.
+ */
+#define TCLKIT_INIT "main.tcl"
+#define TCLKIT_VFSMOUNT "/zvfs"
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT TclKit_AppInit
+#endif
+#ifndef MODULE_SCOPE
+# define MODULE_SCOPE extern
+#endif
+MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
+
+/*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv, etc.,
+ * without needing to rewrite Tcl_Main()
+ */
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tcl_Main never returns here, so this procedure never returns
+ * either.
+ *
+ * Side effects:
+ * Just about anything, since from here we call arbitrary Tcl code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_BROKEN_MAINARGS
+int
+main(
+ int argc, /* Number of command-line arguments. */
+ char *dummy[]) /* Not used. */
+{
+ TCHAR **argv;
+#else
+int
+_tmain(
+ int argc, /* Number of command-line arguments. */
+ TCHAR *argv[]) /* Values of command-line arguments. */
+{
+#endif
+ TCHAR *p;
+
+ /*
+ * Set up the default locale to be standard "C" locale so parsing is
+ * performed correctly.
+ */
+
+ setlocale(LC_ALL, "C");
+
+#ifdef TCL_BROKEN_MAINARGS
+ /*
+ * Get our args from the c-runtime. Ignore command line.
+ */
+
+ setargv(&argc, &argv);
+#endif
+
+ /*
+ * Forward slashes substituted for backslashes.
+ */
+
+ for (p = argv[0]; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+ /* This voodoo ensures that Tcl_Main does not eat the first argument */
+ Tcl_FindExecutable(argv[0]);
+ Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL);
+ Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclKit_AppInit --
+ *
+ * This procedure performs application-specific initialization. Most
+ * applications, especially those that incorporate additional packages,
+ * will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclKit_AppInit(
+ Tcl_Interp *interp) /* Interpreter for application. */
+{
+ Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT);
+ if ((Tcl_Init)(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (Registry_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+
+ if (Dde_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
+
+ /*
+ * Call the init procedures for included packages. Each call should look
+ * like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module. (Dynamically-loadable packages
+ * should have the same entry-point name.)
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if they
+ * weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application is
+ * run interactively. Typically the startup file is "~/.apprc" where "app"
+ * is the name of the application. If this line is deleted then no
+ * user-specific startup file will be run under any conditions.
+ */
+
+ (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * setargv --
+ *
+ * Parse the Windows command line string into argc/argv. Done here
+ * because we don't trust the builtin argument parser in crt0. Windows
+ * applications are responsible for breaking their command line into
+ * arguments.
+ *
+ * 2N backslashes + quote -> N backslashes + begin quoted string
+ * 2N + 1 backslashes + quote -> literal
+ * N backslashes + non-quote -> literal
+ * quote + quote in a quoted string -> single quote
+ * quote + quote not in quoted string -> empty string
+ * quote -> begin quoted string
+ *
+ * Results:
+ * Fills argcPtr with the number of arguments and argvPtr with the array
+ * of arguments.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+#ifdef TCL_BROKEN_MAINARGS
+static void
+setargv(
+ int *argcPtr, /* Filled with number of argument strings. */
+ TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
+{
+ TCHAR *cmdLine, *p, *arg, *argSpace;
+ TCHAR **argv;
+ int argc, size, inquote, copy, slashes;
+
+ cmdLine = GetCommandLine();
+
+ /*
+ * Precompute an overly pessimistic guess at the number of arguments in
+ * the command line by counting non-space spans.
+ */
+
+ size = 2;
+ for (p = cmdLine; *p != '\0'; p++) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ size++;
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+ }
+ }
+
+ /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
+ #undef Tcl_Alloc
+ #undef Tcl_DbCkalloc
+
+ argSpace = ckalloc(size * sizeof(char *)
+ + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
+ argv = (TCHAR **) argSpace;
+ argSpace += size * (sizeof(char *)/sizeof(TCHAR));
+ size--;
+
+ p = cmdLine;
+ for (argc = 0; argc < size; argc++) {
+ argv[argc] = arg = argSpace;
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ inquote = 0;
+ slashes = 0;
+ while (1) {
+ copy = 1;
+ while (*p == '\\') {
+ slashes++;
+ p++;
+ }
+ if (*p == '"') {
+ if ((slashes & 1) == 0) {
+ copy = 0;
+ if ((inquote) && (p[1] == '"')) {
+ p++;
+ copy = 1;
+ } else {
+ inquote = !inquote;
+ }
+ }
+ slashes >>= 1;
+ }
+
+ while (slashes) {
+ *arg = '\\';
+ arg++;
+ slashes--;
+ }
+
+ if ((*p == '\0') || (!inquote &&
+ ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
+ break;
+ }
+ if (copy != 0) {
+ *arg = *p;
+ arg++;
+ }
+ p++;
+ }
+ *arg = '\0';
+ argSpace = arg + 1;
+ }
+ argv[argc] = NULL;
+
+ *argcPtr = argc;
+ *argvPtr = argv;
+}
+#endif /* TCL_BROKEN_MAINARGS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
generated by cgit v0.12 at 2024-11-17 00:50:00 (GMT)