diff options
| -rw-r--r-- | library/http/http.tcl | 2 | ||||
| -rw-r--r-- | tools/mkVfs.tcl | 109 | ||||
| -rw-r--r-- | win/Makefile.in | 35 | ||||
| -rw-r--r-- | win/tclKitInit.c | 649 |
4 files changed, 454 insertions, 341 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index a6b2bfd..afa9458 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -12,7 +12,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.8 - +puts [list LOADED [info script]] namespace eval http { # Allow resourcing to not clobber existing data diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl new file mode 100644 index 0000000..c7bf17b --- /dev/null +++ b/tools/mkVfs.tcl @@ -0,0 +1,109 @@ +proc cat fname {
+ set fname [open $fname r]
+ set data [read $fname]
+ close $fname
+ return $data
+}
+
+proc pkgIndexDir {root fout d1} {
+
+ puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
+ [file tail $d1]]
+ set idx [string length $root]
+ foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+ set f [file join $d1 $ftail]
+ if {[file isdirectory $f] && [string compare CVS $ftail]} {
+ pkgIndexDir $root $fout $f
+ } elseif {[file tail $f] eq "pkgIndex.tcl"} {
+ puts $fout "set dir \$HERE[string range $d1 $idx end]"
+ puts $fout [cat $f]
+ }
+ }
+}
+
+###
+# Script to build the VFS file system
+###
+proc copyDir {d1 d2} {
+
+ puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
+ [file tail $d2]]
+
+ file delete -force -- $d2
+ file mkdir $d2
+
+ foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+ set f [file join $d1 $ftail]
+ if {[file isdirectory $f] && [string compare CVS $ftail]} {
+ copyDir $f [file join $d2 $ftail]
+ } elseif {[file isfile $f]} {
+ file copy -force $f [file join $d2 $ftail]
+ if {$::tcl_platform(platform) eq {unix}} {
+ file attributes [file join $d2 $ftail] -permissions 0644
+ } else {
+ file attributes [file join $d2 $ftail] -readonly 1
+ }
+ }
+ }
+
+ if {$::tcl_platform(platform) eq {unix}} {
+ file attributes $d2 -permissions 0755
+ } else {
+ file attributes $d2 -readonly 1
+ }
+}
+
+if {[llength $argv] < 3} {
+ puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
+ exit 1
+}
+set TCL_SCRIPT_DIR [lindex $argv 0]
+set TCLSRC_ROOT [lindex $argv 1]
+set PLATFORM [lindex $argv 2]
+
+puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
+copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}
+
+if {$PLATFORM == "windows"} {
+ set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
+ puts "DDE DLL $ddedll"
+ if {$ddedll != {}} {
+ file copy $ddedll ${TCL_SCRIPT_DIR}/dde
+ }
+ set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
+ puts "REG DLL $ddedll"
+ if {$regdll != {}} {
+ file copy $regdll ${TCL_SCRIPT_DIR}/reg
+ }
+} else {
+ # Remove the dde and reg package paths
+ file delete -force ${TCL_SCRIPT_DIR}/dde
+ file delete -force ${TCL_SCRIPT_DIR}/reg
+}
+
+# For the following packages, cat their pkgIndex files to tclIndex
+file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
+set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
+puts $fout {#
+# MANIFEST OF INCLUDED PACKAGES
+#
+set HERE $dir
+}
+pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
+close $fout
+exit 0
+puts $fout {
+# Save Tcl the trouble of hunting for these packages
+}
+set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
+puts "DDE DLL $ddedll"
+if {$ddedll != {}} {
+ puts $fout [cat ${TCL_SCRIPT_DIR}/dde/pkgIndex.tcl]
+}
+set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
+puts "REG DLL $ddedll"
+if {$regdll != {}} {
+ puts $fout [cat ${TCL_SCRIPT_DIR}/reg/pkgIndex.tcl]
+}
+close $fout
+file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 1
diff --git a/win/Makefile.in b/win/Makefile.in index e85cc16..ec824cc 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -103,6 +103,10 @@ COMPAT_DIR = $(TOP_DIR)/compat PKGS_DIR = $(TOP_DIR)/pkgs ZLIB_DIR = $(COMPAT_DIR)/zlib +VFS_SCRIPT_INSTALL_DIR = $(WIN_DIR)/tclvfs.zip/tcl$(VERSION) +VFS_PKG_INSTALL_DIR = $(WIN_DIR)/tclvfs.zip/lib + + # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ @@ -392,9 +396,6 @@ STUB_OBJS = \ TCLSH_OBJS = tclAppInit.$(OBJEXT) -TCLKIT_OBJS = tclKitInit.$(OBJEXT) - - ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ @@ -410,6 +411,10 @@ ZLIB_OBJS = \ TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ +TCLKIT_OBJS = tclKitInit.$(OBJEXT) \ + ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} + + TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc packages @@ -435,17 +440,17 @@ null.zip: # 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) +tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) + @echo "Building VFS File system in tclkit.vfs" + @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ + "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows + +$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs + $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat null.zip >> $(TCLKIT) - cd tclkit.vfs${prefix}/lib ; zip -rAq $(WIN_DIR)/$(TCLKIT) tcl8 tcl8.6 + cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -510,9 +515,6 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) -tclKitInit.$(OBJEXT): tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_KIT @DEPARG@ $(CC_OBJNAME) - # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -762,8 +764,9 @@ cleanhelp: clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) + $(RM) $(TCLSH) $(CAT32) $(TCLKIT) null.zip $(RM) *.pch *.ilk *.pdb + $(RMDIR) tclkit.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ diff --git a/win/tclKitInit.c b/win/tclKitInit.c index 69a298c..9531ab5 100644 --- a/win/tclKitInit.c +++ b/win/tclKitInit.c @@ -1,324 +1,325 @@ -/*
- * 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:
- */
+/* + * 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 "tclWinInt.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: + */ |