summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in86
-rw-r--r--win/README26
-rw-r--r--win/coffbase.txt2
-rwxr-xr-xwin/configure31
-rw-r--r--win/configure.in15
-rw-r--r--win/makefile.bc4
-rw-r--r--win/makefile.vc97
-rw-r--r--win/nmakehlp.c71
-rw-r--r--win/rules.vc10
-rw-r--r--win/tcl.m412
-rw-r--r--win/tclWinDde.c453
-rw-r--r--win/tclWinError.c11
-rw-r--r--win/tclWinFCmd.c18
-rw-r--r--win/tclWinFile.c30
-rw-r--r--win/tclWinInit.c7
-rw-r--r--win/tclWinInt.h6
-rw-r--r--win/tclWinLoad.c2
-rw-r--r--win/tclWinPipe.c69
-rw-r--r--win/tclWinReg.c138
-rw-r--r--win/tclWinSock.c56
-rw-r--r--win/tclWinTest.c82
21 files changed, 654 insertions, 572 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 8492b8f..84dcaf7 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -137,10 +137,9 @@ TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
ZLIB_DLL_FILE = zlib1.dll
SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
-STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
+STATIC_LIBRARIES = $(TCL_LIB_FILE)
TCLSH = tclsh$(VER)${EXESUFFIX}
-TCLTEST = tcltest${EXEEXT}
CAT32 = cat32$(EXEEXT)
MAN2TCL = man2tcl$(EXEEXT)
@@ -403,7 +402,7 @@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
all: binaries libraries doc packages
-tcltest: $(TCLTEST)
+tcltest: $(TCLSH) $(TEST_DLL_FILE)
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH)
@@ -416,11 +415,6 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
@VC_MANIFEST_EMBED_EXE@
-$(TCLTEST): testMain.$(OBJEXT) ${TEST_DLL_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES)
- $(CC) $(CFLAGS) testMain.$(OBJEXT) ${TEST_LIB_FILE} $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
- @VC_MANIFEST_EMBED_EXE@
-
cat32.$(OBJEXT): cat.c
$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
@@ -440,9 +434,9 @@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
@VC_MANIFEST_EMBED_DLL@
-${TCL_LIB_FILE}: ${TCL_OBJS}
+${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@$(RM) ${TCL_LIB_FILE}
- @MAKE_LIB@ ${TCL_OBJS}
+ @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@POST_MAKE_LIB@
# assume GNU make
@@ -451,31 +445,11 @@ ${TCL_LIB_FILE}: ${TCL_OBJS}
# targets have to depend on tcl<x>.lib, this ensures that linking of tcl<x>.dll
# does not execute concurrently with the renaming and recompiling of tcl<x>.lib
-${DDE_DLL_FILE}: ${DDE_OBJS} ${DDE_LIB_FILE} ${TCL_STUB_LIB_FILE}
- @-$(RM) ${DDE_DLL_FILE} ${DDE_LIB_FILE}.sav
- @-$(COPY) ${DDE_LIB_FILE} ${DDE_LIB_FILE}.sav
+${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE}
@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
- @-$(RM) ${DDE_LIB_FILE}
- @-$(COPY) ${DDE_LIB_FILE}.sav ${DDE_LIB_FILE}
- @-$(RM) ${DDE_LIB_FILE}.sav
-${DDE_LIB_FILE}: ${DDE_OBJS}
- @$(RM) ${DDE_LIB_FILE}
- @MAKE_LIB@ ${DDE_OBJS}
- @POST_MAKE_LIB@
-
-${REG_DLL_FILE}: ${REG_OBJS} ${REG_LIB_FILE} ${TCL_STUB_LIB_FILE}
- @-$(RM) ${REG_DLL_FILE} ${REG_LIB_FILE}.sav
- @-$(COPY) ${REG_LIB_FILE} ${REG_LIB_FILE}.sav
+${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
- @-$(RM) ${REG_LIB_FILE}
- @-$(COPY) ${REG_LIB_FILE}.sav ${REG_LIB_FILE}
- @-$(RM) ${REG_LIB_FILE}.sav
-
-${REG_LIB_FILE}: ${REG_OBJS}
- @$(RM) ${REG_LIB_FILE}
- @MAKE_LIB@ ${REG_OBJS}
- @POST_MAKE_LIB@
${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE}
@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
@@ -606,23 +580,23 @@ install-binaries: binaries
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde1.3; \
+ $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
$(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg1.3; \
+ $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
fi
install-libraries: libraries install-tzdata install-msgs
@@ -669,8 +643,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.4.4 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
+ @echo "Installing package msgcat 1.4.5 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.5.tm;
@echo "Installing package tcltest 2.3.4 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
@echo "Installing package platform 1.0.10 as a Tcl Module";
@@ -719,17 +693,19 @@ install-private-headers: libraries
test: test-tcl test-packages
-test-tcl: binaries $(TCLTEST)
+test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
- set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32)
+ ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
+ -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
+ package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
-# Useful target to launch a built tcltest with the proper path,...
-runtest: binaries $(TCLTEST)
+# Useful target to launch a built tclsh with the proper path,...
+runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
- set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT)
+ ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
+ package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
@@ -753,7 +729,7 @@ cleanhelp:
clean: cleanhelp clean-packages
$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
- $(RM) $(TCLSH) $(TCLTEST) $(CAT32)
+ $(RM) $(TCLSH) $(CAT32)
$(RM) *.pch *.ilk *.pdb
distclean: distclean-packages clean
@@ -849,14 +825,14 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
@echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tcl.decls" \
- "$(GENERIC_DIR_NATIVE)\tclInt.decls" \
- "$(GENERIC_DIR_NATIVE)\tclTomMath.decls"
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ "$(GENERIC_DIR_NATIVE)/tcl.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclInt.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls"
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tclOO.decls"
+ "$(GENERIC_DIR_NATIVE)/tclOO.decls"
#
# This target creates the HTML folder for Tcl & Tk and places it in
diff --git a/win/README b/win/README
index 98ba19f..8b257b1 100644
--- a/win/README
+++ b/win/README
@@ -24,28 +24,28 @@ In order to compile Tcl for Windows, you need the following:
or
- Linux + MinGW-w64 (any distribution e.g. Ubuntu)
- (for either 32-bit or 64-bit executables)
+ Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/]
+ (win32 or win64)
or
Cygwin + MinGW-w64 [http://cygwin.com/install.html]
- (for either 32-bit or 64-bit executables)
+ (win32 or win64)
or
Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/]
- (for either 32-bit or 64-bit executables)
+ (win32 or win64)
or
Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/]
- (for either 32-bit or 64-bit executables)
+ (win32 or win64)
or
- Msys + Mingw [http://www.mingw.org/download.shtml]
- (32-bit executables only)
+ Msys + MinGW [http://www.mingw.org/download.shtml]
+ (win32 only)
In practice, this release is built with Visual C++ 6.0 and the TEA
@@ -67,20 +67,20 @@ configure/build process works just like the UNIX one, so you will want
to refer to ../unix/README for available configure options.
If you want 64-bit executables (x86_64), you need to configure using
-the --enable-64bit option. Then make sure that the x86_64-w64-mingw32
+the --enable-64bit option. Make sure that the x86_64-w64-mingw32
compiler is present. For Cygwin this compiler can be found in the
"mingw64-x86_64-gcc-core" package, which can be installed through
the normal Cygwin install process. If you only want 32-bit executables,
-the "mingw64-i686-gcc-core" package is what you need. If your Linux
-distribution does not have a MinGW-w64 package, you can download one
-from [https://sourceforge.net/projects/mingw-w64/files/]
+the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin
+and Msys, you can download a suitable win32 or win64 compiler from
+[https://sourceforge.net/projects/mingw-w64/files/]
Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
-Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on
-your path, in the system directory, or in the directory containing
+Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is
+on your path, in the system directory, or in the directory containing
tclsh86.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/coffbase.txt b/win/coffbase.txt
index 7d19420..bdf5506 100644
--- a/win/coffbase.txt
+++ b/win/coffbase.txt
@@ -24,6 +24,7 @@ blt 0x10680000 0x00080000
iocpsock 0x10700000 0x00080000
tls 0x10780000 0x00100000
winico 0x10880000 0x00010000
+sample 0x108B0000 0x00010000
tile 0x10900000 0x00080000
memchan 0x109D0000 0x00010000
tdom 0x109E0000 0x00080000
@@ -32,6 +33,7 @@ tkvideo 0x10B00000 0x00010000
tclsdl 0x10B20000 0x00080000
vqtcl 0x10C00000 0x00010000
tdbc 0x10C40000 0x00010000
+thread 0x10C80000 0x00020000
;
; insert new packages here
;
diff --git a/win/configure b/win/configure
index f3bd0d9..f5a23fe 100755
--- a/win/configure
+++ b/win/configure
@@ -309,7 +309,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -840,18 +840,18 @@ if test -n "$ac_init_help"; then
Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-threads build with threads
- --enable-shared build and link with shared libraries --enable-shared
+ --enable-threads build with threads (default: on)
+ --enable-shared build and link with shared libraries (default: on)
--enable-64bit enable 64bit support (where applicable)
--enable-wince enable Win/CE support (where applicable)
- --enable-symbols build with debugging symbols --disable-symbols
+ --enable-symbols build with debugging symbols (default: off)
--enable-embedded-manifest
embed manifest if possible (default: yes)
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-encoding encoding for configuration values
+ --with-encoding encoding for configuration values
--with-celib=DIR use Windows/CE support library from DIR
Some influential environment variables:
@@ -1314,21 +1314,24 @@ TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
-TCL_DDE_PATCH_LEVEL="2"
+TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
-TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
PKG_CFG_ARGS=$@
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -3065,8 +3068,8 @@ else
fi;
if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+ echo "$as_me:$LINENO: result: yes (default)" >&5
+echo "${ECHO_T}yes (default)" >&6
TCL_THREADS=1
cat >>confdefs.h <<\_ACEOF
#define TCL_THREADS 1
@@ -3595,8 +3598,8 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
MAKE_EXE="\${CC} -o \$@"
LIBPREFIX="lib"
- extra_ldflags="$extra_ldflags -pipe"
extra_cflags="$extra_cflags -pipe"
+ extra_ldflags="$extra_ldflags -pipe"
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -5250,8 +5253,6 @@ fi
-
-
ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -5980,11 +5981,9 @@ s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t
s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t
s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t
-s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t
s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t
s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t
s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t
-s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t
s,@RC_OUT@,$RC_OUT,;t t
s,@RC_TYPE@,$RC_TYPE,;t t
s,@RC_INCLUDE@,$RC_INCLUDE,;t t
diff --git a/win/configure.in b/win/configure.in
index 0ed8f89..d17f815 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -17,21 +17,24 @@ TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
-TCL_DDE_PATCH_LEVEL="2"
+TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
-TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
PKG_CFG_ARGS=$@
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -216,7 +219,7 @@ if test "$tcl_cv_intrinsics" = "yes"; then
[Defined when the compilers supports intrinsics])
fi
-# See if the <wspiapi.h> header file is present
+# See if the <wspiapi.h> header file is present
AC_CACHE_CHECK(for wspiapi.h,
tcl_cv_wspiapi_h,
@@ -425,11 +428,9 @@ AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_DDE_VERSION)
AC_SUBST(TCL_DDE_MAJOR_VERSION)
AC_SUBST(TCL_DDE_MINOR_VERSION)
-AC_SUBST(TCL_DDE_PATCH_LEVEL)
AC_SUBST(TCL_REG_VERSION)
AC_SUBST(TCL_REG_MAJOR_VERSION)
AC_SUBST(TCL_REG_MINOR_VERSION)
-AC_SUBST(TCL_REG_PATCH_LEVEL)
AC_SUBST(RC)
AC_SUBST(RC_OUT)
diff --git a/win/makefile.bc b/win/makefile.bc
index 338205e..d17c624 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -126,8 +126,8 @@ STUBPREFIX = $(NAMEPREFIX)stub
DOTVERSION = 8.6
VERSION = 86
-DDEVERSION = 13
-DDEDOTVERSION = 1.3
+DDEVERSION = 14
+DDEDOTVERSION = 1.4
REGVERSION = 13
REGDOTVERSION = 1.3
diff --git a/win/makefile.vc b/win/makefile.vc
index bc16584..ba5b710 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -13,10 +13,9 @@
# Copyright (c) 2003-2008 Pat Thoyts.
#------------------------------------------------------------------------------
-# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
-# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define
-# VCINSTALLDIR instead.
-!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR)
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
Platform SDK first to setup the environment. Jump to this line to read^
@@ -72,57 +71,62 @@ the build instructions.
# Sets where to install Tcl from the built binaries.
# C:\Progra~1\Tcl is assumed when not specified.
#
-# OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,unchecked,pdbs,none
+# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
#
-# static = Builds a static library of the core instead of a
-# dll. The shell will be static (and large), as well.
-# msvcrt = Affects the static option only to switch it from
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# msvcrt = Affects the static option only to switch it from
# using libcmt(d) as the C runtime [by default] to
# msvcrt(d). This is useful for static embedding
# support.
+# nothreads= Turns off full multithreading support.
+# pdbs = Build detached symbols for release builds.
+# profile = Adds profiling hooks. Map file is assumed.
+# static = Builds a static library of the core instead of a
+# dll. The static library will contain the dde and reg
+# extensions. External applications who want to use
+# this, need to link with the stub library as well as
+# the static Tcl library.The shell will be static (and
+# large), as well.
# staticpkg = Affects the static option only to switch
# tclshXX.exe to have the dde and reg extension linked
# inside it.
-# nothreads = Turns off full multithreading support.
+# symbols = Debug build. Links to the debug C runtime, disables
+# optimizations and creates pdb symbols files.
# thrdalloc = Use the thread allocator (shared global free pool)
# This is the default on threaded builds.
# tclalloc = Use the old non-thread allocator
-# symbols = Debug build. Links to the debug C runtime, disables
-# optimizations and creates pdb symbols files.
-# pdbs = Build detached symbols for release builds.
-# profile = Adds profiling hooks. Map file is assumed.
-# loimpact = Adds a flag for how NT treats the heap to keep memory
-# in use, low. This is said to impact alloc performance.
-# unchecked = Allows a symbols build to not use the debug
+# unchecked= Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
#
-# STATS=memdbg,compdbg,none
+# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
# to the core. The default is for none. Any combination of the
# above may be used (comma separated). 'none' will over-ride
# everything to nothing.
#
-# memdbg = Enables the debugging memory allocator.
# compdbg = Enables byte compilation logging.
+# memdbg = Enables the debugging memory allocator.
#
-# CHECKS=nodep,fullwarn,64bit,none
+# CHECKS=64bit,fullwarn,nodep,none
# Sets special macros for checking compatability.
#
-# nodep = Turns off compatability macros to ensure the core
-# isn't being built with deprecated functions.
+# 64bit = Enable 64bit portability warnings (if available)
# fullwarn = Builds with full compiler and link warnings enabled.
# Very verbose.
-# 64bit = Enable 64bit portability warnings (if available)
+# nodep = Turns off compatability macros to ensure the core
+# isn't being built with deprecated functions.
#
-# MACHINE=(IX86|IA64|AMD64|ALPHA)
+# MACHINE=(ALPHA|AMD64|IA64|IX86)
# Set the machine type used for the compiler, linker, and
# resource compiler. This hook is needed to tell the tools
# when alternate platforms are requested. IX86 is the default
-# when not specified.
+# when not specified. If the CPU environment variable has been
+# set (ie: recent Platform SDK) then MACHINE is set from CPU.
#
# TMP_DIR=<path>
# OUT_DIR=<path>
@@ -179,14 +183,14 @@ Please `cd` to its location first.
!error $(MSG)
!endif
-PROJECT = tcl
+PROJECT = tcl
!include "rules.vc"
STUBPREFIX = $(PROJECT)stub
DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-DDEDOTVERSION = 1.3
+DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)
REGDOTVERSION = 1.3
@@ -232,10 +236,12 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
TCLSHOBJS = \
$(TMP_DIR)\tclAppInit.obj \
+!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!endif
+!endif
$(TMP_DIR)\tclsh.res
TCLTESTOBJS = \
@@ -244,10 +250,12 @@ TCLTESTOBJS = \
$(TMP_DIR)\tclTestProcBodyObj.obj \
$(TMP_DIR)\tclThreadTest.obj \
$(TMP_DIR)\tclWinTest.obj \
+!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!endif
+!endif
$(TMP_DIR)\testMain.obj
COREOBJS = \
@@ -429,11 +437,13 @@ PLATFORMOBJS = \
$(TMP_DIR)\tclWinSock.obj \
$(TMP_DIR)\tclWinThrd.obj \
$(TMP_DIR)\tclWinTime.obj \
-!if !$(STATIC_BUILD)
+!if $(STATIC_BUILD)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!else
$(TMP_DIR)\tcl.res
!endif
-
TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
TCLSTUBOBJS = \
@@ -565,27 +575,27 @@ install: install-binaries install-libraries install-docs install-pkgs
test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT:\=/)/../library
+ set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
- $(DEBUGGER) $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- set ::ddelib [file normalize $(TCLDDELIB:\=/)]
- set ::reglib [file normalize $(TCLREGLIB:\=/)]
+ $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
+ package ifneeded dde 1.4.0b1 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.3.0 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
@echo Please wait while the tests are collected...
- $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
- set ::ddelib [file normalize $(TCLDDELIB:\=/)]
- set ::reglib [file normalize $(TCLREGLIB:\=/)]
+ $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
+ package ifneeded dde 1.4.0b1 "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.3.0 "$(TCLREGLIB:\=/)" registry]
<<
type tests.log | more
!endif
runtest: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
+ set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) $(SCRIPT)
runshell: setup $(TCLSH) dlls
- set TCL_LIBRARY=$(ROOT)/library
+ set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLSH) $(SCRIPT)
setup:
@@ -820,7 +830,6 @@ install-docs:
@$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
!endif
-#"
#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------
@@ -1159,15 +1168,15 @@ install-libraries: tclConfig install-msgs install-tzdata
install-tzdata:
@echo Installing time zone data
- @set TCL_LIBRARY=$(ROOT)/library
- @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \
- "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
install-msgs:
@echo Installing message catalogs
- @set TCL_LIBRARY=$(ROOT)/library
- @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \
- "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
#---------------------------------------------------------------------
# Clean up
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index b5e0788..2868857 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -14,8 +14,13 @@
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
+#define NO_SHLWAPI_GDI
+#define NO_SHLWAPI_STREAM
+#define NO_SHLWAPI_REG
+#include <shlwapi.h>
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
+#pragma comment (lib, "shlwapi.lib")
#include <stdio.h>
#include <math.h>
@@ -37,12 +42,13 @@
/* protos */
-int CheckForCompilerFeature(const char *option);
-int CheckForLinkerFeature(const char *option);
-int IsIn(const char *string, const char *substring);
-int SubstituteFile(const char *substs, const char *filename);
-const char * GetVersionFromFile(const char *filename, const char *match);
-DWORD WINAPI ReadFromPipe(LPVOID args);
+static int CheckForCompilerFeature(const char *option);
+static int CheckForLinkerFeature(const char *option);
+static int IsIn(const char *string, const char *substring);
+static int SubstituteFile(const char *substs, const char *filename);
+static int QualifyPath(const char *path);
+static const char *GetVersionFromFile(const char *filename, const char *match);
+static DWORD WINAPI ReadFromPipe(LPVOID args);
/* globals */
@@ -149,10 +155,21 @@ main(
}
printf("%s\n", GetVersionFromFile(argv[2], argv[3]));
return 0;
+ case 'Q':
+ if (argc != 3) {
+ chars = snprintf(msg, sizeof(msg) - 1,
+ "usage: %s -Q path\n"
+ "Emit the fully qualified path\n"
+ "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+ &dwWritten, NULL);
+ return 2;
+ }
+ return QualifyPath(argv[2]);
}
}
chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c|-l|-f|-g|-V ...\n"
+ "usage: %s -c|-f|-l|-Q|-s|-V ...\n"
"This is a little helper app to equalize shell differences between WinNT and\n"
"Win9x and get nmake.exe to accomplish its job.\n",
argv[0]);
@@ -160,7 +177,7 @@ main(
return 2;
}
-int
+static int
CheckForCompilerFeature(
const char *option)
{
@@ -245,7 +262,7 @@ CheckForCompilerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -294,7 +311,7 @@ CheckForCompilerFeature(
|| strstr(Err.buffer, "D2021") != NULL);
}
-int
+static int
CheckForLinkerFeature(
const char *option)
{
@@ -373,7 +390,7 @@ CheckForLinkerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -419,7 +436,7 @@ CheckForLinkerFeature(
strstr(Err.buffer, "LNK4044") != NULL);
}
-DWORD WINAPI
+static DWORD WINAPI
ReadFromPipe(
LPVOID args)
{
@@ -444,7 +461,7 @@ ReadFromPipe(
return 0; /* makes the compiler happy */
}
-int
+static int
IsIn(
const char *string,
const char *substring)
@@ -459,7 +476,7 @@ IsIn(
* package provide or package ifneeded.
*/
-const char *
+static const char *
GetVersionFromFile(
const char *filename,
const char *match)
@@ -565,7 +582,7 @@ list_free(list_item_t **listPtrPtr)
* <<
*/
-int
+static int
SubstituteFile(
const char *substitutions,
const char *filename)
@@ -641,6 +658,30 @@ SubstituteFile(
fclose(fp);
return 0;
}
+
+/*
+ * QualifyPath --
+ *
+ * This composes the current working directory with a provided path
+ * and returns the fully qualified and normalized path.
+ * Mostly needed to setup paths for testing.
+ */
+
+static int
+QualifyPath(
+ const char *szPath)
+{
+ char szCwd[MAX_PATH + 1];
+ char szTmp[MAX_PATH + 1];
+ char *p;
+ GetCurrentDirectory(MAX_PATH, szCwd);
+ while ((p = strchr(szPath, '/')) && *p)
+ *p = '\\';
+ PathCombine(szTmp, szCwd, szPath);
+ PathCanonicalize(szCwd, szTmp);
+ printf("%s\n", szCwd);
+ return 0;
+}
/*
* Local variables:
diff --git a/win/rules.vc b/win/rules.vc
index f2ee135..f09e2ea 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -8,7 +8,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2001-2003 David Gravereaux.
-# Copyright (c) 2003-2007 Patrick Thoyts
+# Copyright (c) 2003-2008 Patrick Thoyts
#------------------------------------------------------------------------------
!ifndef _RULES_VC
@@ -243,9 +243,9 @@ TCL_USE_STATIC_PACKAGES = 1
TCL_USE_STATIC_PACKAGES = 0
!endif
!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
TCL_THREADS = 0
!else
-!message *** Doing threads
TCL_THREADS = 1
USE_THREAD_ALLOC= 1
!endif
@@ -287,7 +287,7 @@ LOIMPACT = 0
USE_THREAD_ALLOC = 1
!endif
!if [nmakehlp -f $(OPTS) "tclalloc"]
-!message *** Doing thrdalloc
+!message *** Doing tclalloc
USE_THREAD_ALLOC = 0
!endif
!if [nmakehlp -f $(OPTS) "unchecked"]
@@ -598,7 +598,7 @@ TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY = $(_TCLDIR)\lib
TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
COFFBASE = \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES = -I"$(_TCLDIR)\include"
@@ -611,7 +611,7 @@ TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY = $(_TCLDIR)\library
TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
diff --git a/win/tcl.m4 b/win/tcl.m4
index bbea9a3..5e8e135 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -211,7 +211,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
AC_DEFUN([SC_ENABLE_SHARED], [
AC_MSG_CHECKING([how to build libraries])
AC_ARG_ENABLE(shared,
- [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [ --enable-shared build and link with shared libraries (default: on)],
[tcl_ok=$enableval], [tcl_ok=yes])
if test "${enable_shared+set}" = set; then
@@ -250,11 +250,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [
AC_DEFUN([SC_ENABLE_THREADS], [
AC_MSG_CHECKING(for building with threads)
- AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)],
[tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT(yes)
+ AC_MSG_RESULT([yes (default)])
TCL_THREADS=1
AC_DEFINE(TCL_THREADS)
# USE_THREAD_ALLOC tells us to try the special thread-based
@@ -297,7 +297,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
AC_DEFUN([SC_ENABLE_SYMBOLS], [
AC_MSG_CHECKING([for build with symbols])
- AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
@@ -533,8 +533,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
MAKE_EXE="\${CC} -o \[$]@"
LIBPREFIX="lib"
- extra_ldflags="$extra_ldflags -pipe"
extra_cflags="$extra_cflags -pipe"
+ extra_ldflags="$extra_ldflags -pipe"
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -1071,7 +1071,7 @@ AC_DEFUN([SC_BUILD_TCLSH], [
#--------------------------------------------------------------------
AC_DEFUN([SC_TCL_CFG_ENCODING], [
- AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
+ AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
if test x"${with_tcencoding}" != x ; then
AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}")
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 71b03a9..4d6e31b 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -11,13 +11,21 @@
*/
#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
+#ifndef UNICODE
+# undef CP_WINUNICODE
+# define CP_WINUNICODE CP_WINANSI
+# undef Tcl_WinTCharToUtf
+# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+# undef Tcl_WinUtfToTChar
+# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif
+
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
* declaration is in the source file itself, which is only accessed when we
@@ -37,7 +45,7 @@ typedef struct RegisteredInterp {
struct RegisteredInterp *nextPtr;
/* The next interp this application knows
* about. */
- char *name; /* Interpreter's name (malloc-ed). */
+ TCHAR *name; /* Interpreter's name (malloc-ed). */
Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -51,7 +59,7 @@ typedef struct Conversation {
/* The next conversation in the list. */
RegisteredInterp *riPtr; /* The info we know about the conversation. */
HCONV hConv; /* The DDE handle for this conversation. */
- Tcl_Obj *returnPackagePtr; /* The result package for this conversation */
+ Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
typedef struct DdeEnumServices {
@@ -79,13 +87,17 @@ static Tcl_ThreadDataKey dataKey;
static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance; /* The application instance handle given to us
- * by DdeInitializeA. */
+ * by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.3.2"
+#define TCL_DDE_VERSION "1.4.0b1"
#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
-#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
+#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
+#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
+
+#define DDE_FLAG_ASYNC 1
+#define DDE_FLAG_BINARY 2
+#define DDE_FLAG_FORCE 4
TCL_DECLARE_MUTEX(ddeMutex)
@@ -100,7 +112,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
static int DdeGetServicesList(Tcl_Interp *interp,
- const char *serviceName, const char *topicName);
+ const TCHAR *serviceName, const TCHAR *topicName);
static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
DWORD dwData1, DWORD dwData2);
@@ -110,7 +122,7 @@ static void DeleteProc(ClientData clientData);
static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr);
static int MakeDdeConnection(Tcl_Interp *interp,
- const char *name, HCONV *ddeConvPtr);
+ const TCHAR *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -143,6 +155,12 @@ Dde_Init(
return TCL_ERROR;
}
+#ifdef UNICODE
+ if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
+ Tcl_AppendResult(interp, "Win32s and Windows 9x are not supported platforms", NULL);
+ return TCL_ERROR;
+ }
+#endif
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
@@ -215,7 +233,7 @@ Initialize(void)
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
- if (DdeInitializeA(&ddeInstance, (PFNCALLBACK) DdeServerProc,
+ if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
| CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
ddeInstance = 0;
@@ -228,8 +246,8 @@ Initialize(void)
if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
- ddeServiceGlobal = DdeCreateStringHandleA(ddeInstance,
- TCL_DDE_SERVICE_NAME, 0);
+ ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
ddeIsServer = 0;
@@ -263,20 +281,20 @@ Initialize(void)
*----------------------------------------------------------------------
*/
-static const char *
+static const TCHAR *
DdeSetServerName(
Tcl_Interp *interp,
- const char *name, /* The name that will be used to refer to the
+ const TCHAR *name, /* The name that will be used to refer to the
* interpreter in later "send" commands. Must
* be globally unique. */
- int exactName, /* Should we make a unique name? 0 = unique */
+ int flags, /* DDE_FLAG_FORCE or 0 */
Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle
* incoming Dde eval's */
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- const char *actualName;
+ const TCHAR *actualName;
Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -314,7 +332,7 @@ DdeSetServerName(
* current interp, but it doesn't have a name.
*/
- return "";
+ return TEXT("");
}
/*
@@ -325,7 +343,7 @@ DdeSetServerName(
Tcl_DStringInit(&dString);
actualName = name;
- if (!exactName) {
+ if (!(flags & DDE_FLAG_FORCE)) {
r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL);
if (r == TCL_OK) {
srvListPtr = Tcl_GetObjResult(interp);
@@ -335,7 +353,9 @@ DdeSetServerName(
&srvPtrPtr);
}
if (r != TCL_OK) {
- OutputDebugStringA(Tcl_GetStringResult(interp));
+ Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString);
+ OutputDebugString((TCHAR *) Tcl_DStringValue(&dString));
+ Tcl_DStringFree(&dString);
return NULL;
}
@@ -352,13 +372,13 @@ DdeSetServerName(
lastSuffix = suffix;
if (suffix > 1) {
if (suffix == 2) {
- Tcl_DStringAppend(&dString, name, -1);
- Tcl_DStringAppend(&dString, " #", 2);
+ Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR));
+ Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR));
offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
- actualName = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE);
+ actualName = (TCHAR *) Tcl_DStringValue(&dString);
}
- sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
+ _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), TEXT("%d"), suffix);
}
/*
@@ -367,16 +387,18 @@ DdeSetServerName(
for (n = 0; n < srvCount; ++n) {
Tcl_Obj* namePtr;
+ Tcl_DString ds;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
+ Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
+ if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
suffix++;
+ Tcl_DStringFree(&ds);
break;
}
+ Tcl_DStringFree(&ds);
}
}
- Tcl_DStringSetLength(&dString,
- offset + (int)strlen(Tcl_DStringValue(&dString)+offset));
}
/*
@@ -385,14 +407,14 @@ DdeSetServerName(
riPtr = ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc(strlen(actualName) + 1);
+ riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
Tcl_IncrRefCount(riPtr->handlerPtr);
}
tsdPtr->interpListPtr = riPtr;
- strcpy(riPtr->name, actualName);
+ _tcscpy(riPtr->name, actualName);
if (Tcl_IsSafe(interp)) {
Tcl_ExposeCommand(interp, "dde", "dde");
@@ -472,7 +494,7 @@ DeleteProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
- searchPtr != NULL && searchPtr != riPtr;
+ (searchPtr != NULL) && (searchPtr != riPtr);
prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
/*
* Empty loop body.
@@ -552,7 +574,8 @@ ExecuteRemoteObject(
returnPackagePtr = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_NewIntObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
@@ -607,7 +630,7 @@ DdeServerProc(
Tcl_DString dString;
int len;
DWORD dlen;
- char *utilString;
+ TCHAR *utilString;
Tcl_Obj *ddeObjectPtr;
HDDEDATA ddeReturn = NULL;
RegisteredInterp *riPtr;
@@ -621,16 +644,16 @@ DdeServerProc(
* sure we have a valid topic.
*/
- len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(utilString, riPtr->name) == 0) {
+ if (_tcsicmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
@@ -646,15 +669,15 @@ DdeServerProc(
* result to return in an XTYP_REQUEST.
*/
- len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(riPtr->name, utilString) == 0) {
+ if (_tcsicmp(riPtr->name, utilString) == 0) {
convPtr = ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
@@ -698,7 +721,7 @@ DdeServerProc(
* execute.
*/
- if (uFmt != CF_TEXT) {
+ if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
return (HDDEDATA) FALSE;
}
@@ -711,35 +734,51 @@ DdeServerProc(
}
if (convPtr != NULL) {
- BYTE *returnString;
+ char *returnString;
- len = DdeQueryStringA(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryStringA(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINANSI);
- if (strcasecmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
- returnString = (BYTE *)
- Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
- ddeReturn = DdeCreateDataHandle(ddeInstance, returnString,
- (DWORD) len+1, 0, ddeItem, CF_TEXT, 0);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
+ if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ if (uFmt == CF_TEXT) {
+ returnString =
+ Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
+ } else {
+ returnString = (char *)
+ Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
+ len = 2 * len + 1;
+ }
+ ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
+ (DWORD) len+1, 0, ddeItem, uFmt, 0);
} else {
if (Tcl_IsSafe(convPtr->riPtr->interp)) {
ddeReturn = NULL;
} else {
- Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
- convPtr->riPtr->interp, utilString, NULL,
+ Tcl_DString ds;
+ Tcl_Obj *variableObjPtr;
+ Tcl_WinTCharToUtf(utilString, -1, &ds);
+ variableObjPtr = Tcl_GetVar2Ex(
+ convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
- returnString = (BYTE *) Tcl_GetStringFromObj(
- variableObjPtr, &len);
+ if (uFmt == CF_TEXT) {
+ returnString = Tcl_GetStringFromObj(
+ variableObjPtr, &len);
+ } else {
+ returnString = (char *) Tcl_GetUnicodeFromObj(
+ variableObjPtr, &len);
+ len = 2 * len + 1;
+ }
ddeReturn = DdeCreateDataHandle(ddeInstance,
- returnString, (DWORD) len+1, 0, ddeItem,
- CF_TEXT, 0);
+ (BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
+ uFmt, 0);
} else {
ddeReturn = NULL;
}
+ Tcl_DStringFree(&ds);
}
}
Tcl_DStringFree(&dString);
@@ -753,6 +792,7 @@ DdeServerProc(
*/
Tcl_Obj *returnPackagePtr;
+ char *string;
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
@@ -765,9 +805,22 @@ DdeServerProc(
return (HDDEDATA) DDE_FNOTPROCESSED;
}
- utilString = (char *) DdeAccessData(hData, &dlen);
- len = dlen;
- ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
+ utilString = (TCHAR *) DdeAccessData(hData, &dlen);
+ string = (char *) utilString;
+ if (!dlen) {
+ /* Empty binary array. */
+ ddeObjectPtr = Tcl_NewObj();
+ } else if ((dlen & 1) || utilString[(dlen>>1)-1]) {
+ /* Cannot be unicode, so assume utf-8 */
+ if (!string[dlen-1]) {
+ dlen--;
+ }
+ ddeObjectPtr = Tcl_NewStringObj(string, dlen);
+ } else {
+ /* unicode */
+ dlen >>= 1;
+ ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);
+ }
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
if (convPtr->returnPackagePtr != NULL) {
@@ -818,10 +871,10 @@ DdeServerProc(
len = dlen;
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
- returnPtr[i].hszSvc = DdeCreateStringHandleA(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINANSI);
- returnPtr[i].hszTopic = DdeCreateStringHandleA(ddeInstance,
- riPtr->name, CP_WINANSI);
+ returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
+ returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
+ riPtr->name, CP_WINUNICODE);
}
returnPtr[i].hszSvc = NULL;
returnPtr[i].hszTopic = NULL;
@@ -879,14 +932,14 @@ DdeExitProc(
static int
MakeDdeConnection(
Tcl_Interp *interp, /* Used to report errors. */
- const char *name, /* The connection to use. */
+ const TCHAR *name, /* The connection to use. */
HCONV *ddeConvPtr)
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
- ddeService = DdeCreateStringHandleA(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
- ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) name, 0);
+ ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -929,9 +982,9 @@ static int
DdeCreateClient(
struct DdeEnumServices *es)
{
- WNDCLASSEXA wc;
- static const char *szDdeClientClassName = "TclEval client class";
- static const char *szDdeClientWindowName = "TclEval client window";
+ WNDCLASSEX wc;
+ static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
+ static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
memset(&wc, 0, sizeof(wc));
wc.cbSize = sizeof(wc);
@@ -943,8 +996,8 @@ DdeCreateClient(
* Register and create the callback window.
*/
- RegisterClassExA(&wc);
- es->hwnd = CreateWindowExA(0, szDdeClientClassName, szDdeClientWindowName,
+ RegisterClassEx(&wc);
+ es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es);
return TCL_OK;
}
@@ -956,7 +1009,6 @@ DdeClientWindowProc(
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
-
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
@@ -964,17 +1016,16 @@ DdeClientWindowProc(
(struct DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)es);
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
#else
- SetWindowLongA(hwnd, GWL_USERDATA, (long)es);
+ SetWindowLong(hwnd, GWL_USERDATA, (LONG) es);
#endif
return (LRESULT) 0L;
}
case WM_DDE_ACK:
return DdeServicesOnAck(hwnd, wParam, lParam);
- break;
default:
- return DefWindowProcA(hwnd, uMsg, wParam, lParam);
+ return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
}
@@ -988,12 +1039,13 @@ DdeServicesOnAck(
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
struct DdeEnumServices *es;
- char sz[255];
+ TCHAR sz[255];
+ Tcl_DString dString;
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- es = (struct DdeEnumServices *) GetWindowLongA(hwnd, GWL_USERDATA);
+ es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif
if ((es->service == (ATOM)0 || es->service == service)
@@ -1001,10 +1053,14 @@ DdeServicesOnAck(
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
- GlobalGetAtomNameA(service, sz, 255);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
- GlobalGetAtomNameA(topic, sz, 255);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
+ GlobalGetAtomName(service, sz, 255);
+ Tcl_WinTCharToUtf(sz, -1, &dString);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
+ Tcl_DStringFree(&dString);
+ GlobalGetAtomName(topic, sz, 255);
+ Tcl_WinTCharToUtf(sz, -1, &dString);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
+ Tcl_DStringFree(&dString);
/*
* Adding the hwnd as a third list element provides a unique
@@ -1030,7 +1086,7 @@ DdeServicesOnAck(
* Tell the server we are no longer interested.
*/
- PostMessageA(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
+ PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
return 0L;
}
@@ -1042,7 +1098,7 @@ DdeEnumWindowsCallback(
DWORD_PTR dwResult = 0;
struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
- SendMessageTimeoutA(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
+ SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
&dwResult);
return TRUE;
@@ -1051,16 +1107,16 @@ DdeEnumWindowsCallback(
static int
DdeGetServicesList(
Tcl_Interp *interp,
- const char *serviceName,
- const char *topicName)
+ const TCHAR *serviceName,
+ const TCHAR *topicName)
{
struct DdeEnumServices es;
es.interp = interp;
es.result = TCL_OK;
es.service = (serviceName == NULL)
- ? (ATOM)0 : GlobalAddAtomA(serviceName);
- es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomA(topicName);
+ ? (ATOM)0 : GlobalAddAtom(serviceName);
+ es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName);
Tcl_ResetResult(interp); /* our list is to be appended to result. */
DdeCreateClient(&es);
@@ -1147,12 +1203,11 @@ DdeObjCmd(
ClientData clientData, /* Used only for deletion */
Tcl_Interp *interp, /* The interp we are sending from */
int objc, /* Number of arguments */
- Tcl_Obj *const * objv) /* The arguments */
+ Tcl_Obj *const *objv) /* The arguments */
{
static const char *const ddeCommands[] = {
"servername", "execute", "poke", "request", "services", "eval",
- (char *) NULL
- };
+ (char *) NULL};
enum DdeSubcommands {
DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
@@ -1164,20 +1219,25 @@ DdeObjCmd(
DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
};
static const char *const ddeExecOptions[] = {
+ "-async", "-binary", NULL
+ };
+ enum DdeExecOptions {
+ DDE_EXEC_ASYNC, DDE_EXEC_BINARY
+ };
+ static const char *const ddeEvalOptions[] = {
"-async", NULL
};
static const char *const ddeReqOptions[] = {
"-binary", NULL
};
- int index, i, length;
- int async = 0, binary = 0, exact = 0;
- int result = TCL_OK, firstArg = 0;
+ int index, i, length, argIndex;
+ int flags = 0, result = TCL_OK, firstArg = 0;
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- const char *serviceName = NULL, *topicName = NULL;
- char *string;
+ const TCHAR *serviceName = NULL, *topicName = NULL;
+ const char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
@@ -1198,7 +1258,6 @@ DdeObjCmd(
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
- int argIndex;
if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
"option", 0, &argIndex) != TCL_OK) {
/*
@@ -1213,7 +1272,7 @@ DdeObjCmd(
break;
}
if (argIndex == DDE_SERVERNAME_EXACT) {
- exact = 1;
+ flags |= DDE_FLAG_FORCE;
} else if (argIndex == DDE_SERVERNAME_HANDLER) {
if ((objc - i) == 1) { /* return current handler */
RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
@@ -1245,39 +1304,53 @@ DdeObjCmd(
if (objc == 5) {
firstArg = 2;
break;
- } else if (objc == 6) {
- int dummy;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
- &dummy) == TCL_OK) {
- async = 1;
- firstArg = 3;
- break;
+ } else if (objc >= 6 && objc <= 7) {
+ firstArg = objc - 3;
+ for (i = 2; i < firstArg; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
+ "option", 0, &argIndex) != TCL_OK) {
+ goto wrongDdeExecuteArgs;
+ }
+ if (argIndex == DDE_EXEC_ASYNC) {
+ flags |= DDE_FLAG_ASYNC;
+ } else {
+ flags |= DDE_FLAG_BINARY;
+ }
}
+ break;
}
/* otherwise... */
+ wrongDdeExecuteArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "?-async? serviceName topicName value");
+ "?-async? ?-binary? serviceName topicName value");
return TCL_ERROR;
case DDE_POKE:
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "serviceName topicName item value");
- return TCL_ERROR;
+ if (objc == 6) {
+ firstArg = 2;
+ break;
+ } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
+ ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+ flags |= DDE_FLAG_BINARY;
+ firstArg = 3;
+ break;
}
- firstArg = 2;
- break;
+
+ /*
+ * Otherwise...
+ */
+
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-binary? serviceName topicName item value");
+ return TCL_ERROR;
case DDE_REQUEST:
if (objc == 5) {
firstArg = 2;
break;
- } else if (objc == 6) {
- int dummy;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
- &dummy) == TCL_OK) {
- binary = 1;
- firstArg = 3;
- break;
- }
+ } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
+ ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+ flags |= DDE_FLAG_BINARY;
+ firstArg = 3;
+ break;
}
/*
@@ -1300,15 +1373,13 @@ DdeObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
return TCL_ERROR;
} else {
- int dummy;
-
firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
- 0, &dummy) == TCL_OK) {
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option",
+ 0, &argIndex) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
}
- async = 1;
+ flags |= DDE_FLAG_ASYNC;
firstArg++;
}
break;
@@ -1318,7 +1389,11 @@ DdeObjCmd(
Initialize();
if (firstArg != 1) {
+#ifdef UNICODE
+ serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
+#else
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
+#endif
} else {
length = 0;
}
@@ -1326,26 +1401,30 @@ DdeObjCmd(
if (length == 0) {
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- ddeService = DdeCreateStringHandleA(ddeInstance, (void *) serviceName,
- CP_WINANSI);
+ ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
+ CP_WINUNICODE);
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
+#ifdef UNICODE
+ topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
+#else
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
+#endif
if (length == 0) {
topicName = NULL;
} else {
- ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) topicName,
- CP_WINANSI);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
+ CP_WINUNICODE);
}
}
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
- serviceName = DdeSetServerName(interp, serviceName, exact,
+ serviceName = DdeSetServerName(interp, serviceName, flags,
handlerPtr);
if (serviceName != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
+ Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
} else {
Tcl_ResetResult(interp);
}
@@ -1353,10 +1432,18 @@ DdeObjCmd(
case DDE_EXECUTE: {
int dataLength;
- BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
- objv[firstArg + 2], &dataLength);
+ const char *dataString;
+
+ if (flags & DDE_FLAG_BINARY) {
+ dataString = (const char *)
+ Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
+ } else {
+ dataString =
+ Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
+ dataLength += 1;
+ }
- if (dataLength == 0) {
+ if (dataLength <= 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
@@ -1373,10 +1460,10 @@ DdeObjCmd(
break;
}
- ddeData = DdeCreateDataHandle(ddeInstance, dataString,
- (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
+ ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
+ (DWORD) dataLength, 0, 0, CF_TEXT, 0);
if (ddeData != NULL) {
- if (async) {
+ if (flags & DDE_FLAG_ASYNC) {
DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
@@ -1396,8 +1483,13 @@ DdeObjCmd(
break;
}
case DDE_REQUEST: {
- const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+#ifdef UNICODE
+ const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
&length);
+#else
+ const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+ &length);
+#endif
if (length == 0) {
Tcl_SetObjResult(interp,
@@ -1415,8 +1507,8 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
Tcl_Obj *returnObjPtr;
- ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ CP_WINUNICODE);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
CF_TEXT, XTYP_REQUEST, 5000, NULL);
@@ -1425,13 +1517,17 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
DWORD tmp;
- const BYTE *dataString = DdeAccessData(ddeData, &tmp);
+ const char *dataString = (const char *) DdeAccessData(ddeData, &tmp);
- if (binary) {
- returnObjPtr = Tcl_NewByteArrayObj(dataString,
- (int) tmp);
+ if (flags & DDE_FLAG_BINARY) {
+ returnObjPtr =
+ Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
} else {
- returnObjPtr = Tcl_NewStringObj((char*)dataString,-1);
+ if (tmp && !dataString[tmp-1]) {
+ --tmp;
+ }
+ returnObjPtr = Tcl_NewStringObj(dataString,
+ (int) tmp);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
@@ -1446,8 +1542,13 @@ DdeObjCmd(
break;
}
case DDE_POKE: {
- const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+#ifdef UNICODE
+ const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
+ &length);
+#else
+ const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
&length);
+#endif
BYTE *dataString;
if (length == 0) {
@@ -1457,8 +1558,14 @@ DdeObjCmd(
result = TCL_ERROR;
goto cleanup;
}
- dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
- &length);
+ if (flags & DDE_FLAG_BINARY) {
+ dataString = (BYTE *)
+ Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
+ } else {
+ dataString = (BYTE *)
+ Tcl_GetStringFromObj(objv[firstArg + 3], &length);
+ length += 1;
+ }
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -1468,10 +1575,10 @@ DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
} else {
- ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ CP_WINUNICODE);
if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
+ ddeData = DdeClientTransaction(dataString, (DWORD) length,
hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
@@ -1501,8 +1608,8 @@ DdeObjCmd(
goto cleanup;
}
- objc -= (async + 3);
- objv += (async + 3);
+ objc -= firstArg + 1;
+ objv += firstArg + 1;
/*
* See if the target interpreter is local. If so, execute the command
@@ -1515,7 +1622,7 @@ DdeObjCmd(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(serviceName, riPtr->name) == 0) {
+ if (_tcsicmp(serviceName, riPtr->name) == 0) {
break;
}
}
@@ -1541,9 +1648,9 @@ DdeObjCmd(
*/
if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
- Tcl_SetResult(riPtr->interp, "permission denied: "
- "a handler procedure must be defined for use in "
- "a safe interp", TCL_STATIC);
+ Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
+ "permission denied: a handler procedure must be"
+ " defined for use in a safe interp", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
NULL);
result = TCL_ERROR;
@@ -1608,8 +1715,7 @@ DdeObjCmd(
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
invalidServerResponse:
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid data returned from server",
- -1));
+ Tcl_NewStringObj("invalid data returned from server", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
result = TCL_ERROR;
goto cleanup;
@@ -1618,9 +1724,9 @@ DdeObjCmd(
objPtr = Tcl_ConcatObj(objc, objv);
string = Tcl_GetStringFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance,
- (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
+ (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
- if (async) {
+ if (flags & DDE_FLAG_ASYNC) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
@@ -1630,8 +1736,8 @@ DdeObjCmd(
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
- ddeCookie = DdeCreateStringHandleA(ddeInstance,
- TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
+ ddeCookie = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
CF_TEXT, XTYP_REQUEST, 30000, NULL);
}
@@ -1642,9 +1748,10 @@ DdeObjCmd(
if (ddeData == 0) {
SetDdeError(interp);
result = TCL_ERROR;
+ goto cleanup;
}
- if (async == 0) {
+ if (!(flags & DDE_FLAG_ASYNC)) {
Tcl_Obj *resultPtr;
/*
@@ -1658,7 +1765,7 @@ DdeObjCmd(
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
- Tcl_SetObjLength(resultPtr, length);
+ Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1);
string = Tcl_GetString(resultPtr);
DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
Tcl_SetObjLength(resultPtr, (int) strlen(string));
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 969780d..49eeed3 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -331,11 +331,6 @@ static const unsigned char wsaErrorTable[] = {
EREMOTE /* WSAEREMOTE */
};
-#ifdef __CYGWIN__
-# include <windows.h>
-# define DWORD unsigned int
-#endif
-
/*
*----------------------------------------------------------------------
*
@@ -415,6 +410,12 @@ tclWinDebugPanic(
fprintf(stderr, "\n");
fflush(stderr);
}
+# if defined(__GNUC__)
+ __builtin_trap();
+# else
+ DebugBreak();
+# endif
+ abort();
}
#endif
/*
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index fea9ddb..77a5b82 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -50,7 +50,7 @@ enum {
WIN_SYSTEM_ATTRIBUTE
};
-static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
+static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
@@ -1011,13 +1011,12 @@ TclpObjRemoveDirectory(
}
if (ret != TCL_OK) {
- int len = Tcl_DStringLength(&ds);
- if (len > 0) {
+ if (Tcl_DStringLength(&ds) > 0) {
if (normPtr != NULL &&
!strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ *errorPtr = TclDStringToObj(&ds);
}
Tcl_IncrRefCount(*errorPtr);
}
@@ -1126,9 +1125,9 @@ DoRemoveJustDirectory(
len = strlen(path);
find = Tcl_DStringAppend(&buffer, path, len);
if ((len > 0) && (find[len - 1] != '\\')) {
- Tcl_DStringAppend(&buffer, "\\", 1);
+ TclDStringAppendLiteral(&buffer, "\\");
}
- find = Tcl_DStringAppend(&buffer, "*.*", 3);
+ find = TclDStringAppendLiteral(&buffer, "*.*");
handle = FindFirstFileA(find, &data);
if (handle != INVALID_HANDLE_VALUE) {
while (1) {
@@ -1762,6 +1761,7 @@ ConvertFileNameFormat(
Tcl_DStringInit(&dsTemp);
Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
+ Tcl_DStringFree(&ds);
/*
* Deal with issues of tildes being absolute.
@@ -1771,13 +1771,11 @@ ConvertFileNameFormat(
TclNewLiteralStringObj(tempPath, "./");
Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
+ Tcl_DStringFree(&dsTemp);
} else {
- tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
+ tempPath = TclDStringToObj(&dsTemp);
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index dcc05bb..1f56060 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -819,6 +819,16 @@ tclWinDebugPanic(
MessageBoxW(NULL, msgString, L"Fatal Error",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
}
+#if defined(__GNUC__)
+ __builtin_trap();
+#elif defined(_WIN64)
+ __debugbreak();
+#elif defined(_MSC_VER)
+ _asm {int 3}
+#else
+ DebugBreak();
+#endif
+ abort();
}
/*
@@ -986,7 +996,7 @@ TclpMatchInDirectory(
lastChar = dirName[dirLength -1];
if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
- Tcl_DStringAppend(&dsOrig, "/", 1);
+ TclDStringAppendLiteral(&dsOrig, "/");
dirLength++;
}
dirName = Tcl_DStringValue(&dsOrig);
@@ -1006,7 +1016,7 @@ TclpMatchInDirectory(
dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
} else {
- dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
+ dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
}
native = Tcl_WinUtfToTChar(dirName, -1, &ds);
@@ -1457,7 +1467,7 @@ TclpGetUserHome(
GetWindowsDirectoryW(buf, MAX_PATH);
Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
- Tcl_DStringAppend(bufferPtr, "/users/default", -1);
+ TclDStringAppendLiteral(bufferPtr, "/users/default");
}
result = Tcl_DStringValue(bufferPtr);
NetApiBufferFree((void *) uiPtr);
@@ -2066,7 +2076,7 @@ NativeDev(
* won't work.
*/
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ fullPath = TclDStringAppendLiteral(&ds, "\\");
p = fullPath + Tcl_DStringLength(&ds);
} else {
p++;
@@ -2350,13 +2360,9 @@ TclpFilesystemPathType(
return NULL;
} else {
Tcl_DString ds;
- Tcl_Obj *objPtr;
Tcl_WinTCharToUtf(volType, -1, &ds);
- objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- return objPtr;
+ return TclDStringToObj(&ds);
}
#undef VOL_BUF_SIZE
}
@@ -2530,7 +2536,7 @@ TclpObjNormalizePath(
* string.
*/
- Tcl_DStringAppend(&dsNorm,"/", 1);
+ TclDStringAppendLiteral(&dsNorm, "/");
} else {
char *nativeName;
@@ -2540,8 +2546,8 @@ TclpObjNormalizePath(
nativeName = fData.cAlternateFileName;
}
FindClose(handle);
- Tcl_DStringAppend(&dsNorm,"/", 1);
- Tcl_DStringAppend(&dsNorm,nativeName,-1);
+ TclDStringAppendLiteral(&dsNorm, "/");
+ Tcl_DStringAppend(&dsNorm, nativeName, -1);
}
}
}
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index fb53685..d89c98e 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -288,8 +288,6 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- const char *str;
-
/*
* TCL_LIBRARY is set but refers to a different tcl installation
* than the current version. Try fiddling with the specified
@@ -299,9 +297,8 @@ AppendEnvironment(
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
- str = Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
+ (void) Tcl_JoinPath(pathc, pathv, &ds);
+ objPtr = TclDStringToObj(&ds);
} else {
objPtr = Tcl_NewStringObj(buf, -1);
}
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 882b811..22ad8e9 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -33,6 +33,12 @@
# define TCL_I_MODIFIER ""
#endif
+#ifdef _WIN64
+# define TCL_I_MODIFIER "I"
+#else
+# define TCL_I_MODIFIER ""
+#endif
+
/*
* Declarations of functions that are not accessible by way of the
* stubs table.
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index e5b927d..b59ccba 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -184,7 +184,7 @@ FindSymbol(
const char *sym2;
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, "_", 1);
+ TclDStringAppendLiteral(&ds, "_");
sym2 = Tcl_DStringAppend(&ds, symbol, -1);
proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
Tcl_DStringFree(&ds);
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index f1b18df..db462f8 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -676,6 +676,7 @@ TclpCreateTempFile(
if (contents != NULL) {
DWORD result, length;
const char *p;
+ int toCopy;
/*
* Convert the contents from UTF to native encoding
@@ -683,7 +684,8 @@ TclpCreateTempFile(
native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
- for (p = native; *p != '\0'; p++) {
+ toCopy = Tcl_DStringLength(&dstring);
+ for (p = native; toCopy > 0; p++, toCopy--) {
if (*p == '\n') {
length = p - native;
if (length > 0) {
@@ -860,7 +862,7 @@ TclpCloseFile(
*--------------------------------------------------------------------------
*/
-unsigned long
+int
TclpGetPid(
Tcl_Pid pid) /* The HANDLE of the child process. */
{
@@ -1115,7 +1117,7 @@ TclpCreateProcess(
startInfo.wShowWindow = SW_HIDE;
startInfo.dwFlags |= STARTF_USESHOWWINDOW;
createFlags = CREATE_NEW_CONSOLE;
- Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
+ TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
} else {
createFlags = DETACHED_PROCESS;
}
@@ -1290,7 +1292,7 @@ ApplicationType(
Tcl_DString nameBuf, ds;
const TCHAR *nativeName;
TCHAR nativeFullPath[MAX_PATH];
- static char extensions[][5] = {"", ".com", ".exe", ".bat"};
+ static const char extensions[][5] = {"", ".com", ".exe", ".bat"};
/*
* Look for the program as an external program. First try the name as it
@@ -1465,9 +1467,9 @@ BuildCommandLine(
* Prime the path. Add a space separator if we were primed with something.
*/
- Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
+ TclDStringAppendDString(&ds, linePtr);
if (Tcl_DStringLength(linePtr) > 0) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
for (i = 0; i < argc; i++) {
@@ -1475,7 +1477,7 @@ BuildCommandLine(
arg = executable;
} else {
arg = argv[i];
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
quote = 0;
@@ -1494,7 +1496,7 @@ BuildCommandLine(
}
}
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
start = arg;
for (special = arg; ; ) {
@@ -1523,7 +1525,7 @@ BuildCommandLine(
}
if (*special == '"') {
Tcl_DStringAppend(&ds, start, (int) (special - start));
- Tcl_DStringAppend(&ds, "\\\"", 2);
+ TclDStringAppendLiteral(&ds, "\\\"");
start = special + 1;
}
if (*special == '\0') {
@@ -1533,7 +1535,7 @@ BuildCommandLine(
}
Tcl_DStringAppend(&ds, start, (int) (special - start));
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
}
Tcl_DStringFree(linePtr);
@@ -1709,8 +1711,8 @@ TclGetAndDetachPids(
{
PipeInfo *pipePtr;
const Tcl_ChannelType *chanTypePtr;
+ Tcl_Obj *pidsObj;
int i;
- char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -1721,12 +1723,15 @@ TclGetAndDetachPids(
return;
}
- pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+ pipePtr = Tcl_GetChannelInstanceData(chan);
+ TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_AppendElement(interp, buf);
- Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(NULL, pidsObj,
+ Tcl_NewWideIntObj((unsigned)
+ TclpGetPid(pipePtr->pidPtr[i])));
+ Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
+ Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
@@ -1873,12 +1878,26 @@ PipeClose2Proc(
&& (pipePtr->writeFile != NULL)) {
if (pipePtr->writeThread) {
/*
- * Wait for the writer thread to finish the current buffer, then
- * terminate the thread and close the handles. If the channel is
- * nonblocking, there should be no pending write operations.
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking but blocked during exit, bail out since the worker
+ * thread is not interruptible and we want TIP#398-fast-exit.
*/
+ if (TclInExit()
+ && (pipePtr->flags & PIPE_ASYNC)) {
+
+ /* give it a chance to leave honorably */
+ SetEvent(pipePtr->stopWriter);
- WaitForSingleObject(pipePtr->writable, INFINITE);
+ if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) {
+ return EAGAIN;
+ }
+
+ } else {
+
+ WaitForSingleObject(pipePtr->writable, INFINITE);
+
+ }
/*
* The thread may already have closed on it's own. Check its exit
@@ -2626,15 +2645,13 @@ Tcl_PidObjCmd(
PipeInfo *pipePtr;
int i;
Tcl_Obj *resultPtr;
- char buf[TCL_INTEGER_SPACE];
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
return TCL_ERROR;
}
if (objc == 1) {
- wsprintfA(buf, "%lu", (unsigned long) getpid());
- Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
} else {
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
NULL);
@@ -2649,9 +2666,9 @@ Tcl_PidObjCmd(
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
- Tcl_NewStringObj(buf, -1));
+ Tcl_NewWideIntObj((unsigned)
+ TclpGetPid(pipePtr->pidPtr[i])));
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -2943,6 +2960,10 @@ PipeWriterThread(
* an error, so exit.
*/
+ if (waitResult == WAIT_OBJECT_0) {
+ SetEvent(infoPtr->writable);
+ }
+
break;
}
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 1390415..9c08b0c 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -13,15 +13,21 @@
*/
#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
#include "tclInt.h"
#ifdef _MSC_VER
# pragma comment (lib, "advapi32.lib")
#endif
#include <stdlib.h>
+#ifndef UNICODE
+# undef Tcl_WinTCharToUtf
+# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+# undef Tcl_WinUtfToTChar
+# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif
+
/*
* Ensure that we can say which registry is being accessed.
*/
@@ -34,6 +40,14 @@
#endif
/*
+ * The maximum length of a sub-key name.
+ */
+
+#ifndef MAX_KEY_LENGTH
+#define MAX_KEY_LENGTH 256
+#endif
+
+/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
* Registry_Init declaration is in the source file itself, which is only
* accessed when we are building a library.
@@ -43,6 +57,14 @@
#define TCL_STORAGE_CLASS DLLEXPORT
/*
+ * The maximum length of a sub-key name.
+ */
+
+#ifndef MAX_KEY_LENGTH
+#define MAX_KEY_LENGTH 256
+#endif
+
+/*
* The following macros convert between different endian ints.
*/
@@ -67,7 +89,7 @@ static const char *const rootKeyNames[] = {
"HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
};
-static HKEY rootKeys[] = {
+static const HKEY rootKeys[] = {
HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
};
@@ -157,7 +179,7 @@ Registry_Init(
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3");
+ return Tcl_PkgProvide(interp, "registry", "1.3.0");
}
/*
@@ -552,9 +574,7 @@ GetKeyNames(
{
const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
- DWORD subKeyCount; /* Number of subkeys to list */
- DWORD maxSubKeyLen; /* Maximum string length of any subkey */
- TCHAR *buffer; /* Buffer to hold the subkey name */
+ TCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -578,40 +598,27 @@ GetKeyNames(
}
/*
- * Determine how big a buffer is needed for enumerating subkeys, and how
- * many subkeys there are.
- */
-
- result = RegQueryInfoKey(key, NULL, NULL, NULL,
- &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- RegCloseKey(key);
- return TCL_ERROR;
- }
- buffer = ckalloc((maxSubKeyLen+1) * sizeof(TCHAR));
-
- /*
* Enumerate the subkeys.
*/
resultPtr = Tcl_NewObj();
- for (index = 0; index < subKeyCount; ++index) {
- bufSize = maxSubKeyLen+1;
+ for (index = 0;; ++index) {
+ bufSize = MAX_KEY_LENGTH;
result = RegEnumKeyEx(key, index, buffer, &bufSize,
NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- result = TCL_ERROR;
+ if (result == ERROR_NO_MORE_ITEMS) {
+ result = TCL_OK;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewObj());
+ Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
+ AppendSystemError(interp, result);
+ result = TCL_ERROR;
+ }
break;
}
- Tcl_WinTCharToUtf(buffer, bufSize * sizeof(WCHAR), &ds);
+ Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
name = Tcl_DStringValue(&ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
@@ -626,9 +633,10 @@ GetKeyNames(
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
}
- ckfree(buffer);
RegCloseKey(key);
return result;
}
@@ -756,8 +764,8 @@ GetValue(
*/
Tcl_DStringInit(&data);
- length = TCL_DSTRING_STATIC_SIZE - 1;
- Tcl_DStringSetLength(&data, (int) length);
+ Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
+ length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
@@ -771,8 +779,8 @@ GetValue(
* HKEY_PERFORMANCE_DATA
*/
- length *= 2;
- Tcl_DStringSetLength(&data, (int) length);
+ length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
+ Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
result = RegQueryValueEx(key, nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
@@ -865,7 +873,7 @@ GetValueNames(
{
HKEY key;
Tcl_Obj *resultPtr;
- DWORD index, size, maxSize, result;
+ DWORD index, size, result;
Tcl_DString buffer, ds;
const char *pattern, *name;
@@ -878,27 +886,9 @@ GetValueNames(
return TCL_ERROR;
}
- /*
- * Query the key to determine the appropriate buffer size to hold the
- * largest value name plus the terminating null.
- */
-
- result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL,
- NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- RegCloseKey(key);
- result = TCL_ERROR;
- goto done;
- }
- maxSize++;
-
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer,
- (int) (maxSize*sizeof(WCHAR)));
+ Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
index = 0;
result = TCL_OK;
@@ -914,10 +904,10 @@ GetValueNames(
* each iteration because RegEnumValue smashes the old value.
*/
- size = maxSize;
+ size = MAX_KEY_LENGTH;
while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
&size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
- size *= 2;
+ size *= sizeof(TCHAR);
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
&ds);
@@ -933,12 +923,10 @@ GetValueNames(
Tcl_DStringFree(&ds);
index++;
- size = maxSize;
+ size = MAX_KEY_LENGTH;
}
Tcl_SetObjResult(interp, resultPtr);
Tcl_DStringFree(&buffer);
-
- done:
RegCloseKey(key);
return result;
}
@@ -1180,7 +1168,7 @@ RecursiveDeleteKey(
* encoding, not UTF. */
REGSAM mode) /* Mode flags to pass. */
{
- DWORD result, size, maxSize;
+ DWORD result, size;
Tcl_DString subkey;
HKEY hKey;
REGSAM saveMode = mode;
@@ -1200,16 +1188,9 @@ RecursiveDeleteKey(
if (result != ERROR_SUCCESS) {
return result;
}
- result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL,
- &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
- maxSize++;
- if (result != ERROR_SUCCESS) {
- return result;
- }
Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey,
- (int) (maxSize * sizeof(WCHAR)));
+ Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
mode = saveMode;
while (result == ERROR_SUCCESS) {
@@ -1217,7 +1198,7 @@ RecursiveDeleteKey(
* Always get index 0 because key deletion changes ordering.
*/
- size = maxSize;
+ size = MAX_KEY_LENGTH;
result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
&size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
@@ -1334,16 +1315,15 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
+ const char *bytes = Tcl_GetStringFromObj(objv[i], &length);
+
+ Tcl_DStringAppend(&data, bytes, length);
/*
- * Add a null character to separate this value from the next. We
- * accomplish this by growing the string by one byte. Since the
- * DString always tacks on an extra null byte, the new byte will
- * already be set to null.
+ * Add a null character to separate this value from the next.
*/
- Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
+ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */
}
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 7181701..97b10a3 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1280,9 +1280,14 @@ CreateSocket(
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "couldn't open socket: ", NULL);
+ if (errorMsg == NULL) {
+ Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
+ } else {
+ Tcl_AppendResult(interp, errorMsg, NULL);
+ }
}
+
if (sock != INVALID_SOCKET) {
closesocket(sock);
}
@@ -1398,7 +1403,7 @@ Tcl_OpenTcpClient(
return NULL;
}
- sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
infoPtr, (TCL_READABLE | TCL_WRITABLE));
@@ -1461,7 +1466,7 @@ Tcl_MakeTcpClientChannel(
infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
- sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
infoPtr, (TCL_READABLE | TCL_WRITABLE));
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
@@ -1514,7 +1519,7 @@ Tcl_OpenTcpServer(
infoPtr->acceptProc = acceptProc;
infoPtr->acceptProcData = acceptProcData;
- sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
infoPtr, 0);
@@ -1620,7 +1625,7 @@ TcpAccept(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
(LPARAM) newInfoPtr);
- sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd);
newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
@@ -2574,22 +2579,18 @@ InitializeHostName(
Tcl_DStringInit(&ds);
if (TclpHasSockets(NULL) == TCL_OK) {
/*
- * Buffer length of 255 copied slavishly from previous version of
- * this routine. Presumably there's a more "correct" macro value
- * for a properly sized buffer for a gethostname() call.
- * Maintainers are welcome to supply it.
+ * The buffer size of 256 is recommended by the MSDN page that
+ * documents gethostname() as being always adequate.
*/
Tcl_DString inDs;
Tcl_DStringInit(&inDs);
- Tcl_DStringSetLength(&inDs, 255);
+ Tcl_DStringSetLength(&inDs, 256);
if (gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
- Tcl_DStringSetLength(&ds, 0);
- } else {
- Tcl_ExternalToUtfDString(NULL,
- Tcl_DStringValue(&inDs), -1, &ds);
+ Tcl_DStringLength(&inDs)) == 0) {
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
+ &ds);
}
Tcl_DStringFree(&inDs);
}
@@ -2663,9 +2664,9 @@ TclWinSetSockOpt(
return setsockopt(s, level, optname, optval, optlen);
}
-u_short
+unsigned short
TclWinNToHS(
- u_short netshort)
+ unsigned short netshort)
{
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -2674,12 +2675,29 @@ TclWinNToHS(
*/
if (!SocketsEnabled()) {
- return (u_short) -1;
+ return (unsigned short) -1;
}
return ntohs(netshort);
}
+char *
+TclpInetNtoa(
+ struct in_addr addr)
+{
+ /*
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
+ */
+
+ if (!SocketsEnabled()) {
+ return NULL;
+ }
+
+ return inet_ntoa(addr);
+}
+
struct servent *
TclWinGetServByName(
const char *name,
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 6ef1157..136c4db 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -42,8 +42,6 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc TestExceptionCmd;
-static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
static int TestplatformChmod(const char *nativePath, int pmode);
static int TestchmodCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
@@ -78,7 +76,6 @@ TclplatformtestInit(
Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
@@ -294,83 +291,6 @@ TestwinclockCmd(
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * TestwincpuidCmd --
- *
- * Retrieves CPU ID information.
- *
- * Usage:
- * testwincpuid <eax>
- *
- * Parameters:
- * eax - The value to pass in the EAX register to a CPUID instruction.
- *
- * Results:
- * Returns a four-element list containing the values from the EAX, EBX,
- * ECX and EDX registers returned from the CPUID instruction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestwincpuidCmd(
- ClientData dummy,
- Tcl_Interp* interp, /* Tcl interpreter */
- int objc, /* Parameter count */
- Tcl_Obj *const * objv) /* Parameter vector */
-{
- int status, index, i;
- unsigned int regs[4];
- Tcl_Obj *regsObjs[4];
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "eax");
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
- return TCL_ERROR;
- }
- status = TclWinCPUID((unsigned) index, regs);
- if (status != TCL_OK) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("operation not available", -1));
- return status;
- }
- for (i=0 ; i<4 ; ++i) {
- regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
- }
- Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestwinsleepCmd --
- *
- * Causes this process to wait for the given number of milliseconds by
- * means of a direct call to Sleep.
- *
- * Usage:
- * testwinsleep <n>
- *
- * Parameters:
- * n - the number of milliseconds to sleep
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sleeps for the requisite number of milliseconds.
- *
- *----------------------------------------------------------------------
- */
-
static int
TestwinsleepCmd(
ClientData clientData, /* Unused */
@@ -430,7 +350,7 @@ TestExceptionCmd(
"invalid_disp", "guard_page", "invalid_handle", "ctrl+c",
NULL
};
- static DWORD exceptions[] = {
+ static const DWORD exceptions[] = {
EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT,
EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND,
EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT,
generated by cgit v0.12 at 2024-07-02 18:23:05 (GMT)