summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in58
-rw-r--r--win/README2
-rwxr-xr-xwin/buildall.vc.bat12
-rwxr-xr-xwin/configure246
-rw-r--r--win/configure.in58
-rw-r--r--win/makefile.bc4
-rw-r--r--win/makefile.vc39
-rw-r--r--win/rc/lamp.bmpbin2102 -> 2102 bytes
-rw-r--r--win/rc/tk.icobin1398 -> 57022 bytes
-rw-r--r--win/rc/wish.icobin3630 -> 43646 bytes
-rw-r--r--win/rules.vc26
-rw-r--r--win/stubs.c68
-rw-r--r--win/tcl.m482
-rw-r--r--win/tkWin.h20
-rw-r--r--win/tkWin3d.c2
-rw-r--r--win/tkWinButton.c26
-rw-r--r--win/tkWinClipboard.c21
-rw-r--r--win/tkWinColor.c78
-rw-r--r--win/tkWinConfig.c4
-rw-r--r--win/tkWinCursor.c37
-rw-r--r--win/tkWinDefault.h65
-rw-r--r--win/tkWinDialog.c2238
-rw-r--r--win/tkWinDraw.c29
-rw-r--r--win/tkWinEmbed.c47
-rw-r--r--win/tkWinFont.c622
-rw-r--r--win/tkWinImage.c70
-rw-r--r--win/tkWinInit.c90
-rw-r--r--win/tkWinInt.h81
-rw-r--r--win/tkWinKey.c27
-rw-r--r--win/tkWinMenu.c299
-rw-r--r--win/tkWinPixmap.c12
-rw-r--r--win/tkWinPointer.c14
-rw-r--r--win/tkWinPort.h35
-rw-r--r--win/tkWinScrlbr.c101
-rw-r--r--win/tkWinSend.c209
-rw-r--r--win/tkWinSendCom.c108
-rw-r--r--win/tkWinSendCom.h6
-rw-r--r--win/tkWinTest.c279
-rw-r--r--win/tkWinWindow.c192
-rw-r--r--win/tkWinWm.c1278
-rw-r--r--win/tkWinX.c191
-rw-r--r--win/ttkWinMonitor.c6
-rw-r--r--win/ttkWinTheme.c2
-rw-r--r--win/ttkWinXPTheme.c51
-rw-r--r--win/winMain.c300
45 files changed, 4662 insertions, 2473 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 1d18b60..7b1766d 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,6 +4,8 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
+TCLVERSION = @TCL_VERSION@
+TCLPATCHL = @TCL_PATCH_LEVEL@
VERSION = @TK_VERSION@
PATCH_LEVEL = @TK_PATCH_LEVEL@
@@ -132,6 +134,8 @@ EXESUFFIX = @EXESUFFIX@
TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@
TK_LIB_FILE = @TK_LIB_FILE@
TK_DLL_FILE = @TK_DLL_FILE@
+TEST_DLL_FILE = tktest$(VER)${DLLSUFFIX}
+TEST_LIB_FILE = @LIBPREFIX@tktest$(VER)${LIBSUFFIX}
SHARED_LIBRARIES = $(TK_DLL_FILE) $(TK_STUB_LIB_FILE)
STATIC_LIBRARIES = $(TK_LIB_FILE)
@@ -160,18 +164,12 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
-# Tk does not used deprecated Tcl constructs so it should
-# compile fine with -DTCL_NO_DEPRECATED. To remove its own
-# set of deprecated code uncomment the second line.
-NO_DEPRECATED_FLAGS =
-#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED
-
# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = $(CFLAGS_DEBUG)
#CFLAGS = $(CFLAGS_OPTIMIZE)
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ $(NO_DEPRECATED_FLAGS)
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE
# Special compiler flags to use when building man2tcl on Windows.
MAN2TCLFLAGS = @MAN2TCLFLAGS@
@@ -205,6 +203,12 @@ COPY = cp
BUILD_TCLSH = @BUILD_TCLSH@
+# Tk does not used deprecated Tcl constructs so it should
+# compile fine with -DTCL_NO_DEPRECATED. To remove its own
+# set of deprecated code uncomment the second line.
+NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
+#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED
+
# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
# running make for the first time. Certain build targets (make genstubs)
# need it to be available on the PATH. This executable should *NOT* be
@@ -215,14 +219,12 @@ TCL_EXE = @TCLSH_PROG@
CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
-I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
-I"${XLIB_DIR_NATIVE}" -I"${BITMAP_DIR_NATIVE}" \
--I"${TCL_GENERIC_NATIVE}" -I"${TCL_PLATFORM_NATIVE}" ${AC_FLAGS}
+-I"${TCL_GENERIC_NATIVE}" -I"${TCL_PLATFORM_NATIVE}" \
+${AC_FLAGS} $(NO_DEPRECATED_FLAGS) -DUSE_TCL_STUBS
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
-STUB_CC_SWITCHES = ${CC_SWITCHES} -DUSE_TCL_STUBS
-CON_CC_SWITCHES = ${CC_SWITCHES} -DCONSOLE
-
# Tk used to let the configure script choose which program to use
# for installing, but there are just too many different versions of
# "install" around; better to use the install-sh script that comes
@@ -236,7 +238,6 @@ WISH_OBJS = \
winMain.$(OBJEXT)
TKTEST_OBJS = \
- testMain.$(OBJEXT) \
tkSquare.$(OBJEXT) \
tkTest.$(OBJEXT) \
tkOldTest.$(OBJEXT) \
@@ -284,6 +285,7 @@ TK_OBJS = \
tkAtom.$(OBJEXT) \
tkBind.$(OBJEXT) \
tkBitmap.$(OBJEXT) \
+ tkBusy.$(OBJEXT) \
tkButton.$(OBJEXT) \
tkCanvArc.$(OBJEXT) \
tkCanvBmap.$(OBJEXT) \
@@ -315,12 +317,15 @@ TK_OBJS = \
tkImage.$(OBJEXT) \
tkImgBmap.$(OBJEXT) \
tkImgGIF.$(OBJEXT) \
+ tkImgPNG.$(OBJEXT) \
tkImgPPM.$(OBJEXT) \
tkImgPhoto.$(OBJEXT) \
+ tkImgPhInstance.$(OBJEXT) \
tkImgUtil.$(OBJEXT) \
tkListbox.$(OBJEXT) \
tkMacWinMenu.$(OBJEXT) \
tkMain.$(OBJEXT) \
+ tkMain2.$(OBJEXT) \
tkMenu.$(OBJEXT) \
tkMenubutton.$(OBJEXT) \
tkMenuDraw.$(OBJEXT) \
@@ -432,15 +437,15 @@ $(MAN2TCL): $(TCL_SRC_DIR)/tools/man2tcl.c
test: test-classic test-ttk
-test-classic: binaries $(TKTEST) $(CAT32)
+test-classic: binaries $(TKTEST) $(TEST_DLL_FILE) $(CAT32)
$(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" \
$(TESTFLAGS) | ./$(CAT32)
-test-ttk: binaries $(TKTEST) $(CAT32)
+test-ttk: binaries $(TKTEST) $(TEST_DLL_FILE) $(CAT32)
$(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/ttk/all.tcl" \
$(TESTFLAGS) | ./$(CAT32)
-runtest: binaries $(TKTEST)
+runtest: binaries $(TKTEST) $(TEST_DLL_FILE)
$(SHELL_ENV) ./$(TKTEST) $(TESTFLAGS) $(SCRIPT)
# This target can be used to run wish from the build directory
@@ -481,7 +486,7 @@ install-binaries: binaries
@echo "Creating package index $(PKG_INDEX)";
@$(RM) $(PKG_INDEX);
@(\
- echo "if {[catch {package present Tcl 8.5.0}]} return";\
+ echo "if {[catch {package present Tcl 8.6.0}]} return";\
echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\
echo " || ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\
echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin libtk$(VERSION).dll]] Tk]";\
@@ -605,19 +610,23 @@ install-private-headers: libraries
$(INSTALL_DATA) $$i $(PRIVATE_INCLUDE_INSTALL_DIR); \
done;
-$(WISH): $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) wish.$(RES)
- $(CC) $(CFLAGS) $(WISH_OBJS) $(TCL_LIB_FILE) $(TK_LIB_FILE) $(LIBS) \
+$(WISH): $(WISH_OBJS) @LIBRARIES@ $(TK_STUB_LIB_FILE) wish.$(RES)
+ $(CC) $(CFLAGS) $(WISH_OBJS) $(TK_LIB_FILE) \
+ $(TK_STUB_LIB_FILE) $(TCL_LIB_FILE) $(LIBS) \
wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW)
@VC_MANIFEST_EMBED_EXE@
tktest: $(TKTEST)
-$(TKTEST): $(TKTEST_OBJS) $(TK_LIB_FILE) wish.$(RES)
- $(CC) $(CFLAGS) $(TKTEST_OBJS) $(TCL_LIB_FILE) \
- $(TK_LIB_FILE) $(LIBS) \
+$(TKTEST): testMain.$(OBJEXT) $(TEST_DLL_FILE) @LIBRARIES@ $(TK_STUB_LIB_FILE) wish.$(RES)
+ $(CC) $(CFLAGS) testMain.$(OBJEXT) $(TEST_LIB_FILE) $(TK_LIB_FILE) \
+ $(TK_STUB_LIB_FILE) $(TCL_LIB_FILE) $(LIBS) \
wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW)
@VC_MANIFEST_EMBED_EXE@
+${TEST_DLL_FILE}: ${TKTEST_OBJS} ${TK_STUB_LIB_FILE}
+ @MAKE_DLL@ ${TKTEST_OBJS} $(TK_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+
# Msys make requires this next rule for some reason.
$(TCL_SRC_DIR)/win/cat.c:
@@ -665,6 +674,9 @@ tkWinTest.$(OBJEXT): tkWinTest.c
tkSquare.$(OBJEXT): tkSquare.c
$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+tkMain2.$(OBJEXT): tkMain.c
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tk -DTK_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
+
# Extra dependency info
tkConsole.$(OBJEXT): configure Makefile
tkMain.$(OBJEXT): configure Makefile
@@ -680,10 +692,10 @@ tkWindow.$(OBJEXT): configure Makefile
# Implicit rule for all object files that will end up in the Tk library
%.$(OBJEXT): %.c
- $(CC) -c $(STUB_CC_SWITCHES) -DBUILD_tk -DBUILD_ttk @DEPARG@ $(CC_OBJNAME)
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tk -DBUILD_ttk @DEPARG@ $(CC_OBJNAME)
.rc.$(RES):
- $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(TCL_PLATFORM_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
depend:
diff --git a/win/README b/win/README
index 1d4b27a..8670446 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tk 8.5 for Windows
+Tk 8.6 for Windows
Originally by Scott Stanton while at Sun Microsystems Labs
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index 9cdf0d9..8f6803b 100755
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -63,15 +63,15 @@ if "%TCLDIR%" == "" set TCLDIR=..\..\tcl
:: Build the normal stuff along with the help file.
::
-set OPTS=threads
-if not %SYMBOLS%.==. set OPTS=symbols,threads
-nmake -nologo -f makefile.vc release OPTS=%OPTS% %1
+set OPTS=none
+if not %SYMBOLS%.==. set OPTS=symbols
+nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the static core and shell.
::
-set OPTS=static,msvcrt,threads
-if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
+set OPTS=static,msvcrt
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
@@ -93,7 +93,7 @@ echo usage:
echo %0 : builds Tk for all build types (do this first)
echo %0 install : installs all the release builds (do this second)
echo %0 symbols : builds Tk for all debugging build types
-echo %0 symbols install : install all the debug builds
+echo %0 symbols install : install all the debug builds.
echo.
goto out
diff --git a/win/configure b/win/configure
index bd48382..64aea44 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 TCL_VERSION TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_DEFS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING MAN2TCLFLAGS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE BUILD_TCLSH TCLSH_PROG TK_WIN_VERSION MACHINE TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_DBGX TK_LIB_FILE TK_DLL_FILE TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_BUILD_STUB_LIB_SPEC TK_SRC_DIR TK_BIN_DIR TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_DBGX CFG_TK_SHARED_LIB_SUFFIX CFG_TK_UNSHARED_LIB_SUFFIX CFG_TK_EXPORT_FILE_SUFFIX TK_SHARED_BUILD DEPARG EXTRA_CFLAGS STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES TK_RES RES LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TK_LIB_FLAG TK_LIB_SPEC TK_BUILD_LIB_SPEC TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_BUILD_STUB_LIB_PATH TK_CC_SEARCH_FLAGS TK_LD_SEARCH_FLAGS 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 TCL_VERSION TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_DEFS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING MAN2TCLFLAGS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE BUILD_TCLSH TCLSH_PROG TK_WIN_VERSION MACHINE TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_DBGX TK_LIB_FILE TK_DLL_FILE TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_BUILD_STUB_LIB_SPEC TK_SRC_DIR TK_BIN_DIR TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_DBGX CFG_TK_SHARED_LIB_SUFFIX CFG_TK_UNSHARED_LIB_SUFFIX CFG_TK_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW TK_RES STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TK_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TK_LIB_FLAG TK_LIB_SPEC TK_BUILD_LIB_SPEC TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_BUILD_STUB_LIB_PATH TK_CC_SEARCH_FLAGS TK_LD_SEARCH_FLAGS RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -840,7 +840,7 @@ 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 (default: off)
+ --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)
@@ -1309,10 +1309,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TK_VERSION=8.5
+TK_VERSION=8.6
TK_MAJOR_VERSION=8
-TK_MINOR_VERSION=5
-TK_PATCH_LEVEL=".18"
+TK_MINOR_VERSION=6
+TK_PATCH_LEVEL=".4"
VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION
#------------------------------------------------------------------------
@@ -3048,12 +3048,12 @@ if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
tcl_ok=$enableval
else
- tcl_ok=no
+ tcl_ok=yes
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
@@ -3067,8 +3067,8 @@ _ACEOF
else
TCL_THREADS=0
- echo "$as_me:$LINENO: result: no (default)" >&5
-echo "${ECHO_T}no (default)" >&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
@@ -3284,6 +3284,25 @@ echo "${ECHO_T}could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6
+if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then
+ { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}.
+Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}.
+Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5
+echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}.
+Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}.
+Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then
+ { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}.
+Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}.
+Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5
+echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}.
+Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}.
+Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
@@ -3408,6 +3427,11 @@ echo "${ECHO_T}$CELIB_DIR" >&6
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
+cat >>confdefs.h <<\_ACEOF
+#define MODULE_SCOPE extern
+_ACEOF
+
+
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
@@ -3465,7 +3489,7 @@ cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
- #ifndef __WIN32__
+ #ifndef _WIN32
#error cross-compiler
#endif
@@ -3588,7 +3612,7 @@ cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
- #ifdef __WIN32__
+ #ifdef _WIN32
#error win32
#endif
@@ -3639,14 +3663,80 @@ echo "${ECHO_T}$ac_cv_win32" >&6
echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
{ (exit 1); exit 1; }; }
fi
+
+ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
+ echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
+echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
+if test "${ac_cv_municode+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #include <windows.h>
+ int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_municode=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_municode=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
+echo "${ECHO_T}$ac_cv_municode" >&6
+ CFLAGS=$hold_cflags
+ if test "$ac_cv_municode" = "yes" ; then
+ extra_ldflags="$extra_ldflags -municode"
+ else
+ extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
+ fi
fi
echo "$as_me:$LINENO: checking compiler flags" >&5
echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
- SHLIB_LD_LIBS=""
- LIBS="-lws2_32"
+ SHLIB_LD_LIBS='${LIBS}'
+ LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
@@ -3666,9 +3756,6 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
runtime=
- MAKE_DLL="echo "
- LIBSUFFIX="s\${DBGX}.a"
- LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
else
@@ -3686,29 +3773,29 @@ echo "$as_me: error: ${CC} does not support the -shared option.
fi
runtime=
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default.
- SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
# Add SHLIB_LD_LIBS to the Make rule, not here.
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
- -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt by default.
+ SHLIB_LD='${CC} -shared'
+ SHLIB_LD_LIBS='${LIBS}'
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
+ LIBSUFFIX="\${DBGX}.a"
+ LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall"
+ CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -3809,24 +3896,16 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
runtime=-MT
- MAKE_DLL="echo "
- LIBSUFFIX="s\${DBGX}.lib"
- LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
- SHLIB_LD_LIBS=""
else
# dynamic
echo "$as_me:$LINENO: result: using shared flags" >&5
echo "${ECHO_T}using shared flags" >&6
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
- EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
- SHLIB_LD_LIBS='${LIBS}'
+ EXESUFFIX="\${DBGX}.exe"
case "x`echo \${VisualStudioVersion}`" in
x1[4-9]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
@@ -3835,9 +3914,12 @@ echo "${ECHO_T}using shared flags" >&6
;;
esac
fi
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
+ LIBSUFFIX="\${DBGX}.lib"
+ LIBFLAGSUFFIX="\${DBGX}"
# This is a 2-stage check to make sure we have the 64-bit SDK
# We have to know where the SDK is installed.
@@ -3870,7 +3952,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
fi
- LIBS="user32.lib advapi32.lib ws2_32.lib"
+ LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
x1[4-9]*)
@@ -4077,6 +4159,7 @@ _ACEOF
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
+ SHLIB_LD_LIBS='${LIBS}'
# link -lib only works when -lib is the first arg
STLIB_LD="${LINKBIN} -lib ${lflags}"
RC_OUT=-fo
@@ -4692,6 +4775,63 @@ echo "$as_me: xpnative theme will be unavailable" >&6;}
fi
+echo "$as_me:$LINENO: checking for vssym32.h" >&5
+echo $ECHO_N "checking for vssym32.h... $ECHO_C" >&6
+if test "${ac_cv_header_vssym32_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <windows.h>
+#include <uxtheme.h>
+
+#include <vssym32.h>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_header_vssym32_h=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_vssym32_h=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_vssym32_h" >&5
+echo "${ECHO_T}$ac_cv_header_vssym32_h" >&6
+if test $ac_cv_header_vssym32_h = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_VSSYM32_H 1
+_ACEOF
+
+fi
+
+
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
@@ -4985,6 +5125,8 @@ TK_WIN_VERSION="$TK_VERSION.$TK_RELEASE_LEVEL.`echo $TK_PATCH_LEVEL | tr -d ab.`
+# win/tcl.m4 doesn't set (LDFLAGS)
+
@@ -5020,11 +5162,15 @@ TK_WIN_VERSION="$TK_VERSION.$TK_RELEASE_LEVEL.`echo $TK_PATCH_LEVEL | tr -d ab.`
+# undefined at this point for win
+
+
+
+
-# undefined at this point for win
@@ -5726,27 +5872,21 @@ s,@TCL_DBGX@,$TCL_DBGX,;t t
s,@CFG_TK_SHARED_LIB_SUFFIX@,$CFG_TK_SHARED_LIB_SUFFIX,;t t
s,@CFG_TK_UNSHARED_LIB_SUFFIX@,$CFG_TK_UNSHARED_LIB_SUFFIX,;t t
s,@CFG_TK_EXPORT_FILE_SUFFIX@,$CFG_TK_EXPORT_FILE_SUFFIX,;t t
-s,@TK_SHARED_BUILD@,$TK_SHARED_BUILD,;t t
-s,@DEPARG@,$DEPARG,;t t
s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t
-s,@STLIB_LD@,$STLIB_LD,;t t
-s,@SHLIB_LD@,$SHLIB_LD,;t t
-s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t
-s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t
-s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t
+s,@DEPARG@,$DEPARG,;t t
s,@CC_OBJNAME@,$CC_OBJNAME,;t t
s,@CC_EXENAME@,$CC_EXENAME,;t t
s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t
s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t
s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t
s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t
-s,@RC_OUT@,$RC_OUT,;t t
-s,@RC_TYPE@,$RC_TYPE,;t t
-s,@RC_INCLUDE@,$RC_INCLUDE,;t t
-s,@RC_DEFINE@,$RC_DEFINE,;t t
-s,@RC_DEFINES@,$RC_DEFINES,;t t
s,@TK_RES@,$TK_RES,;t t
-s,@RES@,$RES,;t t
+s,@STLIB_LD@,$STLIB_LD,;t t
+s,@SHLIB_LD@,$SHLIB_LD,;t t
+s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t
+s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t
+s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t
+s,@TK_SHARED_BUILD@,$TK_SHARED_BUILD,;t t
s,@LIBS_GUI@,$LIBS_GUI,;t t
s,@DLLSUFFIX@,$DLLSUFFIX,;t t
s,@LIBPREFIX@,$LIBPREFIX,;t t
@@ -5766,6 +5906,12 @@ s,@TK_STUB_LIB_PATH@,$TK_STUB_LIB_PATH,;t t
s,@TK_BUILD_STUB_LIB_PATH@,$TK_BUILD_STUB_LIB_PATH,;t t
s,@TK_CC_SEARCH_FLAGS@,$TK_CC_SEARCH_FLAGS,;t t
s,@TK_LD_SEARCH_FLAGS@,$TK_LD_SEARCH_FLAGS,;t t
+s,@RC_OUT@,$RC_OUT,;t t
+s,@RC_TYPE@,$RC_TYPE,;t t
+s,@RC_INCLUDE@,$RC_INCLUDE,;t t
+s,@RC_DEFINE@,$RC_DEFINE,;t t
+s,@RC_DEFINES@,$RC_DEFINES,;t t
+s,@RES@,$RES,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF
diff --git a/win/configure.in b/win/configure.in
index 4634bb6..709b97f 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -11,10 +11,10 @@ AC_PREREQ(2.59)
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TK_VERSION=8.5
+TK_VERSION=8.6
TK_MAJOR_VERSION=8
-TK_MINOR_VERSION=5
-TK_PATCH_LEVEL=".18"
+TK_MINOR_VERSION=6
+TK_PATCH_LEVEL=".4"
VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION
#------------------------------------------------------------------------
@@ -81,6 +81,17 @@ SC_ENABLE_SHARED
SC_PATH_TCLCONFIG($TK_PATCH_LEVEL)
SC_LOAD_TCLCONFIG
+if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then
+ AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}.
+Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}.
+Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.])
+fi
+if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then
+ AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}.
+Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}.
+Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.])
+fi
+
#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
@@ -115,6 +126,9 @@ fi
AC_CHECK_HEADER([uxtheme.h], [AC_DEFINE(HAVE_UXTHEME_H)],
[AC_MSG_NOTICE([xpnative theme will be unavailable])],
[#include <windows.h>])
+AC_CHECK_HEADER([vssym32.h], [AC_DEFINE(HAVE_VSSYM32_H)], [],
+ [#include <windows.h>
+#include <uxtheme.h>])
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
@@ -229,25 +243,22 @@ AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
+
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_DBGX)
AC_SUBST(CFG_TK_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TK_UNSHARED_LIB_SUFFIX)
AC_SUBST(CFG_TK_EXPORT_FILE_SUFFIX)
-AC_SUBST(TK_SHARED_BUILD)
-AC_SUBST(CYGPATH)
-AC_SUBST(DEPARG)
AC_SUBST(CFLAGS_DEFAULT)
AC_SUBST(EXTRA_CFLAGS)
-AC_SUBST(STLIB_LD)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(SHLIB_LD_LIBS)
-AC_SUBST(SHLIB_CFLAGS)
-AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(CYGPATH)
+AC_SUBST(DEPARG)
AC_SUBST(CC_OBJNAME)
AC_SUBST(CC_EXENAME)
+
+# win/tcl.m4 doesn't set (LDFLAGS)
AC_SUBST(LDFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEBUG)
AC_SUBST(LDFLAGS_OPTIMIZE)
@@ -255,14 +266,15 @@ AC_SUBST(LDFLAGS_CONSOLE)
AC_SUBST(LDFLAGS_WINDOW)
AC_SUBST(AR)
AC_SUBST(RANLIB)
-AC_SUBST(RC)
-AC_SUBST(RC_OUT)
-AC_SUBST(RC_TYPE)
-AC_SUBST(RC_INCLUDE)
-AC_SUBST(RC_DEFINE)
-AC_SUBST(RC_DEFINES)
AC_SUBST(TK_RES)
-AC_SUBST(RES)
+
+AC_SUBST(STLIB_LD)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(TK_SHARED_BUILD)
+
AC_SUBST(LIBS)
AC_SUBST(LIBS_GUI)
AC_SUBST(DLLSUFFIX)
@@ -287,7 +299,15 @@ AC_SUBST(TK_BUILD_STUB_LIB_PATH)
AC_SUBST(TK_CC_SEARCH_FLAGS)
AC_SUBST(TK_LD_SEARCH_FLAGS)
-AC_OUTPUT([Makefile tkConfig.sh wish.exe.manifest])
+AC_SUBST(RC)
+AC_SUBST(RC_OUT)
+AC_SUBST(RC_TYPE)
+AC_SUBST(RC_INCLUDE)
+AC_SUBST(RC_DEFINE)
+AC_SUBST(RC_DEFINES)
+AC_SUBST(RES)
+
+AC_OUTPUT(Makefile tkConfig.sh wish.exe.manifest)
dnl Local Variables:
dnl mode: autoconf;
diff --git a/win/makefile.bc b/win/makefile.bc
index 5a22c95..d98dfd7 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -161,6 +161,7 @@ TKOBJS = \
$(TMPDIR)\tkAtom.obj \
$(TMPDIR)\tkBind.obj \
$(TMPDIR)\tkBitmap.obj \
+ $(TMPDIR)\tkBusy.obj \
$(TMPDIR)\tkButton.obj \
$(TMPDIR)\tkCanvArc.obj \
$(TMPDIR)\tkCanvBmap.obj \
@@ -194,6 +195,7 @@ TKOBJS = \
$(TMPDIR)\tkImgGIF.obj \
$(TMPDIR)\tkImgPPM.obj \
$(TMPDIR)\tkImgPhoto.obj \
+ $(TMPDIR)\tkImgPhInstance.obj \
$(TMPDIR)\tkImgUtil.obj \
$(TMPDIR)\tkListbox.obj \
$(TMPDIR)\tkMacWinMenu.obj \
@@ -241,7 +243,7 @@ RCDIR = $(WINDIR)\rc
TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
-I$(TCLDIR)\generic -I$(TCLDIR)\win
-TK_DEFINES = -D__WIN32__ $(DEBUGDEFINES) $(THREADDEFINES) SUPPORT_CONFIG_EMBEDDED
+TK_DEFINES = -D_WIN32 $(DEBUGDEFINES) $(THREADDEFINES) SUPPORT_CONFIG_EMBEDDED
######################################################################
# Compile flags
diff --git a/win/makefile.vc b/win/makefile.vc
index d2795c9..ae43eb6 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -213,8 +213,8 @@ TTK_SQUARE_WIDGET = 0
STUBPREFIX = $(PROJECT)stub
WISHNAMEPREFIX = wish
-BINROOT = $(MAKEDIR) # originally .
-ROOT = $(MAKEDIR)\.. # originally ..
+BINROOT = $(MAKEDIR) # originally .
+ROOT = $(MAKEDIR)\.. # originally ..
TK_LIBRARY = $(ROOT)\library
@@ -294,6 +294,7 @@ TKOBJS = \
$(TMP_DIR)\tkAtom.obj \
$(TMP_DIR)\tkBind.obj \
$(TMP_DIR)\tkBitmap.obj \
+ $(TMP_DIR)\tkBusy.obj \
$(TMP_DIR)\tkButton.obj \
$(TMP_DIR)\tkCanvArc.obj \
$(TMP_DIR)\tkCanvBmap.obj \
@@ -325,12 +326,15 @@ TKOBJS = \
$(TMP_DIR)\tkImage.obj \
$(TMP_DIR)\tkImgBmap.obj \
$(TMP_DIR)\tkImgGIF.obj \
+ $(TMP_DIR)\tkImgPNG.obj \
$(TMP_DIR)\tkImgPPM.obj \
$(TMP_DIR)\tkImgPhoto.obj \
+ $(TMP_DIR)\tkImgPhInstance.obj \
$(TMP_DIR)\tkImgUtil.obj \
$(TMP_DIR)\tkListbox.obj \
$(TMP_DIR)\tkMacWinMenu.obj \
$(TMP_DIR)\tkMain.obj \
+ $(TMP_DIR)\tkMain2.obj \
$(TMP_DIR)\tkMenu.obj \
$(TMP_DIR)\tkMenubutton.obj \
$(TMP_DIR)\tkMenuDraw.obj \
@@ -517,7 +521,9 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib user32.lib
+tcllibs = $(TCLSTUBLIB) $(TCLIMPLIB)
+
+baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
@@ -564,12 +570,7 @@ test-classic: setup $(TKTEST) $(TKLIB) $(CAT32)
!else
@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
!endif
-!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) | $(CAT32)
-!else
- $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) > tests.log
- type tests.log | more
-!endif
test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -580,12 +581,7 @@ test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32)
!else
@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
!endif
-!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) | $(CAT32)
-!else
- $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) > tests.log
- type tests.log | more
-!endif
runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -660,18 +656,18 @@ $(TKSTUBLIB): $(TKSTUBOBJS)
$(lib32) -nologo -nodefaultlib -out:$@ $**
-$(WISH): $(WISHOBJS) $(TKIMPLIB)
- $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(TCLIMPLIB) $**
+$(WISH): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-$(WISHC): $(WISHOBJS) $(TKIMPLIB)
- $(link32) $(conlflags) -stack:2300000 -out:$@ $(guilibs) $(TCLIMPLIB) $**
+$(WISHC): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-$(TKTEST): $(TKTESTOBJS) $(TKIMPLIB)
- $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(TCLIMPLIB) $**
+$(TKTEST): $(TKTESTOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
$(_VC_MANIFEST_EMBED_EXE)
@@ -850,6 +846,9 @@ $(TMP_DIR)\winMain.obj: $(WINDIR)\winMain.c
-DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
-Fo$@ $?
+$(TMP_DIR)\tkMain2.obj: $(GENERICDIR)\tkMain.c
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -DTK_ASCII_MAIN -Fo$@ $?
+
# The following objects are part of the stub library and should not
# be built as DLL objects but none of the symbols should be exported
# and no reference made to a C runtime.
@@ -962,7 +961,7 @@ install-binaries:
!if !$(STATIC_BUILD)
@echo creating package index
@type << > $(OUT_DIR)\pkgIndex.tcl
-if {[catch {package present Tcl $(TK_DOTVERSION).0}]} { return }
+if {[catch {package present Tcl $(TCL_PATCH_LEVEL)}]} { return }
if {($$::tcl_platform(platform) eq "unix") && ([info exists ::env(DISPLAY)]
|| ([info exists ::argv] && ("-display" in $$::argv)))} {
package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin libtk$(TK_DOTVERSION).dll] Tk]
diff --git a/win/rc/lamp.bmp b/win/rc/lamp.bmp
index 834c0f9..1e2f9d4 100644
--- a/win/rc/lamp.bmp
+++ b/win/rc/lamp.bmp
Binary files differ
diff --git a/win/rc/tk.ico b/win/rc/tk.ico
index 5fdb9a7..e254318 100644
--- a/win/rc/tk.ico
+++ b/win/rc/tk.ico
Binary files differ
diff --git a/win/rc/wish.ico b/win/rc/wish.ico
index 1825751..5801fb8 100644
--- a/win/rc/wish.ico
+++ b/win/rc/wish.ico
Binary files differ
diff --git a/win/rules.vc b/win/rules.vc
index a43fac6..0d8cd6b 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -159,7 +159,7 @@ DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
DEBUGFLAGS = $(DEBUGFLAGS) -GZ
!endif
-COMPILERFLAGS =-W3
+COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE
# In v13 -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
@@ -213,7 +213,7 @@ LINKERFLAGS =-ltcg
!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
STATIC_BUILD = 0
-TCL_THREADS = 0
+TCL_THREADS = 1
DEBUG = 0
SYMBOLS = 0
PROFILE = 0
@@ -221,7 +221,7 @@ PGO = 0
MSVCRT = 1
LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
-USE_THREAD_ALLOC = 0
+USE_THREAD_ALLOC = 1
UNCHECKED = 0
!else
!if [nmakehlp -f $(OPTS) "static"]
@@ -246,13 +246,13 @@ TCL_USE_STATIC_PACKAGES = 1
!else
TCL_USE_STATIC_PACKAGES = 0
!endif
-!if [nmakehlp -f $(OPTS) "threads"]
-!message *** Doing threads
-TCL_THREADS = 1
-USE_THREAD_ALLOC = 1
-!else
+!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
TCL_THREADS = 0
-USE_THREAD_ALLOC = 0
+USE_THREAD_ALLOC= 0
+!else
+TCL_THREADS = 1
+USE_THREAD_ALLOC= 1
!endif
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
@@ -588,8 +588,8 @@ TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:x=).lib"
!endif
TCL_LIBRARY = $(_TCLDIR)\lib
-TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(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"
@@ -604,8 +604,8 @@ TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:x=).lib"
!endif
TCL_LIBRARY = $(_TCLDIR)\library
-TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(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/stubs.c b/win/stubs.c
index 4564639..1cf23ef 100644
--- a/win/stubs.c
+++ b/win/stubs.c
@@ -404,3 +404,71 @@ XGetWindowProperty(
*prop_return = NULL;
return BadValue;
}
+
+/*
+ * The following functions were implemented as macros under Windows.
+ */
+
+int
+XFlush(
+ Display *display)
+{
+ return 0;
+}
+
+int
+XGrabServer(
+ Display *display)
+{
+ return 0;
+}
+
+int
+XUngrabServer(
+ Display *display)
+{
+ return 0;
+}
+
+int
+XFree(
+ void *data)
+{
+ if ((data) != NULL) {
+ ckfree(data);
+ }
+ return 0;
+}
+
+int
+XNoOp(
+ Display *display)
+{
+ display->request++;
+ return 0;
+}
+
+XAfterFunction
+XSynchronize(
+ Display *display,
+ Bool bool)
+{
+ display->request++;
+ return NULL;
+}
+
+int
+XSync(
+ Display *display,
+ Bool bool)
+{
+ display->request++;
+ return 0;
+}
+
+VisualID
+XVisualIDFromVisual(
+ Visual *visual)
+{
+ return visual->visualid;
+}
diff --git a/win/tcl.m4 b/win/tcl.m4
index 2795086..db86f6c 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -247,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
#
# Results:
#
-# Subst the following vars:
+# Substitutes the following vars:
# TCL_BIN_DIR
# TCL_SRC_DIR
# TCL_LIB_FILE
@@ -401,11 +401,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 (default: off)],
- [tcl_ok=$enableval], [tcl_ok=no])
+ 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
@@ -413,7 +413,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
AC_DEFINE(USE_THREAD_ALLOC)
else
TCL_THREADS=0
- AC_MSG_RESULT([no (default)])
+ AC_MSG_RESULT(no)
fi
AC_SUBST(TCL_THREADS)
])
@@ -557,6 +557,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
+ AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
@@ -571,7 +572,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_CACHE_CHECK(for cross-compile version of gcc,
ac_cv_cross,
AC_TRY_COMPILE([
- #ifndef __WIN32__
+ #ifndef _WIN32
#error cross-compiler
#endif
], [],
@@ -638,7 +639,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_CACHE_CHECK(for mingw32 version of gcc,
ac_cv_win32,
AC_TRY_COMPILE([
- #ifdef __WIN32__
+ #ifdef _WIN32
#error win32
#endif
], [],
@@ -648,13 +649,31 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
if test "$ac_cv_win32" != "yes"; then
AC_MSG_ERROR([${CC} cannot produce win32 executables.])
fi
+
+ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
+ AC_CACHE_CHECK(for working -municode linker flag,
+ ac_cv_municode,
+ AC_TRY_LINK([
+ #include <windows.h>
+ int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
+ ],
+ [],
+ ac_cv_municode=yes,
+ ac_cv_municode=no)
+ )
+ CFLAGS=$hold_cflags
+ if test "$ac_cv_municode" = "yes" ; then
+ extra_ldflags="$extra_ldflags -municode"
+ else
+ extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
+ fi
fi
AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
- SHLIB_LD_LIBS=""
- LIBS="-lws2_32"
+ SHLIB_LD_LIBS='${LIBS}'
+ LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
@@ -673,9 +692,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# static
AC_MSG_RESULT([using static flags])
runtime=
- MAKE_DLL="echo "
- LIBSUFFIX="s\${DBGX}.a"
- LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
else
@@ -689,29 +705,29 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
runtime=
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default.
- SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
# Add SHLIB_LD_LIBS to the Make rule, not here.
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
- -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt by default.
+ SHLIB_LD='${CC} -shared'
+ SHLIB_LD_LIBS='${LIBS}'
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
+ LIBSUFFIX="\${DBGX}.a"
+ LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall"
+ CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -766,23 +782,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# static
AC_MSG_RESULT([using static flags])
runtime=-MT
- MAKE_DLL="echo "
- LIBSUFFIX="s\${DBGX}.lib"
- LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
- SHLIB_LD_LIBS=""
else
# dynamic
AC_MSG_RESULT([using shared flags])
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
- EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
- SHLIB_LD_LIBS='${LIBS}'
+ EXESUFFIX="\${DBGX}.exe"
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
@@ -791,9 +799,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
;;
esac
fi
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
+ LIBSUFFIX="\${DBGX}.lib"
+ LIBFLAGSUFFIX="\${DBGX}"
# This is a 2-stage check to make sure we have the 64-bit SDK
# We have to know where the SDK is installed.
@@ -823,7 +834,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
- LIBS="user32.lib advapi32.lib ws2_32.lib"
+ LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
@@ -957,6 +968,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
+ SHLIB_LD_LIBS='${LIBS}'
# link -lib only works when -lib is the first arg
STLIB_LD="${LINKBIN} -lib ${lflags}"
RC_OUT=-fo
@@ -1117,13 +1129,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.5$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.5$1/win
+ if test -d ../../tcl8.6$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.6$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.5/win
+ TCL_BIN_DEFAULT=../../tcl8.6/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
diff --git a/win/tkWin.h b/win/tkWin.h
index 00d3486..4d278d7 100644
--- a/win/tkWin.h
+++ b/win/tkWin.h
@@ -16,9 +16,9 @@
/*
* We must specify the lower version we intend to support. In particular
* the SystemParametersInfo API doesn't like to receive structures that
- * are larger than it expects which affects the font assignements.
+ * are larger than it expects which affects the font assignments.
*
- * WINVER = 0x0410 means Windows 98 and above
+ * WINVER = 0x0500 means Windows 2000 and above
*/
#ifndef WINVER
@@ -36,16 +36,11 @@
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
-#ifdef BUILD_tk
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-
/*
* The following messages are used to communicate between a Tk toplevel
- * and its container window. A Tk container may not be able to provide
- * service to all of the following requests at the moment. But an embedded
- * Tk window will send out these requests to support external Tk container
+ * and its container window. A Tk container may not be able to provide
+ * service to all of the following requests at the moment. But an embedded
+ * Tk window will send out these requests to support external Tk container
* application.
*/
@@ -66,7 +61,7 @@
/*
* The following are sub-messages (wParam) for TK_INFO. An embedded window may
- * send a TK_INFO message with one of the sub-messages to query a container
+ * send a TK_INFO message with one of the sub-messages to query a container
* for verification and availability
*/
#define TK_CONTAINER_VERIFY 0x01
@@ -83,7 +78,4 @@
#include "tkPlatDecls.h"
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
-
#endif /* _TKWIN */
diff --git a/win/tkWin3d.c b/win/tkWin3d.c
index df6aa95..d3c443d 100644
--- a/win/tkWin3d.c
+++ b/win/tkWin3d.c
@@ -43,7 +43,7 @@ typedef struct {
TkBorder *
TkpGetBorder(void)
{
- WinBorder *borderPtr = (WinBorder *) ckalloc(sizeof(WinBorder));
+ WinBorder *borderPtr = ckalloc(sizeof(WinBorder));
borderPtr->light2ColorPtr = NULL;
borderPtr->dark2ColorPtr = NULL;
diff --git a/win/tkWinButton.c b/win/tkWinButton.c
index 9e1960d..e46bcb3 100644
--- a/win/tkWinButton.c
+++ b/win/tkWinButton.c
@@ -86,7 +86,7 @@ static void InitBoxes(void);
* The class procedure table for the button widgets.
*/
-Tk_ClassProcs tkpButtonProcs = {
+const Tk_ClassProcs tkpButtonProcs = {
sizeof(Tk_ClassProcs), /* size */
TkButtonWorldChanged, /* worldChangedProc */
CreateProc, /* createProc */
@@ -131,7 +131,7 @@ InitBoxes(void)
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- hrsrc = FindResource(module, "buttons", RT_BITMAP);
+ hrsrc = FindResource(module, TEXT("buttons"), RT_BITMAP);
if (hrsrc == NULL) {
Tcl_Panic("FindResource() failed for buttons bitmap resource, "
"resources in tk_base.rc must be linked into Tk dll or static executable");
@@ -148,7 +148,7 @@ InitBoxes(void)
&& !(tsdPtr->boxesPtr->biHeight % 2)) {
size = tsdPtr->boxesPtr->biSize + (1 << tsdPtr->boxesPtr->biBitCount)
* sizeof(RGBQUAD) + tsdPtr->boxesPtr->biSizeImage;
- newBitmap = (LPBITMAPINFOHEADER) ckalloc(size);
+ newBitmap = ckalloc(size);
memcpy(newBitmap, tsdPtr->boxesPtr, size);
tsdPtr->boxesPtr = newBitmap;
tsdPtr->boxWidth = tsdPtr->boxesPtr->biWidth / 4;
@@ -184,9 +184,9 @@ void
TkpButtonSetDefaults()
{
int width = GetSystemMetrics(SM_CXEDGE);
- if (width > 0) {
- sprintf(tkDefButtonBorderWidth, "%d", width);
- }
+ if (width > 0) {
+ sprintf(tkDefButtonBorderWidth, "%d", width);
+ }
}
/*
@@ -211,7 +211,7 @@ TkpCreateButton(
{
WinButton *butPtr;
- butPtr = (WinButton *)ckalloc(sizeof(WinButton));
+ butPtr = ckalloc(sizeof(WinButton));
butPtr->hwnd = NULL;
return (TkButton *) butPtr;
}
@@ -241,15 +241,15 @@ CreateProc(
{
Window window;
HWND parent;
- char *class;
+ const TCHAR *class;
WinButton *butPtr = (WinButton *)instanceData;
parent = Tk_GetHWND(parentWin);
if (butPtr->info.type == TYPE_LABEL) {
- class = "STATIC";
+ class = TEXT("STATIC");
butPtr->style = SS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS;
} else {
- class = "BUTTON";
+ class = TEXT("BUTTON");
butPtr->style = BS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS;
}
butPtr->hwnd = CreateWindow(class, NULL, butPtr->style,
@@ -258,7 +258,7 @@ CreateProc(
SetWindowPos(butPtr->hwnd, HWND_TOP, 0, 0, 0, 0,
SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
butPtr->oldProc = (WNDPROC)SetWindowLongPtr(butPtr->hwnd, GWLP_WNDPROC,
- (INT_PTR) ButtonProc);
+ (LONG_PTR) ButtonProc);
window = Tk_AttachHWND(tkwin, butPtr->hwnd);
return window;
@@ -288,7 +288,7 @@ TkpDestroyButton(
HWND hwnd = winButPtr->hwnd;
if (hwnd) {
- SetWindowLongPtr(hwnd, GWLP_WNDPROC, (INT_PTR) winButPtr->oldProc);
+ SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) winButPtr->oldProc);
}
}
@@ -1281,7 +1281,7 @@ ButtonProc(
if (code != TCL_OK && code != TCL_CONTINUE
&& code != TCL_BREAK) {
Tcl_AddErrorInfo(interp, "\n (button invoke)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
Tcl_Release((ClientData)interp);
}
diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c
index 76711b5..2501688 100644
--- a/win/tkWinClipboard.c
+++ b/win/tkWinClipboard.c
@@ -104,7 +104,7 @@ TkSelGetSelection(
*/
locale = LANGIDFROMLCID(*((int*)data));
- GetLocaleInfo(locale, LOCALE_IDEFAULTANSICODEPAGE,
+ GetLocaleInfoA(locale, LOCALE_IDEFAULTANSICODEPAGE,
Tcl_DStringValue(&ds)+2, Tcl_DStringLength(&ds)-2);
GlobalUnlock(handle);
@@ -156,15 +156,16 @@ TkSelGetSelection(
* Pass the data off to the selection procedure.
*/
- result = (*proc)(clientData, interp, Tcl_DStringValue(&ds));
+ result = proc(clientData, interp, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
CloseClipboard();
return result;
error:
- Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
- " selection doesn't exist or form \"",
- Tk_GetAtomName(tkwin, target), "\" not defined", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s selection doesn't exist or form \"%s\" not defined",
+ Tk_GetAtomName(tkwin, selection), Tk_GetAtomName(tkwin, target)));
+ Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL);
return TCL_ERROR;
}
@@ -274,7 +275,7 @@ TkWinClipboardRender(
* Copy the data and change EOL characters.
*/
- buffer = rawText = ckalloc((unsigned)length + 1);
+ buffer = rawText = ckalloc(length + 1);
if (targetPtr != NULL) {
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
@@ -294,7 +295,7 @@ TkWinClipboardRender(
* encoding before placing it on the clipboard.
*/
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+#ifdef UNICODE
Tcl_DStringInit(&ds);
Tcl_UtfToUniCharDString(rawText, -1, &ds);
ckfree(rawText);
@@ -310,7 +311,7 @@ TkWinClipboardRender(
GlobalUnlock(handle);
Tcl_DStringFree(&ds);
SetClipboardData(CF_UNICODETEXT, handle);
- } else {
+#else
Tcl_UtfToExternalDString(NULL, rawText, -1, &ds);
ckfree(rawText);
handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
@@ -325,7 +326,7 @@ TkWinClipboardRender(
GlobalUnlock(handle);
Tcl_DStringFree(&ds);
SetClipboardData(CF_TEXT, handle);
- }
+#endif
}
/*
@@ -384,7 +385,7 @@ UpdateClipboard(
* possible.
*/
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ if (TkWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS) {
SetClipboardData(CF_UNICODETEXT, NULL);
} else {
SetClipboardData(CF_TEXT, NULL);
diff --git a/win/tkWinColor.c b/win/tkWinColor.c
index 20ab2e0..ba9815c 100644
--- a/win/tkWinColor.c
+++ b/win/tkWinColor.c
@@ -31,11 +31,11 @@ typedef struct WinColor {
*/
typedef struct {
- char *name;
+ const char *name;
int index;
} SystemColorEntry;
-static SystemColorEntry sysColors[] = {
+static const SystemColorEntry sysColors[] = {
{"3dDarkShadow", COLOR_3DDKSHADOW},
{"3dLight", COLOR_3DLIGHT},
{"ActiveBorder", COLOR_ACTIVEBORDER},
@@ -61,15 +61,9 @@ static SystemColorEntry sysColors[] = {
{"Scrollbar", COLOR_SCROLLBAR},
{"Window", COLOR_WINDOW},
{"WindowFrame", COLOR_WINDOWFRAME},
- {"WindowText", COLOR_WINDOWTEXT},
- {NULL, 0}
+ {"WindowText", COLOR_WINDOWTEXT}
};
-typedef struct ThreadSpecificData {
- int ncolors;
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-
/*
* Forward declarations for functions defined later in this file.
*/
@@ -102,37 +96,14 @@ FindSystemColor(
int *indexPtr) /* Out parameter to store color index. */
{
int l, u, r, i;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- /*
- * Count the number of elements in the color array if we haven't done so
- * yet.
- */
-
- if (tsdPtr->ncolors == 0) {
- SystemColorEntry *ePtr;
- int version;
-
- version = LOBYTE(LOWORD(GetVersion()));
- for (ePtr = sysColors; ePtr->name != NULL; ePtr++) {
- if (version < 4) {
- if (ePtr->index == COLOR_3DDKSHADOW) {
- ePtr->index = COLOR_BTNSHADOW;
- } else if (ePtr->index == COLOR_3DLIGHT) {
- ePtr->index = COLOR_BTNHIGHLIGHT;
- }
- }
- tsdPtr->ncolors++;
- }
- }
+ int index;
/*
* Perform a binary search on the sorted array of colors.
*/
l = 0;
- u = tsdPtr->ncolors - 1;
+ u = (sizeof(sysColors) / sizeof(sysColors[0])) - 1;
while (l <= u) {
i = (l + u) / 2;
r = strcasecmp(name, sysColors[i].name);
@@ -148,8 +119,8 @@ FindSystemColor(
return 0;
}
- *indexPtr = sysColors[i].index;
- colorPtr->pixel = GetSysColor(sysColors[i].index);
+ *indexPtr = index = sysColors[i].index;
+ colorPtr->pixel = GetSysColor(index);
/*
* x257 is (value<<8 + value) to get the properly bit shifted and padded
@@ -202,7 +173,7 @@ TkpGetColor(
&& FindSystemColor(name+6, &color, &index))
|| TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), name,
&color)) {
- winColPtr = (WinColor *) ckalloc(sizeof(WinColor));
+ winColPtr = ckalloc(sizeof(WinColor));
winColPtr->info.color = color;
winColPtr->index = index;
@@ -240,7 +211,7 @@ TkpGetColorByValue(
XColor *colorPtr) /* Red, green, and blue fields indicate
* desired color. */
{
- WinColor *tkColPtr = (WinColor *) ckalloc(sizeof(WinColor));
+ WinColor *tkColPtr = ckalloc(sizeof(WinColor));
tkColPtr->info.color.red = colorPtr->red;
tkColPtr->info.color.green = colorPtr->green;
@@ -345,7 +316,8 @@ XAllocColor(
if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) {
unsigned long sizePalette = GetDeviceCaps(dc, SIZEPALETTE);
UINT newPixel, closePixel;
- int new, refCount;
+ int new;
+ size_t refCount;
Tcl_HashEntry *entryPtr;
UINT index;
@@ -375,7 +347,7 @@ XAllocColor(
color->blue = closeEntry.peBlue * 257;
entry = closeEntry;
if (index >= cmap->size) {
- OutputDebugString("XAllocColor: Colormap is bigger than we thought");
+ OutputDebugStringA("XAllocColor: Colormap is bigger than we thought");
}
} else {
cmap->size++;
@@ -390,9 +362,9 @@ XAllocColor(
if (new) {
refCount = 1;
} else {
- refCount = (PTR2INT(Tcl_GetHashValue(entryPtr))) + 1;
+ refCount = (size_t)Tcl_GetHashValue(entryPtr) + 1;
}
- Tcl_SetHashValue(entryPtr, INT2PTR(refCount));
+ Tcl_SetHashValue(entryPtr, (void *)refCount);
} else {
/*
* Determine what color will actually be used on non-colormap systems.
@@ -436,7 +408,8 @@ XFreeColors(
{
TkWinColormap *cmap = (TkWinColormap *) colormap;
COLORREF cref;
- UINT count, index, refCount;
+ UINT count, index;
+ size_t refCount;
int i;
PALETTEENTRY entry, *entries;
Tcl_HashEntry *entryPtr;
@@ -454,27 +427,26 @@ XFreeColors(
for (i = 0; i < npixels; i++) {
entryPtr = Tcl_FindHashEntry(&cmap->refCounts, INT2PTR(pixels[i]));
if (!entryPtr) {
- Tcl_Panic("Tried to free a color that isn't allocated.");
+ Tcl_Panic("Tried to free a color that isn't allocated");
}
- refCount = PTR2INT(Tcl_GetHashValue(entryPtr)) - 1;
+ refCount = (size_t)Tcl_GetHashValue(entryPtr) - 1;
if (refCount == 0) {
cref = pixels[i] & 0x00ffffff;
index = GetNearestPaletteIndex(cmap->palette, cref);
GetPaletteEntries(cmap->palette, index, 1, &entry);
if (cref == RGB(entry.peRed, entry.peGreen, entry.peBlue)) {
count = cmap->size - index;
- entries = (PALETTEENTRY *)
- ckalloc(sizeof(PALETTEENTRY) * count);
+ entries = ckalloc(sizeof(PALETTEENTRY) * count);
GetPaletteEntries(cmap->palette, index+1, count, entries);
SetPaletteEntries(cmap->palette, index, count, entries);
- ckfree((char *) entries);
+ ckfree(entries);
cmap->size--;
} else {
- Tcl_Panic("Tried to free a color that isn't allocated.");
+ Tcl_Panic("Tried to free a color that isn't allocated");
}
Tcl_DeleteHashEntry(entryPtr);
} else {
- Tcl_SetHashValue(entryPtr, INT2PTR(refCount));
+ Tcl_SetHashValue(entryPtr, (size_t)refCount);
}
}
}
@@ -524,7 +496,7 @@ XCreateColormap(
logPalettePtr->palNumEntries = GetPaletteEntries(sysPal, 0, 256,
logPalettePtr->palPalEntry);
- cmap = (TkWinColormap *) ckalloc(sizeof(TkWinColormap));
+ cmap = ckalloc(sizeof(TkWinColormap));
cmap->size = logPalettePtr->palNumEntries;
cmap->stale = 0;
cmap->palette = CreatePalette(logPalettePtr);
@@ -569,10 +541,10 @@ XFreeColormap(
TkWinColormap *cmap = (TkWinColormap *) colormap;
if (!DeleteObject(cmap->palette)) {
- Tcl_Panic("Unable to free colormap, palette is still selected.");
+ Tcl_Panic("Unable to free colormap, palette is still selected");
}
Tcl_DeleteHashTable(&cmap->refCounts);
- ckfree((char *) cmap);
+ ckfree(cmap);
return Success;
}
diff --git a/win/tkWinConfig.c b/win/tkWinConfig.c
index 422e399..aeb9405 100644
--- a/win/tkWinConfig.c
+++ b/win/tkWinConfig.c
@@ -35,8 +35,8 @@
Tcl_Obj *
TkpGetSystemDefault(
Tk_Window tkwin, /* A window to use. */
- CONST char *dbName, /* The option database name. */
- CONST char *className) /* The name of the option class. */
+ const char *dbName, /* The option database name. */
+ const char *className) /* The name of the option class. */
{
Tcl_Obj *valueObjPtr;
Tk_Uid classUid;
diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c
index dee3419..622ba4d 100644
--- a/win/tkWinCursor.c
+++ b/win/tkWinCursor.c
@@ -40,7 +40,7 @@ typedef struct {
*/
static struct CursorName {
- char *name;
+ const char *name;
LPCTSTR id;
} cursorNames[] = {
{"starting", IDC_APPSTARTING},
@@ -72,7 +72,6 @@ static struct CursorName {
*/
#define TK_DEFAULT_CURSOR IDC_ARROW
-
/*
*----------------------------------------------------------------------
@@ -100,7 +99,7 @@ TkGetCursorByName(
struct CursorName *namePtr;
TkWinCursor *cursorPtr;
int argc;
- CONST char **argv = NULL;
+ const char **argv = NULL;
/*
* All cursor names are valid lists of one element (for
@@ -114,7 +113,7 @@ TkGetCursorByName(
goto badCursorSpec;
}
- cursorPtr = (TkWinCursor *) ckalloc(sizeof(TkWinCursor));
+ cursorPtr = ckalloc(sizeof(TkWinCursor));
cursorPtr->info.cursor = (Tk_Cursor) cursorPtr;
cursorPtr->winCursor = NULL;
cursorPtr->system = 0;
@@ -131,13 +130,14 @@ TkGetCursorByName(
*/
if (Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "can't get cursor from a file in",
- " a safe interpreter", NULL);
- ckfree((char *) argv);
- ckfree((char *) cursorPtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't get cursor from a file in a safe interpreter",-1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "CURSOR_FILE", NULL);
+ ckfree(argv);
+ ckfree(cursorPtr);
return NULL;
}
- cursorPtr->winCursor = LoadCursorFromFile(&(argv[0][1]));
+ cursorPtr->winCursor = LoadCursorFromFileA(&(argv[0][1]));
} else {
/*
* Check for the cursor in the system cursor set.
@@ -156,22 +156,23 @@ TkGetCursorByName(
* one of our application resources.
*/
- cursorPtr->winCursor = LoadCursor(Tk_GetHINSTANCE(), argv[0]);
+ cursorPtr->winCursor = LoadCursorA(Tk_GetHINSTANCE(), argv[0]);
} else {
cursorPtr->system = 1;
}
}
if (cursorPtr->winCursor == NULL) {
- ckfree((char *) cursorPtr);
+ ckfree(cursorPtr);
badCursorSpec:
- ckfree((char *) argv);
- Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL);
+ ckfree(argv);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad cursor spec \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL);
return NULL;
- } else {
- ckfree((char *) argv);
- return (TkCursor *) cursorPtr;
}
+ ckfree(argv);
+ return (TkCursor *) cursorPtr;
}
/*
@@ -193,8 +194,8 @@ TkGetCursorByName(
TkCursor *
TkCreateCursorFromData(
Tk_Window tkwin, /* Window in which cursor will be used. */
- CONST char *source, /* Bitmap data for cursor shape. */
- CONST char *mask, /* Bitmap data for cursor mask. */
+ const char *source, /* Bitmap data for cursor shape. */
+ const char *mask, /* Bitmap data for cursor mask. */
int width, int height, /* Dimensions of cursor. */
int xHot, int yHot, /* Location of hot-spot in cursor. */
XColor fgColor, /* Foreground color for cursor. */
diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h
index d0bae8f..c52cc4d 100644
--- a/win/tkWinDefault.h
+++ b/win/tkWinDefault.h
@@ -68,7 +68,7 @@
#define DEF_BUTTON_HIGHLIGHT HIGHLIGHT
#define DEF_LABEL_HIGHLIGHT_WIDTH "0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH "1"
-#define DEF_BUTTON_IMAGE (char *) NULL
+#define DEF_BUTTON_IMAGE ((char *) NULL)
#define DEF_BUTTON_INDICATOR "1"
#define DEF_BUTTON_JUSTIFY "center"
#define DEF_BUTTON_OFF_VALUE "0"
@@ -84,10 +84,10 @@
#define DEF_BUTTON_REPEAT_INTERVAL "0"
#define DEF_BUTTON_SELECT_COLOR INDICATOR
#define DEF_BUTTON_SELECT_MONO BLACK
-#define DEF_BUTTON_SELECT_IMAGE (char *) NULL
+#define DEF_BUTTON_SELECT_IMAGE ((char *) NULL)
#define DEF_BUTTON_STATE "normal"
#define DEF_LABEL_TAKE_FOCUS "0"
-#define DEF_BUTTON_TAKE_FOCUS (char *) NULL
+#define DEF_BUTTON_TAKE_FOCUS ((char *) NULL)
#define DEF_BUTTON_TEXT ""
#define DEF_BUTTON_TEXT_VARIABLE ""
#define DEF_BUTTON_TRISTATE_VALUE ""
@@ -126,7 +126,7 @@
#define DEF_CANVAS_SELECT_BD_MONO "0"
#define DEF_CANVAS_SELECT_FG_COLOR SELECT_FG
#define DEF_CANVAS_SELECT_FG_MONO WHITE
-#define DEF_CANVAS_TAKE_FOCUS (char *) NULL
+#define DEF_CANVAS_TAKE_FOCUS ((char *) NULL)
#define DEF_CANVAS_WIDTH "10c"
#define DEF_CANVAS_X_SCROLL_CMD ""
#define DEF_CANVAS_X_SCROLL_INCREMENT "0"
@@ -167,9 +167,9 @@
#define DEF_ENTRY_SELECT_BD_MONO "0"
#define DEF_ENTRY_SELECT_FG_COLOR SELECT_FG
#define DEF_ENTRY_SELECT_FG_MONO WHITE
-#define DEF_ENTRY_SHOW (char *) NULL
+#define DEF_ENTRY_SHOW ((char *) NULL)
#define DEF_ENTRY_STATE "normal"
-#define DEF_ENTRY_TAKE_FOCUS (char *) NULL
+#define DEF_ENTRY_TAKE_FOCUS ((char *) NULL)
#define DEF_ENTRY_TEXT_VARIABLE ""
#define DEF_ENTRY_WIDTH "20"
@@ -235,36 +235,36 @@
#define DEF_LISTBOX_SELECT_MODE "browse"
#define DEF_LISTBOX_SET_GRID "0"
#define DEF_LISTBOX_STATE "normal"
-#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL
+#define DEF_LISTBOX_TAKE_FOCUS ((char *) NULL)
#define DEF_LISTBOX_WIDTH "20"
/*
* Defaults for individual entries of menus:
*/
-#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL
-#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL
-#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL
-#define DEF_MENU_ENTRY_BG (char *) NULL
+#define DEF_MENU_ENTRY_ACTIVE_BG ((char *) NULL)
+#define DEF_MENU_ENTRY_ACTIVE_FG ((char *) NULL)
+#define DEF_MENU_ENTRY_ACCELERATOR ((char *) NULL)
+#define DEF_MENU_ENTRY_BG ((char *) NULL)
#define DEF_MENU_ENTRY_BITMAP None
#define DEF_MENU_ENTRY_COLUMN_BREAK "0"
-#define DEF_MENU_ENTRY_COMMAND (char *) NULL
+#define DEF_MENU_ENTRY_COMMAND ((char *) NULL)
#define DEF_MENU_ENTRY_COMPOUND "none"
-#define DEF_MENU_ENTRY_FG (char *) NULL
-#define DEF_MENU_ENTRY_FONT (char *) NULL
+#define DEF_MENU_ENTRY_FG ((char *) NULL)
+#define DEF_MENU_ENTRY_FONT ((char *) NULL)
#define DEF_MENU_ENTRY_HIDE_MARGIN "0"
-#define DEF_MENU_ENTRY_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_IMAGE ((char *) NULL)
#define DEF_MENU_ENTRY_INDICATOR "1"
-#define DEF_MENU_ENTRY_LABEL (char *) NULL
-#define DEF_MENU_ENTRY_MENU (char *) NULL
+#define DEF_MENU_ENTRY_LABEL ((char *) NULL)
+#define DEF_MENU_ENTRY_MENU ((char *) NULL)
#define DEF_MENU_ENTRY_OFF_VALUE "0"
#define DEF_MENU_ENTRY_ON_VALUE "1"
-#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_SELECT_IMAGE ((char *) NULL)
#define DEF_MENU_ENTRY_STATE "normal"
-#define DEF_MENU_ENTRY_VALUE (char *) NULL
-#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL
+#define DEF_MENU_ENTRY_VALUE ((char *) NULL)
+#define DEF_MENU_ENTRY_CHECK_VARIABLE ((char *) NULL)
#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton"
-#define DEF_MENU_ENTRY_SELECT (char *) NULL
+#define DEF_MENU_ENTRY_SELECT ((char *) NULL)
#define DEF_MENU_ENTRY_UNDERLINE "-1"
/*
@@ -290,7 +290,7 @@
#define DEF_MENU_SELECT_MONO BLACK
#define DEF_MENU_TAKE_FOCUS "0"
#define DEF_MENU_TEAROFF "1"
-#define DEF_MENU_TEAROFF_CMD (char *) NULL
+#define DEF_MENU_TEAROFF_CMD ((char *) NULL)
#define DEF_MENU_TITLE ""
#define DEF_MENU_TYPE "normal"
@@ -318,7 +318,7 @@
#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO
#define DEF_MENUBUTTON_HIGHLIGHT HIGHLIGHT
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0"
-#define DEF_MENUBUTTON_IMAGE (char *) NULL
+#define DEF_MENUBUTTON_IMAGE ((char *) NULL)
#define DEF_MENUBUTTON_INDICATOR "0"
#define DEF_MENUBUTTON_JUSTIFY "center"
#define DEF_MENUBUTTON_MENU ""
@@ -419,7 +419,7 @@
#define DEF_SCALE_LENGTH "100"
#define DEF_SCALE_ORIENT "vertical"
#define DEF_SCALE_RELIEF "flat"
-#define DEF_SCALE_REPEAT_DELAY "300"
+#define DEF_SCALE_REPEAT_DELAY "300"
#define DEF_SCALE_REPEAT_INTERVAL "100"
#define DEF_SCALE_RESOLUTION "1"
#define DEF_SCALE_TROUGH_COLOR TROUGH
@@ -428,7 +428,7 @@
#define DEF_SCALE_SLIDER_LENGTH "30"
#define DEF_SCALE_SLIDER_RELIEF "raised"
#define DEF_SCALE_STATE "normal"
-#define DEF_SCALE_TAKE_FOCUS (char *) NULL
+#define DEF_SCALE_TAKE_FOCUS ((char *) NULL)
#define DEF_SCALE_TICK_INTERVAL "0"
#define DEF_SCALE_TO "100"
#define DEF_SCALE_VARIABLE ""
@@ -455,7 +455,7 @@
#define DEF_SCROLLBAR_RELIEF "sunken"
#define DEF_SCROLLBAR_REPEAT_DELAY "300"
#define DEF_SCROLLBAR_REPEAT_INTERVAL "100"
-#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL
+#define DEF_SCROLLBAR_TAKE_FOCUS ((char *) NULL)
#define DEF_SCROLLBAR_TROUGH_COLOR TROUGH
#define DEF_SCROLLBAR_TROUGH_MONO WHITE
#define DEF_SCROLLBAR_WIDTH "10"
@@ -482,8 +482,9 @@
#define DEF_TEXT_INSERT_BD_MONO "0"
#define DEF_TEXT_INSERT_OFF_TIME "300"
#define DEF_TEXT_INSERT_ON_TIME "600"
+#define DEF_TEXT_INSERT_UNFOCUSSED "none"
#define DEF_TEXT_INSERT_WIDTH "2"
-#define DEF_TEXT_MAX_UNDO "0"
+#define DEF_TEXT_MAX_UNDO "0"
#define DEF_TEXT_PADX "1"
#define DEF_TEXT_PADY "1"
#define DEF_TEXT_RELIEF "sunken"
@@ -502,8 +503,8 @@
#define DEF_TEXT_STATE "normal"
#define DEF_TEXT_TABS ""
#define DEF_TEXT_TABSTYLE "tabular"
-#define DEF_TEXT_TAKE_FOCUS (char *) NULL
-#define DEF_TEXT_UNDO "0"
+#define DEF_TEXT_TAKE_FOCUS ((char *) NULL)
+#define DEF_TEXT_UNDO "0"
#define DEF_TEXT_WIDTH "80"
#define DEF_TEXT_WRAP "char"
#define DEF_TEXT_XSCROLL_COMMAND ""
@@ -525,4 +526,10 @@
#define DEF_TOPLEVEL_SCREEN ""
#define DEF_TOPLEVEL_USE ""
+/*
+ * Defaults for busy windows:
+ */
+
+#define DEF_BUSY_CURSOR "wait"
+
#endif /* _TKWINDEFAULT */
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index e03862c..d7f63fb 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -8,24 +8,25 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#define WINVER 0x0500 /* Requires Windows 2K definitions */
-#define _WIN32_WINNT 0x0500
+
#include "tkWinInt.h"
#include "tkFileFilter.h"
+#include "tkFont.h"
#include <commdlg.h> /* includes common dialog functionality */
-#ifdef _MSC_VER
-# pragma comment (lib, "comdlg32.lib")
-#endif
#include <dlgs.h> /* includes common dialog template defines */
#include <cderr.h> /* includes the common dialog error codes */
#include <shlobj.h> /* includes SHBrowseForFolder */
+
#ifdef _MSC_VER
# pragma comment (lib, "shell32.lib")
+# pragma comment (lib, "comdlg32.lib")
+# pragma comment (lib, "uuid.lib")
#endif
/* These needed for compilation with VC++ 5.2 */
+/* XXX - remove these since need at least VC 6 */
#ifndef BIF_EDITBOX
#define BIF_EDITBOX 0x10
#endif
@@ -34,6 +35,7 @@
#define BIF_VALIDATE 0x0020
#endif
+/* This "new" dialog style is now actually the "old" dialog style post-Vista */
#ifndef BIF_NEWDIALOGSTYLE
#define BIF_NEWDIALOGSTYLE 0x0040
#endif
@@ -46,10 +48,6 @@
#endif
#endif /* BFFM_VALIDATEFAILED */
-#ifndef OPENFILENAME_SIZE_VERSION_400
-#define OPENFILENAME_SIZE_VERSION_400 76
-#endif
-
typedef struct ThreadSpecificData {
int debugFlag; /* Flags whether we should output debugging
* information while displaying a builtin
@@ -61,6 +59,10 @@ typedef struct ThreadSpecificData {
HHOOK hMsgBoxHook; /* Hook proc for tk_messageBox and the */
HICON hSmallIcon; /* icons used by a parent to be used in */
HICON hBigIcon; /* the message box */
+ int newFileDialogsState;
+#define FDLG_STATE_INIT 0 /* Uninitialized */
+#define FDLG_STATE_USE_NEW 1 /* Use the new dialogs */
+#define FDLG_STATE_USE_OLD 2 /* Use the old dialogs */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
@@ -118,11 +120,11 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = {
*/
#define TkWinGetHInstance(from) \
- ((HINSTANCE) GetWindowLongPtrW((from), GWLP_HINSTANCE))
+ ((HINSTANCE) GetWindowLongPtr((from), GWLP_HINSTANCE))
#define TkWinGetUserData(from) \
- GetWindowLongPtrW((from), GWLP_USERDATA)
+ GetWindowLongPtr((from), GWLP_USERDATA)
#define TkWinSetUserData(to,what) \
- SetWindowLongPtrW((to), GWLP_USERDATA, (LPARAM)(what))
+ SetWindowLongPtr((to), GWLP_USERDATA, (LPARAM)(what))
/*
* The value of TK_MULTI_MAX_PATH dictates how many files can be retrieved
@@ -141,8 +143,8 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = {
*/
typedef struct {
- WCHAR initDir[MAX_PATH]; /* Initial folder to use */
- WCHAR retDir[MAX_PATH]; /* Returned folder to use */
+ TCHAR initDir[MAX_PATH]; /* Initial folder to use */
+ TCHAR retDir[MAX_PATH]; /* Returned folder to use */
Tcl_Interp *interp;
int mustExist; /* True if file must exist to return from
* callback */
@@ -159,10 +161,412 @@ typedef struct OFNData {
int dynFileBufferSize; /* Dynamic filename buffer size, stored to
* avoid shrinking and expanding the buffer
* when selection changes */
- WCHAR *dynFileBuffer; /* Dynamic filename buffer */
+ TCHAR *dynFileBuffer; /* Dynamic filename buffer */
} OFNData;
/*
+ * The following structure is used to gather options used by various
+ * file dialogs
+ */
+typedef struct OFNOpts {
+ Tk_Window tkwin; /* Owner window for dialog */
+ Tcl_Obj *extObj; /* Default extension */
+ Tcl_Obj *titleObj; /* Title for dialog */
+ Tcl_Obj *filterObj; /* File type filter list */
+ Tcl_Obj *typeVariableObj; /* Variable in which to store type selected */
+ Tcl_Obj *initialTypeObj; /* Initial value of above, or NULL */
+ Tcl_DString utfDirString; /* Initial dir */
+ int multi; /* Multiple selection enabled */
+ int confirmOverwrite; /* Confirm before overwriting */
+ int mustExist; /* Used only for */
+ int forceXPStyle; /* XXX - Force XP style even on newer systems */
+ TCHAR file[TK_MULTI_MAX_PATH]; /* File name
+ XXX - fixed size because it was so
+ historically. Why not malloc'ed ?
+ XXX - also, TCHAR should really be WCHAR
+ because TkWinGetUnicodeEncoding is always
+ UCS2.
+ */
+} OFNOpts;
+
+/* Define the operation for which option parsing is to be done. */
+enum OFNOper {
+ OFN_FILE_SAVE, /* tk_getOpenFile */
+ OFN_FILE_OPEN, /* tk_getSaveFile */
+ OFN_DIR_CHOOSE /* tk_chooseDirectory */
+};
+
+
+/*
+ * The following definitions are required when using older versions of
+ * Visual C++ (like 6.0) and possibly MingW. Those headers do not contain
+ * required definitions for interfaces new to Vista that we need for
+ * the new file dialogs. Duplicating definitions is OK because they
+ * should forever remain unchanged.
+ *
+ * XXX - is there a better/easier way to use new data definitions with
+ * older compilers? Should we prefix definitions with Tcl_ instead
+ * of using the same names as in the SDK?
+ */
+#ifndef __IShellItem_INTERFACE_DEFINED__
+# define __IShellItem_INTERFACE_DEFINED__
+#ifdef __MSVCRT__
+typedef struct IShellItem IShellItem;
+
+typedef enum __MIDL_IShellItem_0001 {
+ SIGDN_NORMALDISPLAY = 0,SIGDN_PARENTRELATIVEPARSING = 0x80018001,SIGDN_PARENTRELATIVEFORADDRESSBAR = 0x8001c001,
+ SIGDN_DESKTOPABSOLUTEPARSING = 0x80028000,SIGDN_PARENTRELATIVEEDITING = 0x80031001,SIGDN_DESKTOPABSOLUTEEDITING = 0x8004c000,
+ SIGDN_FILESYSPATH = 0x80058000,SIGDN_URL = 0x80068000
+} SIGDN;
+
+typedef DWORD SICHINTF;
+
+typedef struct IShellItemVtbl
+{
+ BEGIN_INTERFACE
+
+ HRESULT (STDMETHODCALLTYPE *QueryInterface)(IShellItem *, REFIID, void **);
+ ULONG (STDMETHODCALLTYPE *AddRef)(IShellItem *);
+ ULONG (STDMETHODCALLTYPE *Release)(IShellItem *);
+ HRESULT (STDMETHODCALLTYPE *BindToHandler)(IShellItem *, IBindCtx *, REFGUID, REFIID, void **);
+ HRESULT (STDMETHODCALLTYPE *GetParent)(IShellItem *, IShellItem **);
+ HRESULT (STDMETHODCALLTYPE *GetDisplayName)(IShellItem *, SIGDN, LPOLESTR *);
+ HRESULT (STDMETHODCALLTYPE *GetAttributes)(IShellItem *, SFGAOF, SFGAOF *);
+ HRESULT (STDMETHODCALLTYPE *Compare)(IShellItem *, IShellItem *, SICHINTF, int *);
+
+ END_INTERFACE
+} IShellItemVtbl;
+struct IShellItem {
+ CONST_VTBL struct IShellItemVtbl *lpVtbl;
+};
+#endif
+#endif
+
+#ifndef __IShellItemArray_INTERFACE_DEFINED__
+#define __IShellItemArray_INTERFACE_DEFINED__
+
+typedef enum SIATTRIBFLAGS {
+ SIATTRIBFLAGS_AND = 0x1,
+ SIATTRIBFLAGS_OR = 0x2,
+ SIATTRIBFLAGS_APPCOMPAT = 0x3,
+ SIATTRIBFLAGS_MASK = 0x3,
+ SIATTRIBFLAGS_ALLITEMS = 0x4000
+} SIATTRIBFLAGS;
+#ifdef __MSVCRT__
+typedef ULONG SFGAOF;
+#endif /* __MSVCRT__ */
+typedef struct IShellItemArray IShellItemArray;
+typedef struct IShellItemArrayVtbl
+{
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IShellItemArray *, REFIID riid,void **ppvObject);
+ ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray *);
+ ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray *);
+ HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray *,
+ IBindCtx *, REFGUID, REFIID, void **);
+ /* flags is actually is enum GETPROPERTYSTOREFLAGS */
+ HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )(
+ IShellItemArray *, int, REFIID, void **);
+ /* keyType actually REFPROPERTYKEY */
+ HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )(
+ IShellItemArray *, void *, REFIID, void **);
+ HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray *,
+ SIATTRIBFLAGS, SFGAOF, SFGAOF *);
+ HRESULT ( STDMETHODCALLTYPE *GetCount )(
+ IShellItemArray *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *GetItemAt )(
+ IShellItemArray *, DWORD, IShellItem **);
+ /* ppenumShellItems actually (IEnumShellItems **) */
+ HRESULT ( STDMETHODCALLTYPE *EnumItems )(
+ IShellItemArray *, void **);
+
+ END_INTERFACE
+} IShellItemArrayVtbl;
+
+struct IShellItemArray {
+ CONST_VTBL struct IShellItemArrayVtbl *lpVtbl;
+};
+
+#endif /* __IShellItemArray_INTERFACE_DEFINED__ */
+
+/*
+ * Older compilers do not define these CLSIDs so we do so here under
+ * a slightly different name so as to not clash with the definitions
+ * in new compilers
+ */
+static const CLSID ClsidFileOpenDialog = {
+ 0xDC1C5A9C, 0xE88A, 0X4DDE, {0xA5, 0xA1, 0x60, 0xF8, 0x2A, 0x20, 0xAE, 0xF7}
+};
+static const CLSID ClsidFileSaveDialog = {
+ 0xC0B4E2F3, 0xBA21, 0x4773, {0x8D, 0xBA, 0x33, 0x5E, 0xC9, 0x46, 0xEB, 0x8B}
+};
+static const IID IIDIFileOpenDialog = {
+ 0xD57C7288, 0xD4AD, 0x4768, {0xBE, 0x02, 0x9D, 0x96, 0x95, 0x32, 0xD9, 0x60}
+};
+static const IID IIDIFileSaveDialog = {
+ 0x84BCCD23, 0x5FDE, 0x4CDB, {0xAE, 0xA4, 0xAF, 0x64, 0xB8, 0x3D, 0x78, 0xAB}
+};
+static const IID IIDIShellItem = {
+ 0x43826D1E, 0xE718, 0x42EE, {0xBC, 0x55, 0xA1, 0xE2, 0x61, 0xC3, 0x7B, 0xFE}
+};
+
+#ifdef __IFileDialog_INTERFACE_DEFINED__
+# define TCLCOMDLG_FILTERSPEC COMDLG_FILTERSPEC
+#else
+
+/* Forward declarations for structs that are referenced but not used */
+typedef struct IPropertyStore IPropertyStore;
+typedef struct IPropertyDescriptionList IPropertyDescriptionList;
+typedef struct IFileOperationProgressSink IFileOperationProgressSink;
+typedef enum FDAP {
+ FDAP_BOTTOM = 0,
+ FDAP_TOP = 1
+} FDAP;
+
+typedef struct {
+ LPCWSTR pszName;
+ LPCWSTR pszSpec;
+} TCLCOMDLG_FILTERSPEC;
+
+enum _FILEOPENDIALOGOPTIONS {
+ FOS_OVERWRITEPROMPT = 0x2,
+ FOS_STRICTFILETYPES = 0x4,
+ FOS_NOCHANGEDIR = 0x8,
+ FOS_PICKFOLDERS = 0x20,
+ FOS_FORCEFILESYSTEM = 0x40,
+ FOS_ALLNONSTORAGEITEMS = 0x80,
+ FOS_NOVALIDATE = 0x100,
+ FOS_ALLOWMULTISELECT = 0x200,
+ FOS_PATHMUSTEXIST = 0x800,
+ FOS_FILEMUSTEXIST = 0x1000,
+ FOS_CREATEPROMPT = 0x2000,
+ FOS_SHAREAWARE = 0x4000,
+ FOS_NOREADONLYRETURN = 0x8000,
+ FOS_NOTESTFILECREATE = 0x10000,
+ FOS_HIDEMRUPLACES = 0x20000,
+ FOS_HIDEPINNEDPLACES = 0x40000,
+ FOS_NODEREFERENCELINKS = 0x100000,
+ FOS_DONTADDTORECENT = 0x2000000,
+ FOS_FORCESHOWHIDDEN = 0x10000000,
+ FOS_DEFAULTNOMINIMODE = 0x20000000,
+ FOS_FORCEPREVIEWPANEON = 0x40000000
+} ;
+typedef DWORD FILEOPENDIALOGOPTIONS;
+
+typedef struct IFileDialog IFileDialog;
+typedef struct IFileDialogVtbl
+{
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IFileDialog *, REFIID, void **);
+ ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog *);
+ ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog *);
+ HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog *, HWND);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog *,
+ UINT, const TCLCOMDLG_FILTERSPEC *);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog *, UINT);
+ HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog *, UINT *);
+ /* XXX - Actually pfde is IFileDialogEvents* but we do not use
+ this call and do not want to define IFileDialogEvents as that
+ pulls in a whole bunch of other stuff. */
+ HRESULT ( STDMETHODCALLTYPE *Advise )(
+ IFileDialog *, void *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog *, DWORD);
+ HRESULT ( STDMETHODCALLTYPE *SetOptions )(
+ IFileDialog *, FILEOPENDIALOGOPTIONS);
+ HRESULT ( STDMETHODCALLTYPE *GetOptions )(
+ IFileDialog *, FILEOPENDIALOGOPTIONS *);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
+ IFileDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetFolder )(
+ IFileDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *GetFolder )(
+ IFileDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
+ IFileDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *SetFileName )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetFileName )(
+ IFileDialog *, LPWSTR *);
+ HRESULT ( STDMETHODCALLTYPE *SetTitle )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetResult )(
+ IFileDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *AddPlace )(
+ IFileDialog *, IShellItem *, FDAP);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog *, HRESULT);
+ HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
+ IFileDialog *, REFGUID);
+ HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog *);
+ /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do
+ not use it anyways. So define as void* */
+ HRESULT ( STDMETHODCALLTYPE *SetFilter )(
+ IFileDialog *, void *);
+
+ END_INTERFACE
+} IFileDialogVtbl;
+
+struct IFileDialog {
+ CONST_VTBL struct IFileDialogVtbl *lpVtbl;
+};
+
+
+typedef struct IFileSaveDialog IFileSaveDialog;
+typedef struct IFileSaveDialogVtbl {
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IFileSaveDialog *, REFIID, void **);
+ ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog *);
+ ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog *);
+ HRESULT ( STDMETHODCALLTYPE *Show )(
+ IFileSaveDialog *, HWND);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog * this,
+ UINT, const TCLCOMDLG_FILTERSPEC *);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
+ IFileSaveDialog *, UINT);
+ HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(
+ IFileSaveDialog *, UINT *);
+ /* Actually pfde is IFileSaveDialogEvents* */
+ HRESULT ( STDMETHODCALLTYPE *Advise )(
+ IFileSaveDialog *, void *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog *, DWORD);
+ HRESULT ( STDMETHODCALLTYPE *SetOptions )(
+ IFileSaveDialog *, FILEOPENDIALOGOPTIONS);
+ HRESULT ( STDMETHODCALLTYPE *GetOptions )(
+ IFileSaveDialog *, FILEOPENDIALOGOPTIONS *);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
+ IFileSaveDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetFolder )(
+ IFileSaveDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *GetFolder )(
+ IFileSaveDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
+ IFileSaveDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *SetFileName )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetFileName )(
+ IFileSaveDialog *, LPWSTR *);
+ HRESULT ( STDMETHODCALLTYPE *SetTitle )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetResult )(
+ IFileSaveDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *AddPlace )(
+ IFileSaveDialog *, IShellItem *, FDAP);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog *, HRESULT);
+ HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
+ IFileSaveDialog *, REFGUID);
+ HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog *);
+ /* pFilter Actually IShellItemFilter* */
+ HRESULT ( STDMETHODCALLTYPE *SetFilter )(
+ IFileSaveDialog *, void *);
+ HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )(
+ IFileSaveDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetProperties )(
+ IFileSaveDialog *, IPropertyStore *);
+ HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )(
+ IFileSaveDialog *, IPropertyDescriptionList *, BOOL);
+ HRESULT ( STDMETHODCALLTYPE *GetProperties )(
+ IFileSaveDialog *, IPropertyStore **);
+ HRESULT ( STDMETHODCALLTYPE *ApplyProperties )(
+ IFileSaveDialog *, IShellItem *, IPropertyStore *,
+ HWND, IFileOperationProgressSink *);
+
+ END_INTERFACE
+
+} IFileSaveDialogVtbl;
+
+struct IFileSaveDialog {
+ CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl;
+};
+
+typedef struct IFileOpenDialog IFileOpenDialog;
+typedef struct IFileOpenDialogVtbl {
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IFileOpenDialog *, REFIID, void **);
+ ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog *);
+ ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog *);
+ HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog *, HWND);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog *,
+ UINT, const TCLCOMDLG_FILTERSPEC *);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
+ IFileOpenDialog *, UINT);
+ HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(
+ IFileOpenDialog *, UINT *);
+ /* Actually pfde is IFileDialogEvents* */
+ HRESULT ( STDMETHODCALLTYPE *Advise )(
+ IFileOpenDialog *, void *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog *, DWORD);
+ HRESULT ( STDMETHODCALLTYPE *SetOptions )(
+ IFileOpenDialog *, FILEOPENDIALOGOPTIONS);
+ HRESULT ( STDMETHODCALLTYPE *GetOptions )(
+ IFileOpenDialog *, FILEOPENDIALOGOPTIONS *);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
+ IFileOpenDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetFolder )(
+ IFileOpenDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *GetFolder )(
+ IFileOpenDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
+ IFileOpenDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *SetFileName )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetFileName )(
+ IFileOpenDialog *, LPWSTR *);
+ HRESULT ( STDMETHODCALLTYPE *SetTitle )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetResult )(
+ IFileOpenDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *AddPlace )(
+ IFileOpenDialog *, IShellItem *, FDAP);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog *, HRESULT);
+ HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
+ IFileOpenDialog *, REFGUID);
+ HRESULT ( STDMETHODCALLTYPE *ClearClientData )(
+ IFileOpenDialog *);
+ HRESULT ( STDMETHODCALLTYPE *SetFilter )(
+ IFileOpenDialog *,
+ /* pFilter is actually IShellItemFilter */
+ void *);
+ HRESULT ( STDMETHODCALLTYPE *GetResults )(
+ IFileOpenDialog *, IShellItemArray **);
+ HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )(
+ IFileOpenDialog *, IShellItemArray **);
+
+ END_INTERFACE
+} IFileOpenDialogVtbl;
+
+struct IFileOpenDialog
+{
+ CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl;
+};
+
+#endif /* __IFileDialog_INTERFACE_DEFINED__ */
+
+/*
* Definitions of functions used only in this file.
*/
@@ -170,9 +574,21 @@ static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
LPARAM wParam, LPARAM lParam);
static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
+static void CleanupOFNOptions(OFNOpts *optsPtr);
+static int ParseOFNOptions(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], enum OFNOper oper, OFNOpts *optsPtr);
+static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr,
+ enum OFNOper oper);
+static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
+ enum OFNOper oper);
static int GetFileName(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[], int isOpen);
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], enum OFNOper oper);
+static int MakeFilterVista(Tcl_Interp *interp, OFNOpts *optsPtr,
+ DWORD *countPtr, TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr,
+ DWORD *defaultFilterIndexPtr);
+static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr);
static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
int *indexPtr);
@@ -180,8 +596,68 @@ static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);
static void SetTkDialog(ClientData clientData);
-static const char *ConvertExternalFilename(WCHAR *filename,
+static const char *ConvertExternalFilename(TCHAR *filename,
Tcl_DString *dsPtr);
+static void LoadShellProcs(void);
+
+
+/* Definitions of dynamically loaded Win32 calls */
+typedef HRESULT (STDAPICALLTYPE SHCreateItemFromParsingNameProc)(
+ PCWSTR pszPath, IBindCtx *pbc, REFIID riid, void **ppv);
+struct ShellProcPointers {
+ SHCreateItemFromParsingNameProc *SHCreateItemFromParsingName;
+} ShellProcs;
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * LoadShellProcs --
+ *
+ * Some shell functions are not available on older versions of
+ * Windows. This function dynamically loads them and stores pointers
+ * to them in ShellProcs. Any function that is not available has
+ * the corresponding pointer set to NULL.
+ *
+ * Note this call never fails. Unavailability of a function is not
+ * a reason for failure. Caller should check whether a particular
+ * function pointer is NULL or not. Once loaded a function stays
+ * forever loaded.
+ *
+ * XXX - we load the function pointers into global memory. This implies
+ * there is a potential (however small) for race conditions between
+ * threads. However, Tk is in any case meant to be loaded in exactly
+ * one thread so this should not be an issue and saves us from
+ * unnecessary bookkeeping.
+ *
+ * Return value:
+ * None.
+ *
+ * Side effects:
+ * ShellProcs is populated.
+ *-------------------------------------------------------------------------
+ */
+static void LoadShellProcs()
+{
+ static HMODULE shell32_handle = NULL;
+
+ if (shell32_handle != NULL)
+ return; /* We have already been through here. */
+
+ /*
+ * XXX - Note we never call FreeLibrary. There is no point because
+ * shell32.dll is loaded at startup anyways and stays for the duration
+ * of the process so why bother with keeping track of when to unload
+ */
+ shell32_handle = LoadLibrary(TEXT("shell32.dll"));
+ if (shell32_handle == NULL) /* Should never happen but check anyways. */
+ return;
+
+ ShellProcs.SHCreateItemFromParsingName =
+ (SHCreateItemFromParsingNameProc*) GetProcAddress(shell32_handle,
+ "SHCreateItemFromParsingName");
+}
+
/*
*-------------------------------------------------------------------------
@@ -252,7 +728,7 @@ void
TkWinDialogDebug(
int debug)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->debugFlag = debug;
@@ -284,14 +760,14 @@ Tk_ChooseColorObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData, parent;
+ Tk_Window tkwin = clientData, parent;
HWND hWnd;
int i, oldMode, winCode, result;
- CHOOSECOLORW chooseColor;
+ CHOOSECOLOR chooseColor;
static int inited = 0;
static COLORREF dwCustColors[16];
static long oldColor; /* the color selected last time */
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-initialcolor", "-parent", "-title", NULL
};
enum options {
@@ -315,7 +791,7 @@ Tk_ChooseColorObjCmd(
}
parent = tkwin;
- chooseColor.lStructSize = sizeof(CHOOSECOLORW);
+ chooseColor.lStructSize = sizeof(CHOOSECOLOR);
chooseColor.hwndOwner = NULL;
chooseColor.hInstance = NULL;
chooseColor.rgbResult = oldColor;
@@ -323,7 +799,7 @@ Tk_ChooseColorObjCmd(
chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
chooseColor.lCustData = (LPARAM) NULL;
chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc;
- chooseColor.lpTemplateName = (LPWSTR) interp;
+ chooseColor.lpTemplateName = (LPTSTR) interp;
for (i = 1; i < objc; i += 2) {
int index;
@@ -333,14 +809,14 @@ Tk_ChooseColorObjCmd(
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL);
return TCL_ERROR;
}
@@ -375,7 +851,7 @@ Tk_ChooseColorObjCmd(
chooseColor.hwndOwner = hWnd;
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- winCode = ChooseColorW(&chooseColor);
+ winCode = ChooseColor(&chooseColor);
(void) Tcl_SetServiceMode(oldMode);
/*
@@ -401,13 +877,11 @@ Tk_ChooseColorObjCmd(
/*
* User has selected a color
*/
- char color[100];
- sprintf(color, "#%02x%02x%02x",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x",
GetRValue(chooseColor.rgbResult),
GetGValue(chooseColor.rgbResult),
- GetBValue(chooseColor.rgbResult));
- Tcl_AppendResult(interp, color, NULL);
+ GetBValue(chooseColor.rgbResult)));
oldColor = chooseColor.rgbResult;
result = TCL_OK;
}
@@ -440,10 +914,10 @@ ColorDlgHookProc(
WPARAM wParam, /* First message parameter. */
LPARAM lParam) /* Second message parameter. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
const char *title;
- CHOOSECOLORW *ccPtr;
+ CHOOSECOLOR *ccPtr;
if (WM_INITDIALOG == uMsg) {
@@ -451,18 +925,18 @@ ColorDlgHookProc(
* Set the title string of the dialog.
*/
- ccPtr = (CHOOSECOLORW *) lParam;
+ ccPtr = (CHOOSECOLOR *) lParam;
title = (const char *) ccPtr->lCustData;
if ((title != NULL) && (title[0] != '\0')) {
Tcl_DString ds;
- SetWindowTextW(hDlg, (WCHAR *)Tcl_WinUtfToTChar(title,-1,&ds));
+ SetWindowText(hDlg, Tcl_WinUtfToTChar(title,-1,&ds));
Tcl_DStringFree(&ds);
}
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
+ Tcl_DoWhenIdle(SetTkDialog, hDlg);
}
return TRUE;
}
@@ -493,7 +967,7 @@ Tk_GetOpenFileObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- return GetFileName(clientData, interp, objc, objv, 1);
+ return GetFileName(clientData, interp, objc, objv, OFN_FILE_OPEN);
}
/*
@@ -520,51 +994,61 @@ Tk_GetSaveFileObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- return GetFileName(clientData, interp, objc, objv, 0);
+ return GetFileName(clientData, interp, objc, objv, OFN_FILE_SAVE);
}
/*
*----------------------------------------------------------------------
*
- * GetFileName --
+ * CleanupOFNOptions --
*
- * Calls GetOpenFileName() or GetSaveFileName().
+ * Cleans up any storage allocated by ParseOFNOptions
*
* Results:
- * See user documentation.
+ * None.
*
* Side effects:
- * See user documentation.
+ * Releases resources held by *optsPtr
+ *----------------------------------------------------------------------
+ */
+static void CleanupOFNOptions(OFNOpts *optsPtr)
+{
+ Tcl_DStringFree(&optsPtr->utfDirString);
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseOFNOptions --
+ *
+ * Option parsing for tk_get{Open,Save}File
+ *
+ * Results:
+ * TCL_OK on success, TCL_ERROR otherwise
*
+ * Side effects:
+ * Returns option values in *optsPtr. Note these may include string
+ * pointers into objv[]
*----------------------------------------------------------------------
*/
static int
-GetFileName(
+ParseOFNOptions(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
- int open) /* 1 to call GetOpenFileName(), 0 to call
- * GetSaveFileName(). */
+ enum OFNOper oper, /* 1 for Open, 0 for Save */
+ OFNOpts *optsPtr) /* Output, uninitialized on entry */
{
- OPENFILENAMEW ofn;
- WCHAR file[TK_MULTI_MAX_PATH];
- OFNData ofnData;
- int cdlgerr;
- int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
- int confirmOverwrite = 1;
- const char *extension = NULL, *title = NULL;
- Tk_Window tkwin = (Tk_Window) clientData;
- HWND hWnd;
- Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
- Tcl_DString utfFilterString, utfDirString, ds;
- Tcl_DString extString, filterString, dirString, titleString;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int i;
+ Tcl_DString ds;
enum options {
FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT,
- FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW
+ FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW,
+ FILE_MUSTEXIST,
};
struct Options {
const char *name;
@@ -592,118 +1076,528 @@ GetFileName(
{"-typevariable", FILE_TYPEVARIABLE},
{NULL, FILE_DEFAULT/*ignored*/ }
};
- const struct Options *options = open ? openOptions : saveOptions;
+ static const struct Options dirOptions[] = {
+ {"-initialdir", FILE_INITDIR},
+ {"-mustexist", FILE_MUSTEXIST},
+ {"-parent", FILE_PARENT},
+ {"-title", FILE_TITLE},
+ {NULL, FILE_DEFAULT/*ignored*/ }
+ };
- file[0] = '\0';
- ZeroMemory(&ofnData, sizeof(OFNData));
- Tcl_DStringInit(&utfFilterString);
- Tcl_DStringInit(&utfDirString);
+ const struct Options *options = NULL;
- /*
- * Parse the arguments.
- */
+ switch (oper) {
+ case OFN_FILE_SAVE: options = saveOptions; break;
+ case OFN_DIR_CHOOSE: options = dirOptions; break;
+ case OFN_FILE_OPEN: options = openOptions; break;
+ }
+
+ ZeroMemory(optsPtr, sizeof(*optsPtr));
+ // optsPtr->forceXPStyle = 1;
+ optsPtr->tkwin = clientData;
+ optsPtr->confirmOverwrite = 1; /* By default we ask for confirmation */
+ Tcl_DStringInit(&optsPtr->utfDirString);
+ optsPtr->file[0] = 0;
for (i = 1; i < objc; i += 2) {
int index;
const char *string;
- Tcl_Obj *valuePtr = objv[i + 1];
+ Tcl_Obj *valuePtr;
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(struct Options), "option", 0, &index) != TCL_OK) {
- goto end;
+ /*
+ * XXX -xpstyle is explicitly checked for as it is undocumented
+ * and we do not want it to show in option error messages.
+ */
+ if (strcmp(Tcl_GetString(objv[i]), "-xpstyle"))
+ goto error_return;
+ if (i + 1 == objc) {
+ Tcl_SetResult(interp, "value for \"-xpstyle\" missing", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
+ goto error_return;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1],
+ &optsPtr->forceXPStyle) != TCL_OK)
+ goto error_return;
+
+ continue;
+
} else if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"", options[index].name,
- "\" missing", NULL);
- goto end;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", options[index].name));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
+ goto error_return;
}
+ valuePtr = objv[i + 1];
string = Tcl_GetString(valuePtr);
switch (options[index].value) {
case FILE_DEFAULT:
- if (string[0] == '.') {
- string++;
- }
- extension = string;
+ optsPtr->extObj = valuePtr;
break;
case FILE_TYPES:
- filterObj = valuePtr;
+ optsPtr->filterObj = valuePtr;
break;
case FILE_INITDIR:
- Tcl_DStringFree(&utfDirString);
+ Tcl_DStringFree(&optsPtr->utfDirString);
if (Tcl_TranslateFileName(interp, string,
- &utfDirString) == NULL) {
- goto end;
- }
+ &optsPtr->utfDirString) == NULL)
+ goto error_return;
break;
case FILE_INITFILE:
- if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
- goto end;
- }
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+ goto error_return;
Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
- Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
- (char *) file, sizeof(file), NULL, NULL, NULL);
+ Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
+ (char *) &optsPtr->file[0], sizeof(optsPtr->file),
+ NULL, NULL, NULL);
Tcl_DStringFree(&ds);
break;
case FILE_PARENT:
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
- goto end;
- }
+ optsPtr->tkwin = Tk_NameToWindow(interp, string, clientData);
+ if (optsPtr->tkwin == NULL)
+ goto error_return;
break;
case FILE_TITLE:
- title = string;
+ optsPtr->titleObj = valuePtr;
break;
case FILE_TYPEVARIABLE:
- typeVariableObj = valuePtr;
- initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
- TCL_GLOBAL_ONLY);
+ optsPtr->typeVariableObj = valuePtr;
+ optsPtr->initialTypeObj = Tcl_ObjGetVar2(interp, valuePtr,
+ NULL, TCL_GLOBAL_ONLY);
break;
case FILE_MULTIPLE:
- if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (Tcl_GetBooleanFromObj(interp, valuePtr,
+ &optsPtr->multi) != TCL_OK)
+ goto error_return;
break;
case FILE_CONFIRMOW:
if (Tcl_GetBooleanFromObj(interp, valuePtr,
- &confirmOverwrite) != TCL_OK) {
- return TCL_ERROR;
- }
+ &optsPtr->confirmOverwrite) != TCL_OK)
+ goto error_return;
break;
+ case FILE_MUSTEXIST:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr,
+ &optsPtr->mustExist) != TCL_OK)
+ goto error_return;
+ break;
}
}
- if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
- &filterIndex) != TCL_OK) {
- goto end;
+ return TCL_OK;
+
+error_return: /* interp should already hold error */
+ /* On error, we need to clean up anything we might have allocated */
+ CleanupOFNOptions(optsPtr);
+ return TCL_ERROR;
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ * VistaFileDialogsAvailable
+ *
+ * Checks whether the new (Vista) file dialogs can be used on
+ * the system.
+ *
+ * Returns:
+ * 1 if new dialogs are available, 0 otherwise
+ *
+ * Side effects:
+ * Loads required procedures dynamically if available.
+ * If new dialogs are available, COM is also initialized.
+ *----------------------------------------------------------------------
+ */
+static int VistaFileDialogsAvailable()
+{
+ HRESULT hr;
+ IFileDialog *fdlgPtr = NULL;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->newFileDialogsState == FDLG_STATE_INIT) {
+ tsdPtr->newFileDialogsState = FDLG_STATE_USE_OLD;
+ LoadShellProcs();
+ if (ShellProcs.SHCreateItemFromParsingName != NULL) {
+ hr = CoInitialize(0);
+ /* XXX - need we schedule CoUninitialize at thread shutdown ? */
+
+ /* Ensure all COM interfaces we use are available */
+ if (SUCCEEDED(hr)) {
+ hr = CoCreateInstance(&ClsidFileOpenDialog, NULL,
+ CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgPtr);
+ if (SUCCEEDED(hr)) {
+ fdlgPtr->lpVtbl->Release(fdlgPtr);
+ hr = CoCreateInstance(&ClsidFileSaveDialog, NULL,
+ CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog,
+ (void **) &fdlgPtr);
+ if (SUCCEEDED(hr)) {
+ fdlgPtr->lpVtbl->Release(fdlgPtr);
+
+ /* Looks like we have all we need */
+ tsdPtr->newFileDialogsState = FDLG_STATE_USE_NEW;
+ }
+ }
+ }
+ }
}
- Tk_MakeWindowExist(tkwin);
- hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+ return (tsdPtr->newFileDialogsState == FDLG_STATE_USE_NEW);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileNameVista --
+ *
+ * Displays the new file dialogs on Vista and later.
+ * This function must generally not be called unless the
+ * tsdPtr->newFileDialogsState is FDLG_STATE_USE_NEW but if
+ * it is, it will just pass the call to the older GetFileNameXP
+ *
+ * Results:
+ * TCL_OK - dialog was successfully displayed, results returned in interp
+ * TCL_ERROR - error return
+ *
+ * Side effects:
+ * Dialogs is displayed
+ *----------------------------------------------------------------------
+ */
+static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
+ enum OFNOper oper)
+{
+ HRESULT hr;
+ HWND hWnd;
+ DWORD flags, nfilters, defaultFilterIndex;
+ TCLCOMDLG_FILTERSPEC *filterPtr = NULL;
+ IFileDialog *fdlgIf = NULL;
+ IShellItem *dirIf = NULL;
+ LPWSTR wstr;
+ Tcl_Obj *resultObj = NULL;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int oldMode;
+
+ if (tsdPtr->newFileDialogsState != FDLG_STATE_USE_NEW) {
+ /* XXX - should be an assert but Tcl does not seem to have one? */
+ Tcl_SetResult(interp, "Internal error: GetFileNameVista: IFileDialog API not available", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At this point new interfaces are supposed to be available.
+ * fdlgIf is actually a IFileOpenDialog or IFileSaveDialog
+ * both of which inherit from IFileDialog. We use the common
+ * IFileDialog interface for the most part, casting only for
+ * type-specific calls.
+ */
+ Tk_MakeWindowExist(optsPtr->tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin));
+
+ /*
+ * The only validation we need to do w.r.t caller supplied data
+ * is the filter specification so do that before creating
+ */
+ if (MakeFilterVista(interp, optsPtr, &nfilters, &filterPtr,
+ &defaultFilterIndex) != TCL_OK)
+ return TCL_ERROR;
+
+ /*
+ * Beyond this point, do not just return on error as there will be
+ * resources that need to be released/freed.
+ */
+
+ if (oper == OFN_FILE_OPEN || oper == OFN_DIR_CHOOSE)
+ hr = CoCreateInstance(&ClsidFileOpenDialog, NULL,
+ CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgIf);
+ else
+ hr = CoCreateInstance(&ClsidFileSaveDialog, NULL,
+ CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, (void **) &fdlgIf);
+
+ if (FAILED(hr))
+ goto vamoose;
+
+ /*
+ * Get current settings first because we want to preserve existing
+ * settings like whether to show hidden files etc. based on the
+ * user's existing preference
+ */
+ hr = fdlgIf->lpVtbl->GetOptions(fdlgIf, &flags);
+ if (FAILED(hr))
+ goto vamoose;
+
+ if (filterPtr) {
+ /*
+ * Causes -filetypes {{All *}} -defaultextension ext to return
+ * foo.ext.ext when foo is typed into the entry box
+ * flags |= FOS_STRICTFILETYPES;
+ */
+ hr = fdlgIf->lpVtbl->SetFileTypes(fdlgIf, nfilters, filterPtr);
+ if (FAILED(hr))
+ goto vamoose;
+ hr = fdlgIf->lpVtbl->SetFileTypeIndex(fdlgIf, defaultFilterIndex);
+ if (FAILED(hr))
+ goto vamoose;
+ }
+
+ /* Flags are equivalent to those we used in the older API */
+
+ /*
+ * Following flags must be set irrespective of original setting
+ * XXX - should FOS_NOVALIDATE be there ? Note FOS_NOVALIDATE has different
+ * semantics than OFN_NOVALIDATE in the old API.
+ */
+ flags |=
+ FOS_FORCEFILESYSTEM | /* Only want files, not other shell items */
+ FOS_NOVALIDATE | /* Don't check for access denied etc. */
+ FOS_PATHMUSTEXIST; /* The *directory* path must exist */
+
+
+ if (oper == OFN_DIR_CHOOSE) {
+ flags |= FOS_PICKFOLDERS;
+ if (optsPtr->mustExist)
+ flags |= FOS_FILEMUSTEXIST; /* XXX - check working */
+ } else
+ flags &= ~ FOS_PICKFOLDERS;
+
+ if (optsPtr->multi)
+ flags |= FOS_ALLOWMULTISELECT;
+ else
+ flags &= ~FOS_ALLOWMULTISELECT;
+
+ if (optsPtr->confirmOverwrite)
+ flags |= FOS_OVERWRITEPROMPT;
+ else
+ flags &= ~FOS_OVERWRITEPROMPT;
+
+ hr = fdlgIf->lpVtbl->SetOptions(fdlgIf, flags);
+ if (FAILED(hr))
+ goto vamoose;
+
+ if (optsPtr->extObj != NULL) {
+ wstr = Tcl_GetUnicode(optsPtr->extObj);
+ if (wstr[0] == L'.')
+ ++wstr;
+ hr = fdlgIf->lpVtbl->SetDefaultExtension(fdlgIf, wstr);
+ if (FAILED(hr))
+ goto vamoose;
+ }
+
+ if (optsPtr->titleObj != NULL) {
+ hr = fdlgIf->lpVtbl->SetTitle(fdlgIf,
+ Tcl_GetUnicode(optsPtr->titleObj));
+ if (FAILED(hr))
+ goto vamoose;
+ }
+
+ if (optsPtr->file[0]) {
+ hr = fdlgIf->lpVtbl->SetFileName(fdlgIf, optsPtr->file);
+ if (FAILED(hr))
+ goto vamoose;
+ }
+
+ if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') {
+ Tcl_Obj *normPath, *iniDirPath;
+ iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), -1);
+ Tcl_IncrRefCount(iniDirPath);
+ normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath);
+ /* XXX - Note on failures do not raise error, simply ignore ini dir */
+ if (normPath) {
+ const WCHAR *nativePath;
+ Tcl_IncrRefCount(normPath);
+ nativePath = Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/
+ if (nativePath) {
+ hr = ShellProcs.SHCreateItemFromParsingName(
+ nativePath, NULL,
+ &IIDIShellItem, (void **) &dirIf);
+ if (SUCCEEDED(hr)) {
+ /* Note we use SetFolder, not SetDefaultFolder - see MSDN */
+ fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */
+ }
+ }
+ Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */
+ }
+ Tcl_DecrRefCount(iniDirPath);
+ }
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd);
+ Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we have updated
+ * the wrapper of the parent, which causes us to leave this child disabled
+ * (Windows loses sync).
+ */
+
+ if (hWnd)
+ EnableWindow(hWnd, 1);
+
+ /*
+ * Clear interp result since it might have been set during the modal loop.
+ * http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6
+ */
+ Tcl_ResetResult(interp);
- ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
- if (LOBYTE(LOWORD(GetVersion())) < 5) {
- ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
+ if (SUCCEEDED(hr)) {
+ if ((oper == OFN_FILE_OPEN) && optsPtr->multi) {
+ IShellItemArray *multiIf;
+ DWORD dw, count;
+ IFileOpenDialog *fodIf = (IFileOpenDialog *) fdlgIf;
+ hr = fodIf->lpVtbl->GetResults(fodIf, &multiIf);
+ if (SUCCEEDED(hr)) {
+ Tcl_Obj *multiObj;
+ hr = multiIf->lpVtbl->GetCount(multiIf, &count);
+ multiObj = Tcl_NewListObj(count, NULL);
+ if (SUCCEEDED(hr)) {
+ IShellItem *itemIf;
+ for (dw = 0; dw < count; ++dw) {
+ hr = multiIf->lpVtbl->GetItemAt(multiIf, dw, &itemIf);
+ if (FAILED(hr))
+ break;
+ hr = itemIf->lpVtbl->GetDisplayName(itemIf,
+ SIGDN_FILESYSPATH, &wstr);
+ if (SUCCEEDED(hr)) {
+ Tcl_DString fnds;
+ ConvertExternalFilename(wstr, &fnds);
+ CoTaskMemFree(wstr);
+ Tcl_ListObjAppendElement(
+ interp, multiObj,
+ Tcl_NewStringObj(Tcl_DStringValue(&fnds),
+ Tcl_DStringLength(&fnds)));
+ }
+ itemIf->lpVtbl->Release(itemIf);
+ if (FAILED(hr))
+ break;
+ }
+ }
+ multiIf->lpVtbl->Release(multiIf);
+ if (SUCCEEDED(hr))
+ resultObj = multiObj;
+ else
+ Tcl_DecrRefCount(multiObj);
+ }
+ } else {
+ IShellItem *resultIf;
+ hr = fdlgIf->lpVtbl->GetResult(fdlgIf, &resultIf);
+ if (SUCCEEDED(hr)) {
+ hr = resultIf->lpVtbl->GetDisplayName(resultIf, SIGDN_FILESYSPATH,
+ &wstr);
+ if (SUCCEEDED(hr)) {
+ Tcl_DString fnds;
+ ConvertExternalFilename(wstr, &fnds);
+ resultObj = Tcl_NewStringObj(Tcl_DStringValue(&fnds),
+ Tcl_DStringLength(&fnds));
+ CoTaskMemFree(wstr);
+ }
+ resultIf->lpVtbl->Release(resultIf);
+ }
+ }
+ if (SUCCEEDED(hr)) {
+ if (filterPtr && optsPtr->typeVariableObj) {
+ UINT ftix;
+ hr = fdlgIf->lpVtbl->GetFileTypeIndex(fdlgIf, &ftix);
+ if (SUCCEEDED(hr)) {
+ /* Note ftix is a 1-based index */
+ if (ftix > 0 && ftix <= nfilters) {
+ Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
+ Tcl_NewUnicodeObj(filterPtr[ftix-1].pszName, -1),
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ }
+ }
+ }
+ }
} else {
- ofn.lStructSize = sizeof(OPENFILENAMEW);
+ if (hr == HRESULT_FROM_WIN32(ERROR_CANCELLED))
+ hr = 0; /* User cancelled, return empty string */
}
+
+vamoose: /* (hr != 0) => error */
+ if (dirIf)
+ dirIf->lpVtbl->Release(dirIf);
+ if (fdlgIf)
+ fdlgIf->lpVtbl->Release(fdlgIf);
+
+ if (filterPtr)
+ FreeFilterVista(nfilters, filterPtr);
+
+ if (hr == 0) {
+ if (resultObj) /* May be NULL if user cancelled */
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+ } else {
+ if (resultObj)
+ Tcl_DecrRefCount(resultObj);
+ Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
+ return TCL_ERROR;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileNameXP --
+ *
+ * Displays the old pre-Vista file dialogs.
+ *
+ * Results:
+ * TCL_OK - if dialog was successfully displayed
+ * TCL_ERROR - error return
+ *
+ * Side effects:
+ * See user documentation.
+ *----------------------------------------------------------------------
+ */
+static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, enum OFNOper oper)
+{
+ OPENFILENAME ofn;
+ OFNData ofnData;
+ int cdlgerr;
+ int filterIndex = 0, result = TCL_ERROR, winCode, oldMode;
+ HWND hWnd;
+ Tcl_DString utfFilterString, ds;
+ Tcl_DString extString, filterString, dirString, titleString;
+ const char *str;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ ZeroMemory(&ofnData, sizeof(OFNData));
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&dirString); /* XXX - original code was missing this
+ leaving dirString uninitialized for
+ the unlikely code path where cwd failed */
+
+ if (MakeFilter(interp, optsPtr->filterObj, &utfFilterString,
+ optsPtr->initialTypeObj, &filterIndex) != TCL_OK) {
+ goto end;
+ }
+
+ Tk_MakeWindowExist(optsPtr->tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin));
+
+ ZeroMemory(&ofn, sizeof(OPENFILENAME));
+ ofn.lStructSize = sizeof(OPENFILENAME);
ofn.hwndOwner = hWnd;
ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
- ofn.lpstrFile = file;
+ ofn.lpstrFile = optsPtr->file;
ofn.nMaxFile = TK_MULTI_MAX_PATH;
ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR
- | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING;
+ | OFN_EXPLORER| OFN_ENABLEHOOK| OFN_ENABLESIZING;
ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
ofn.lCustData = (LPARAM) &ofnData;
- if (open != 0) {
+ if (oper != OFN_FILE_SAVE) {
ofn.Flags |= OFN_FILEMUSTEXIST;
- } else if (confirmOverwrite) {
+ } else if (optsPtr->confirmOverwrite) {
ofn.Flags |= OFN_OVERWRITEPROMPT;
}
if (tsdPtr->debugFlag != 0) {
ofnData.interp = interp;
}
- if (multi != 0) {
+ if (optsPtr->multi != 0) {
ofn.Flags |= OFN_ALLOWMULTISELECT;
/*
@@ -712,22 +1606,25 @@ GetFileName(
*/
ofnData.dynFileBufferSize = 512;
- ofnData.dynFileBuffer = (WCHAR *)ckalloc(512 * sizeof(WCHAR));
+ ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR));
}
- if (extension != NULL) {
- Tcl_WinUtfToTChar(extension, -1, &extString);
- ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
+ if (optsPtr->extObj != NULL) {
+ str = Tcl_GetString(optsPtr->extObj);
+ if (str[0] == '.')
+ ++str;
+ Tcl_WinUtfToTChar(str, -1, &extString);
+ ofn.lpstrDefExt = (TCHAR *) Tcl_DStringValue(&extString);
}
Tcl_WinUtfToTChar(Tcl_DStringValue(&utfFilterString),
Tcl_DStringLength(&utfFilterString), &filterString);
- ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
+ ofn.lpstrFilter = (TCHAR *) Tcl_DStringValue(&filterString);
ofn.nFilterIndex = filterIndex;
- if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
- Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString),
- Tcl_DStringLength(&utfDirString), &dirString);
+ if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') {
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString),
+ Tcl_DStringLength(&optsPtr->utfDirString), &dirString);
} else {
/*
* NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure
@@ -736,10 +1633,10 @@ GetFileName(
Tcl_DString cwd;
- Tcl_DStringFree(&utfDirString);
- if ((Tcl_GetCwd(interp, &utfDirString) == NULL) ||
+ Tcl_DStringFree(&optsPtr->utfDirString);
+ if ((Tcl_GetCwd(interp, &optsPtr->utfDirString) == NULL) ||
(Tcl_TranslateFileName(interp,
- Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
+ Tcl_DStringValue(&optsPtr->utfDirString), &cwd) == NULL)) {
Tcl_ResetResult(interp);
} else {
Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd),
@@ -747,11 +1644,11 @@ GetFileName(
}
Tcl_DStringFree(&cwd);
}
- ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
+ ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString);
- if (title != NULL) {
- Tcl_WinUtfToTChar(title, -1, &titleString);
- ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
+ if (optsPtr->titleObj != NULL) {
+ Tcl_WinUtfToTChar(Tcl_GetString(optsPtr->titleObj), -1, &titleString);
+ ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString);
}
/*
@@ -759,10 +1656,10 @@ GetFileName(
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- if (open != 0) {
- winCode = GetOpenFileNameW(&ofn);
+ if (oper != OFN_FILE_SAVE) {
+ winCode = GetOpenFileName(&ofn);
} else {
- winCode = GetSaveFileNameW(&ofn);
+ winCode = GetSaveFileName(&ofn);
}
Tcl_SetServiceMode(oldMode);
EatSpuriousMessageBugFix();
@@ -816,7 +1713,7 @@ GetFileName(
* first element is the directory path.
*/
- WCHAR *files = ofnData.dynFileBuffer;
+ TCHAR *files = ofnData.dynFileBuffer;
Tcl_Obj *returnList = Tcl_NewObj();
int count = 0;
@@ -862,34 +1759,51 @@ GetFileName(
Tcl_SetObjResult(interp, returnList);
Tcl_DStringFree(&ds);
} else {
- Tcl_AppendResult(interp, ConvertExternalFilename(
- ofn.lpstrFile, &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(ofn.lpstrFile, &ds), -1));
gotFilename = (Tcl_DStringLength(&ds) > 0);
Tcl_DStringFree(&ds);
}
result = TCL_OK;
- if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj
- && filterObj) {
+ if ((ofn.nFilterIndex > 0) && gotFilename && optsPtr->typeVariableObj
+ && optsPtr->filterObj) {
int listObjc, count;
Tcl_Obj **listObjv = NULL;
Tcl_Obj **typeInfo = NULL;
- if (Tcl_ListObjGetElements(interp, filterObj,
+ if (Tcl_ListObjGetElements(interp, optsPtr->filterObj,
&listObjc, &listObjv) != TCL_OK) {
result = TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp,
listObjv[ofn.nFilterIndex - 1], &count,
&typeInfo) != TCL_OK) {
result = TCL_ERROR;
- } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
- typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
+ } else {
+ /*
+ * BUGFIX for d43a10ce2fed950e00890049f3c273f2cdd12583
+ * The original code was broken because it passed typeinfo[0]
+ * directly into Tcl_ObjSetVar2. In the case of typeInfo[0]
+ * pointing into a list which is also referenced by
+ * typeVariableObj, TOSV2 shimmers the object into
+ * variable intrep which loses the list representation.
+ * This invalidates typeInfo[0] which is freed but
+ * nevertheless stored as the value of the variable.
+ */
+ Tcl_Obj *selFilterObj = typeInfo[0];
+ Tcl_IncrRefCount(selFilterObj);
+ if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
+ selFilterObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(selFilterObj);
}
}
} else if (cdlgerr == FNERR_INVALIDFILENAME) {
- Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
- Tcl_AppendResult(interp, ConvertExternalFilename(
- ofn.lpstrFile, &ds), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid filename \"%s\"",
+ ConvertExternalFilename(ofn.lpstrFile, &ds)));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME",
+ NULL);
Tcl_DStringFree(&ds);
} else {
result = TCL_OK;
@@ -899,6 +1813,8 @@ GetFileName(
Tcl_DStringFree(&titleString);
}
if (ofn.lpstrInitialDir != NULL) {
+ /* XXX - huh? lpstrInitialDir is set from Tcl_DStringValue which
+ can never return NULL */
Tcl_DStringFree(&dirString);
}
Tcl_DStringFree(&filterString);
@@ -906,16 +1822,58 @@ GetFileName(
Tcl_DStringFree(&extString);
}
- end:
- Tcl_DStringFree(&utfDirString);
+end:
Tcl_DStringFree(&utfFilterString);
if (ofnData.dynFileBuffer != NULL) {
- ckfree((char *)ofnData.dynFileBuffer);
+ ckfree(ofnData.dynFileBuffer);
ofnData.dynFileBuffer = NULL;
}
return result;
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileName --
+ *
+ * Calls GetOpenFileName() or GetSaveFileName().
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * See user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileName(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects. */
+ enum OFNOper oper) /* 1 to call GetOpenFileName(), 0 to call
+ * GetSaveFileName(). */
+{
+ OFNOpts ofnOpts;
+ int result;
+
+ result = ParseOFNOptions(clientData, interp, objc, objv, oper, &ofnOpts);
+ if (result != TCL_OK)
+ return result;
+
+ if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle)
+ result = GetFileNameVista(interp, &ofnOpts, oper);
+ else
+ result = GetFileNameXP(interp, &ofnOpts, oper);
+
+ CleanupOFNOptions(&ofnOpts);
+ return result;
+}
+
/*
*-------------------------------------------------------------------------
@@ -943,15 +1901,15 @@ OFNHookProc(
WPARAM wParam, /* Message parameter */
LPARAM lParam) /* Message parameter */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- OPENFILENAMEW *ofnPtr;
+ OPENFILENAME *ofnPtr;
OFNData *ofnData;
if (uMsg == WM_INITDIALOG) {
TkWinSetUserData(hdlg, lParam);
} else if (uMsg == WM_NOTIFY) {
- OFNOTIFYW *notifyPtr = (OFNOTIFYW *) lParam;
+ OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam;
/*
* This is weird... or not. The CDN_FILEOK is NOT sent when the
@@ -967,7 +1925,7 @@ OFNHookProc(
if (notifyPtr->hdr.code == CDN_FILEOK ||
notifyPtr->hdr.code == CDN_SELCHANGE) {
int dirsize, selsize;
- WCHAR *buffer;
+ TCHAR *buffer;
int buffersize;
/*
@@ -980,8 +1938,8 @@ OFNHookProc(
buffer = ofnData->dynFileBuffer;
hdlg = GetParent(hdlg);
- selsize = SendMessageW(hdlg, CDM_GETSPEC, 0, 0);
- dirsize = SendMessageW(hdlg, CDM_GETFOLDERPATH, 0, 0);
+ selsize = (int) SendMessage(hdlg, CDM_GETSPEC, 0, 0);
+ dirsize = (int) SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0);
buffersize = (selsize + dirsize + 1);
/*
@@ -991,15 +1949,15 @@ OFNHookProc(
if ((selsize > 1) && (dirsize > 0)) {
if (ofnData->dynFileBufferSize < buffersize) {
- buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize * sizeof(WCHAR));
+ buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR));
ofnData->dynFileBufferSize = buffersize;
ofnData->dynFileBuffer = buffer;
}
- SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
+ SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
buffer += dirsize;
- SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+ SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
/*
* If there are multiple files, delete the quotes and change
@@ -1008,7 +1966,7 @@ OFNHookProc(
if (buffer[0] == '"') {
BOOL findquote = TRUE;
- WCHAR *tmp = buffer;
+ TCHAR *tmp = buffer;
while (*buffer != '\0') {
if (findquote) {
@@ -1037,8 +1995,8 @@ OFNHookProc(
if (TCL_PATH_ABSOLUTE ==
Tcl_GetPathType(Tcl_DStringValue(&tmpfile))) {
/* re-get the full path to the start of the buffer */
- buffer = (WCHAR *) ofnData->dynFileBuffer;
- SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+ buffer = (TCHAR *) ofnData->dynFileBuffer;
+ SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
} else {
*(buffer-1) = '\\';
}
@@ -1062,7 +2020,7 @@ OFNHookProc(
* information every time it gets a WM_WINDOWPOSCHANGED message.
*/
- ofnPtr = (OPENFILENAMEW *) TkWinGetUserData(hdlg);
+ ofnPtr = (OPENFILENAME *) TkWinGetUserData(hdlg);
if (ofnPtr != NULL) {
ofnData = (OFNData *) ofnPtr->lCustData;
if (ofnData->interp != NULL) {
@@ -1137,12 +2095,13 @@ MakeFilter(
*p = '\0';
} else {
- int len;
+ size_t len;
if (valuePtr == NULL) {
len = 0;
} else {
- (void) Tcl_GetStringFromObj(valuePtr, &len);
+ (void) Tcl_GetString(valuePtr);
+ len = valuePtr->length;
}
/*
@@ -1159,7 +2118,7 @@ MakeFilter(
* twice the size of the string to format the filter
*/
- filterStr = ckalloc((unsigned int) len * 3);
+ filterStr = ckalloc(len * 3);
for (filterPtr = flist.filters, p = filterStr; filterPtr;
filterPtr = filterPtr->next) {
@@ -1229,7 +2188,7 @@ MakeFilter(
}
Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
- ckfree((char *) filterStr);
+ ckfree(filterStr);
TkFreeFileFilters(&flist);
return TCL_OK;
@@ -1238,6 +2197,145 @@ MakeFilter(
/*
*----------------------------------------------------------------------
*
+ * FreeFilterVista
+ *
+ * Frees storage previously allocated by MakeFilterVista.
+ * count is the number of elements in dlgFilterPtr[]
+ */
+static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr)
+{
+ if (dlgFilterPtr != NULL) {
+ DWORD dw;
+ for (dw = 0; dw < count; ++dw) {
+ if (dlgFilterPtr[dw].pszName != NULL)
+ ckfree(dlgFilterPtr[dw].pszName);
+ if (dlgFilterPtr[dw].pszSpec != NULL)
+ ckfree(dlgFilterPtr[dw].pszSpec);
+ }
+ ckfree(dlgFilterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeFilterVista --
+ *
+ * Returns file type filters in a format required
+ * by the Vista file dialogs.
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * Various values are returned through the parameters as
+ * described in the comments below.
+ *----------------------------------------------------------------------
+ */
+static int MakeFilterVista(
+ Tcl_Interp *interp, /* Current interpreter. */
+ OFNOpts *optsPtr, /* Caller specified options */
+ DWORD *countPtr, /* Will hold number of filters */
+ TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, /* Will hold pointer to filter array.
+ Set to NULL if no filters specified.
+ Must be freed by calling
+ FreeFilterVista */
+ DWORD *initialIndexPtr) /* Will hold index of default type */
+{
+ TCLCOMDLG_FILTERSPEC *dlgFilterPtr;
+ const char *initial = NULL;
+ FileFilterList flist;
+ FileFilter *filterPtr;
+ DWORD initialIndex = 0;
+ Tcl_DString ds, patterns;
+ int i;
+
+ if (optsPtr->filterObj == NULL) {
+ *dlgFilterPtrPtr = NULL;
+ *countPtr = 0;
+ return TCL_OK;
+ }
+
+ if (optsPtr->initialTypeObj)
+ initial = Tcl_GetString(optsPtr->initialTypeObj);
+
+ TkInitFileFilters(&flist);
+ if (TkGetFileFilters(interp, &flist, optsPtr->filterObj, 1) != TCL_OK)
+ return TCL_ERROR;
+
+ if (flist.filters == NULL) {
+ *dlgFilterPtrPtr = NULL;
+ *countPtr = 0;
+ return TCL_OK;
+ }
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringInit(&patterns);
+ dlgFilterPtr = ckalloc(flist.numFilters * sizeof(*dlgFilterPtr));
+
+ for (i = 0, filterPtr = flist.filters;
+ filterPtr;
+ filterPtr = filterPtr->next, ++i) {
+ const char *sep;
+ FileFilterClause *clausePtr;
+ int nbytes;
+
+ /* Check if this entry should be shown as the default */
+ if (initial && strcmp(initial, filterPtr->name) == 0)
+ initialIndex = i+1; /* Windows filter indices are 1-based */
+
+ /* First stash away the text description of the pattern */
+ Tcl_WinUtfToTChar(filterPtr->name, -1, &ds);
+ nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */
+ nbytes += sizeof(WCHAR); /* Terminating \0 */
+ dlgFilterPtr[i].pszName = ckalloc(nbytes);
+ memmove((void *) dlgFilterPtr[i].pszName, Tcl_DStringValue(&ds), nbytes);
+ Tcl_DStringFree(&ds);
+
+ /*
+ * Loop through and join patterns with a ";" Each "clause"
+ * corresponds to a single textual description (called typename)
+ * in the tk_getOpenFile docs. Each such typename may occur
+ * multiple times and all these form a single filter entry
+ * with one clause per occurence. Further each clause may specify
+ * multiple patterns. Hence the nested loop here.
+ */
+ sep = "";
+ for (clausePtr=filterPtr->clauses ; clausePtr;
+ clausePtr=clausePtr->next) {
+ GlobPattern *globPtr;
+ for (globPtr = clausePtr->patterns; globPtr;
+ globPtr = globPtr->next) {
+ Tcl_DStringAppend(&patterns, sep, -1);
+ Tcl_DStringAppend(&patterns, globPtr->pattern, -1);
+ sep = ";";
+ }
+ }
+
+ /* Again we need a Unicode form of the string */
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&patterns), -1, &ds);
+ nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */
+ nbytes += sizeof(WCHAR); /* Terminating \0 */
+ dlgFilterPtr[i].pszSpec = ckalloc(nbytes);
+ memmove((void *)dlgFilterPtr[i].pszSpec, Tcl_DStringValue(&ds), nbytes);
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&patterns);
+ }
+
+ if (initialIndex == 0)
+ initialIndex = 1; /* If no default, show first entry */
+ *initialIndexPtr = initialIndex;
+ *dlgFilterPtrPtr = dlgFilterPtr;
+ *countPtr = flist.numFilters;
+
+ TkFreeFileFilters(&flist);
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tk_ChooseDirectoryObjCmd --
*
* This function implements the "tk_chooseDirectory" dialog box for the
@@ -1312,103 +2410,61 @@ Tk_ChooseDirectoryObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- WCHAR path[MAX_PATH];
- int oldMode, result = TCL_ERROR, i;
+ TCHAR path[MAX_PATH];
+ int oldMode, result;
LPCITEMIDLIST pidl; /* Returned by browser */
- BROWSEINFOW bInfo; /* Used by browser */
+ BROWSEINFO bInfo; /* Used by browser */
ChooseDir cdCBData; /* Structure to pass back and forth */
LPMALLOC pMalloc; /* Used by shell */
- Tk_Window tkwin = (Tk_Window) clientData;
HWND hWnd;
- const char *utfTitle = NULL;/* Title for window */
- WCHAR saveDir[MAX_PATH];
+ TCHAR saveDir[MAX_PATH];
Tcl_DString titleString; /* Title */
- Tcl_DString initDirString; /* Initial directory */
Tcl_DString tempString; /* temporary */
Tcl_Obj *objPtr;
- static const char *optionStrings[] = {
- "-initialdir", "-mustexist", "-parent", "-title", NULL
- };
- enum options {
- DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
- };
+ OFNOpts ofnOpts;
+ const char *utfDir;
+
+ result = ParseOFNOptions(clientData, interp, objc, objv,
+ OFN_DIR_CHOOSE, &ofnOpts);
+ if (result != TCL_OK)
+ return result;
+
+ /* Use new dialogs if available */
+ if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) {
+ result = GetFileNameVista(interp, &ofnOpts, OFN_DIR_CHOOSE);
+ CleanupOFNOptions(&ofnOpts);
+ return result;
+ }
- /*
- * Initialize
- */
+ /* Older dialogs */
path[0] = '\0';
ZeroMemory(&cdCBData, sizeof(ChooseDir));
cdCBData.interp = interp;
+ cdCBData.mustExist = ofnOpts.mustExist;
- /*
- * Process the command line options
- */
-
- for (i = 1; i < objc; i += 2) {
- int index;
- const char *string;
- const WCHAR *uniStr;
- Tcl_Obj *optionPtr, *valuePtr;
-
- optionPtr = objv[i];
- valuePtr = objv[i + 1];
-
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 0,
- &index) != TCL_OK) {
- goto cleanup;
- }
- if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
- goto cleanup;
- }
+ utfDir = Tcl_DStringValue(&ofnOpts.utfDirString);
+ if (utfDir[0] != '\0') {
+ const TCHAR *uniStr;
- string = Tcl_GetString(valuePtr);
- switch ((enum options) index) {
- case DIR_INITIAL:
- if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
- goto cleanup;
- }
- Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1,
- &tempString);
- uniStr = (WCHAR *) Tcl_DStringValue(&tempString);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&ofnOpts.utfDirString), -1,
+ &tempString);
+ uniStr = (TCHAR *) Tcl_DStringValue(&tempString);
- /*
- * Convert possible relative path to full path to keep dialog
- * happy.
- */
+ /* Convert possible relative path to full path to keep dialog happy. */
- GetFullPathNameW(uniStr, MAX_PATH, saveDir, NULL);
- wcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
- Tcl_DStringFree(&initDirString);
- Tcl_DStringFree(&tempString);
- break;
- case DIR_EXIST:
- if (Tcl_GetBooleanFromObj(interp, valuePtr,
- &cdCBData.mustExist) != TCL_OK) {
- goto cleanup;
- }
- break;
- case DIR_PARENT:
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
- goto cleanup;
- }
- break;
- case FILE_TITLE:
- utfTitle = string;
- break;
- }
+ GetFullPathName(uniStr, MAX_PATH, saveDir, NULL);
+ _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
}
+ /* XXX - rest of this (original) code has no error checks at all. */
+
/*
* Get ready to call the browser
*/
- Tk_MakeWindowExist(tkwin);
- hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+ Tk_MakeWindowExist(ofnOpts.tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(ofnOpts.tkwin));
/*
* Setup the parameters used by SHBrowseForFolder
@@ -1417,16 +2473,16 @@ Tk_ChooseDirectoryObjCmd(
bInfo.hwndOwner = hWnd;
bInfo.pszDisplayName = path;
bInfo.pidlRoot = NULL;
- if (wcslen(cdCBData.initDir) == 0) {
- GetCurrentDirectoryW(MAX_PATH, cdCBData.initDir);
+ if (_tcslen(cdCBData.initDir) == 0) {
+ GetCurrentDirectory(MAX_PATH, cdCBData.initDir);
}
bInfo.lParam = (LPARAM) &cdCBData;
- if (utfTitle != NULL) {
- Tcl_WinUtfToTChar(utfTitle, -1, &titleString);
- bInfo.lpszTitle = (LPWSTR) Tcl_DStringValue(&titleString);
+ if (ofnOpts.titleObj != NULL) {
+ Tcl_WinUtfToTChar(Tcl_GetString(ofnOpts.titleObj), -1, &titleString);
+ bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
} else {
- bInfo.lpszTitle = L"Please choose a directory, then select OK.";
+ bInfo.lpszTitle = TEXT("Please choose a directory, then select OK.");
}
/*
@@ -1459,9 +2515,13 @@ Tk_ChooseDirectoryObjCmd(
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- GetCurrentDirectoryW(MAX_PATH, saveDir);
+ GetCurrentDirectory(MAX_PATH, saveDir);
if (SHGetMalloc(&pMalloc) == NOERROR) {
- pidl = SHBrowseForFolderW(&bInfo);
+ /*
+ * XXX - MSDN says CoInitialize must have been called before
+ * SHBrowseForFolder can be used but don't see that called anywhere.
+ */
+ pidl = SHBrowseForFolder(&bInfo);
/*
* This is a fix for Windows 2000, which seems to modify the folder
@@ -1476,17 +2536,18 @@ Tk_ChooseDirectoryObjCmd(
*/
if (pidl != NULL) {
- if (!SHGetPathFromIDListW(pidl, path)) {
- Tcl_SetResult(interp, "Error: Not a file system folder\n",
- TCL_VOLATILE);
+ if (!SHGetPathFromIDList(pidl, path)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error: not a file system folder", -1));
+ Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "PSEUDO", NULL);
}
pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
- } else if (wcslen(cdCBData.retDir) > 0) {
- wcscpy(path, cdCBData.retDir);
+ } else if (_tcslen(cdCBData.retDir) > 0) {
+ _tcscpy(path, cdCBData.retDir);
}
pMalloc->lpVtbl->Release(pMalloc);
}
- SetCurrentDirectoryW(saveDir);
+ SetCurrentDirectory(saveDir);
Tcl_SetServiceMode(oldMode);
/*
@@ -1506,19 +2567,13 @@ Tk_ChooseDirectoryObjCmd(
if (*path) {
Tcl_DString ds;
- Tcl_AppendResult(interp, ConvertExternalFilename(path,
- &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(path, &ds), -1));
Tcl_DStringFree(&ds);
}
- result = TCL_OK;
-
- if (utfTitle != NULL) {
- Tcl_DStringFree(&titleString);
- }
-
- cleanup:
- return result;
+ CleanupOFNOptions(&ofnOpts);
+ return TCL_OK;
}
/*
@@ -1544,17 +2599,17 @@ ChooseDirectoryValidateProc(
LPARAM lParam,
LPARAM lpData)
{
- WCHAR selDir[MAX_PATH];
+ TCHAR selDir[MAX_PATH];
ChooseDir *chooseDirSharedData = (ChooseDir *) lpData;
Tcl_DString tempString;
Tcl_DString initDirString;
- WCHAR string[MAX_PATH];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TCHAR string[MAX_PATH];
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ Tcl_DoWhenIdle(SetTkDialog, hwnd);
}
chooseDirSharedData->retDir[0] = '\0';
switch (message) {
@@ -1582,11 +2637,11 @@ ChooseDirectoryValidateProc(
Tcl_DStringFree(&initDirString);
Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString);
Tcl_DStringFree(&tempString);
- wcsncpy(string, (WCHAR *) Tcl_DStringValue(&initDirString),
+ _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString),
MAX_PATH);
Tcl_DStringFree(&initDirString);
- if (SetCurrentDirectoryW(string) == 0) {
+ if (SetCurrentDirectory(string) == 0) {
/*
* Get the full path name to the user entry, at this point it does
@@ -1594,16 +2649,17 @@ ChooseDirectoryValidateProc(
* it.
*/
- GetFullPathNameW(string, MAX_PATH,
+ GetFullPathName(string, MAX_PATH,
chooseDirSharedData->retDir, NULL);
if (chooseDirSharedData->mustExist) {
/*
* User HAS to select a valid directory.
*/
- wsprintfW(selDir, L"Directory '%.200s' does not exist,\nplease select or enter an existing directory.",
+ wsprintf(selDir, TEXT("Directory '%s' does not exist,\n")
+ TEXT("please select or enter an existing directory."),
chooseDirSharedData->retDir);
- MessageBoxW(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
+ MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
chooseDirSharedData->retDir[0] = '\0';
return 1;
}
@@ -1613,7 +2669,7 @@ ChooseDirectoryValidateProc(
* directory in utfRetDir.
*/
- GetCurrentDirectoryW(MAX_PATH, chooseDirSharedData->retDir);
+ GetCurrentDirectory(MAX_PATH, chooseDirSharedData->retDir);
return 0;
}
return 0;
@@ -1628,13 +2684,13 @@ ChooseDirectoryValidateProc(
* Not called when user changes edit box directly.
*/
- if (SHGetPathFromIDListW((LPITEMIDLIST) lParam, selDir)) {
- SendMessageW(hwnd, BFFM_SETSTATUSTEXTW, 0, (LPARAM) selDir);
+ if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) {
+ SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir);
// enable the OK button
- SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
} else {
// disable the OK button
- SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
}
UpdateWindow(hwnd);
return 1;
@@ -1645,9 +2701,9 @@ ChooseDirectoryValidateProc(
* specified parameter.
*/
- WCHAR *initDir = chooseDirSharedData->initDir;
+ TCHAR *initDir = chooseDirSharedData->initDir;
- SetCurrentDirectoryW(initDir);
+ SetCurrentDirectory(initDir);
if (*initDir == '\\') {
/*
@@ -1664,10 +2720,10 @@ ChooseDirectoryValidateProc(
ULONG ulCount, ulAttr;
if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName(
- psfFolder, hwnd, NULL, (WCHAR *)
+ psfFolder, hwnd, NULL, (TCHAR *)
initDir, &ulCount,&pidlMain,&ulAttr))
&& (pidlMain != NULL)) {
- SendMessageW(hwnd, BFFM_SETSELECTIONW, FALSE,
+ SendMessage(hwnd, BFFM_SETSELECTION, FALSE,
(LPARAM) pidlMain);
pMalloc->lpVtbl->Free(pMalloc, pidlMain);
}
@@ -1676,9 +2732,9 @@ ChooseDirectoryValidateProc(
pMalloc->lpVtbl->Release(pMalloc);
}
} else {
- SendMessageW(hwnd, BFFM_SETSELECTIONW, TRUE, (LPARAM) initDir);
+ SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) initDir);
}
- SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
break;
}
@@ -1711,13 +2767,13 @@ Tk_MessageBoxObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData, parent;
+ Tk_Window tkwin = clientData, parent;
HWND hWnd;
Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;
int defaultBtn, icon, type;
int i, oldMode, winCode;
UINT flags;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-default", "-detail", "-icon", "-message",
"-parent", "-title", "-type", NULL
};
@@ -1725,7 +2781,7 @@ Tk_MessageBoxObjCmd(
MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE,
MSG_PARENT, MSG_TITLE, MSG_TYPE
};
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
defaultBtn = -1;
@@ -1743,14 +2799,14 @@ Tk_MessageBoxObjCmd(
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
- const char *string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL);
return TCL_ERROR;
}
@@ -1819,9 +2875,10 @@ Tk_MessageBoxObjCmd(
}
}
if (defaultBtnIdx < 0) {
- Tcl_AppendResult(interp, "invalid default button \"",
- TkFindStateString(buttonMap, defaultBtn),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid default button \"%s\"",
+ TkFindStateString(buttonMap, defaultBtn)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL);
return TCL_ERROR;
}
break;
@@ -1853,9 +2910,9 @@ Tk_MessageBoxObjCmd(
tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL);
tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG);
- tsdPtr->hMsgBoxHook = SetWindowsHookExW(WH_CBT, MsgBoxCBTProc, NULL,
+ tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL,
GetCurrentThreadId());
- winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj),
+ winCode = MessageBox(hWnd, Tcl_GetUnicode(tmpObj),
titleObj ? Tcl_GetUnicode(titleObj) : L"", flags);
UnhookWindowsHookEx(tsdPtr->hMsgBoxHook);
(void) Tcl_SetServiceMode(oldMode);
@@ -1869,8 +2926,8 @@ Tk_MessageBoxObjCmd(
EnableWindow(hWnd, 1);
Tcl_DecrRefCount(tmpObj);
-
- Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TkFindStateString(buttonMap, winCode), -1));
return TCL_OK;
}
@@ -1880,7 +2937,7 @@ MsgBoxCBTProc(
WPARAM wParam,
LPARAM lParam)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (nCode == HCBT_CREATEWND) {
@@ -1897,9 +2954,9 @@ MsgBoxCBTProc(
if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) {
HWND hwnd = (HWND) wParam;
- SendMessageW(hwnd, WM_SETICON, ICON_SMALL,
+ SendMessage(hwnd, WM_SETICON, ICON_SMALL,
(LPARAM) tsdPtr->hSmallIcon);
- SendMessageW(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon);
+ SendMessage(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon);
}
}
@@ -1927,12 +2984,12 @@ static void
SetTkDialog(
ClientData clientData)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
char buf[32];
sprintf(buf, "0x%p", (HWND) clientData);
- Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(tsdPtr->debugInterp, "tk_dialog", NULL, buf, TCL_GLOBAL_ONLY);
}
/*
@@ -1941,12 +2998,12 @@ SetTkDialog(
static const char *
ConvertExternalFilename(
- WCHAR *filename,
+ TCHAR *filename,
Tcl_DString *dsPtr)
{
char *p;
- Tcl_WinTCharToUtf((TCHAR *) filename, -1, dsPtr);
+ Tcl_WinTCharToUtf(filename, -1, dsPtr);
for (p = Tcl_DStringValue(dsPtr); *p != '\0'; p++) {
/*
* Change the pathname to the Tcl "normalized" pathname, where back
@@ -1961,6 +3018,569 @@ ConvertExternalFilename(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * GetFontObj --
+ *
+ * Convert a windows LOGFONT into a Tk font description.
+ *
+ * Result:
+ * A list containing a Tk font description.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetFontObj(
+ HDC hdc,
+ LOGFONT *plf)
+{
+ Tcl_DString ds;
+ Tcl_Obj *resObj;
+ int pt = 0;
+
+ resObj = Tcl_NewListObj(0, NULL);
+ Tcl_WinTCharToUtf(plf->lfFaceName, -1, &ds);
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj(Tcl_DStringValue(&ds), -1));
+ Tcl_DStringFree(&ds);
+ pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY));
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt));
+ if (plf->lfWeight >= 700) {
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1));
+ }
+ if (plf->lfItalic) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("italic", -1));
+ }
+ if (plf->lfUnderline) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("underline", -1));
+ }
+ if (plf->lfStrikeOut) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("overstrike", -1));
+ }
+ return resObj;
+}
+
+static void
+ApplyLogfont(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ HDC hdc,
+ LOGFONT *logfontPtr)
+{
+ int objc;
+ Tcl_Obj **objv, **tmpv;
+
+ Tcl_ListObjGetElements(NULL, cmdObj, &objc, &objv);
+ tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
+ memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
+ tmpv[objc] = GetFontObj(hdc, logfontPtr);
+ TkBackgroundEvalObjv(interp, objc+1, tmpv, TCL_EVAL_GLOBAL);
+ ckfree(tmpv);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * HookProc --
+ *
+ * Font selection hook. If the user selects Apply on the dialog, we call
+ * the applyProc script with the currently selected font as arguments.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+typedef struct HookData {
+ Tcl_Interp *interp;
+ Tcl_Obj *titleObj;
+ Tcl_Obj *cmdObj;
+ Tcl_Obj *parentObj;
+ Tcl_Obj *fontObj;
+ HWND hwnd;
+ Tk_Window parent;
+} HookData;
+
+static UINT_PTR CALLBACK
+HookProc(
+ HWND hwndDlg,
+ UINT msg,
+ WPARAM wParam,
+ LPARAM lParam)
+{
+ CHOOSEFONT *pcf = (CHOOSEFONT *) lParam;
+ HWND hwndCtrl;
+ static HookData *phd = NULL;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (WM_INITDIALOG == msg && lParam != 0) {
+ phd = (HookData *) pcf->lCustData;
+ phd->hwnd = hwndDlg;
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = phd->interp;
+ Tcl_DoWhenIdle(SetTkDialog, hwndDlg);
+ }
+ if (phd->titleObj != NULL) {
+ Tcl_DString title;
+
+ Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title);
+ if (Tcl_DStringLength(&title) > 0) {
+ SetWindowText(hwndDlg, (LPCTSTR) Tcl_DStringValue(&title));
+ }
+ Tcl_DStringFree(&title);
+ }
+
+ /*
+ * Disable the colour combobox (0x473) and its label (0x443).
+ */
+
+ hwndCtrl = GetDlgItem(hwndDlg, 0x443);
+ if (IsWindow(hwndCtrl)) {
+ EnableWindow(hwndCtrl, FALSE);
+ }
+ hwndCtrl = GetDlgItem(hwndDlg, 0x473);
+ if (IsWindow(hwndCtrl)) {
+ EnableWindow(hwndCtrl, FALSE);
+ }
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ return 1; /* we handled the message */
+ }
+
+ if (WM_DESTROY == msg) {
+ phd->hwnd = NULL;
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ return 0;
+ }
+
+ /*
+ * Handle apply button by calling the provided command script as a
+ * background evaluation (ie: errors dont come back here).
+ */
+
+ if (WM_COMMAND == msg && LOWORD(wParam) == 1026) {
+ LOGFONT lf = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0, 0}};
+ HDC hdc = GetDC(hwndDlg);
+
+ SendMessage(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM) &lf);
+ if (phd && phd->cmdObj) {
+ ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
+ }
+ if (phd && phd->parent) {
+ TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
+ }
+ return 1;
+ }
+ return 0; /* pass on for default processing */
+}
+
+/*
+ * Helper for the FontchooserConfigure command to return the current value of
+ * any of the options (which may be NULL in the structure)
+ */
+
+enum FontchooserOption {
+ FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
+ FontchooserVisible
+};
+
+static Tcl_Obj *
+FontchooserCget(
+ HookData *hdPtr,
+ int optionIndex)
+{
+ Tcl_Obj *resObj = NULL;
+
+ switch(optionIndex) {
+ case FontchooserParent:
+ if (hdPtr->parentObj) {
+ resObj = hdPtr->parentObj;
+ } else {
+ resObj = Tcl_NewStringObj(".", 1);
+ }
+ break;
+ case FontchooserTitle:
+ if (hdPtr->titleObj) {
+ resObj = hdPtr->titleObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserFont:
+ if (hdPtr->fontObj) {
+ resObj = hdPtr->fontObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserCmd:
+ if (hdPtr->cmdObj) {
+ resObj = hdPtr->cmdObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserVisible:
+ resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd));
+ break;
+ default:
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ return resObj;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserConfigureCmd --
+ *
+ * Implementation of the 'tk fontchooser configure' ensemble command. See
+ * the user documentation for what it does.
+ *
+ * Results:
+ * See the user documentation.
+ *
+ * Side effects:
+ * Per-interp data structure may be modified
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserConfigureCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tk_Window tkwin = clientData;
+ HookData *hdPtr = NULL;
+ int i, r = TCL_OK;
+ static const char *const optionStrings[] = {
+ "-parent", "-title", "-font", "-command", "-visible", NULL
+ };
+
+ hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ /*
+ * With no arguments we return all the options in a dict.
+ */
+
+ if (objc == 1) {
+ Tcl_Obj *keyObj, *valueObj;
+ Tcl_Obj *dictObj = Tcl_NewDictObj();
+
+ for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) {
+ keyObj = Tcl_NewStringObj(optionStrings[i], -1);
+ valueObj = FontchooserCget(hdPtr, i);
+ r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
+ }
+ if (r == TCL_OK) {
+ Tcl_SetObjResult(interp, dictObj);
+ }
+ return r;
+ }
+
+ for (i = 1; i < objc; i += 2) {
+ int optionIndex;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ /*
+ * If one option and no arg - return the current value.
+ */
+
+ Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex));
+ return TCL_OK;
+ }
+ if (i + 1 == objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+ switch (optionIndex) {
+ case FontchooserVisible: {
+ static const char *msg = "cannot change read-only option "
+ "\"-visible\": use the show or hide command";
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL);
+ return TCL_ERROR;
+ }
+ case FontchooserParent: {
+ Tk_Window parent = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[i+1]), tkwin);
+
+ if (parent == None) {
+ return TCL_ERROR;
+ }
+ if (hdPtr->parentObj) {
+ Tcl_DecrRefCount(hdPtr->parentObj);
+ }
+ hdPtr->parentObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->parentObj)) {
+ hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj);
+ }
+ Tcl_IncrRefCount(hdPtr->parentObj);
+ break;
+ }
+ case FontchooserTitle:
+ if (hdPtr->titleObj) {
+ Tcl_DecrRefCount(hdPtr->titleObj);
+ }
+ hdPtr->titleObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->titleObj)) {
+ hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj);
+ }
+ Tcl_IncrRefCount(hdPtr->titleObj);
+ break;
+ case FontchooserFont:
+ if (hdPtr->fontObj) {
+ Tcl_DecrRefCount(hdPtr->fontObj);
+ }
+ (void)Tcl_GetString(objv[i+1]);
+ if (objv[i+1]->length) {
+ hdPtr->fontObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->fontObj)) {
+ hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj);
+ }
+ Tcl_IncrRefCount(hdPtr->fontObj);
+ } else {
+ hdPtr->fontObj = NULL;
+ }
+ break;
+ case FontchooserCmd:
+ if (hdPtr->cmdObj) {
+ Tcl_DecrRefCount(hdPtr->cmdObj);
+ }
+ (void)Tcl_GetString(objv[i+1]);
+ if (objv[i+1]->length) {
+ hdPtr->cmdObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->cmdObj)) {
+ hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj);
+ }
+ Tcl_IncrRefCount(hdPtr->cmdObj);
+ } else {
+ hdPtr->cmdObj = NULL;
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserShowCmd --
+ *
+ * Implements the 'tk fontchooser show' ensemble command. The per-interp
+ * configuration data for the dialog is held in an interp associated
+ * structure.
+ *
+ * Calls the Win32 FontChooser API which provides a modal dialog. See
+ * HookProc where we make a few changes to the dialog and set some
+ * additional state.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserShowCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_DString ds;
+ Tk_Window tkwin = clientData, parent;
+ CHOOSEFONT cf;
+ LOGFONT lf;
+ HDC hdc;
+ HookData *hdPtr;
+ int r = TCL_OK, oldMode = 0;
+
+ hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ parent = tkwin;
+ if (hdPtr->parentObj) {
+ parent = Tk_NameToWindow(interp, Tcl_GetString(hdPtr->parentObj),
+ tkwin);
+ if (parent == None) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tk_MakeWindowExist(parent);
+
+ ZeroMemory(&cf, sizeof(CHOOSEFONT));
+ ZeroMemory(&lf, sizeof(LOGFONT));
+ lf.lfCharSet = DEFAULT_CHARSET;
+ cf.lStructSize = sizeof(CHOOSEFONT);
+ cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+ cf.lpLogFont = &lf;
+ cf.nFontType = SCREEN_FONTTYPE;
+ cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK;
+ cf.rgbColors = RGB(0,0,0);
+ cf.lpfnHook = HookProc;
+ cf.lCustData = (INT_PTR) hdPtr;
+ hdPtr->interp = interp;
+ hdPtr->parent = parent;
+ hdc = GetDC(cf.hwndOwner);
+
+ if (hdPtr->fontObj != NULL) {
+ TkFont *fontPtr;
+ Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj);
+
+ if (f == NULL) {
+ return TCL_ERROR;
+ }
+ fontPtr = (TkFont *) f;
+ cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+ Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds);
+ _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds),
+ LF_FACESIZE-1);
+ Tcl_DStringFree(&ds);
+ lf.lfFaceName[LF_FACESIZE-1] = 0;
+ lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size),
+ GetDeviceCaps(hdc, LOGPIXELSY), 72);
+ if (fontPtr->fa.weight == TK_FW_BOLD) {
+ lf.lfWeight = FW_BOLD;
+ }
+ if (fontPtr->fa.slant != TK_FS_ROMAN) {
+ lf.lfItalic = TRUE;
+ }
+ if (fontPtr->fa.underline) {
+ lf.lfUnderline = TRUE;
+ }
+ if (fontPtr->fa.overstrike) {
+ lf.lfStrikeOut = TRUE;
+ }
+ Tk_FreeFont(f);
+ }
+
+ if (TCL_OK == r && hdPtr->cmdObj != NULL) {
+ int len = 0;
+
+ r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len);
+ if (len > 0) {
+ cf.Flags |= CF_APPLY;
+ }
+ }
+
+ if (TCL_OK == r) {
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (ChooseFont(&cf)) {
+ if (hdPtr->cmdObj) {
+ ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
+ }
+ if (hdPtr->parent) {
+ TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
+ }
+ }
+ Tcl_SetServiceMode(oldMode);
+ EnableWindow(cf.hwndOwner, 1);
+ }
+
+ ReleaseDC(cf.hwndOwner, hdc);
+ return r;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserHideCmd --
+ *
+ * Implementation of the 'tk fontchooser hide' ensemble. See the user
+ * documentation for details.
+ * As the Win32 FontChooser function is always modal all we do here is
+ * destroy the dialog
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserHideCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ HookData *hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ if (hdPtr->hwnd && IsWindow(hdPtr->hwnd)) {
+ EndDialog(hdPtr->hwnd, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteHookData --
+ *
+ * Clean up the font chooser configuration data when the interp is
+ * destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteHookData(ClientData clientData, Tcl_Interp *interp)
+{
+ HookData *hdPtr = clientData;
+
+ if (hdPtr->parentObj) {
+ Tcl_DecrRefCount(hdPtr->parentObj);
+ }
+ if (hdPtr->fontObj) {
+ Tcl_DecrRefCount(hdPtr->fontObj);
+ }
+ if (hdPtr->titleObj) {
+ Tcl_DecrRefCount(hdPtr->titleObj);
+ }
+ if (hdPtr->cmdObj) {
+ Tcl_DecrRefCount(hdPtr->cmdObj);
+ }
+ ckfree(hdPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitFontchooser --
+ *
+ * Associate the font chooser configuration data with the Tcl
+ * interpreter. There is one font chooser per interp.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+const TkEnsemble tkFontchooserEnsemble[] = {
+ { "configure", FontchooserConfigureCmd, NULL },
+ { "show", FontchooserShowCmd, NULL },
+ { "hide", FontchooserHideCmd, NULL },
+ { NULL, NULL, NULL }
+};
+
+int
+TkInitFontchooser(Tcl_Interp *interp, ClientData clientData)
+{
+ HookData *hdPtr = ckalloc(sizeof(HookData));
+
+ memset(hdPtr, 0, sizeof(HookData));
+ Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteHookData, hdPtr);
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/tkWinDraw.c b/win/tkWinDraw.c
index 1897bc8..ba4176c 100644
--- a/win/tkWinDraw.c
+++ b/win/tkWinDraw.c
@@ -17,14 +17,13 @@
* These macros convert between X's bizarre angle units to radians.
*/
-#define PI 3.14159265358979
#define XAngleToRadians(a) ((double)(a) / 64 * PI / 180);
/*
* Translation table between X gc functions and Win32 raster op modes.
*/
-CONST int tkpWinRopModes[] = {
+const int tkpWinRopModes[] = {
R2_BLACK, /* GXclear */
R2_MASKPEN, /* GXand */
R2_MASKPENNOT, /* GXandReverse */
@@ -55,7 +54,7 @@ CONST int tkpWinRopModes[] = {
#define SRCORREVERSE (DWORD)0x00DD0228 /* dest = source OR (NOT dest) */
#define SRCNAND (DWORD)0x007700E6 /* dest = NOT (source AND dest) */
-CONST int tkpWinBltModes[] = {
+const int tkpWinBltModes[] = {
BLACKNESS, /* GXclear */
SRCAND, /* GXand */
SRCERASE, /* GXandReverse */
@@ -102,7 +101,7 @@ CONST int tkpWinBltModes[] = {
* The followng typedef is used to pass Windows GDI drawing functions.
*/
-typedef BOOL (CALLBACK *WinDrawFunc)(HDC dc, CONST POINT* points, int npoints);
+typedef BOOL (CALLBACK *WinDrawFunc)(HDC dc, const POINT *points, int npoints);
typedef struct ThreadSpecificData {
POINT *winPoints; /* Array of points that is reused. */
@@ -243,9 +242,9 @@ ConvertPoints(
if (npoints > tsdPtr->nWinPoints) {
if (tsdPtr->winPoints != NULL) {
- ckfree((char *) tsdPtr->winPoints);
+ ckfree(tsdPtr->winPoints);
}
- tsdPtr->winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints);
+ tsdPtr->winPoints = ckalloc(sizeof(POINT) * npoints);
if (tsdPtr->winPoints == NULL) {
tsdPtr->nWinPoints = -1;
return NULL;
@@ -554,10 +553,10 @@ TkPutImage(
usePalette = (image->bits_per_pixel < 16);
if (usePalette) {
- infoPtr = (BITMAPINFO *) ckalloc(sizeof(BITMAPINFOHEADER)
+ infoPtr = ckalloc(sizeof(BITMAPINFOHEADER)
+ sizeof(RGBQUAD)*ncolors);
} else {
- infoPtr = (BITMAPINFO *) ckalloc(sizeof(BITMAPINFOHEADER));
+ infoPtr = ckalloc(sizeof(BITMAPINFOHEADER));
}
infoPtr->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
@@ -584,10 +583,10 @@ TkPutImage(
}
bitmap = CreateDIBitmap(dc, &infoPtr->bmiHeader, CBM_INIT,
image->data, infoPtr, DIB_RGB_COLORS);
- ckfree((char *) infoPtr);
+ ckfree(infoPtr);
}
if (!bitmap) {
- Tcl_Panic("Fail to allocate bitmap\n");
+ Tcl_Panic("Fail to allocate bitmap");
DeleteDC(dcMem);
TkWinReleaseDrawableDC(d, dc, &state);
return BadValue;
@@ -749,7 +748,7 @@ RenderObject(
HPEN pen,
WinDrawFunc func)
{
- RECT rect = {0, 0, 0, 0};
+ RECT rect = {0,0,0,0};
HPEN oldPen;
HBRUSH oldBrush;
POINT *winPoints = ConvertPoints(points, npoints, mode, &rect);
@@ -817,7 +816,7 @@ RenderObject(
SetPolyFillMode(dcMem, (gc->fill_rule == EvenOddRule) ? ALTERNATE
: WINDING);
oldMemBrush = SelectObject(dcMem, CreateSolidBrush(gc->foreground));
- (*func)(dcMem, winPoints, npoints);
+ func(dcMem, winPoints, npoints);
BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0, COPYFG);
/*
@@ -829,7 +828,7 @@ RenderObject(
if (gc->fill_style == FillOpaqueStippled) {
DeleteObject(SelectObject(dcMem,
CreateSolidBrush(gc->background)));
- (*func)(dcMem, winPoints, npoints);
+ func(dcMem, winPoints, npoints);
BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0,
COPYBG);
}
@@ -845,9 +844,7 @@ RenderObject(
SetPolyFillMode(dc, (gc->fill_rule == EvenOddRule) ? ALTERNATE
: WINDING);
-
- (*func)(dc, winPoints, npoints);
-
+ func(dc, winPoints, npoints);
SelectObject(dc, oldPen);
}
DeleteObject(SelectObject(dc, oldBrush));
diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c
index b7f5085..42809cc 100644
--- a/win/tkWinEmbed.c
+++ b/win/tkWinEmbed.c
@@ -69,15 +69,15 @@ void
TkWinCleanupContainerList(void)
{
Container *nextPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (; tsdPtr->firstContainerPtr != (Container *) NULL;
+ for (; tsdPtr->firstContainerPtr != NULL;
tsdPtr->firstContainerPtr = nextPtr) {
nextPtr = tsdPtr->firstContainerPtr->nextPtr;
- ckfree((char *) tsdPtr->firstContainerPtr);
+ ckfree(tsdPtr->firstContainerPtr);
}
- tsdPtr->firstContainerPtr = (Container *) NULL;
+ tsdPtr->firstContainerPtr = NULL;
}
/*
@@ -101,8 +101,8 @@ int
TkpTestembedCmd(
ClientData clientData,
Tcl_Interp *interp,
- int argc,
- CONST char **argv)
+ int objc,
+ Tcl_Obj *const objv[])
{
return TCL_OK;
}
@@ -134,7 +134,7 @@ Tk_DetachEmbeddedWindow(
TkpWinToplevelOverrideRedirect(winPtr, 0);
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -230,7 +230,7 @@ TkpUseWindow(
* string is bogus. */
Tk_Window tkwin, /* Tk window that does not yet have an
* associated X window. */
- CONST char *string) /* String identifying an X window to use for
+ const char *string) /* String identifying an X window to use for
* tkwin; must be an integer value. */
{
TkWindow *winPtr = (TkWindow *) tkwin;
@@ -243,8 +243,9 @@ TkpUseWindow(
/*
if (winPtr->window != None) {
- Tcl_AppendResult(interp,
- "can't modify container after widget is created", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't modify container after widget is created", -1));
+ Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL);
return TCL_ERROR;
}
*/
@@ -272,8 +273,9 @@ TkpUseWindow(
if (!IsWindow(hwnd)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "window \"", string,
- "\" doesn't exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" doesn't exist", string));
+ Tcl_SetErrorCode(interp, "TK", "EMBED", "EXIST", NULL);
}
return TCL_ERROR;
}
@@ -281,12 +283,15 @@ TkpUseWindow(
id = SendMessage(hwnd, TK_INFO, TK_CONTAINER_VERIFY, 0);
if (id == PTR2INT(hwnd)) {
if (!SendMessage(hwnd, TK_INFO, TK_CONTAINER_ISAVAILABLE, 0)) {
- Tcl_AppendResult(interp, "The container is already in use", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "The container is already in use", -1));
+ Tcl_SetErrorCode(interp, "TK", "EMBED", "IN_USE", NULL);
return TCL_ERROR;
}
} else if (id == -PTR2INT(hwnd)) {
- Tcl_AppendResult(interp, "the window to use is not a Tk container",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "the window to use is not a Tk container", -1));
+ Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL);
return TCL_ERROR;
} else {
/*
@@ -298,9 +303,11 @@ TkpUseWindow(
char msg[256];
sprintf(msg, "Unable to get information of window \"%.80s\". Attach to this\nwindow may have unpredictable results if it is not a valid container.\n\nPress Ok to proceed or Cancel to abort attaching.", string);
- if (IDCANCEL == MessageBox(hwnd, msg, "Tk Warning",
+ if (IDCANCEL == MessageBoxA(hwnd, msg, "Tk Warning",
MB_OKCANCEL | MB_ICONWARNING)) {
- Tcl_SetResult(interp, "Operation has been canceled", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Operation has been canceled", -1));
+ Tcl_SetErrorCode(interp, "TK", "EMBED", "CANCEL", NULL);
return TCL_ERROR;
}
}
@@ -361,7 +368,7 @@ TkpMakeContainer(
*/
Tk_MakeWindowExist(tkwin);
- containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr = ckalloc(sizeof(Container));
containerPtr->parentPtr = winPtr;
containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin));
containerPtr->embeddedHWnd = NULL;
@@ -935,7 +942,7 @@ Tk_GetEmbeddedHWnd(
}
return NULL;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1095,7 +1102,7 @@ EmbedWindowDeleted(
} else {
prevPtr->nextPtr = containerPtr->nextPtr;
}
- ckfree((char *) containerPtr);
+ ckfree(containerPtr);
}
}
diff --git a/win/tkWinFont.c b/win/tkWinFont.c
index f209716..9172b00 100644
--- a/win/tkWinFont.c
+++ b/win/tkWinFont.c
@@ -33,7 +33,7 @@
typedef struct FontFamily {
struct FontFamily *nextPtr; /* Next in list of all known font families. */
- int refCount; /* How many SubFonts are referring to this
+ size_t refCount; /* How many SubFonts are referring to this
* FontFamily. When the refCount drops to
* zero, this FontFamily may be freed. */
/*
@@ -50,7 +50,7 @@ typedef struct FontFamily {
int isSymbolFont; /* Non-zero if this is a symbol font. */
int isWideFont; /* 1 if this is a double-byte font, 0
* otherwise. */
- BOOL (WINAPI *textOutProc)(HDC, int, int, TCHAR *, int);
+ BOOL (WINAPI *textOutProc)(HDC hdc, int x, int y, TCHAR *str, int len);
/* The procedure to use to draw text after it
* has been converted from UTF-8 to the
* encoding of this font. */
@@ -94,10 +94,12 @@ typedef struct FontFamily {
typedef struct SubFont {
char **fontMap; /* Pointer to font map from the FontFamily,
* cached here to save a dereference. */
- HFONT hFont; /* The specific screen font that will be used
+ HFONT hFont0; /* The specific screen font that will be used
* when displaying/measuring chars belonging
* to the FontFamily. */
FontFamily *familyPtr; /* The FontFamily for this SubFont. */
+ HFONT hFontAngled;
+ double angle;
} SubFont;
/*
@@ -123,7 +125,6 @@ typedef struct WinFont {
* attributes. Usually points to
* staticSubFonts, but may point to malloced
* space if there are lots of SubFonts. */
-
HWND hwnd; /* Toplevel window of application that owns
* this font, used for getting HDC for
* offscreen measurements. */
@@ -172,7 +173,7 @@ typedef struct ThreadSpecificData {
* currently loaded. As screen fonts are
* loaded, this list grows to hold information
* about what characters exist in each font
- * family. */
+ * family. */
Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
@@ -189,40 +190,45 @@ static Tcl_Encoding systemEncoding;
static FontFamily * AllocFontFamily(HDC hdc, HFONT hFont, int base);
static SubFont * CanUseFallback(HDC hdc, WinFont *fontPtr,
- char *fallbackName, int ch,
+ const char *fallbackName, int ch,
SubFont **subFontPtrPtr);
static SubFont * CanUseFallbackWithAliases(HDC hdc, WinFont *fontPtr,
- char *faceName, int ch, Tcl_DString *nameTriedPtr,
+ const char *faceName, int ch,
+ Tcl_DString *nameTriedPtr,
SubFont **subFontPtrPtr);
-static int FamilyExists(HDC hdc, CONST char *faceName);
-static char * FamilyOrAliasExists(HDC hdc, CONST char *faceName);
+static int FamilyExists(HDC hdc, const char *faceName);
+static const char * FamilyOrAliasExists(HDC hdc, const char *faceName);
static SubFont * FindSubFontForChar(WinFont *fontPtr, int ch,
SubFont **subFontPtrPtr);
static void FontMapInsert(SubFont *subFontPtr, int ch);
static void FontMapLoadPage(SubFont *subFontPtr, int row);
static int FontMapLookup(SubFont *subFontPtr, int ch);
static void FreeFontFamily(FontFamily *familyPtr);
-static HFONT GetScreenFont(CONST TkFontAttributes *faPtr,
- CONST char *faceName, int pixelSize);
+static HFONT GetScreenFont(const TkFontAttributes *faPtr,
+ const char *faceName, int pixelSize,
+ double angle);
static void InitFont(Tk_Window tkwin, HFONT hFont,
int overstrike, WinFont *tkFontPtr);
-static void InitSubFont(HDC hdc, HFONT hFont, int base,
+static inline void InitSubFont(HDC hdc, HFONT hFont, int base,
SubFont *subFontPtr);
static int CreateNamedSystemLogFont(Tcl_Interp *interp,
- Tk_Window tkwin, CONST char* name,
+ Tk_Window tkwin, const char* name,
LOGFONT* logFontPtr);
static int CreateNamedSystemFont(Tcl_Interp *interp,
- Tk_Window tkwin, CONST char* name, HFONT hFont);
+ Tk_Window tkwin, const char* name, HFONT hFont);
static int LoadFontRanges(HDC hdc, HFONT hFont,
USHORT **startCount, USHORT **endCount,
int *symbolPtr);
static void MultiFontTextOut(HDC hdc, WinFont *fontPtr,
- CONST char *source, int numBytes, int x, int y);
+ const char *source, int numBytes, int x, int y,
+ double angle);
static void ReleaseFont(WinFont *fontPtr);
-static void ReleaseSubFont(SubFont *subFontPtr);
-static int SeenName(CONST char *name, Tcl_DString *dsPtr);
-static void SwapLong(PULONG p);
-static void SwapShort(USHORT *p);
+static inline void ReleaseSubFont(SubFont *subFontPtr);
+static int SeenName(const char *name, Tcl_DString *dsPtr);
+static inline HFONT SelectFont(HDC hdc, WinFont *fontPtr,
+ SubFont *subFontPtr, double angle);
+static inline void SwapLong(PULONG p);
+static inline void SwapShort(USHORT *p);
static int CALLBACK WinFontCanUseProc(ENUMLOGFONT *lfPtr,
NEWTEXTMETRIC *tmPtr, int fontType,
LPARAM lParam);
@@ -298,7 +304,7 @@ TkpFontPkgInit(
TkFont *
TkpGetNativeFont(
Tk_Window tkwin, /* For display where font will be used. */
- CONST char *name) /* Platform-specific font name. */
+ const char *name) /* Platform-specific font name. */
{
int object;
WinFont *fontPtr;
@@ -309,7 +315,7 @@ TkpGetNativeFont(
}
tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
- fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ fontPtr = ckalloc(sizeof(WinFont));
InitFont(tkwin, GetStockObject(object), 0, fontPtr);
return (TkFont *) fontPtr;
@@ -317,13 +323,13 @@ TkpGetNativeFont(
/*
*---------------------------------------------------------------------------
+ *
* CreateNamedSystemFont --
*
* This function registers a Windows logical font description with the Tk
* named font mechanism.
*
- * Side effects
- *
+ * Side effects:
* A new named font is added to the Tk font registry.
*
*---------------------------------------------------------------------------
@@ -333,12 +339,12 @@ static int
CreateNamedSystemLogFont(
Tcl_Interp *interp,
Tk_Window tkwin,
- CONST char* name,
- LOGFONTA* logFontPtr)
+ const char* name,
+ LOGFONT* logFontPtr)
{
HFONT hFont;
int r;
-
+
hFont = CreateFontIndirect(logFontPtr);
r = CreateNamedSystemFont(interp, tkwin, name, hFont);
DeleteObject((HGDIOBJ)hFont);
@@ -347,13 +353,13 @@ CreateNamedSystemLogFont(
/*
*---------------------------------------------------------------------------
- * CreateNamedSystemFont --
*
- * This function registers a Windows font with the Tk
- * named font mechanism.
+ * CreateNamedSystemFont --
*
- * Side effects
+ * This function registers a Windows font with the Tk named font
+ * mechanism.
*
+ * Side effects:
* A new named font is added to the Tk font registry.
*
*---------------------------------------------------------------------------
@@ -363,12 +369,12 @@ static int
CreateNamedSystemFont(
Tcl_Interp *interp,
Tk_Window tkwin,
- CONST char* name,
+ const char* name,
HFONT hFont)
{
WinFont winfont;
int r;
-
+
TkDeleteNamedFont(NULL, tkwin, name);
InitFont(tkwin, hFont, 0, &winfont);
r = TkCreateNamedFont(interp, tkwin, name, &winfont.font.fa);
@@ -378,16 +384,19 @@ CreateNamedSystemFont(
/*
*---------------------------------------------------------------------------
+ *
* TkWinSystemFonts --
*
* Create some platform specific named fonts that to give access to the
- * system fonts. These are all defined for the Windows desktop parameters.
+ * system fonts. These are all defined for the Windows desktop
+ * parameters.
*
*---------------------------------------------------------------------------
*/
void
-TkWinSetupSystemFonts(TkMainInfo *mainPtr)
+TkWinSetupSystemFonts(
+ TkMainInfo *mainPtr)
{
Tcl_Interp *interp;
Tk_Window tkwin;
@@ -401,14 +410,14 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr)
/* force this for now */
if (((TkWindow *) tkwin)->mainPtr == NULL) {
- ((TkWindow *) tkwin)->mainPtr = mainPtr;
+ ((TkWindow *) tkwin)->mainPtr = mainPtr;
}
/*
- * If this API call fails then we will fallback to setting these
- * named fonts from script in ttk/fonts.tcl. So far I've only
- * seen it fail when WINVER has been defined for a higher platform than
- * we are running on. (ie: WINVER=0x0600 and running on XP).
+ * If this API call fails then we will fallback to setting these named
+ * fonts from script in ttk/fonts.tcl. So far I've only seen it fail when
+ * WINVER has been defined for a higher platform than we are running on.
+ * (i.e. WINVER=0x0600 and running on XP).
*/
ZeroMemory(&ncMetrics, sizeof(ncMetrics));
@@ -416,26 +425,26 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr)
if (SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
sizeof(ncMetrics), &ncMetrics, 0)) {
CreateNamedSystemLogFont(interp, tkwin, "TkDefaultFont",
- &ncMetrics.lfMessageFont);
+ &ncMetrics.lfMessageFont);
CreateNamedSystemLogFont(interp, tkwin, "TkHeadingFont",
- &ncMetrics.lfMessageFont);
+ &ncMetrics.lfMessageFont);
CreateNamedSystemLogFont(interp, tkwin, "TkTextFont",
- &ncMetrics.lfMessageFont);
+ &ncMetrics.lfMessageFont);
CreateNamedSystemLogFont(interp, tkwin, "TkMenuFont",
- &ncMetrics.lfMenuFont);
+ &ncMetrics.lfMenuFont);
CreateNamedSystemLogFont(interp, tkwin, "TkTooltipFont",
- &ncMetrics.lfStatusFont);
+ &ncMetrics.lfStatusFont);
CreateNamedSystemLogFont(interp, tkwin, "TkCaptionFont",
- &ncMetrics.lfCaptionFont);
+ &ncMetrics.lfCaptionFont);
CreateNamedSystemLogFont(interp, tkwin, "TkSmallCaptionFont",
- &ncMetrics.lfSmCaptionFont);
+ &ncMetrics.lfSmCaptionFont);
}
iconMetrics.cbSize = sizeof(iconMetrics);
if (SystemParametersInfo(SPI_GETICONMETRICS, sizeof(iconMetrics),
&iconMetrics, 0)) {
CreateNamedSystemLogFont(interp, tkwin, "TkIconFont",
- &iconMetrics.lfFont);
+ &iconMetrics.lfFont);
}
/*
@@ -444,9 +453,9 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr)
*/
{
- LOGFONTA lfFixed = {
+ LOGFONT lfFixed = {
0, 0, 0, 0, FW_NORMAL, FALSE, FALSE, FALSE, DEFAULT_CHARSET,
- 0, 0, DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, ""
+ 0, 0, DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, TEXT("")
};
long pointSize, dpi;
HDC hdc = GetDC(NULL);
@@ -457,13 +466,13 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr)
CreateNamedSystemLogFont(interp, tkwin, "TkFixedFont", &lfFixed);
}
- /*
+ /*
* Setup the remaining standard Tk font names as named fonts.
*/
for (mapPtr = systemMap; mapPtr->strKey != NULL; mapPtr++) {
- hFont = (HFONT)GetStockObject(mapPtr->numKey);
- CreateNamedSystemFont(interp, tkwin, mapPtr->strKey, hFont);
+ hFont = (HFONT) GetStockObject(mapPtr->numKey);
+ CreateNamedSystemFont(interp, tkwin, mapPtr->strKey, hFont);
}
}
@@ -505,7 +514,7 @@ TkpGetFontFromAttributes(
* will be released. If NULL, a new TkFont
* structure is allocated. */
Tk_Window tkwin, /* For display where font will be used. */
- CONST TkFontAttributes *faPtr)
+ const TkFontAttributes *faPtr)
/* Set of attributes to match. */
{
int i, j;
@@ -514,7 +523,7 @@ TkpGetFontFromAttributes(
HFONT hFont;
Window window;
WinFont *fontPtr;
- char ***fontFallbacks;
+ const char *const *const *fontFallbacks;
Tk_Uid faceName, fallback, actualName;
tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
@@ -562,9 +571,9 @@ TkpGetFontFromAttributes(
ReleaseDC(hwnd, hdc);
hFont = GetScreenFont(faPtr, faceName,
- TkFontGetPixels(tkwin, faPtr->size));
+ TkFontGetPixels(tkwin, faPtr->size), 0.0);
if (tkFontPtr == NULL) {
- fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ fontPtr = ckalloc(sizeof(WinFont));
} else {
fontPtr = (WinFont *) tkFontPtr;
ReleaseFont(fontPtr);
@@ -629,10 +638,12 @@ TkpGetFontFamilies(
HDC hdc;
HWND hwnd;
Window window;
+ Tcl_Obj *resultObj;
window = Tk_WindowId(tkwin);
hwnd = (window == None) ? NULL : TkWinGetHWND(window);
hdc = GetDC(hwnd);
+ resultObj = Tcl_NewObj();
/*
* On any version NT, there may fonts with international names. Use the
@@ -649,14 +660,10 @@ TkpGetFontFamilies(
* because it only exists under NT.
*/
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc,
- (LPARAM) interp);
- } else {
- EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc,
- (LPARAM) interp);
- }
+ EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontFamilyEnumProc,
+ (LPARAM) resultObj);
ReleaseDC(hwnd, hdc);
+ Tcl_SetObjResult(interp, resultObj);
}
static int CALLBACK
@@ -666,17 +673,13 @@ WinFontFamilyEnumProc(
int fontType, /* Type of font (not used). */
LPARAM lParam) /* Result object to hold result. */
{
- char *faceName;
+ char *faceName = (char *) lfPtr->elfLogFont.lfFaceName;
+ Tcl_Obj *resultObj = (Tcl_Obj *) lParam;
Tcl_DString faceString;
- Tcl_Obj *strPtr;
- Tcl_Interp *interp;
- interp = (Tcl_Interp *) lParam;
- faceName = lfPtr->elfLogFont.lfFaceName;
Tcl_ExternalToUtfDString(systemEncoding, faceName, -1, &faceString);
- strPtr = Tcl_NewStringObj(Tcl_DStringValue(&faceString),
- Tcl_DStringLength(&faceString));
- Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_DStringValue(&faceString), Tcl_DStringLength(&faceString)));
Tcl_DStringFree(&faceString);
return 1;
}
@@ -709,13 +712,14 @@ TkpGetSubFonts(
FontFamily *familyPtr;
Tcl_Obj *resultPtr, *strPtr;
- resultPtr = Tcl_GetObjResult(interp);
+ resultPtr = Tcl_NewObj();
fontPtr = (WinFont *) tkfont;
for (i = 0; i < fontPtr->numSubFonts; i++) {
familyPtr = fontPtr->subFontArray[i].familyPtr;
strPtr = Tcl_NewStringObj(familyPtr->faceName, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
+ Tcl_SetObjResult(interp, resultPtr);
}
/*
@@ -740,7 +744,7 @@ TkpGetFontAttrsForChar(
Tk_Window tkwin, /* Window on the font's display */
Tk_Font tkfont, /* Font to query */
Tcl_UniChar c, /* Character of interest */
- TkFontAttributes* faPtr) /* Output: Font attributes */
+ TkFontAttributes *faPtr) /* Output: Font attributes */
{
WinFont *fontPtr = (WinFont *) tkfont;
/* Structure describing the logical font */
@@ -748,22 +752,22 @@ TkpGetFontAttrsForChar(
/* GDI device context */
SubFont *lastSubFontPtr = &fontPtr->subFontArray[0];
/* Pointer to subfont array in case
- * FindSubFontForChar needs to fix up
- * the memory allocation */
- SubFont *thisSubFontPtr = FindSubFontForChar(fontPtr, c,
- &lastSubFontPtr);
- /* Pointer to the subfont to use for
- * the given character */
+ * FindSubFontForChar needs to fix up the
+ * memory allocation */
+ SubFont *thisSubFontPtr =
+ FindSubFontForChar(fontPtr, c, &lastSubFontPtr);
+ /* Pointer to the subfont to use for the given
+ * character */
FontFamily *familyPtr = thisSubFontPtr->familyPtr;
HFONT oldfont; /* Saved font from the device context */
- TEXTMETRIC tm; /* Font metrics of the selected subfont */
+ TEXTMETRICA tm; /* Font metrics of the selected subfont */
/*
* Get the font attributes.
*/
- oldfont = SelectObject(hdc, thisSubFontPtr->hFont);
- GetTextMetrics(hdc, &tm);
+ oldfont = SelectObject(hdc, thisSubFontPtr->hFont0);
+ GetTextMetricsA(hdc, &tm);
SelectObject(hdc, oldfont);
ReleaseDC(fontPtr->hwnd, hdc);
faPtr->family = familyPtr->faceName;
@@ -778,7 +782,7 @@ TkpGetFontAttrsForChar(
/*
*---------------------------------------------------------------------------
*
- * Tk_MeasureChars --
+ * Tk_MeasureChars --
*
* Determine the number of bytes from the string that will fit in the
* given horizontal span. The measurement is done under the assumption
@@ -798,7 +802,7 @@ TkpGetFontAttrsForChar(
int
Tk_MeasureChars(
Tk_Font tkfont, /* Font in which characters will be drawn. */
- CONST char *source, /* UTF-8 string to be displayed. Need not be
+ const char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. */
int numBytes, /* Maximum number of bytes to consider from
* source string. */
@@ -829,7 +833,7 @@ Tk_MeasureChars(
FontFamily *familyPtr;
Tcl_DString runString;
SubFont *thisSubFontPtr, *lastSubFontPtr;
- CONST char *p, *end, *next = NULL, *start;
+ const char *p, *end, *next = NULL, *start;
if (numBytes == 0) {
*lengthPtr = 0;
@@ -840,7 +844,7 @@ Tk_MeasureChars(
hdc = GetDC(fontPtr->hwnd);
lastSubFontPtr = &fontPtr->subFontArray[0];
- oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont0);
/*
* A three step process:
@@ -862,8 +866,8 @@ Tk_MeasureChars(
Tcl_UtfToExternalDString(familyPtr->encoding, start,
(int) (p - start), &runString);
size.cx = 0;
- (*familyPtr->getTextExtentPoint32Proc)(hdc,
- Tcl_DStringValue(&runString),
+ familyPtr->getTextExtentPoint32Proc(hdc,
+ (TCHAR *)Tcl_DStringValue(&runString),
Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
&size);
Tcl_DStringFree(&runString);
@@ -875,7 +879,7 @@ Tk_MeasureChars(
lastSubFontPtr = thisSubFontPtr;
start = p;
- SelectObject(hdc, lastSubFontPtr->hFont);
+ SelectObject(hdc, lastSubFontPtr->hFont0);
}
p = next;
}
@@ -890,8 +894,7 @@ Tk_MeasureChars(
Tcl_UtfToExternalDString(familyPtr->encoding, start,
(int) (p - start), &runString);
size.cx = 0;
- (*familyPtr->getTextExtentPoint32Proc)(hdc,
- Tcl_DStringValue(&runString),
+ familyPtr->getTextExtentPoint32Proc(hdc, (TCHAR *) Tcl_DStringValue(&runString),
Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
&size);
Tcl_DStringFree(&runString);
@@ -924,8 +927,8 @@ Tk_MeasureChars(
&dstWrote, NULL);
Tcl_DStringAppend(&runString,buf,dstWrote);
size.cx = 0;
- (*familyPtr->getTextExtentPoint32Proc)(hdc,
- Tcl_DStringValue(&runString),
+ familyPtr->getTextExtentPoint32Proc(hdc,
+ (TCHAR *) Tcl_DStringValue(&runString),
Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
&size);
if ((curX+size.cx) > maxLength) {
@@ -966,7 +969,7 @@ Tk_MeasureChars(
* procedure without the maxLength limit or any flags.
*/
- CONST char *lastWordBreak = NULL;
+ const char *lastWordBreak = NULL;
Tcl_UniChar ch2;
end = p;
@@ -1000,7 +1003,7 @@ Tk_MeasureChars(
/*
*---------------------------------------------------------------------------
*
- * TkpMeasureCharsInContext --
+ * TkpMeasureCharsInContext --
*
* Determine the number of bytes from the string that will fit in the
* given horizontal span. The measurement is done under the assumption
@@ -1025,7 +1028,7 @@ Tk_MeasureChars(
int
TkpMeasureCharsInContext(
Tk_Font tkfont, /* Font in which characters will be drawn. */
- CONST char *source, /* UTF-8 string to be displayed. Need not be
+ const char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. */
int numBytes, /* Maximum number of bytes to consider from
* source string in all. */
@@ -1077,7 +1080,7 @@ Tk_DrawChars(
GC gc, /* Graphics context for drawing characters. */
Tk_Font tkfont, /* Font in which characters will be drawn;
* must be the same as font used in GC. */
- CONST char *source, /* UTF-8 string to be displayed. Need not be
+ const char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
@@ -1104,18 +1107,18 @@ Tk_DrawChars(
SetROP2(dc, tkpWinRopModes[gc->function]);
if ((gc->clip_mask != None) &&
- ((TkpClipMask*)gc->clip_mask)->type == TKP_CLIP_REGION) {
- SelectClipRgn(dc, (HRGN)((TkpClipMask*)gc->clip_mask)->value.region);
+ ((TkpClipMask *) gc->clip_mask)->type == TKP_CLIP_REGION) {
+ SelectClipRgn(dc, (HRGN)((TkpClipMask *)gc->clip_mask)->value.region);
}
if ((gc->fill_style == FillStippled
|| gc->fill_style == FillOpaqueStippled)
&& gc->stipple != None) {
- TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple;
+ TkWinDrawable *twdPtr = (TkWinDrawable *) gc->stipple;
HBRUSH oldBrush, stipple;
HBITMAP oldBitmap, bitmap;
HDC dcMem;
- TEXTMETRIC tm;
+ TEXTMETRICA tm;
SIZE size;
if (twdPtr->type != TWD_BITMAP) {
@@ -1141,8 +1144,8 @@ Tk_DrawChars(
* Compute the bounding box and create a compatible bitmap.
*/
- GetTextExtentPoint(dcMem, source, numBytes, &size);
- GetTextMetrics(dcMem, &tm);
+ GetTextExtentPointA(dcMem, source, numBytes, &size);
+ GetTextMetricsA(dcMem, &tm);
size.cx -= tm.tmOverhang;
bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
oldBitmap = SelectObject(dcMem, bitmap);
@@ -1156,11 +1159,11 @@ Tk_DrawChars(
*/
PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
- MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y, 0.0);
BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
0, 0, 0xEA02E9);
PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS);
- MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y, 0.0);
BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
0, 0, 0x8A0E06);
@@ -1177,11 +1180,11 @@ Tk_DrawChars(
SetTextAlign(dc, TA_LEFT | TA_BASELINE);
SetTextColor(dc, gc->foreground);
SetBkMode(dc, TRANSPARENT);
- MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y, 0.0);
} else {
HBITMAP oldBitmap, bitmap;
HDC dcMem;
- TEXTMETRIC tm;
+ TEXTMETRICA tm;
SIZE size;
dcMem = CreateCompatibleDC(dc);
@@ -1195,13 +1198,14 @@ Tk_DrawChars(
* Compute the bounding box and create a compatible bitmap.
*/
- GetTextExtentPoint(dcMem, source, numBytes, &size);
- GetTextMetrics(dcMem, &tm);
+ GetTextExtentPointA(dcMem, source, numBytes, &size);
+ GetTextMetricsA(dcMem, &tm);
size.cx -= tm.tmOverhang;
bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
oldBitmap = SelectObject(dcMem, bitmap);
- MultiFontTextOut(dcMem, fontPtr, source, numBytes, 0, tm.tmAscent);
+ MultiFontTextOut(dcMem, fontPtr, source, numBytes, 0, tm.tmAscent,
+ 0.0);
BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
0, 0, (DWORD) tkpWinBltModes[gc->function]);
@@ -1216,6 +1220,154 @@ Tk_DrawChars(
TkWinReleaseDrawableDC(drawable, dc, &state);
}
+void
+TkDrawAngledChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for drawing characters. */
+ Tk_Font tkfont, /* Font in which characters will be drawn;
+ * must be the same as font used in GC. */
+ const char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. All Tk meta-characters
+ * (tabs, control characters, and newlines)
+ * should be stripped out of the string that
+ * is passed to this function. If they are not
+ * stripped out, they will be displayed as
+ * regular printing characters. */
+ int numBytes, /* Number of bytes in string. */
+ double x, double y, /* Coordinates at which to place origin of
+ * string when drawing. */
+ double angle)
+{
+ HDC dc;
+ WinFont *fontPtr;
+ TkWinDCState state;
+
+ fontPtr = (WinFont *) gc->font;
+ display->request++;
+
+ if (drawable == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, drawable, &state);
+
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+
+ if ((gc->clip_mask != None) &&
+ ((TkpClipMask *) gc->clip_mask)->type == TKP_CLIP_REGION) {
+ SelectClipRgn(dc, (HRGN)((TkpClipMask *)gc->clip_mask)->value.region);
+ }
+
+ if ((gc->fill_style == FillStippled
+ || gc->fill_style == FillOpaqueStippled)
+ && gc->stipple != None) {
+ TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple;
+ HBRUSH oldBrush, stipple;
+ HBITMAP oldBitmap, bitmap;
+ HDC dcMem;
+ TEXTMETRICA tm;
+ SIZE size;
+
+ if (twdPtr->type != TWD_BITMAP) {
+ Tcl_Panic("unexpected drawable type in stipple");
+ }
+
+ /*
+ * Select stipple pattern into destination dc.
+ */
+
+ dcMem = CreateCompatibleDC(dc);
+
+ stipple = CreatePatternBrush(twdPtr->bitmap.handle);
+ SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
+ oldBrush = SelectObject(dc, stipple);
+
+ SetTextAlign(dcMem, TA_LEFT | TA_BASELINE);
+ SetTextColor(dcMem, gc->foreground);
+ SetBkMode(dcMem, TRANSPARENT);
+ SetBkColor(dcMem, RGB(0, 0, 0));
+
+ /*
+ * Compute the bounding box and create a compatible bitmap.
+ */
+
+ GetTextExtentPointA(dcMem, source, numBytes, &size);
+ GetTextMetricsA(dcMem, &tm);
+ size.cx -= tm.tmOverhang;
+ bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
+ oldBitmap = SelectObject(dcMem, bitmap);
+
+ /*
+ * The following code is tricky because fonts are rendered in multiple
+ * colors. First we draw onto a black background and copy the white
+ * bits. Then we draw onto a white background and copy the black bits.
+ * Both the foreground and background bits of the font are ANDed with
+ * the stipple pattern as they are copied.
+ */
+
+ PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, (int)x, (int)y, angle);
+ BitBlt(dc, (int)x, (int)y - tm.tmAscent, size.cx, size.cy, dcMem,
+ 0, 0, 0xEA02E9);
+ PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, (int)x, (int)y, angle);
+ BitBlt(dc, (int)x, (int)y - tm.tmAscent, size.cx, size.cy, dcMem,
+ 0, 0, 0x8A0E06);
+
+ /*
+ * Destroy the temporary bitmap and restore the device context.
+ */
+
+ SelectObject(dcMem, oldBitmap);
+ DeleteObject(bitmap);
+ DeleteDC(dcMem);
+ SelectObject(dc, oldBrush);
+ DeleteObject(stipple);
+ } else if (gc->function == GXcopy) {
+ SetTextAlign(dc, TA_LEFT | TA_BASELINE);
+ SetTextColor(dc, gc->foreground);
+ SetBkMode(dc, TRANSPARENT);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, (int)x, (int)y, angle);
+ } else {
+ HBITMAP oldBitmap, bitmap;
+ HDC dcMem;
+ TEXTMETRICA tm;
+ SIZE size;
+
+ dcMem = CreateCompatibleDC(dc);
+
+ SetTextAlign(dcMem, TA_LEFT | TA_BASELINE);
+ SetTextColor(dcMem, gc->foreground);
+ SetBkMode(dcMem, TRANSPARENT);
+ SetBkColor(dcMem, RGB(0, 0, 0));
+
+ /*
+ * Compute the bounding box and create a compatible bitmap.
+ */
+
+ GetTextExtentPointA(dcMem, source, numBytes, &size);
+ GetTextMetricsA(dcMem, &tm);
+ size.cx -= tm.tmOverhang;
+ bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
+ oldBitmap = SelectObject(dcMem, bitmap);
+
+ MultiFontTextOut(dcMem, fontPtr, source, numBytes, 0, tm.tmAscent,
+ angle);
+ BitBlt(dc, (int)x, (int)y - tm.tmAscent, size.cx, size.cy, dcMem,
+ 0, 0, (DWORD) tkpWinBltModes[gc->function]);
+
+ /*
+ * Destroy the temporary bitmap and restore the device context.
+ */
+
+ SelectObject(dcMem, oldBitmap);
+ DeleteObject(bitmap);
+ DeleteDC(dcMem);
+ }
+ TkWinReleaseDrawableDC(drawable, dc, &state);
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -1241,7 +1393,7 @@ TkpDrawCharsInContext(
GC gc, /* Graphics context for drawing characters. */
Tk_Font tkfont, /* Font in which characters will be drawn;
* must be the same as font used in GC. */
- CONST char *source, /* UTF-8 string to be displayed. Need not be
+ const char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
@@ -1256,8 +1408,8 @@ TkpDrawCharsInContext(
* drawing. */
{
(void) numBytes; /*unused*/
- Tk_DrawChars(display, drawable, gc, tkfont,
- source + rangeStart, rangeLength, x, y);
+ Tk_DrawChars(display, drawable, gc, tkfont, source + rangeStart,
+ rangeLength, x, y);
}
/*
@@ -1285,23 +1437,24 @@ MultiFontTextOut(
HDC hdc, /* HDC to draw into. */
WinFont *fontPtr, /* Contains set of fonts to use when drawing
* following string. */
- CONST char *source, /* Potentially multilingual UTF-8 string. */
+ const char *source, /* Potentially multilingual UTF-8 string. */
int numBytes, /* Length of string in bytes. */
- int x, int y) /* Coordinates at which to place origin of
+ int x, int y, /* Coordinates at which to place origin of
* string when drawing. */
+ double angle)
{
Tcl_UniChar ch;
SIZE size;
HFONT oldFont;
FontFamily *familyPtr;
Tcl_DString runString;
- CONST char *p, *end, *next;
+ const char *p, *end, *next;
SubFont *lastSubFontPtr, *thisSubFontPtr;
- TEXTMETRIC tm;
+ TEXTMETRICA tm;
lastSubFontPtr = &fontPtr->subFontArray[0];
- oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
- GetTextMetrics(hdc, &tm);
+ oldFont = SelectFont(hdc, fontPtr, lastSubFontPtr, angle);
+ GetTextMetricsA(hdc, &tm);
end = source + numBytes;
for (p = source; p < end; ) {
@@ -1312,11 +1465,11 @@ MultiFontTextOut(
familyPtr = lastSubFontPtr->familyPtr;
Tcl_UtfToExternalDString(familyPtr->encoding, source,
(int) (p - source), &runString);
- (*familyPtr->textOutProc)(hdc, x-(tm.tmOverhang/2), y,
- Tcl_DStringValue(&runString),
+ familyPtr->textOutProc(hdc, x-(tm.tmOverhang/2), y,
+ (TCHAR *)Tcl_DStringValue(&runString),
Tcl_DStringLength(&runString)>>familyPtr->isWideFont);
- (*familyPtr->getTextExtentPoint32Proc)(hdc,
- Tcl_DStringValue(&runString),
+ familyPtr->getTextExtentPoint32Proc(hdc,
+ (TCHAR *)Tcl_DStringValue(&runString),
Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
&size);
x += size.cx;
@@ -1324,8 +1477,8 @@ MultiFontTextOut(
}
lastSubFontPtr = thisSubFontPtr;
source = p;
- SelectObject(hdc, lastSubFontPtr->hFont);
- GetTextMetrics(hdc, &tm);
+ SelectFont(hdc, fontPtr, lastSubFontPtr, angle);
+ GetTextMetricsA(hdc, &tm);
}
p = next;
}
@@ -1333,13 +1486,38 @@ MultiFontTextOut(
familyPtr = lastSubFontPtr->familyPtr;
Tcl_UtfToExternalDString(familyPtr->encoding, source,
(int) (p - source), &runString);
- (*familyPtr->textOutProc)(hdc, x-(tm.tmOverhang/2), y,
- Tcl_DStringValue(&runString),
+ familyPtr->textOutProc(hdc, x-(tm.tmOverhang/2), y,
+ (TCHAR *)Tcl_DStringValue(&runString),
Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
Tcl_DStringFree(&runString);
}
SelectObject(hdc, oldFont);
}
+
+static inline HFONT
+SelectFont(
+ HDC hdc,
+ WinFont *fontPtr,
+ SubFont *subFontPtr,
+ double angle)
+{
+ if (angle == 0.0) {
+ return SelectObject(hdc, subFontPtr->hFont0);
+ } else if (angle == subFontPtr->angle) {
+ return SelectObject(hdc, subFontPtr->hFontAngled);
+ } else {
+ if (subFontPtr->hFontAngled) {
+ DeleteObject(subFontPtr->hFontAngled);
+ }
+ subFontPtr->hFontAngled = GetScreenFont(&fontPtr->font.fa,
+ subFontPtr->familyPtr->faceName, fontPtr->pixelSize, angle);
+ if (subFontPtr->hFontAngled == NULL) {
+ return SelectObject(hdc, subFontPtr->hFont0);
+ }
+ subFontPtr->angle = angle;
+ return SelectObject(hdc, subFontPtr->hFontAngled);
+ }
+}
/*
*---------------------------------------------------------------------------
@@ -1378,20 +1556,20 @@ InitFont(
HDC hdc;
HWND hwnd;
HFONT oldFont;
- TEXTMETRIC tm;
+ TEXTMETRICA tm;
Window window;
TkFontMetrics *fmPtr;
Tcl_Encoding encoding;
Tcl_DString faceString;
TkFontAttributes *faPtr;
- char buf[LF_FACESIZE * sizeof(WCHAR)];
+ TCHAR buf[LF_FACESIZE];
window = Tk_WindowId(tkwin);
hwnd = (window == None) ? NULL : TkWinGetHWND(window);
hdc = GetDC(hwnd);
oldFont = SelectObject(hdc, hFont);
- GetTextMetrics(hdc, &tm);
+ GetTextMetricsA(hdc, &tm);
/*
* On any version NT, there may fonts with international names. Use the
@@ -1408,12 +1586,8 @@ InitFont(
* GetTextFace because it only exists under NT.
*/
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
- } else {
- GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
- }
- Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
+ GetTextFace(hdc, LF_FACESIZE, buf);
+ Tcl_ExternalToUtfDString(systemEncoding, (char *) buf, -1, &faceString);
fontPtr->font.fid = (Font) fontPtr;
fontPtr->hwnd = hwnd;
@@ -1423,7 +1597,7 @@ InitFont(
faPtr->family = Tk_GetUid(Tcl_DStringValue(&faceString));
faPtr->size =
- TkFontGetPoints(tkwin, -(fontPtr->pixelSize));
+ TkFontGetPoints(tkwin, -(fontPtr->pixelSize));
faPtr->weight =
(tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL;
faPtr->slant = (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN;
@@ -1442,7 +1616,7 @@ InitFont(
encoding = fontPtr->subFontArray[0].familyPtr->encoding;
if (encoding == TkWinGetUnicodeEncoding()) {
- GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ GetCharWidth(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
} else {
GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
}
@@ -1479,7 +1653,7 @@ ReleaseFont(
ReleaseSubFont(&fontPtr->subFontArray[i]);
}
if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
- ckfree((char *) fontPtr->subFontArray);
+ ckfree(fontPtr->subFontArray);
}
}
@@ -1501,7 +1675,7 @@ ReleaseFont(
*-------------------------------------------------------------------------
*/
-static void
+static inline void
InitSubFont(
HDC hdc, /* HDC in which font can be selected. */
HFONT hFont, /* The screen font. */
@@ -1510,9 +1684,11 @@ InitSubFont(
SubFont *subFontPtr) /* Filled with SubFont constructed from above
* attributes. */
{
- subFontPtr->hFont = hFont;
+ subFontPtr->hFont0 = hFont;
subFontPtr->familyPtr = AllocFontFamily(hdc, hFont, base);
subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
+ subFontPtr->hFontAngled = NULL;
+ subFontPtr->angle = 0.0;
}
/*
@@ -1532,11 +1708,14 @@ InitSubFont(
*---------------------------------------------------------------------------
*/
-static void
+static inline void
ReleaseSubFont(
SubFont *subFontPtr) /* The SubFont to delete. */
{
- DeleteObject(subFontPtr->hFont);
+ DeleteObject(subFontPtr->hFont0);
+ if (subFontPtr->hFontAngled) {
+ DeleteObject(subFontPtr->hFontAngled);
+ }
FreeFontFamily(subFontPtr->familyPtr);
}
@@ -1579,17 +1758,13 @@ AllocFontFamily(
FontFamily *familyPtr;
Tcl_DString faceString;
Tcl_Encoding encoding;
- char buf[LF_FACESIZE * sizeof(WCHAR)];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TCHAR buf[LF_FACESIZE];
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
hFont = SelectObject(hdc, hFont);
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
- } else {
- GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
- }
- Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
+ GetTextFace(hdc, LF_FACESIZE, buf);
+ Tcl_ExternalToUtfDString(systemEncoding, (char *) buf, -1, &faceString);
faceName = Tk_GetUid(Tcl_DStringValue(&faceString));
Tcl_DStringFree(&faceString);
hFont = SelectObject(hdc, hFont);
@@ -1602,7 +1777,7 @@ AllocFontFamily(
}
}
- familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ familyPtr = ckalloc(sizeof(FontFamily));
memset(familyPtr, 0, sizeof(FontFamily));
familyPtr->nextPtr = tsdPtr->fontFamilyList;
tsdPtr->fontFamilyList = familyPtr;
@@ -1688,14 +1863,13 @@ FreeFontFamily(
{
int i;
FontFamily **familyPtrPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (familyPtr == NULL) {
return;
}
- familyPtr->refCount--;
- if (familyPtr->refCount > 0) {
+ if (familyPtr->refCount-- > 1) {
return;
}
for (i = 0; i < FONTMAP_PAGES; i++) {
@@ -1704,10 +1878,10 @@ FreeFontFamily(
}
}
if (familyPtr->startCount != NULL) {
- ckfree((char *) familyPtr->startCount);
+ ckfree(familyPtr->startCount);
}
if (familyPtr->endCount != NULL) {
- ckfree((char *) familyPtr->endCount);
+ ckfree(familyPtr->endCount);
}
if (familyPtr->encoding != TkWinGetUnicodeEncoding()) {
Tcl_FreeEncoding(familyPtr->encoding);
@@ -1719,13 +1893,13 @@ FreeFontFamily(
for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
if (*familyPtrPtr == familyPtr) {
- *familyPtrPtr = familyPtr->nextPtr;
+ *familyPtrPtr = familyPtr->nextPtr;
break;
}
familyPtrPtr = &(*familyPtrPtr)->nextPtr;
}
- ckfree((char *) familyPtr);
+ ckfree(familyPtr);
}
/*
@@ -1759,9 +1933,10 @@ FindSubFontForChar(
HDC hdc;
int i, j, k;
CanUse canUse;
- char **aliases, **anyFallbacks;
- char ***fontFallbacks;
- char *fallbackName;
+ const char *const *aliases;
+ const char *const *anyFallbacks;
+ const char *const *const *fontFallbacks;
+ const char *fallbackName;
SubFont *subFontPtr;
Tcl_DString ds;
@@ -1850,13 +2025,8 @@ FindSubFontForChar(
canUse.ch = ch;
canUse.subFontPtr = NULL;
canUse.subFontPtrPtr = subFontPtrPtr;
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc,
- (LPARAM) &canUse);
- } else {
- EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontCanUseProc,
- (LPARAM) &canUse);
- }
+ EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontCanUseProc,
+ (LPARAM) &canUse);
subFontPtr = canUse.subFontPtr;
end:
@@ -1864,7 +2034,7 @@ FindSubFontForChar(
if (subFontPtr == NULL) {
/*
- * No font can display this character. We will use the base font and
+ * No font can display this character. We will use the base font and
* have it display the "unknown" character.
*/
@@ -1897,7 +2067,7 @@ WinFontCanUseProc(
fontPtr = canUsePtr->fontPtr;
nameTriedPtr = canUsePtr->nameTriedPtr;
- fallbackName = lfPtr->elfLogFont.lfFaceName;
+ fallbackName = (char *) lfPtr->elfLogFont.lfFaceName;
Tcl_ExternalToUtfDString(systemEncoding, fallbackName, -1, &faceString);
fallbackName = Tcl_DStringValue(&faceString);
@@ -2022,7 +2192,7 @@ FontMapLoadPage(
USHORT *startCount, *endCount;
int i, j, bitOffset, end, segCount;
- subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ subFontPtr->fontMap[row] = ckalloc(FONTMAP_BITSPERPAGE / 8);
memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
familyPtr = subFontPtr->familyPtr;
@@ -2046,7 +2216,8 @@ FontMapLoadPage(
if (endCount[j] >= i) {
if (startCount[j] <= i) {
bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
- subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ subFontPtr->fontMap[row][bitOffset >> 3] |=
+ 1 << (bitOffset & 7);
}
break;
}
@@ -2104,7 +2275,7 @@ CanUseFallbackWithAliases(
HDC hdc, /* HDC in which font can be selected. */
WinFont *fontPtr, /* The font object that will own the new
* screen font. */
- char *faceName, /* Desired face name for new screen font. */
+ const char *faceName, /* Desired face name for new screen font. */
int ch, /* The Unicode character that the new screen
* font must be able to display. */
Tcl_DString *nameTriedPtr, /* Records face names that have already been
@@ -2115,7 +2286,7 @@ CanUseFallbackWithAliases(
* array of subfonts. */
{
int i;
- char **aliases;
+ const char *const *aliases;
SubFont *subFontPtr;
if (SeenName(faceName, nameTriedPtr) == 0) {
@@ -2160,11 +2331,11 @@ CanUseFallbackWithAliases(
static int
SeenName(
- CONST char *name, /* The name to check. */
+ const char *name, /* The name to check. */
Tcl_DString *dsPtr) /* Contains names that have already been
* seen. */
{
- CONST char *seen, *end;
+ const char *seen, *end;
seen = Tcl_DStringValue(dsPtr);
end = seen + Tcl_DStringLength(dsPtr);
@@ -2174,7 +2345,7 @@ SeenName(
}
seen += strlen(seen) + 1;
}
- Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ Tcl_DStringAppend(dsPtr, name, (int) (strlen(name) + 1));
return 0;
}
@@ -2207,7 +2378,7 @@ CanUseFallback(
HDC hdc, /* HDC in which font can be selected. */
WinFont *fontPtr, /* The font object that will own the new
* screen font. */
- char *faceName, /* Desired face name for new screen font. */
+ const char *faceName, /* Desired face name for new screen font. */
int ch, /* The Unicode character that the new screen
* font must be able to display. */
SubFont **subFontPtrPtr) /* Variable to fix-up if we realloc the array
@@ -2235,7 +2406,8 @@ CanUseFallback(
* Load this font and see if it has the desired character.
*/
- hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize);
+ hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize,
+ 0.0);
InitSubFont(hdc, hFont, 0, &subFont);
if (((ch < 256) && (subFont.familyPtr->isSymbolFont))
|| (FontMapLookup(&subFont, ch) == 0)) {
@@ -2251,12 +2423,11 @@ CanUseFallback(
if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
SubFont *newPtr;
- newPtr = (SubFont *) ckalloc(sizeof(SubFont)
- * (fontPtr->numSubFonts + 1));
- memcpy((char *) newPtr, fontPtr->subFontArray,
+ newPtr = ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1));
+ memcpy(newPtr, fontPtr->subFontArray,
fontPtr->numSubFonts * sizeof(SubFont));
if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
- ckfree((char *) fontPtr->subFontArray);
+ ckfree(fontPtr->subFontArray);
}
/*
@@ -2291,22 +2462,24 @@ CanUseFallback(
static HFONT
GetScreenFont(
- CONST TkFontAttributes *faPtr,
+ const TkFontAttributes *faPtr,
/* Desired font attributes for new HFONT. */
- CONST char *faceName, /* Overrides font family specified in font
+ const char *faceName, /* Overrides font family specified in font
* attributes. */
- int pixelSize) /* Overrides size specified in font
+ int pixelSize, /* Overrides size specified in font
* attributes. */
+ double angle) /* What is the desired orientation of the
+ * font. */
{
Tcl_DString ds;
HFONT hFont;
- LOGFONTW lf;
+ LOGFONT lf;
memset(&lf, 0, sizeof(lf));
lf.lfHeight = -pixelSize;
lf.lfWidth = 0;
- lf.lfEscapement = 0;
- lf.lfOrientation = 0;
+ lf.lfEscapement = ROUND16(angle * 10);
+ lf.lfOrientation = ROUND16(angle * 10);
lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
lf.lfItalic = faPtr->slant;
lf.lfUnderline = faPtr->underline;
@@ -2318,36 +2491,10 @@ GetScreenFont(
lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds);
-
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- Tcl_UniChar *src, *dst;
-
- /*
- * We can only store up to LF_FACESIZE wide characters
- */
-
- if ((size_t)Tcl_DStringLength(&ds) >= (LF_FACESIZE * sizeof(WCHAR))) {
- Tcl_DStringSetLength(&ds, LF_FACESIZE);
- }
- src = (Tcl_UniChar *) Tcl_DStringValue(&ds);
- dst = (Tcl_UniChar *) lf.lfFaceName;
- while (*src != '\0') {
- *dst++ = *src++;
- }
- *dst = '\0';
- hFont = CreateFontIndirectW(&lf);
- } else {
- /*
- * We can only store up to LF_FACESIZE characters
- */
-
- if (Tcl_DStringLength(&ds) >= LF_FACESIZE) {
- Tcl_DStringSetLength(&ds, LF_FACESIZE);
- }
- strcpy((char *) lf.lfFaceName, Tcl_DStringValue(&ds));
- hFont = CreateFontIndirectA((LOGFONTA *) &lf);
- }
+ _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds), LF_FACESIZE-1);
Tcl_DStringFree(&ds);
+ lf.lfFaceName[LF_FACESIZE-1] = 0;
+ hFont = CreateFontIndirect(&lf);
return hFont;
}
@@ -2373,7 +2520,7 @@ GetScreenFont(
static int
FamilyExists(
HDC hdc, /* HDC in which font family will be used. */
- CONST char *faceName) /* Font family to query. */
+ const char *faceName) /* Font family to query. */
{
int result;
Tcl_DString faceString;
@@ -2403,27 +2550,22 @@ FamilyExists(
* non-zero value.
*/
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- result = EnumFontFamiliesW(hdc, (WCHAR*) Tcl_DStringValue(&faceString),
- (FONTENUMPROCW) WinFontExistProc, 0);
- } else {
- result = EnumFontFamiliesA(hdc, (char *) Tcl_DStringValue(&faceString),
- (FONTENUMPROCA) WinFontExistProc, 0);
- }
+ result = EnumFontFamilies(hdc, (TCHAR*) Tcl_DStringValue(&faceString),
+ (FONTENUMPROC) WinFontExistProc, 0);
Tcl_DStringFree(&faceString);
return (result == 0);
}
-static char *
+static const char *
FamilyOrAliasExists(
HDC hdc,
- CONST char *faceName)
+ const char *faceName)
{
- char **aliases;
+ const char *const *aliases;
int i;
if (FamilyExists(hdc, faceName) != 0) {
- return (char *) faceName;
+ return faceName;
}
aliases = TkFontGetAliasList(faceName);
if (aliases != NULL) {
@@ -2453,7 +2595,7 @@ WinFontExistProc(
#pragma pack(1) /* Structures are byte aligned in file. */
-#define CMAPHEX 0x636d6170 /* Key for character map resource. */
+#define CMAPHEX 0x636d6170 /* Key for character map resource. */
typedef struct CMAPTABLE {
USHORT version; /* Table version number (0). */
@@ -2495,7 +2637,7 @@ typedef struct SUBHEADER {
} SUBHEADER;
typedef struct HIBYTETABLE {
- USHORT format; /* Format number is set to 2. */
+ USHORT format; /* Format number is set to 2. */
USHORT length; /* The actual length in bytes of this
* subtable. */
USHORT version; /* Version number (starts at 0). */
@@ -2613,7 +2755,7 @@ LoadFontRanges(
}
n = GetFontData(hdc, cmapKey, 0, &cmapTable, sizeof(cmapTable));
- if (n != (int)GDI_ERROR) {
+ if (n != (int) GDI_ERROR) {
if (swapped) {
SwapShort(&cmapTable.numTables);
}
@@ -2651,8 +2793,8 @@ LoadFontRanges(
segCount = subTable.segment.segCountX2 / 2;
cbData = segCount * sizeof(USHORT);
- startCount = (USHORT *) ckalloc((unsigned)cbData);
- endCount = (USHORT *) ckalloc((unsigned)cbData);
+ startCount = ckalloc(cbData);
+ endCount = ckalloc(cbData);
offset = encTable.offset + sizeof(subTable.segment);
GetFontData(hdc, cmapKey, (DWORD) offset, endCount, cbData);
@@ -2695,8 +2837,8 @@ LoadFontRanges(
segCount = 1;
cbData = segCount * sizeof(USHORT);
- startCount = (USHORT *) ckalloc((unsigned) cbData);
- endCount = (USHORT *) ckalloc((unsigned) cbData);
+ startCount = ckalloc(cbData);
+ endCount = ckalloc(cbData);
startCount[0] = 0x0000;
endCount[0] = 0x00ff;
}
@@ -2724,14 +2866,14 @@ LoadFontRanges(
*-------------------------------------------------------------------------
*/
-static void
+static inline void
SwapShort(
PUSHORT p)
{
*p = (SHORT)(HIBYTE(*p) + (LOBYTE(*p) << 8));
}
-static void
+static inline void
SwapLong(
PULONG p)
{
diff --git a/win/tkWinImage.c b/win/tkWinImage.c
index 8e6ef38..d61b84a 100644
--- a/win/tkWinImage.c
+++ b/win/tkWinImage.c
@@ -39,9 +39,9 @@ DestroyImage(
{
if (imagePtr) {
if (imagePtr->data) {
- ckfree((char*)imagePtr->data);
+ ckfree(imagePtr->data);
}
- ckfree((char*)imagePtr);
+ ckfree(imagePtr);
}
return 0;
}
@@ -211,7 +211,7 @@ XCreateImage(
int bitmap_pad,
int bytes_per_line)
{
- XImage* imagePtr = (XImage *) ckalloc(sizeof(XImage));
+ XImage* imagePtr = ckalloc(sizeof(XImage));
imagePtr->width = width;
imagePtr->height = height;
imagePtr->xoffset = offset;
@@ -301,8 +301,7 @@ XGetImageZPixmap(
BOOL ret;
if (format != ZPixmap) {
- TkpDisplayWarning(
- "XGetImageZPixmap: only ZPixmap types are implemented",
+ TkpDisplayWarning("Only ZPixmap types are implemented",
"XGetImageZPixmap Failure");
return NULL;
}
@@ -350,7 +349,7 @@ XGetImageZPixmap(
if (depth <= 8) {
size += sizeof(unsigned short) * (1 << depth);
}
- bmInfo = (BITMAPINFO *) ckalloc((unsigned)size);
+ bmInfo = ckalloc(size);
bmInfo->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
bmInfo->bmiHeader.biWidth = width;
@@ -368,16 +367,16 @@ XGetImageZPixmap(
unsigned char *p, *pend;
GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_PAL_COLORS);
- data = (unsigned char *) ckalloc(bmInfo->bmiHeader.biSizeImage);
+ data = ckalloc(bmInfo->bmiHeader.biSizeImage);
if (!data) {
/* printf("Failed to allocate data area for XImage.\n"); */
ret_image = NULL;
goto cleanup;
}
- ret_image = XCreateImage(display, NULL, depth, ZPixmap, 0, (char *)data,
+ ret_image = XCreateImage(display, NULL, depth, ZPixmap, 0, (char *) data,
width, height, 32, (int) ((width + 31) >> 3) & ~1);
if (ret_image == NULL) {
- ckfree((char *)data);
+ ckfree(data);
goto cleanup;
}
@@ -387,8 +386,8 @@ XGetImageZPixmap(
if (GetDIBits(hdcMem, hbmp, 0, height, data, bmInfo,
DIB_PAL_COLORS) == 0) {
- ckfree((char *) ret_image->data);
- ckfree((char *) ret_image);
+ ckfree(ret_image->data);
+ ckfree(ret_image);
ret_image = NULL;
goto cleanup;
}
@@ -404,16 +403,16 @@ XGetImageZPixmap(
unsigned char *p;
GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_PAL_COLORS);
- data = (unsigned char *) ckalloc(bmInfo->bmiHeader.biSizeImage);
+ data = ckalloc(bmInfo->bmiHeader.biSizeImage);
if (!data) {
/* printf("Failed to allocate data area for XImage.\n"); */
ret_image = NULL;
goto cleanup;
}
- ret_image = XCreateImage(display, NULL, 8, ZPixmap, 0, (char *)data,
+ ret_image = XCreateImage(display, NULL, 8, ZPixmap, 0, (char *) data,
width, height, 8, (int) width);
if (ret_image == NULL) {
- ckfree((char *) data);
+ ckfree(data);
goto cleanup;
}
@@ -423,8 +422,8 @@ XGetImageZPixmap(
if (GetDIBits(hdcMem, hbmp, 0, height, data, bmInfo,
DIB_PAL_COLORS) == 0) {
- ckfree((char *) ret_image->data);
- ckfree((char *) ret_image);
+ ckfree(ret_image->data);
+ ckfree(ret_image);
ret_image = NULL;
goto cleanup;
}
@@ -435,7 +434,7 @@ XGetImageZPixmap(
}
} else if (depth == 16) {
GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_RGB_COLORS);
- data = (unsigned char *) ckalloc(bmInfo->bmiHeader.biSizeImage);
+ data = ckalloc(bmInfo->bmiHeader.biSizeImage);
if (!data) {
/* printf("Failed to allocate data area for XImage.\n"); */
ret_image = NULL;
@@ -444,7 +443,7 @@ XGetImageZPixmap(
ret_image = XCreateImage(display, NULL, 16, ZPixmap, 0, (char *) data,
width, height, 16, 0 /* will be calc'ed from bitmap_pad */);
if (ret_image == NULL) {
- ckfree((char *) data);
+ ckfree(data);
goto cleanup;
}
@@ -454,14 +453,14 @@ XGetImageZPixmap(
if (GetDIBits(hdcMem, hbmp, 0, height, ret_image->data, bmInfo,
DIB_RGB_COLORS) == 0) {
- ckfree((char *) ret_image->data);
- ckfree((char *) ret_image);
+ ckfree(ret_image->data);
+ ckfree(ret_image);
ret_image = NULL;
goto cleanup;
}
} else {
GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_RGB_COLORS);
- data = (unsigned char *) ckalloc(width * height * 4);
+ data = ckalloc(width * height * 4);
if (!data) {
/* printf("Failed to allocate data area for XImage.\n"); */
ret_image = NULL;
@@ -470,7 +469,7 @@ XGetImageZPixmap(
ret_image = XCreateImage(display, NULL, 32, ZPixmap, 0, (char *) data,
width, height, 0, (int) width * 4);
if (ret_image == NULL) {
- ckfree((char *) data);
+ ckfree(data);
goto cleanup;
}
@@ -484,10 +483,10 @@ XGetImageZPixmap(
unsigned int byte_width, h, w;
byte_width = ((width * 3 + 3) & ~(unsigned)3);
- smallBitBase = (unsigned char *) ckalloc(byte_width * height);
+ smallBitBase = ckalloc(byte_width * height);
if (!smallBitBase) {
- ckfree((char *) ret_image->data);
- ckfree((char *) ret_image);
+ ckfree(ret_image->data);
+ ckfree(ret_image);
ret_image = NULL;
goto cleanup;
}
@@ -499,9 +498,9 @@ XGetImageZPixmap(
if (GetDIBits(hdcMem, hbmp, 0, height, smallBitData, bmInfo,
DIB_RGB_COLORS) == 0) {
- ckfree((char *) ret_image->data);
- ckfree((char *) ret_image);
- ckfree((char *) smallBitBase);
+ ckfree(ret_image->data);
+ ckfree(ret_image);
+ ckfree(smallBitBase);
ret_image = NULL;
goto cleanup;
}
@@ -511,7 +510,7 @@ XGetImageZPixmap(
*/
for (h = 0; h < height; h++) {
- bigBitData = (unsigned char *) (ret_image->data + h * ret_image->bytes_per_line);
+ bigBitData = (unsigned char *) ret_image->data + h * ret_image->bytes_per_line;
smallBitData = smallBitBase + h * byte_width;
for (w = 0; w < width; w++) {
@@ -526,7 +525,7 @@ XGetImageZPixmap(
* Free the Device contexts, and the Bitmap.
*/
- ckfree((char *) smallBitBase);
+ ckfree(smallBitBase);
} else {
/*
* Get the BITMAP info directly into the Image.
@@ -534,8 +533,8 @@ XGetImageZPixmap(
if (GetDIBits(hdcMem, hbmp, 0, height, ret_image->data, bmInfo,
DIB_RGB_COLORS) == 0) {
- ckfree((char *) ret_image->data);
- ckfree((char *) ret_image);
+ ckfree(ret_image->data);
+ ckfree(ret_image);
ret_image = NULL;
goto cleanup;
}
@@ -544,7 +543,7 @@ XGetImageZPixmap(
cleanup:
if (bmInfo) {
- ckfree((char *) bmInfo);
+ ckfree(bmInfo);
}
if (hPal) {
SelectPalette(hdcMem, hPalPrev1, FALSE);
@@ -639,7 +638,7 @@ XGetImage(
imagePtr = XGetImageZPixmap(display, d, x, y,
width, height, plane_mask, format);
} else {
- char *errMsg = NULL;
+ const char *errMsg = NULL;
char infoBuf[sizeof(BITMAPINFO) + sizeof(RGBQUAD)];
BITMAPINFO *infoPtr = (BITMAPINFO*)infoBuf;
@@ -661,8 +660,7 @@ XGetImage(
imagePtr = XCreateImage(display, NULL, 1, XYBitmap, 0, NULL,
width, height, 32, 0);
- imagePtr->data =
- ckalloc((unsigned) imagePtr->bytes_per_line*imagePtr->height);
+ imagePtr->data = ckalloc(imagePtr->bytes_per_line * imagePtr->height);
dc = GetDC(NULL);
diff --git a/win/tkWinInit.c b/win/tkWinInit.c
index 31304d3..b1b2d6b 100644
--- a/win/tkWinInit.c
+++ b/win/tkWinInit.c
@@ -68,9 +68,9 @@ TkpGetAppName(
Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */
{
int argc, namelength;
- CONST char **argv = NULL, *name, *p;
+ const char **argv = NULL, *name, *p;
- name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ name = Tcl_GetVar2(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
namelength = -1;
if (name != NULL) {
Tcl_SplitPath(name, &argc, &argv);
@@ -90,7 +90,7 @@ TkpGetAppName(
}
Tcl_DStringAppend(namePtr, name, namelength);
if (argv != NULL) {
- ckfree((char *)argv);
+ ckfree(argv);
}
}
@@ -113,12 +113,13 @@ TkpGetAppName(
void
TkpDisplayWarning(
- CONST char *msg, /* Message to be displayed. */
- CONST char *title) /* Title of warning. */
+ const char *msg, /* Message to be displayed. */
+ const char *title) /* Title of warning. */
{
#define TK_MAX_WARN_LEN 1024
- WCHAR msgString[TK_MAX_WARN_LEN + 5];
- WCHAR titleString[TK_MAX_WARN_LEN + 1];
+ WCHAR titleString[TK_MAX_WARN_LEN];
+ WCHAR *msgString; /* points to titleString, just after title, leaving space for ": " */
+ int len; /* size of title, including terminating NULL */
/* If running on Cygwin and we have a stderr channel, use it. */
#if !defined(STATIC_BUILD)
@@ -134,20 +135,81 @@ TkpDisplayWarning(
}
#endif /* !STATIC_BUILD */
- MultiByteToWideChar(CP_UTF8, 0, msg, -1, msgString, TK_MAX_WARN_LEN);
- MultiByteToWideChar(CP_UTF8, 0, title, -1, titleString, TK_MAX_WARN_LEN);
+ len = MultiByteToWideChar(CP_UTF8, 0, title, -1, titleString, TK_MAX_WARN_LEN);
+ msgString = &titleString[len + 1];
+ titleString[TK_MAX_WARN_LEN - 1] = L'\0';
+ MultiByteToWideChar(CP_UTF8, 0, msg, -1, msgString, (TK_MAX_WARN_LEN - 1) - len);
/*
* Truncate MessageBox string if it is too long to not overflow the screen
* and cause possible oversized window error.
*/
- memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR));
- titleString[TK_MAX_WARN_LEN] = L'\0';
- MessageBoxW(NULL, msgString, titleString,
- MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
- | MB_SETFOREGROUND | MB_TOPMOST);
+ if (titleString[TK_MAX_WARN_LEN - 1] != L'\0') {
+ memcpy(titleString + (TK_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+ }
+ if (IsDebuggerPresent()) {
+ titleString[len - 1] = L':';
+ titleString[len] = L' ';
+ OutputDebugStringW(titleString);
+ } else {
+ titleString[len - 1] = L'\0';
+ MessageBoxW(NULL, msgString, titleString,
+ MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
+ | MB_SETFOREGROUND | MB_TOPMOST);
+ }
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * Win32ErrorObj --
+ *
+ * Returns a string object containing text from a COM or Win32 error code
+ *
+ * Results:
+ * A Tcl_Obj containing the Win32 error message.
+ *
+ * Side effects:
+ * Removed the error message from the COM threads error object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TkWin32ErrorObj(
+ HRESULT hrError)
+{
+ LPTSTR lpBuffer = NULL, p = NULL;
+ TCHAR sBuffer[30];
+ Tcl_Obj* errPtr = NULL;
+
+ FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError,
+ LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL);
+
+ if (lpBuffer == NULL) {
+ lpBuffer = sBuffer;
+ wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError);
+ }
+
+ if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
+ *p = TEXT('\0');
+ }
+
+#ifdef _UNICODE
+ errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer));
+#else
+ errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
+#endif /* _UNICODE */
+
+ if (lpBuffer != sBuffer) {
+ LocalFree((HLOCAL)lpBuffer);
+ }
+
+ return errPtr;
+}
+
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/tkWinInt.h b/win/tkWinInt.h
index abac7b0..0e2c844 100644
--- a/win/tkWinInt.h
+++ b/win/tkWinInt.h
@@ -26,10 +26,6 @@
#include "tkWin.h"
#endif
-#ifndef _TKPORT
-#include "tkPort.h"
-#endif
-
/*
* Define constants missing from older Win32 SDK header files.
*/
@@ -121,8 +117,8 @@ typedef struct {
* The following macros define the class names for Tk Window types.
*/
-#define TK_WIN_TOPLEVEL_CLASS_NAME "TkTopLevel"
-#define TK_WIN_CHILD_CLASS_NAME "TkChild"
+#define TK_WIN_TOPLEVEL_CLASS_NAME TEXT("TkTopLevel")
+#define TK_WIN_CHILD_CLASS_NAME TEXT("TkChild")
/*
* The following variable is a translation table between X gc functions and
@@ -146,70 +142,33 @@ MODULE_SCOPE const int tkpWinBltModes[];
#include "tkIntPlatDecls.h"
-#ifdef BUILD_tk
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-
/*
* Special proc needed as tsd accessor function between
* tkWinX.c:GenerateXEvent and tkWinClipboard.c:UpdateClipboard
*/
-EXTERN void TkWinUpdatingClipboard(int mode);
+MODULE_SCOPE void TkWinUpdatingClipboard(int mode);
/*
* Used by tkWinDialog.c to associate the right icon with tk_messageBox
*/
-EXTERN HICON TkWinGetIcon(Tk_Window tkw, DWORD iconsize);
+MODULE_SCOPE HICON TkWinGetIcon(Tk_Window tkw, DWORD iconsize);
/*
* Used by tkWinX.c on for certain system display change messages and cleanup
* up containers
*/
-EXTERN void TkWinDisplayChanged(Display *display);
+MODULE_SCOPE void TkWinDisplayChanged(Display *display);
MODULE_SCOPE void TkWinCleanupContainerList(void);
/*
* Used by tkWinWm.c for embedded menu handling. May become public.
*/
-EXTERN HWND Tk_GetMenuHWND(Tk_Window tkwin);
-EXTERN HWND Tk_GetEmbeddedMenuHWND(Tk_Window tkwin);
-
-/*
- * The following structure keeps track of whether we are using the multi-byte
- * or the wide-character interfaces to the operating system. System calls
- * should be made through the following function table.
- *
- * While some system calls need to use this A/W jump-table, it is not
- * necessary for all calls to do it, which is why you won't see this used
- * throughout the Tk code, but only in key areas. -- hobbs
- */
-
-typedef struct TkWinProcs {
- int useWide;
- LRESULT (WINAPI *callWindowProc)(WNDPROC lpPrevWndFunc, HWND hWnd,
- UINT Msg, WPARAM wParam, LPARAM lParam);
- LRESULT (WINAPI *defWindowProc)(HWND hWnd, UINT Msg, WPARAM wParam,
- LPARAM lParam);
- ATOM (WINAPI *registerClass)(const WNDCLASS *lpWndClass);
- BOOL (WINAPI *setWindowText)(HWND hWnd, LPCTSTR lpString);
- HWND (WINAPI *createWindowEx)(DWORD dwExStyle, LPCTSTR lpClassName,
- LPCTSTR lpWindowName, DWORD dwStyle, int x, int y,
- int nWidth, int nHeight, HWND hWndParent, HMENU hMenu,
- HINSTANCE hInstance, LPVOID lpParam);
- BOOL (WINAPI *insertMenu)(HMENU hMenu, UINT uPosition, UINT uFlags,
- UINT uIDNewItem, LPCTSTR lpNewItem);
- int (WINAPI *getWindowText)(HWND hWnd, LPCTSTR lpString, int nMaxCount);
-} TkWinProcs;
-
-EXTERN TkWinProcs *tkWinProcs;
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
+MODULE_SCOPE HWND Tk_GetMenuHWND(Tk_Window tkwin);
+MODULE_SCOPE HWND Tk_GetEmbeddedMenuHWND(Tk_Window tkwin);
/*
* The following allows us to cache these encoding for multiple functions.
@@ -231,20 +190,26 @@ MODULE_SCOPE void TkWinSetupSystemFonts(TkMainInfo *mainPtr);
* The following is implemented in tkWinWm and used by tkWinEmbed.c
*/
-void TkpWinToplevelWithDraw(TkWindow *winPtr);
-void TkpWinToplevelIconify(TkWindow *winPtr);
-void TkpWinToplevelDeiconify(TkWindow *winPtr);
-long TkpWinToplevelIsControlledByWm(TkWindow *winPtr);
-long TkpWinToplevelMove(TkWindow *winPtr, int x, int y);
-long TkpWinToplevelOverrideRedirect(TkWindow *winPtr,
+MODULE_SCOPE void TkpWinToplevelWithDraw(TkWindow *winPtr);
+MODULE_SCOPE void TkpWinToplevelIconify(TkWindow *winPtr);
+MODULE_SCOPE void TkpWinToplevelDeiconify(TkWindow *winPtr);
+MODULE_SCOPE long TkpWinToplevelIsControlledByWm(TkWindow *winPtr);
+MODULE_SCOPE long TkpWinToplevelMove(TkWindow *winPtr, int x, int y);
+MODULE_SCOPE long TkpWinToplevelOverrideRedirect(TkWindow *winPtr,
int reqValue);
-void TkpWinToplevelDetachWindow(TkWindow *winPtr);
-int TkpWmGetState(TkWindow *winPtr);
+MODULE_SCOPE void TkpWinToplevelDetachWindow(TkWindow *winPtr);
+MODULE_SCOPE int TkpWmGetState(TkWindow *winPtr);
+
+/*
+ * Common routines used in Windows implementation
+ */
+MODULE_SCOPE Tcl_Obj * TkWin32ErrorObj(HRESULT hrError);
+
/*
* The following functions are not present in old versions of Windows
- * API headers but are used in the Tk source to ensure 64bit
- * compatability.
+ * API headers but are used in the Tk source to ensure 64bit
+ * compatibility.
*/
#ifndef GetClassLongPtr
diff --git a/win/tkWinKey.c b/win/tkWinKey.c
index daf2ecc..ed546f7 100644
--- a/win/tkWinKey.c
+++ b/win/tkWinKey.c
@@ -23,7 +23,7 @@
#define MAX_KEYCODE 145 /* VK_SCROLL is the last entry in our table below */
-static KeySym keymap[] = {
+static const KeySym keymap[] = {
NoSymbol, NoSymbol, NoSymbol, XK_Cancel, NoSymbol,
NoSymbol, NoSymbol, NoSymbol, XK_BackSpace, XK_Tab,
NoSymbol, NoSymbol, XK_Clear, XK_Return, NoSymbol,
@@ -79,7 +79,7 @@ static KeySym KeycodeToKeysym(unsigned int keycode,
*----------------------------------------------------------------------
*/
-char *
+const char *
TkpGetString(
TkWindow *winPtr, /* Window where event occurred: needed to get
* input context. */
@@ -502,12 +502,11 @@ TkpInitKeymapInfo(
*/
if (dispPtr->modKeyCodes != NULL) {
- ckfree((char *) dispPtr->modKeyCodes);
+ ckfree(dispPtr->modKeyCodes);
}
dispPtr->numModKeyCodes = 0;
arraySize = KEYCODE_ARRAY_SIZE;
- dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
- (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
+ dispPtr->modKeyCodes = ckalloc(KEYCODE_ARRAY_SIZE * sizeof(KeyCode));
for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
if (*codePtr == 0) {
continue;
@@ -530,11 +529,10 @@ TkpInitKeymapInfo(
*/
arraySize *= 2;
- new = (KeyCode *) ckalloc((unsigned)
- (arraySize * sizeof(KeyCode)));
- memcpy((void *) new, (void *) dispPtr->modKeyCodes,
- (dispPtr->numModKeyCodes * sizeof(KeyCode)));
- ckfree((char *) dispPtr->modKeyCodes);
+ new = ckalloc(arraySize * sizeof(KeyCode));
+ memcpy(new, dispPtr->modKeyCodes,
+ dispPtr->numModKeyCodes * sizeof(KeyCode));
+ ckfree(dispPtr->modKeyCodes);
dispPtr->modKeyCodes = new;
}
dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
@@ -660,11 +658,10 @@ XModifierKeymap *
XGetModifierMapping(
Display *display)
{
- XModifierKeymap *map = (XModifierKeymap *)
- ckalloc(sizeof(XModifierKeymap));
+ XModifierKeymap *map = ckalloc(sizeof(XModifierKeymap));
map->max_keypermod = 1;
- map->modifiermap = (KeyCode *) ckalloc(sizeof(KeyCode)*8);
+ map->modifiermap = ckalloc(sizeof(KeyCode) * 8);
map->modifiermap[ShiftMapIndex] = VK_SHIFT;
map->modifiermap[LockMapIndex] = VK_CAPITAL;
map->modifiermap[ControlMapIndex] = VK_CONTROL;
@@ -696,8 +693,8 @@ int
XFreeModifiermap(
XModifierKeymap *modmap)
{
- ckfree((char *) modmap->modifiermap);
- ckfree((char *) modmap);
+ ckfree(modmap->modifiermap);
+ ckfree(modmap);
return Success;
}
diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c
index 48bc16b..4593928 100644
--- a/win/tkWinMenu.c
+++ b/win/tkWinMenu.c
@@ -11,20 +11,16 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#define WINVER 0x0500 /* Requires Windows 2K definitions */
-#define _WIN32_WINNT 0x0500
#define OEMRESOURCE
#include "tkWinInt.h"
#include "tkMenu.h"
-#include <string.h>
-
/*
* The class of the window for popup menus.
*/
-#define MENU_CLASS_NAME "MenuWindowClass"
-#define EMBEDDED_MENU_CLASS_NAME "EmbeddedMenuWindowClass"
+#define MENU_CLASS_NAME TEXT("MenuWindowClass")
+#define EMBEDDED_MENU_CLASS_NAME TEXT("EmbeddedMenuWindowClass")
/*
* Used to align a windows bitmap inside a rectangle
@@ -159,7 +155,7 @@ static void DrawWindowsSystemBitmap(Display *display,
Drawable drawable, GC gc, const RECT *rectPtr,
int bitmapID, int alignFlags);
static void FreeID(WORD commandID);
-static TCHAR * GetEntryText(TkMenuEntry *mePtr);
+static char * GetEntryText(TkMenuEntry *mePtr);
static void GetMenuAccelGeometry(TkMenu *menuPtr,
TkMenuEntry *mePtr, Tk_Font tkfont,
const Tk_FontMetrics *fmPtr, int *widthPtr,
@@ -192,6 +188,26 @@ static LRESULT CALLBACK TkWinMenuProc(HWND hwnd, UINT message, WPARAM wParam,
static LRESULT CALLBACK TkWinEmbeddedMenuProc(HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam);
+static inline void
+ScheduleMenuReconfigure(
+ TkMenu *menuPtr)
+{
+ if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu, menuPtr);
+ }
+}
+
+static inline void
+CallPendingReconfigureImmediately(
+ TkMenu *menuPtr)
+{
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureWindowsMenu, menuPtr);
+ ReconfigureWindowsMenu(menuPtr);
+ }
+}
+
/*
*----------------------------------------------------------------------
*
@@ -217,7 +233,7 @@ GetNewID(
TkMenuEntry *mePtr, /* The menu we are working with. */
WORD *menuIDPtr) /* The resulting id. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
WORD curID = tsdPtr->lastCommandID;
@@ -241,7 +257,7 @@ GetNewID(
commandEntryPtr = Tcl_CreateHashEntry(&tsdPtr->commandTable,
INT2PTR(curID), &new);
if (new) {
- Tcl_SetHashValue(commandEntryPtr, (char *) mePtr);
+ Tcl_SetHashValue(commandEntryPtr, mePtr);
*menuIDPtr = curID;
tsdPtr->lastCommandID = curID;
return TCL_OK;
@@ -269,7 +285,7 @@ static void
FreeID(
WORD commandID)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
@@ -278,7 +294,8 @@ FreeID(
if (tsdPtr->menuHWND != NULL) {
Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
- ((char *) NULL) + commandID);
+ INT2PTR(commandID));
+
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
}
@@ -311,14 +328,14 @@ TkpNewMenu(
HMENU winMenuHdl;
Tcl_HashEntry *hashEntryPtr;
int newEntry;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
winMenuHdl = CreatePopupMenu();
-
if (winMenuHdl == NULL) {
- Tcl_AppendResult(menuPtr->interp, "No more menus can be allocated.",
- (char *) NULL);
+ Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj(
+ "No more menus can be allocated.", -1));
+ Tcl_SetErrorCode(menuPtr->interp, "TK", "MENU", "SYSTEM_RESOURCES", NULL);
return TCL_ERROR;
}
@@ -329,7 +346,7 @@ TkpNewMenu(
hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable,
(char *) winMenuHdl, &newEntry);
- Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
+ Tcl_SetHashValue(hashEntryPtr, menuPtr);
menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
return TCL_OK;
@@ -356,12 +373,12 @@ TkpDestroyMenu(
TkMenu *menuPtr) /* The common menu structure */
{
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
- char *searchName;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ const char *searchName;
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
- Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ Tcl_CancelIdleCall(ReconfigureWindowsMenu, menuPtr);
}
if (winMenuHdl == NULL) {
@@ -404,6 +421,7 @@ TkpDestroyMenu(
if (tsdPtr->menuHWND != NULL) {
Tcl_HashEntry *hashEntryPtr =
Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl);
+
if (hashEntryPtr != NULL) {
Tcl_DeleteHashEntry(hashEntryPtr);
}
@@ -441,10 +459,7 @@ TkpDestroyMenuEntry(
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
if (NULL != winMenuHdl) {
- if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
- menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
- }
+ ScheduleMenuReconfigure(menuPtr);
}
FreeID((WORD) PTR2INT(mePtr->platformEntryData));
mePtr->platformEntryData = NULL;
@@ -489,9 +504,9 @@ GetEntryText(
strcpy(itemText, "( )");
} else {
int i;
- char *label = (mePtr->labelPtr == NULL) ? ""
+ const char *label = (mePtr->labelPtr == NULL) ? ""
: Tcl_GetString(mePtr->labelPtr);
- char *accel = (mePtr->accelPtr == NULL) ? ""
+ const char *accel = (mePtr->accelPtr == NULL) ? ""
: Tcl_GetString(mePtr->accelPtr);
const char *p, *next;
Tcl_DString itemString;
@@ -525,7 +540,7 @@ GetEntryText(
}
}
- itemText = ckalloc((unsigned)Tcl_DStringLength(&itemString) + 1);
+ itemText = ckalloc(Tcl_DStringLength(&itemString) + 1);
strcpy(itemText, Tcl_DStringValue(&itemString));
Tcl_DStringFree(&itemString);
}
@@ -553,10 +568,10 @@ static void
ReconfigureWindowsMenu(
ClientData clientData) /* The menu we are rebuilding */
{
- TkMenu *menuPtr = (TkMenu *) clientData;
+ TkMenu *menuPtr = clientData;
TkMenuEntry *mePtr;
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
- TCHAR *itemText = NULL;
+ char *itemText = NULL;
const TCHAR *lpNewItem;
UINT flags;
UINT itemID;
@@ -594,7 +609,7 @@ ReconfigureWindowsMenu(
if ((menuPtr->menuType == MENUBAR)
|| (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {
Tcl_WinUtfToTChar(itemText, -1, &translatedText);
- lpNewItem = Tcl_DStringValue(&translatedText);
+ lpNewItem = (const TCHAR *) Tcl_DStringValue(&translatedText);
flags |= MF_STRING;
} else {
lpNewItem = (LPCTSTR) mePtr;
@@ -680,23 +695,17 @@ ReconfigureWindowsMenu(
&& (menuPtr->parentTopLevelPtr != NULL)
&& (systemMenuPtr->masterMenuPtr
== menuRefPtr->menuPtr)) {
- HMENU systemMenuHdl =
- (HMENU) systemMenuPtr->platformData;
+ HMENU systemMenuHdl = (HMENU) systemMenuPtr->platformData;
HWND wrapper = TkWinGetWrapperWindow(menuPtr
->parentTopLevelPtr);
+
if (wrapper != NULL) {
DestroyMenu(systemMenuHdl);
systemMenuHdl = GetSystemMenu(wrapper, FALSE);
systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU;
systemMenuPtr->platformData =
(TkMenuPlatformData) systemMenuHdl;
- if (!(systemMenuPtr->menuFlags
- & MENU_RECONFIGURE_PENDING)) {
- systemMenuPtr->menuFlags
- |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu,
- (ClientData) systemMenuPtr);
- }
+ ScheduleMenuReconfigure(systemMenuPtr);
}
}
}
@@ -706,8 +715,7 @@ ReconfigureWindowsMenu(
}
}
if (!systemMenu) {
- (*tkWinProcs->insertMenu)(winMenuHdl, 0xFFFFFFFF, flags,
- itemID, lpNewItem);
+ InsertMenu(winMenuHdl, 0xFFFFFFFF, flags, itemID, lpNewItem);
}
Tcl_DStringFree(&translatedText);
if (itemText != NULL) {
@@ -719,8 +727,8 @@ ReconfigureWindowsMenu(
if ((menuPtr->menuType == MENUBAR)
&& (menuPtr->parentTopLevelPtr != NULL)) {
- HANDLE bar;
- bar = TkWinGetWrapperWindow(menuPtr->parentTopLevelPtr);
+ HANDLE bar = TkWinGetWrapperWindow(menuPtr->parentTopLevelPtr);
+
if (bar) {
DrawMenuBar(bar);
}
@@ -757,15 +765,12 @@ TkpPostMenu(
POINT point;
Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin);
int oldServiceMode = Tcl_GetServiceMode();
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->inPostMenu++;
- if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
- Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
- ReconfigureWindowsMenu((ClientData) menuPtr);
- }
+ CallPendingReconfigureImmediately(menuPtr);
result = TkPreprocessMenu(menuPtr);
if (result != TCL_OK) {
@@ -860,12 +865,7 @@ TkpMenuNewEntry(
if (GetNewID(mePtr, &commandID) != TCL_OK) {
return TCL_ERROR;
}
-
- if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
- menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
- }
-
+ ScheduleMenuReconfigure(menuPtr);
mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR(commandID);
return TCL_OK;
@@ -899,7 +899,7 @@ TkWinMenuProc(
LRESULT lResult;
if (!TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &lResult)) {
- lResult = DefWindowProc(hwnd, message, wParam, lParam);
+ lResult = DefWindowProcA(hwnd, message, wParam, lParam);
}
return lResult;
}
@@ -928,11 +928,12 @@ UpdateEmbeddedMenu(
{
RECT rc;
HWND hMenuWnd = (HWND)clientData;
+
GetClientRect(hMenuWnd, &rc);
InvalidateRect(hMenuWnd, &rc, FALSE);
UpdateWindow(hMenuWnd);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -959,7 +960,7 @@ TkWinEmbeddedMenuProc(
{
static int nIdles = 0;
LRESULT lResult = 1;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
switch(message) {
@@ -997,12 +998,12 @@ TkWinEmbeddedMenuProc(
}
default:
- lResult = DefWindowProc(hwnd, message, wParam, lParam);
+ lResult = DefWindowProcA(hwnd, message, wParam, lParam);
break;
}
return lResult;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1035,7 +1036,7 @@ TkWinHandleMenuEvent(
int returnResult = 0;
TkMenu *menuPtr;
TkMenuEntry *mePtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
switch (*pMessage) {
@@ -1043,7 +1044,7 @@ TkWinHandleMenuEvent(
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
(char *) *pwParam);
if (hashEntryPtr != NULL) {
- menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ menuPtr = Tcl_GetHashValue(hashEntryPtr);
if ((menuPtr->menuRefPtr != NULL)
&& (menuPtr->menuRefPtr->parentEntryPtr != NULL)) {
TkPostSubmenu(menuPtr->interp,
@@ -1058,27 +1059,22 @@ TkWinHandleMenuEvent(
(char *) *pwParam);
if (hashEntryPtr != NULL) {
tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ menuPtr = Tcl_GetHashValue(hashEntryPtr);
tsdPtr->modalMenuPtr = menuPtr;
- if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
- Tcl_CancelIdleCall(ReconfigureWindowsMenu,
- (ClientData) menuPtr);
- ReconfigureWindowsMenu((ClientData) menuPtr);
- }
+ CallPendingReconfigureImmediately(menuPtr);
RecursivelyClearActiveMenu(menuPtr);
if (!tsdPtr->inPostMenu) {
- Tcl_Interp *interp;
+ Tcl_Interp *interp = menuPtr->interp;
int code;
- interp = menuPtr->interp;
- Tcl_Preserve((ClientData)interp);
+ Tcl_Preserve(interp);
code = TkPreprocessMenu(menuPtr);
if ((code != TCL_OK) && (code != TCL_CONTINUE)
&& (code != TCL_BREAK)) {
Tcl_AddErrorInfo(interp, "\n (menu preprocess)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
- Tcl_Release((ClientData)interp);
+ Tcl_Release(interp);
}
TkActivateMenuEntry(menuPtr, -1);
*plResult = 0;
@@ -1095,11 +1091,11 @@ TkWinHandleMenuEvent(
break;
}
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
- ((char *) NULL) + LOWORD(*pwParam));
+ INT2PTR(LOWORD(*pwParam)));
if (hashEntryPtr == NULL) {
break;
}
- mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);
+ mePtr = Tcl_GetHashValue(hashEntryPtr);
if (mePtr != NULL) {
TkMenuReferences *menuRefPtr;
TkMenuEntry *parentEntryPtr;
@@ -1117,7 +1113,7 @@ TkWinHandleMenuEvent(
if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) {
for (parentEntryPtr = menuRefPtr->parentEntryPtr ; ;
parentEntryPtr = parentEntryPtr->nextCascadePtr) {
- char *name = Tcl_GetString(parentEntryPtr->namePtr);
+ const char *name = Tcl_GetString(parentEntryPtr->namePtr);
if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
break;
@@ -1131,13 +1127,13 @@ TkWinHandleMenuEvent(
}
interp = menuPtr->interp;
- Tcl_Preserve((ClientData)interp);
+ Tcl_Preserve(interp);
code = TkInvokeMenu(interp, menuPtr, mePtr->index);
if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
Tcl_AddErrorInfo(interp, "\n (menu invoke)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
- Tcl_Release((ClientData)interp);
+ Tcl_Release(interp);
*plResult = 0;
returnResult = 1;
}
@@ -1152,7 +1148,7 @@ TkWinHandleMenuEvent(
Tcl_UniChar *wlabel, menuChar;
*plResult = 0;
- menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ menuPtr = Tcl_GetHashValue(hashEntryPtr);
/*
* Assume we have something directly convertable to Tcl_UniChar.
* True at least for wide systems.
@@ -1218,7 +1214,7 @@ TkWinHandleMenuEvent(
}
mePtr = (TkMenuEntry *) itemPtr->itemData;
menuPtr = mePtr->menuPtr;
- twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
+ twdPtr = ckalloc(sizeof(TkWinDrawable));
twdPtr->type = TWD_WINDC;
twdPtr->winDC.hdc = itemPtr->hDC;
@@ -1261,7 +1257,7 @@ TkWinHandleMenuEvent(
itemPtr->rcItem.bottom - itemPtr->rcItem.top,
0, drawingParameters);
- ckfree((char *) twdPtr);
+ ckfree(twdPtr);
}
*plResult = 1;
returnResult = 1;
@@ -1284,7 +1280,7 @@ TkWinHandleMenuEvent(
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
(char *) *plParam);
if (hashEntryPtr != NULL) {
- menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ menuPtr = Tcl_GetHashValue(hashEntryPtr);
}
}
@@ -1297,10 +1293,9 @@ TkWinHandleMenuEvent(
mePtr = menuPtr->entries[entryIndex];
} else {
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
- ((char *) NULL) + entryIndex);
+ INT2PTR(entryIndex));
if (hashEntryPtr != NULL) {
- mePtr = (TkMenuEntry *)
- Tcl_GetHashValue(hashEntryPtr);
+ mePtr = Tcl_GetHashValue(hashEntryPtr);
}
}
}
@@ -1309,7 +1304,7 @@ TkWinHandleMenuEvent(
TkActivateMenuEntry(menuPtr, -1);
} else {
if (mePtr->index >= menuPtr->numEntries) {
- Tcl_Panic("Trying to activate an entry which doesn't exist.");
+ Tcl_Panic("Trying to activate an entry which doesn't exist");
}
TkActivateMenuEntry(menuPtr, mePtr->index);
}
@@ -1389,7 +1384,7 @@ TkpSetWindowMenuBar(
TkMenu *menuPtr) /* The menu we are inserting */
{
HMENU winMenuHdl;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (menuPtr != NULL) {
@@ -1404,13 +1399,10 @@ TkpSetWindowMenuBar(
winMenuHdl = CreateMenu();
hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable,
(char *) winMenuHdl, &newEntry);
- Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
+ Tcl_SetHashValue(hashEntryPtr, menuPtr);
menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
TkWinSetMenu(tkwin, winMenuHdl);
- if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
- menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
- }
+ ScheduleMenuReconfigure(menuPtr);
} else {
TkWinSetMenu(tkwin, NULL);
}
@@ -1437,7 +1429,7 @@ void
TkpSetMainMenubar(
Tcl_Interp *interp, /* The interpreter of the application */
Tk_Window tkwin, /* The frame we are setting up */
- char *menuName) /* The name of the menu to put in front. If
+ const char *menuName) /* The name of the menu to put in front. If
* NULL, use the default menu bar. */
{
/*
@@ -1513,7 +1505,7 @@ GetMenuAccelGeometry(
} else if (mePtr->accelPtr == NULL) {
*widthPtr = 0;
} else {
- char *accel = Tcl_GetString(mePtr->accelPtr);
+ const char *accel = Tcl_GetString(mePtr->accelPtr);
*widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
}
@@ -1628,7 +1620,7 @@ DrawWindowsSystemBitmap(
SelectObject(scratchDC, bitmap);
SetMapMode(scratchDC, GetMapMode(hdc));
- GetObject(bitmap, sizeof(BITMAP), &bm);
+ GetObjectA(bitmap, sizeof(BITMAP), &bm);
ptSize.x = bm.bmWidth;
ptSize.y = bm.bmHeight;
DPtoLP(scratchDC, &ptSize, 1);
@@ -1769,7 +1761,7 @@ DrawMenuEntryAccelerator(
{
int baseline;
int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth;
- char *accel;
+ const char *accel;
if (mePtr->accelPtr != NULL) {
accel = Tcl_GetString(mePtr->accelPtr);
@@ -1789,7 +1781,7 @@ DrawMenuEntryAccelerator(
COLORREF oldFgColor = gc->foreground;
gc->foreground = GetSysColor(COLOR_3DHILIGHT);
- if ((mePtr->entryFlags & ENTRY_PLATFORM_FLAG1) == 0) {
+ if (!(mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)) {
Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
mePtr->accelLength, leftEdge + 1, baseline + 1);
}
@@ -1856,6 +1848,7 @@ DrawMenuEntryArrow(
mePtr->menuPtr->tkwin, (mePtr->activeBorderPtr == NULL)
? mePtr->menuPtr->activeBorderPtr
: mePtr->activeBorderPtr));
+
gc->background = activeBgColor->pixel;
}
@@ -1955,7 +1948,7 @@ DrawMenuUnderline(
if (mePtr->underline < len) {
const char *label, *start, *end;
- label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ label = Tcl_GetString(mePtr->labelPtr);
start = Tcl_UtfAtIndex(label, mePtr->underline);
end = Tcl_UtfNext(start);
Tk_UnderlineChars(menuPtr->display, d,
@@ -2028,33 +2021,33 @@ TkWinMenuKeyObjCmd(
if (eventPtr->type == KeyPress) {
switch (keySym) {
case XK_Alt_L:
- scanCode = MapVirtualKey(VK_LMENU, 0);
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ scanCode = MapVirtualKeyA(VK_LMENU, 0);
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYDOWN, VK_MENU,
(int) (scanCode << 16) | (1 << 29));
break;
case XK_Alt_R:
- scanCode = MapVirtualKey(VK_RMENU, 0);
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ scanCode = MapVirtualKeyA(VK_RMENU, 0);
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYDOWN, VK_MENU,
(int) (scanCode << 16) | (1 << 29) | (1 << 24));
break;
case XK_F10:
- scanCode = MapVirtualKey(VK_F10, 0);
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ scanCode = MapVirtualKeyA(VK_F10, 0);
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYDOWN, VK_F10, (int) (scanCode << 16));
break;
default:
virtualKey = XKeysymToKeycode(winPtr->display, keySym);
- scanCode = MapVirtualKey(virtualKey, 0);
+ scanCode = MapVirtualKeyA(virtualKey, 0);
if (0 != scanCode) {
XKeyEvent xkey = eventPtr->xkey;
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYDOWN, virtualKey,
(int) ((scanCode << 16) | (1 << 29)));
if (xkey.nbytes > 0) {
for (i = 0; i < xkey.nbytes; i++) {
- CallWindowProc(DefWindowProc,
+ CallWindowProcA(DefWindowProcA,
Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSCHAR,
xkey.trans_chars[i],
(int) ((scanCode << 16) | (1 << 29)));
@@ -2065,28 +2058,28 @@ TkWinMenuKeyObjCmd(
} else if (eventPtr->type == KeyRelease) {
switch (keySym) {
case XK_Alt_L:
- scanCode = MapVirtualKey(VK_LMENU, 0);
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ scanCode = MapVirtualKeyA(VK_LMENU, 0);
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYUP, VK_MENU, (int) (scanCode << 16)
| (1 << 29) | (1 << 30) | (1 << 31));
break;
case XK_Alt_R:
- scanCode = MapVirtualKey(VK_RMENU, 0);
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ scanCode = MapVirtualKeyA(VK_RMENU, 0);
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYUP, VK_MENU, (int) (scanCode << 16) | (1 << 24)
| (0x111 << 29) | (1 << 30) | (1 << 31));
break;
case XK_F10:
- scanCode = MapVirtualKey(VK_F10, 0);
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ scanCode = MapVirtualKeyA(VK_F10, 0);
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYUP, VK_F10,
(int) (scanCode << 16) | (1 << 30) | (1 << 31));
break;
default:
virtualKey = XKeysymToKeycode(winPtr->display, keySym);
- scanCode = MapVirtualKey(virtualKey, 0);
+ scanCode = MapVirtualKeyA(virtualKey, 0);
if (0 != scanCode) {
- CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYUP, virtualKey, (int) ((scanCode << 16)
| (1 << 29) | (1 << 30) | (1 << 31)));
}
@@ -2212,12 +2205,13 @@ DrawMenuEntryLabel(
haveImage = 1;
} else if (mePtr->bitmapPtr != NULL) {
Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+
Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight);
haveImage = 1;
}
if (!haveImage || (mePtr->compound != COMPOUND_NONE)) {
if (mePtr->labelLength > 0) {
- char *label = Tcl_GetString(mePtr->labelPtr);
+ const char *label = Tcl_GetString(mePtr->labelPtr);
textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
textHeight = fmPtr->linespace;
@@ -2312,7 +2306,7 @@ DrawMenuEntryLabel(
if ((mePtr->compound != COMPOUND_NONE) || !haveImage) {
if (mePtr->labelLength > 0) {
int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
- char *label = Tcl_GetString(mePtr->labelPtr);
+ const char *label = Tcl_GetString(mePtr->labelPtr);
if (TkWinGetPlatformTheme() == TK_THEME_WIN_CLASSIC) {
/*
@@ -2321,8 +2315,9 @@ DrawMenuEntryLabel(
*/
if ((mePtr->state == ENTRY_DISABLED) &&
- ((mePtr->entryFlags & ENTRY_PLATFORM_FLAG1) == 0)) {
+ !(mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)) {
COLORREF oldFgColor = gc->foreground;
+
gc->foreground = GetSysColor(COLOR_3DHILIGHT);
Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
mePtr->labelLength, leftEdge + textXOffset + 1,
@@ -2455,12 +2450,7 @@ TkpConfigureMenuEntry(
register TkMenuEntry *mePtr)/* Information about menu entry; may or may
* not already have values for some fields. */
{
- TkMenu *menuPtr = mePtr->menuPtr;
-
- if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
- menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
- }
+ ScheduleMenuReconfigure(mePtr->menuPtr);
return TCL_OK;
}
@@ -2548,7 +2538,7 @@ TkpDrawMenuEntry(
} else {
TkMenuEntry *cascadeEntryPtr;
int parentDisabled = 0;
- char *name;
+ const char *name;
for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
cascadeEntryPtr != NULL;
@@ -2676,6 +2666,7 @@ GetMenuLabelGeometry(
haveImage = 1;
} else if (mePtr->bitmapPtr != NULL) {
Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
+
Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
haveImage = 1;
} else {
@@ -2694,7 +2685,7 @@ GetMenuLabelGeometry(
if (mePtr->labelPtr != NULL) {
int textWidth;
- char *label = Tcl_GetString(mePtr->labelPtr);
+ const char *label = Tcl_GetString(mePtr->labelPtr);
textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength);
@@ -3024,7 +3015,7 @@ MenuSelectEvent(
void
TkpMenuNotifyToplevelCreate(
Tcl_Interp *interp, /* The interp the menu lives in. */
- char *menuName) /* The name of the menu to reconfigure. */
+ const char *menuName) /* The name of the menu to reconfigure. */
{
TkMenuReferences *menuRefPtr;
TkMenu *menuPtr;
@@ -3034,11 +3025,8 @@ TkpMenuNotifyToplevelCreate(
if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
for (menuPtr = menuRefPtr->menuPtr->masterMenuPtr; menuPtr != NULL;
menuPtr = menuPtr->nextInstancePtr) {
- if ((menuPtr->menuType == MENUBAR)
- && !(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
- menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu,
- (ClientData) menuPtr);
+ if (menuPtr->menuType == MENUBAR) {
+ ScheduleMenuReconfigure(menuPtr);
}
}
}
@@ -3068,8 +3056,9 @@ HWND
Tk_GetMenuHWND(
Tk_Window tkwin)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
TkMenuInit();
return tsdPtr->embeddedMenuHWND;
}
@@ -3119,7 +3108,7 @@ static void
MenuThreadExitHandler(
ClientData clientData) /* Not used */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
DestroyWindow(tsdPtr->menuHWND);
@@ -3195,7 +3184,7 @@ SetDefaults(
HDC scratchDC;
int bold = 0;
int italic = 0;
- TEXTMETRIC tm;
+ TEXTMETRICA tm;
int pointSize;
HFONT menuFont;
/* See: [Bug #3239768] tk8.4.19 (and later) WIN32 menu font support */
@@ -3217,7 +3206,7 @@ SetDefaults(
defaultBorderWidth = GetSystemMetrics(SM_CYBORDER);
}
- scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);
+ scratchDC = CreateDCA("DISPLAY", NULL, NULL, NULL);
if (!firstTime) {
Tcl_DStringFree(&menuFontDString);
}
@@ -3235,8 +3224,8 @@ SetDefaults(
&nc.metrics, 0);
menuFont = CreateFontIndirect(&nc.metrics.lfMenuFont);
SelectObject(scratchDC, menuFont);
- GetTextMetrics(scratchDC, &tm);
- GetTextFace(scratchDC, LF_FACESIZE, faceName);
+ GetTextMetricsA(scratchDC, &tm);
+ GetTextFaceA(scratchDC, LF_FACESIZE, faceName);
pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
72, GetDeviceCaps(scratchDC, LOGPIXELSY));
if (tm.tmWeight >= 700) {
@@ -3279,17 +3268,11 @@ SetDefaults(
* only way to ensure menu items line up, and is not documented.
*/
- if (TkWinGetPlatformId() >= VER_PLATFORM_WIN32_WINDOWS) {
- indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK);
- indicatorDimensions[1] = ((GetSystemMetrics(SM_CXFIXEDFRAME) +
- GetSystemMetrics(SM_CXBORDER)
- + GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8)
- - GetSystemMetrics(SM_CXFIXEDFRAME);
- } else {
- DWORD dimensions = GetMenuCheckMarkDimensions();
- indicatorDimensions[0] = HIWORD(dimensions);
- indicatorDimensions[1] = LOWORD(dimensions);
- }
+ indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK);
+ indicatorDimensions[1] = ((GetSystemMetrics(SM_CXFIXEDFRAME) +
+ GetSystemMetrics(SM_CXBORDER)
+ + GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8)
+ - GetSystemMetrics(SM_CXFIXEDFRAME);
/*
* Accelerators used to be always underlines until Win2K when a system
@@ -3298,7 +3281,7 @@ SetDefaults(
showMenuAccelerators = TRUE;
if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- SystemParametersInfo(SPI_GETKEYBOARDCUES, 0, &showMenuAccelerators, 0);
+ SystemParametersInfoA(SPI_GETKEYBOARDCUES, 0, &showMenuAccelerators, 0);
}
}
@@ -3334,16 +3317,16 @@ TkpMenuInit(void)
wndClass.lpszMenuName = NULL;
wndClass.lpszClassName = MENU_CLASS_NAME;
if (!RegisterClass(&wndClass)) {
- Tcl_Panic("Failed to register menu window class.");
+ Tcl_Panic("Failed to register menu window class");
}
wndClass.lpfnWndProc = TkWinEmbeddedMenuProc;
wndClass.lpszClassName = EMBEDDED_MENU_CLASS_NAME;
if (!RegisterClass(&wndClass)) {
- Tcl_Panic("Failed to register embedded menu window class.");
+ Tcl_Panic("Failed to register embedded menu window class");
}
- TkCreateExitHandler(MenuExitHandler, (ClientData) NULL);
+ TkCreateExitHandler(MenuExitHandler, NULL);
SetDefaults(1);
}
@@ -3367,28 +3350,28 @@ TkpMenuInit(void)
void
TkpMenuThreadInit(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
+ tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, TEXT("MenuWindow"), WS_POPUP,
0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);
if (!tsdPtr->menuHWND) {
- Tcl_Panic("Failed to create the menu window.");
+ Tcl_Panic("Failed to create the menu window");
}
tsdPtr->embeddedMenuHWND =
- CreateWindow(EMBEDDED_MENU_CLASS_NAME, "EmbeddedMenuWindow",
+ CreateWindow(EMBEDDED_MENU_CLASS_NAME, TEXT("EmbeddedMenuWindow"),
WS_POPUP, 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);
if (!tsdPtr->embeddedMenuHWND) {
- Tcl_Panic("Failed to create the embedded menu window.");
+ Tcl_Panic("Failed to create the embedded menu window");
}
Tcl_InitHashTable(&tsdPtr->winMenuTable, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&tsdPtr->commandTable, TCL_ONE_WORD_KEYS);
- TkCreateThreadExitHandler(MenuThreadExitHandler, (ClientData) NULL);
+ TkCreateThreadExitHandler(MenuThreadExitHandler, NULL);
}
/*
diff --git a/win/tkWinPixmap.c b/win/tkWinPixmap.c
index 51f0f59..1cf0634 100644
--- a/win/tkWinPixmap.c
+++ b/win/tkWinPixmap.c
@@ -42,7 +42,7 @@ Tk_GetPixmap(
display->request++;
- newTwdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
+ newTwdPtr = ckalloc(sizeof(TkWinDrawable));
newTwdPtr->type = TWD_BITMAP;
newTwdPtr->bitmap.depth = depth;
twdPtr = (TkWinDrawable *) d;
@@ -100,12 +100,12 @@ Tk_GetPixmap(
LPVOID lpMsgBuf;
repeatError = 1;
- if (FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ if (FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER |
FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
- (LPTSTR) &lpMsgBuf, 0, NULL)) {
- MessageBox(NULL, (LPCTSTR) lpMsgBuf,
+ (LPSTR) &lpMsgBuf, 0, NULL)) {
+ MessageBoxA(NULL, (LPCSTR) lpMsgBuf,
"Tk_GetPixmap: Error from CreateDIBSection",
MB_OK | MB_ICONINFORMATION);
LocalFree(lpMsgBuf);
@@ -114,7 +114,7 @@ Tk_GetPixmap(
}
if (newTwdPtr->bitmap.handle == NULL) {
- ckfree((char *) newTwdPtr);
+ ckfree(newTwdPtr);
return None;
}
@@ -147,7 +147,7 @@ Tk_FreePixmap(
display->request++;
if (twdPtr != NULL) {
DeleteObject(twdPtr->bitmap.handle);
- ckfree((char *) twdPtr);
+ ckfree(twdPtr);
}
}
diff --git a/win/tkWinPointer.c b/win/tkWinPointer.c
index dcddb8f..6f1f840 100644
--- a/win/tkWinPointer.c
+++ b/win/tkWinPointer.c
@@ -362,6 +362,20 @@ XWarpPointer(
SetCursorPos(r.left+dest_x, r.top+dest_y);
return Success;
}
+
+void
+TkpWarpPointer(
+ TkDisplay *dispPtr)
+{
+ if (dispPtr->warpWindow) {
+ RECT r;
+
+ GetWindowRect(Tk_GetHWND(Tk_WindowId(dispPtr->warpWindow)), &r);
+ SetCursorPos(r.left + dispPtr->warpX, r.top + dispPtr->warpY);
+ } else {
+ SetCursorPos(dispPtr->warpX, dispPtr->warpY);
+ }
+}
/*
*----------------------------------------------------------------------
diff --git a/win/tkWinPort.h b/win/tkWinPort.h
index b94628e..965dbc5 100644
--- a/win/tkWinPort.h
+++ b/win/tkWinPort.h
@@ -14,21 +14,23 @@
#ifndef _WINPORT
#define _WINPORT
-#include <X11/Xlib.h>
-#include <X11/cursorfont.h>
-#include <X11/keysym.h>
-#include <X11/Xatom.h>
-#include <X11/Xutil.h>
+/*
+ *---------------------------------------------------------------------------
+ * The following sets of #includes and #ifdefs are required to get Tcl to
+ * compile under the windows compilers.
+ *---------------------------------------------------------------------------
+ */
-#include <malloc.h>
+#include <wchar.h>
+#include <io.h>
+#include <stdlib.h>
#include <errno.h>
+#include <fcntl.h>
+#include <malloc.h>
#include <ctype.h>
#include <math.h>
-#include <stdlib.h>
#include <string.h>
#include <limits.h>
-#include <fcntl.h>
-#include <io.h>
/*
* Need to block out this include for building extensions with MetroWerks
@@ -61,6 +63,11 @@
typedef _TCHAR TCHAR;
#endif
+#include <X11/Xlib.h>
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+#include <X11/Xatom.h>
+#include <X11/Xutil.h>
#ifndef __GNUC__
# define strncasecmp _strnicmp
@@ -98,14 +105,6 @@
#endif /* _MSC_VER */
/*
- * The following stubs implement various calls that don't do anything
- * under Windows.
- */
-
-#define TkFreeWindowId(dispPtr,w)
-#define TkInitXId(dispPtr)
-
-/*
* The following Tk functions are implemented as macros under Windows.
*/
@@ -113,7 +112,7 @@
| ((p)->green & 0xff00) | (((p)->blue << 8) & 0xff0000)) | 0x20000000)
/*
- * These calls implement native bitmaps which are not currently
+ * These calls implement native bitmaps which are not currently
* supported under Windows. The macros eliminate the calls.
*/
diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c
index 46aad58..a280626 100644
--- a/win/tkWinScrlbr.c
+++ b/win/tkWinScrlbr.c
@@ -62,10 +62,7 @@ TCL_DECLARE_MUTEX(winScrlbrMutex)
static Window CreateProc(Tk_Window tkwin, Window parent,
ClientData instanceData);
-static void ModalLoopProc(Tk_Window tkwin, XEvent *eventPtr);
-static int ScrollbarBindProc(ClientData clientData,
- Tcl_Interp *interp, XEvent *eventPtr,
- Tk_Window tkwin, KeySym keySym);
+static void ModalLoop(WinScrollbar *, XEvent *eventPtr);
static LRESULT CALLBACK ScrollbarProc(HWND hwnd, UINT message, WPARAM wParam,
LPARAM lParam);
static void UpdateScrollbar(WinScrollbar *scrollPtr);
@@ -75,13 +72,25 @@ static void UpdateScrollbarMetrics(void);
* The class procedure table for the scrollbar widget.
*/
-Tk_ClassProcs tkpScrollbarProcs = {
+const Tk_ClassProcs tkpScrollbarProcs = {
sizeof(Tk_ClassProcs), /* size */
NULL, /* worldChangedProc */
CreateProc, /* createProc */
- ModalLoopProc, /* modalProc */
+ NULL /* modalProc */
};
+static void
+WinScrollbarEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ WinScrollbar *scrollPtr = clientData;
+
+ if (eventPtr->type == ButtonPress) {
+ ModalLoop(scrollPtr, eventPtr);
+ } else {
+ TkScrollbarEventProc(clientData, eventPtr);
+ }
+}
+
/*
*----------------------------------------------------------------------
@@ -104,7 +113,6 @@ TkpCreateScrollbar(
Tk_Window tkwin)
{
WinScrollbar *scrollPtr;
- TkWindow *winPtr = (TkWindow *)tkwin;
if (!initialized) {
Tcl_MutexLock(&winScrlbrMutex);
@@ -113,22 +121,13 @@ TkpCreateScrollbar(
Tcl_MutexUnlock(&winScrlbrMutex);
}
- scrollPtr = (WinScrollbar *) ckalloc(sizeof(WinScrollbar));
+ scrollPtr = ckalloc(sizeof(WinScrollbar));
scrollPtr->winFlags = 0;
scrollPtr->hwnd = NULL;
Tk_CreateEventHandler(tkwin,
- ExposureMask|StructureNotifyMask|FocusChangeMask,
- TkScrollbarEventProc, (ClientData) scrollPtr);
-
- if (!Tcl_GetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL)) {
- Tcl_SetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL,
- (ClientData)1);
- TkCreateBindingProcedure(winPtr->mainPtr->interp,
- winPtr->mainPtr->bindingTable,
- (ClientData)Tk_GetUid("Scrollbar"), "<ButtonPress>",
- ScrollbarBindProc, NULL, NULL);
- }
+ ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask,
+ WinScrollbarEventProc, scrollPtr);
return (TkScrollbar *) scrollPtr;
}
@@ -224,7 +223,7 @@ CreateProc(
| SBS_HORZ | SBS_BOTTOMALIGN;
}
- scrollPtr->hwnd = CreateWindow("SCROLLBAR", NULL, style,
+ scrollPtr->hwnd = CreateWindow(TEXT("SCROLLBAR"), NULL, style,
Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin),
parent, NULL, Tk_GetHINSTANCE(), NULL);
@@ -247,7 +246,7 @@ CreateProc(
scrollPtr->lastVertical = scrollPtr->info.vertical;
scrollPtr->oldProc = (WNDPROC)SetWindowLongPtr(scrollPtr->hwnd,
- GWLP_WNDPROC, (INT_PTR) ScrollbarProc);
+ GWLP_WNDPROC, (LONG_PTR) ScrollbarProc);
window = Tk_AttachHWND(tkwin, scrollPtr->hwnd);
UpdateScrollbar(scrollPtr);
@@ -292,7 +291,7 @@ TkpDisplayScrollbar(
if (scrollPtr->lastVertical != scrollPtr->info.vertical) {
HWND hwnd = Tk_GetHWND(Tk_WindowId(tkwin));
- SetWindowLongPtr(hwnd, GWLP_WNDPROC, (INT_PTR) scrollPtr->oldProc);
+ SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) scrollPtr->oldProc);
DestroyWindow(hwnd);
CreateProc(tkwin, Tk_WindowId(Tk_Parent(tkwin)),
@@ -556,7 +555,7 @@ ScrollbarProc(
code = Tcl_EvalEx(interp, cmdString.string, -1, TCL_EVAL_GLOBAL);
if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
Tcl_AddErrorInfo(interp, "\n (scrollbar command)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
Tcl_DStringFree(&cmdString);
@@ -599,66 +598,26 @@ TkpConfigureScrollbar(
}
/*
- *--------------------------------------------------------------
- *
- * ScrollbarBindProc --
- *
- * This procedure is invoked when the default <ButtonPress> binding on
- * the Scrollbar bind tag fires.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The event enters a modal loop.
- *
- *--------------------------------------------------------------
- */
-
-static int
-ScrollbarBindProc(
- ClientData clientData,
- Tcl_Interp *interp,
- XEvent *eventPtr,
- Tk_Window tkwin,
- KeySym keySym)
-{
- TkWindow *winPtr = (TkWindow *) tkwin;
-
- if (eventPtr->type == ButtonPress) {
- winPtr->flags |= TK_DEFER_MODAL;
- }
- return TCL_OK;
-}
-
-/*
*----------------------------------------------------------------------
*
- * ModalLoopProc --
- *
- * This function is invoked at the end of the event processing whenever
- * the ScrollbarBindProc has been invoked for a ButtonPress event.
+ * ModalLoop --
*
- * Results:
- * None.
- *
- * Side effects:
- * Enters a modal loop.
+ * This function is invoked in response to a ButtonPress event.
+ * It resends the event to the Scrollbar window procedure,
+ * which in turn enters a modal loop.
*
*----------------------------------------------------------------------
*/
static void
-ModalLoopProc(
- Tk_Window tkwin,
+ModalLoop(
+ WinScrollbar *scrollPtr,
XEvent *eventPtr)
{
- TkWindow *winPtr = (TkWindow *) tkwin;
- WinScrollbar *scrollPtr = (WinScrollbar *) winPtr->instanceData;
int oldMode;
if (scrollPtr->hwnd) {
- Tcl_Preserve(scrollPtr);
+ Tcl_Preserve((ClientData)scrollPtr);
scrollPtr->winFlags |= IN_MODAL_LOOP;
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
TkWinResendEvent(scrollPtr->oldProc, scrollPtr->hwnd, eventPtr);
@@ -667,7 +626,7 @@ ModalLoopProc(
if (scrollPtr->hwnd && scrollPtr->winFlags & ALREADY_DEAD) {
DestroyWindow(scrollPtr->hwnd);
}
- Tcl_Release(scrollPtr);
+ Tcl_Release((ClientData)scrollPtr);
}
}
diff --git a/win/tkWinSend.c b/win/tkWinSend.c
index 4b25963..6c4731a 100644
--- a/win/tkWinSend.c
+++ b/win/tkWinSend.c
@@ -14,10 +14,6 @@
#include "tkInt.h"
#include "tkWinSendCom.h"
-#ifdef _MSC_VER
-#define vsnprintf _vsnprintf
-#endif
-
/*
* Should be defined in WTypes.h but mingw 1.0 is missing them.
*/
@@ -59,7 +55,7 @@ typedef struct {
int initialized;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* Functions internal to this file.
@@ -70,18 +66,17 @@ static void CmdDeleteProc(ClientData clientData);
static void InterpDeleteProc(ClientData clientData,
Tcl_Interp *interp);
static void RevokeObjectRegistration(RegisteredInterp *riPtr);
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
static HRESULT BuildMoniker(const char *name, LPMONIKER *pmk);
#ifdef TK_SEND_ENABLED_ON_WINDOWS
static HRESULT RegisterInterp(const char *name,
RegisteredInterp *riPtr);
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
static int FindInterpreterObject(Tcl_Interp *interp,
const char *name, LPDISPATCH *ppdisp);
static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp,
int async, ClientData clientData, int objc,
Tcl_Obj *const objv[]);
-static Tcl_Obj * Win32ErrorObj(HRESULT hrError);
static void SendTrace(const char *format, ...);
static Tcl_EventProc SendEventProc;
@@ -89,7 +84,7 @@ static Tcl_EventProc SendEventProc;
#define TRACE SendTrace
#else
#define TRACE 1 ? ((void)0) : SendTrace
-#endif
+#endif /* DEBUG || _DEBUG */
/*
*--------------------------------------------------------------
@@ -140,9 +135,7 @@ Tk_SetAppName(
HRESULT hr = S_OK;
interp = winPtr->mainPtr->interp;
-
- tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Initialise the COM library for this interpreter just once.
@@ -151,8 +144,9 @@ Tk_SetAppName(
if (tsdPtr->initialized == 0) {
hr = CoInitialize(0);
if (FAILED(hr)) {
- Tcl_SetResult(interp,
- "failed to initialize the COM library", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "failed to initialize the COM library", -1));
+ Tcl_SetErrorCode(interp, "TK", "SEND", "COM", NULL);
return "";
}
tsdPtr->initialized = 1;
@@ -169,7 +163,7 @@ Tk_SetAppName(
if (riPtr == NULL) {
LPUNKNOWN *objPtr;
- riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr = ckalloc(sizeof(RegisteredInterp));
memset(riPtr, 0, sizeof(RegisteredInterp));
riPtr->interp = interp;
@@ -286,7 +280,7 @@ TkGetInterpNames(
if (objList != NULL) {
Tcl_DecrRefCount(objList);
}
- Tcl_SetObjResult(interp, Win32ErrorObj(hr));
+ Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
result = TCL_ERROR;
}
@@ -326,7 +320,7 @@ Tk_SendObjCmd(
enum {
SEND_ASYNC, SEND_DISPLAYOF, SEND_LAST
};
- static const char *sendOptions[] = {
+ static const char *const sendOptions[] = {
"-async", "-displayof", "--", NULL
};
int result = TCL_OK;
@@ -338,8 +332,8 @@ Tk_SendObjCmd(
*/
for (i = 1; i < objc; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions,
- "option", 0, &optind) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], sendOptions,
+ sizeof(char *), "option", 0, &optind) != TCL_OK) {
break;
}
if (optind == SEND_ASYNC) {
@@ -367,9 +361,10 @@ Tk_SendObjCmd(
*/
if (displayPtr) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "option not implemented: \"displayof\" is not available "
- "for this platform.", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "option not implemented: \"displayof\" is not available"
+ " for this platform.", -1));
+ Tcl_SetErrorCode(interp, "TK", "SEND", "DISPLAYOF_WIN", NULL);
result = TCL_ERROR;
}
@@ -379,6 +374,7 @@ Tk_SendObjCmd(
/* FIX ME: we need to check for local interp */
if (result == TCL_OK) {
LPDISPATCH pdisp;
+
result = FindInterpreterObject(interp, Tcl_GetString(objv[i]), &pdisp);
if (result == TCL_OK) {
i++;
@@ -440,9 +436,10 @@ FindInterpreterObject(
pUnkInterp->lpVtbl->Release(pUnkInterp);
} else {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "no application named \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no application named \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "APPLICATION",
+ NULL);
result = TCL_ERROR;
}
@@ -453,7 +450,7 @@ FindInterpreterObject(
pROT->lpVtbl->Release(pROT);
}
if (FAILED(hr) && result == TCL_OK) {
- Tcl_SetObjResult(interp, Win32ErrorObj(hr));
+ Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
result = TCL_ERROR;
}
return result;
@@ -557,7 +554,7 @@ RevokeObjectRegistration(
riPtr->name = NULL;
}
}
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* ----------------------------------------------------------------------
@@ -584,7 +581,7 @@ InterpDeleteProc(
{
CoUninitialize();
}
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* ----------------------------------------------------------------------
@@ -705,7 +702,7 @@ RegisterInterp(
Tcl_DStringFree(&dString);
return hr;
}
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* ----------------------------------------------------------------------
@@ -786,21 +783,14 @@ Send(
* variables.
*/
- if (hr == DISP_E_EXCEPTION) {
+ if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) {
Tcl_Obj *opError, *opErrorCode, *opErrorInfo;
- if (ei.bstrSource != NULL) {
- int len;
- char *szErrorInfo;
-
- opError = Tcl_NewUnicodeObj(ei.bstrSource, -1);
- Tcl_ListObjIndex(interp, opError, 0, &opErrorCode);
- Tcl_SetObjErrorCode(interp, opErrorCode);
-
- Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo);
- szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len);
- Tcl_AddObjErrorInfo(interp, szErrorInfo, len);
- }
+ opError = Tcl_NewUnicodeObj(ei.bstrSource, -1);
+ Tcl_ListObjIndex(interp, opError, 0, &opErrorCode);
+ Tcl_SetObjErrorCode(interp, opErrorCode);
+ Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo);
+ Tcl_AppendObjToErrorInfo(interp, opErrorInfo);
}
/*
@@ -818,57 +808,7 @@ Send(
/*
* ----------------------------------------------------------------------
*
- * Win32ErrorObj --
- *
- * Returns a string object containing text from a COM or Win32 error code
- *
- * Results:
- * A Tcl_Obj containing the Win32 error message.
- *
- * Side effects:
- * Removed the error message from the COM threads error object.
- *
- * ----------------------------------------------------------------------
- */
-
-static Tcl_Obj*
-Win32ErrorObj(
- HRESULT hrError)
-{
- LPTSTR lpBuffer = NULL, p = NULL;
- TCHAR sBuffer[30];
- Tcl_Obj* errPtr = NULL;
-
- FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
- NULL, (DWORD)hrError, LANG_NEUTRAL,
- (LPTSTR)&lpBuffer, 0, NULL);
-
- if (lpBuffer == NULL) {
- lpBuffer = sBuffer;
- wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError);
- }
-
- if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
- *p = TEXT('\0');
- }
-
-#ifdef _UNICODE
- errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer));
-#else
- errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
-#endif
-
- if (lpBuffer != sBuffer) {
- LocalFree((HLOCAL)lpBuffer);
- }
-
- return errPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * SetErrorInfo --
+ * TkWinSend_SetExcepInfo --
*
* Convert the error information from a Tcl interpreter into a COM
* exception structure. This information is then registered with the COM
@@ -885,48 +825,51 @@ Win32ErrorObj(
*/
void
-SetExcepInfo(
- Tcl_Interp* interp,
+TkWinSend_SetExcepInfo(
+ Tcl_Interp *interp,
EXCEPINFO *pExcepInfo)
{
- if (pExcepInfo) {
- Tcl_Obj *opError, *opErrorInfo, *opErrorCode;
- ICreateErrorInfo *pCEI;
- IErrorInfo *pEI, **ppEI = &pEI;
- HRESULT hr;
-
- opError = Tcl_GetObjResult(interp);
- opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo",NULL, TCL_GLOBAL_ONLY);
- opErrorCode = Tcl_GetVar2Ex(interp, "errorCode",NULL, TCL_GLOBAL_ONLY);
-
- if (Tcl_IsShared(opErrorCode)) {
- Tcl_Obj *ec = Tcl_DuplicateObj(opErrorCode);
-
- Tcl_IncrRefCount(ec);
- Tcl_DecrRefCount(opErrorCode);
- opErrorCode = ec;
- }
- Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo);
+ Tcl_Obj *opError, *opErrorInfo, *opErrorCode;
+ ICreateErrorInfo *pCEI;
+ IErrorInfo *pEI, **ppEI = &pEI;
+ HRESULT hr;
+
+ if (!pExcepInfo) {
+ return;
+ }
- pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError));
- pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode));
- pExcepInfo->scode = E_FAIL;
+ opError = Tcl_GetObjResult(interp);
+ opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
+ opErrorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
- hr = CreateErrorInfo(&pCEI);
- if (SUCCEEDED(hr)) {
- hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch);
- hr = pCEI->lpVtbl->SetDescription(pCEI,
- pExcepInfo->bstrDescription);
- hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource);
- hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo,
- (void**) ppEI);
- if (SUCCEEDED(hr)) {
- SetErrorInfo(0, pEI);
- pEI->lpVtbl->Release(pEI);
- }
- pCEI->lpVtbl->Release(pCEI);
- }
+ /*
+ * Pack the trace onto the end of the Tcl exception descriptor.
+ */
+
+ opErrorCode = Tcl_DuplicateObj(opErrorCode);
+ Tcl_IncrRefCount(opErrorCode);
+ Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo);
+ /* TODO: Handle failure to append */
+
+ pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError));
+ pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode));
+ Tcl_DecrRefCount(opErrorCode);
+ pExcepInfo->scode = E_FAIL;
+
+ hr = CreateErrorInfo(&pCEI);
+ if (!SUCCEEDED(hr)) {
+ return;
+ }
+
+ hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch);
+ hr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription);
+ hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource);
+ hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void **) ppEI);
+ if (SUCCEEDED(hr)) {
+ SetErrorInfo(0, pEI);
+ pEI->lpVtbl->Release(pEI);
}
+ pCEI->lpVtbl->Release(pCEI);
}
/*
@@ -955,7 +898,7 @@ TkWinSend_QueueCommand(
TRACE("SendQueueCommand()\n");
- evPtr = (SendEvent *)ckalloc(sizeof(SendEvent));
+ evPtr = ckalloc(sizeof(SendEvent));
evPtr->header.proc = SendEventProc;
evPtr->header.nextPtr = NULL;
evPtr->interp = interp;
@@ -1035,8 +978,8 @@ SendTrace(
static char buffer[1024];
va_start(args, format);
- vsnprintf(buffer, 1023, format, args);
- OutputDebugString(buffer);
+ _vsnprintf(buffer, 1023, format, args);
+ OutputDebugStringA(buffer);
va_end(args);
}
diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c
index 3bbdd63..83dd56b 100644
--- a/win/tkWinSendCom.c
+++ b/win/tkWinSendCom.c
@@ -100,7 +100,6 @@ TkWinSendCom_CreateInstance(
ISupportErrorInfo_Release,
ISupportErrorInfo_InterfaceSupportsErrorInfo,
};
- HRESULT hr = S_OK;
TkWinSendCom *obj = NULL;
/*
@@ -111,21 +110,19 @@ TkWinSendCom_CreateInstance(
obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom));
if (obj == NULL) {
*ppv = NULL;
- hr = E_OUTOFMEMORY;
- } else {
- obj->lpVtbl = &vtbl;
- obj->lpVtbl2 = &vtbl2;
- obj->refcount = 0;
- obj->interp = interp;
-
- /*
- * lock the interp? Tcl_AddRef/Retain?
- */
-
- hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv);
+ return E_OUTOFMEMORY;
}
- return hr;
+ obj->lpVtbl = &vtbl;
+ obj->lpVtbl2 = &vtbl2;
+ obj->refcount = 0;
+ obj->interp = interp;
+
+ /*
+ * lock the interp? Tcl_AddRef/Retain?
+ */
+
+ return obj->lpVtbl->QueryInterface((IDispatch *) obj, riid, ppv);
}
/*
@@ -147,7 +144,7 @@ static void
TkWinSendCom_Destroy(
LPDISPATCH pdisp)
{
- CoTaskMemFree((void*)pdisp);
+ CoTaskMemFree((void *) pdisp);
}
/*
@@ -169,17 +166,17 @@ WinSendCom_QueryInterface(
void **ppvObject)
{
HRESULT hr = E_NOINTERFACE;
- TkWinSendCom *this = (TkWinSendCom*)This;
+ TkWinSendCom *this = (TkWinSendCom *) This;
*ppvObject = NULL;
if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0
|| memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) {
- *ppvObject = (void**)this;
+ *ppvObject = (void **) this;
this->lpVtbl->AddRef(This);
hr = S_OK;
} else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) {
- *ppvObject = (void**)(this + 1);
- this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1));
+ *ppvObject = (void **) (this + 1);
+ this->lpVtbl2->AddRef((ISupportErrorInfo *) (this + 1));
hr = S_OK;
}
return hr;
@@ -316,16 +313,16 @@ ISupportErrorInfo_QueryInterface(
REFIID riid,
void **ppvObject)
{
- TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ TkWinSendCom *this = (TkWinSendCom *)(This - 1);
- return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject);
+ return this->lpVtbl->QueryInterface((IDispatch *) this, riid, ppvObject);
}
static STDMETHODIMP_(ULONG)
ISupportErrorInfo_AddRef(
ISupportErrorInfo *This)
{
- TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ TkWinSendCom *this = (TkWinSendCom *)(This - 1);
return InterlockedIncrement(&this->refcount);
}
@@ -334,9 +331,9 @@ static STDMETHODIMP_(ULONG)
ISupportErrorInfo_Release(
ISupportErrorInfo *This)
{
- TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ TkWinSendCom *this = (TkWinSendCom *)(This - 1);
- return this->lpVtbl->Release((IDispatch*)this);
+ return this->lpVtbl->Release((IDispatch *) this);
}
static STDMETHODIMP
@@ -378,22 +375,20 @@ Async(
hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR);
if (FAILED(hr)) {
- Tcl_SetStringObj(Tcl_GetObjResult(obj->interp),
- "invalid args: Async(command)", -1);
- SetExcepInfo(obj->interp, pExcepInfo);
+ Tcl_SetObjResult(obj->interp, Tcl_NewStringObj(
+ "invalid args: Async(command)", -1));
+ TkWinSend_SetExcepInfo(obj->interp, pExcepInfo);
hr = DISP_E_EXCEPTION;
}
- if (SUCCEEDED(hr)) {
- if (obj->interp) {
- Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
- (int)SysStringLen(vCmd.bstrVal));
- TkWinSend_QueueCommand(obj->interp, scriptPtr);
- }
+ if (SUCCEEDED(hr) && obj->interp) {
+ Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
+ (int) SysStringLen(vCmd.bstrVal));
+
+ TkWinSend_QueueCommand(obj->interp, scriptPtr);
}
VariantClear(&vCmd);
-
return hr;
}
@@ -427,29 +422,36 @@ Send(
HRESULT hr = S_OK;
int result = TCL_OK;
VARIANT v;
+ register Tcl_Interp *interp = obj->interp;
+ Tcl_Obj *scriptPtr;
+ if (interp == NULL) {
+ return S_OK;
+ }
VariantInit(&v);
hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR);
- if (SUCCEEDED(hr)) {
- if (obj->interp) {
- Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal,
- (int)SysStringLen(v.bstrVal));
-
- result = Tcl_EvalObjEx(obj->interp, scriptPtr,
- TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
- if (pvResult) {
- VariantInit(pvResult);
- pvResult->vt = VT_BSTR;
- pvResult->bstrVal = SysAllocString(
- Tcl_GetUnicode(Tcl_GetObjResult(obj->interp)));
- }
- if (result == TCL_ERROR) {
- hr = DISP_E_EXCEPTION;
- SetExcepInfo(obj->interp, pExcepInfo);
- }
- }
- VariantClear(&v);
+ if (!SUCCEEDED(hr)) {
+ return hr;
+ }
+
+ scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, (int) SysStringLen(v.bstrVal));
+ Tcl_Preserve(interp);
+ Tcl_IncrRefCount(scriptPtr);
+ result = Tcl_EvalObjEx(interp, scriptPtr,
+ TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(scriptPtr);
+ if (pvResult != NULL) {
+ VariantInit(pvResult);
+ pvResult->vt = VT_BSTR;
+ pvResult->bstrVal = SysAllocString(Tcl_GetUnicode(
+ Tcl_GetObjResult(interp)));
+ }
+ if (result == TCL_ERROR) {
+ hr = DISP_E_EXCEPTION;
+ TkWinSend_SetExcepInfo(interp, pExcepInfo);
}
+ Tcl_Release(interp);
+ VariantClear(&v);
return hr;
}
diff --git a/win/tkWinSendCom.h b/win/tkWinSendCom.h
index 4928bc7..cd6ec18 100644
--- a/win/tkWinSendCom.h
+++ b/win/tkWinSendCom.h
@@ -45,11 +45,11 @@ typedef struct {
* TkWinSendCom public functions
*/
-HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp,
+MODULE_SCOPE HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp,
REFIID riid, void **ppv);
-int TkWinSend_QueueCommand(Tcl_Interp *interp,
+MODULE_SCOPE int TkWinSend_QueueCommand(Tcl_Interp *interp,
Tcl_Obj *cmdPtr);
-void SetExcepInfo(Tcl_Interp *interp,
+MODULE_SCOPE void TkWinSend_SetExcepInfo(Tcl_Interp *interp,
EXCEPINFO *pExcepInfo);
#endif /* _tkWinSendCom_h_INCLUDE */
diff --git a/win/tkWinTest.c b/win/tkWinTest.c
index 2498864..d824ee4 100644
--- a/win/tkWinTest.c
+++ b/win/tkWinTest.c
@@ -12,6 +12,10 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+#undef USE_TK_STUBS
+#define USE_TK_STUBS
#include "tkWinInt.h"
HWND tkWinCurrentDialog;
@@ -23,8 +27,9 @@ HWND tkWinCurrentDialog;
static int TestclipboardObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestwineventCmd(ClientData clientData,
- Tcl_Interp *interp, int argc, const char **argv);
+static int TestwineventObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static int TestfindwindowObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -34,7 +39,7 @@ static int TestgetwindowinfoObjCmd(ClientData clientData,
static int TestwinlocaleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp);
+static Tk_GetSelProc SetSelectionResult;
/*
*----------------------------------------------------------------------
@@ -63,7 +68,7 @@ TkplatformtestInit(
Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
- Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd,
+ Tcl_CreateObjCommand(interp, "testwinevent", TestwineventObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testfindwindow", TestfindwindowObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
@@ -74,6 +79,42 @@ TkplatformtestInit(
return TCL_OK;
}
+struct TestFindControlState {
+ int id;
+ HWND control;
+};
+
+/* Callback for window enumeration - used for TestFindControl */
+BOOL CALLBACK TestFindControlCallback(
+ HWND hwnd,
+ LPARAM lParam
+)
+{
+ struct TestFindControlState *fcsPtr = (struct TestFindControlState *)lParam;
+ fcsPtr->control = GetDlgItem(hwnd, fcsPtr->id);
+ /* If we have found the control, return FALSE to stop the enumeration */
+ return fcsPtr->control == NULL ? TRUE : FALSE;
+}
+
+/*
+ * Finds the descendent control window with the specified ID and returns
+ * its HWND.
+ */
+HWND TestFindControl(HWND root, int id)
+{
+ struct TestFindControlState fcs;
+
+ fcs.control = GetDlgItem(root, id);
+ if (fcs.control == NULL) {
+ /* Control is not a direct child. Look in descendents */
+ fcs.id = id;
+ fcs.control = NULL;
+ EnumChildWindows(root, TestFindControlCallback, (LPARAM) &fcs);
+ }
+ return fcs.control;
+}
+
+
/*
*----------------------------------------------------------------------
*
@@ -106,7 +147,8 @@ AppendSystemError(
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
}
- length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
+ length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_IGNORE_INSERTS
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
0, NULL);
@@ -114,6 +156,7 @@ AppendSystemError(
char *msgPtr;
length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_IGNORE_INSERTS
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
0, NULL);
@@ -185,50 +228,36 @@ AppendSystemError(
*/
static int
+SetSelectionResult(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ const char *selection)
+{
+ Tcl_AppendResult(interp, selection, NULL);
+ return TCL_OK;
+}
+
+static int
TestclipboardObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
- HGLOBAL handle;
- char *data;
- int code = TCL_OK;
+ Tk_Window tkwin = (Tk_Window) clientData;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- if (OpenClipboard(NULL)) {
- /*
- * We could consider using CF_UNICODETEXT on NT, but then we
- * would have to convert it from External. Instead we'll just
- * take this and do "bytestring" at the Tcl level for Unicode
- * inclusive text
- */
- handle = GetClipboardData(CF_TEXT);
- if (handle != NULL) {
- data = GlobalLock(handle);
- Tcl_AppendResult(interp, data, NULL);
- GlobalUnlock(handle);
- } else {
- Tcl_AppendResult(interp, "null clipboard handle", NULL);
- code = TCL_ERROR;
- }
- CloseClipboard();
- return code;
- } else {
- Tcl_AppendResult(interp, "couldn't open clipboard: ", NULL);
- AppendSystemError(interp, GetLastError());
- return TCL_ERROR;
- }
- return TCL_OK;
+ return TkSelGetSelection(interp, tkwin, Tk_InternAtom(tkwin, "CLIPBOARD"),
+ XA_STRING, SetSelectionResult, NULL);
}
/*
*----------------------------------------------------------------------
*
- * TestwineventCmd --
+ * TestwineventObjCmd --
*
* This function implements the testwinevent command. It provides a way
* to send messages to windows dialogs.
@@ -243,19 +272,21 @@ TestclipboardObjCmd(
*/
static int
-TestwineventCmd(
+TestwineventObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
HWND hwnd = 0;
HWND child = 0;
+ HWND control;
int id;
char *rest;
UINT message;
WPARAM wParam;
LPARAM lParam;
+ LRESULT result;
static const TkStateMap messageMap[] = {
{WM_LBUTTONDOWN, "WM_LBUTTONDOWN"},
{WM_LBUTTONUP, "WM_LBUTTONUP"},
@@ -266,38 +297,38 @@ TestwineventCmd(
{-1, NULL}
};
- if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
+ if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "debug") == 0)) {
int b;
- if (Tcl_GetBoolean(interp, argv[2], &b) != TCL_OK) {
+ if (Tcl_GetBoolean(interp, Tcl_GetString(objv[2]), &b) != TCL_OK) {
return TCL_ERROR;
}
TkWinDialogDebug(b);
return TCL_OK;
}
- if (argc < 4) {
+ if (objc < 4) {
return TCL_ERROR;
}
- hwnd = INT2PTR(strtol(argv[1], &rest, 0));
- if (rest == argv[1]) {
- hwnd = FindWindow(NULL, argv[1]);
+ hwnd = INT2PTR(strtol(Tcl_GetString(objv[1]), &rest, 0));
+ if (rest == Tcl_GetString(objv[1])) {
+ hwnd = FindWindowA(NULL, Tcl_GetString(objv[1]));
if (hwnd == NULL) {
- Tcl_SetResult(interp, "no such window", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1));
return TCL_ERROR;
}
}
UpdateWindow(hwnd);
- id = strtol(argv[2], &rest, 0);
- if (rest == argv[2]) {
+ id = strtol(Tcl_GetString(objv[2]), &rest, 0);
+ if (rest == Tcl_GetString(objv[2])) {
char buf[256];
child = GetWindow(hwnd, GW_CHILD);
while (child != NULL) {
- SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
- if (strcasecmp(buf, argv[2]) == 0) {
+ SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
+ if (strcasecmp(buf, Tcl_GetString(objv[2])) == 0) {
id = GetDlgCtrlID(child);
break;
}
@@ -305,19 +336,20 @@ TestwineventCmd(
}
if (child == NULL) {
Tcl_AppendResult(interp, "could not find a control matching \"",
- argv[2], "\"", NULL);
+ Tcl_GetString(objv[2]), "\"", NULL);
return TCL_ERROR;
}
}
- message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
+
+ message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3]));
wParam = 0;
lParam = 0;
- if (argc > 4) {
- wParam = strtol(argv[4], NULL, 0);
+ if (objc > 4) {
+ wParam = strtol(Tcl_GetString(objv[4]), NULL, 0);
}
- if (argc > 5) {
- lParam = strtol(argv[5], NULL, 0);
+ if (objc > 5) {
+ lParam = strtol(Tcl_GetString(objv[5]), NULL, 0);
}
switch (message) {
@@ -325,7 +357,19 @@ TestwineventCmd(
Tcl_DString ds;
char buf[256];
- GetDlgItemText(hwnd, id, buf, 256);
+#if 0
+ GetDlgItemTextA(hwnd, id, buf, 256);
+#else
+ control = TestFindControl(hwnd, id);
+ if (control == NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("Could not find control with id %d", id));
+ return TCL_ERROR;
+ }
+ buf[0] = 0;
+ SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf),
+ (LPARAM) buf);
+#endif
Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
Tcl_DStringFree(&ds);
@@ -333,34 +377,40 @@ TestwineventCmd(
}
case WM_SETTEXT: {
Tcl_DString ds;
- BOOL result;
- Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
- result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
+ control = TestFindControl(hwnd, id);
+ if (control == NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("Could not find control with id %d", id));
+ return TCL_ERROR;
+ }
+ Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds);
+ result = SendMessageA(control, WM_SETTEXT, 0,
+ (LPARAM) Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result == 0) {
- Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC);
- AppendSystemError(interp, GetLastError());
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
+ AppendSystemError(interp, GetLastError());
+ return TCL_ERROR;
}
break;
}
case WM_COMMAND: {
char buf[TCL_INTEGER_SPACE];
- if (argc < 5) {
+ if (objc < 5) {
wParam = MAKEWPARAM(id, 0);
lParam = (LPARAM)child;
}
- sprintf(buf, "%d", (int) SendMessage(hwnd, message, wParam, lParam));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
break;
}
default: {
char buf[TCL_INTEGER_SPACE];
sprintf(buf, "%d",
- (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ (int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
break;
}
}
@@ -385,18 +435,48 @@ TestfindwindowObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
- const char *title = NULL, *class = NULL;
+ const TCHAR *title = NULL, *class = NULL;
+ Tcl_DString titleString, classString;
HWND hwnd = NULL;
int r = TCL_OK;
+ DWORD myPid;
+
+ Tcl_DStringInit(&classString);
+ Tcl_DStringInit(&titleString);
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
return TCL_ERROR;
}
- title = Tcl_GetString(objv[1]);
- if (objc == 3)
- class = Tcl_GetString(objv[2]);
- hwnd = FindWindowA(class, title);
+
+ title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString);
+ if (objc == 3) {
+ class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString);
+ }
+ if (title[0] == 0)
+ title = NULL;
+#if 0
+ hwnd = FindWindow(class, title);
+#else
+ /* We want find a window the belongs to us and not some other process */
+ hwnd = NULL;
+ myPid = GetCurrentProcessId();
+ while (1) {
+ DWORD pid, tid;
+ hwnd = FindWindowEx(NULL, hwnd, class, title);
+ if (hwnd == NULL)
+ break;
+ tid = GetWindowThreadProcessId(hwnd, &pid);
+ if (tid == 0) {
+ /* Window has gone */
+ hwnd = NULL;
+ break;
+ }
+ if (pid == myPid)
+ break; /* Found it */
+ }
+
+#endif
if (hwnd == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
@@ -405,7 +485,11 @@ TestfindwindowObjCmd(
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd)));
}
+
+ Tcl_DStringFree(&titleString);
+ Tcl_DStringFree(&classString);
return r;
+
}
static BOOL CALLBACK
@@ -427,10 +511,10 @@ TestgetwindowinfoObjCmd(
Tcl_Obj *const objv[])
{
long hwnd;
- Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL;
+ Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL;
Tcl_Obj *childrenObj = NULL;
- char buf[512];
- int cch, cchBuf = tkWinProcs->useWide ? 256 : 512;
+ TCHAR buf[512];
+ int cch, cchBuf = 256;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "hwnd");
@@ -440,46 +524,35 @@ TestgetwindowinfoObjCmd(
if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK)
return TCL_ERROR;
- if (tkWinProcs->useWide) {
- cch = GetClassNameW(INT2PTR(hwnd), (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR));
- classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch);
- } else {
- cch = GetClassNameA(INT2PTR(hwnd), (LPSTR)buf, sizeof(buf));
- classObj = Tcl_NewStringObj((LPSTR)buf, cch);
- }
+ cch = GetClassName(INT2PTR(hwnd), buf, cchBuf);
if (cch == 0) {
- Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1));
AppendSystemError(interp, GetLastError());
return TCL_ERROR;
+ } else {
+ Tcl_DString ds;
+ Tcl_WinTCharToUtf(buf, -1, &ds);
+ classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
}
- resObj = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("class", -1));
- Tcl_ListObjAppendElement(interp, resObj, classObj);
-
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -1));
- Tcl_ListObjAppendElement(interp, resObj,
- Tcl_NewLongObj(GetWindowLong(INT2PTR(hwnd), GWL_ID)));
+ dictObj = Tcl_NewDictObj();
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj);
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2),
+ Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID)));
- cch = tkWinProcs->getWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf);
- if (tkWinProcs->useWide) {
- textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
- } else {
- textObj = Tcl_NewStringObj((LPCSTR)buf, cch);
- }
+ cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf);
+ textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("text", -1));
- Tcl_ListObjAppendElement(interp, resObj, textObj);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("parent", -1));
- Tcl_ListObjAppendElement(interp, resObj,
- Tcl_NewLongObj(PTR2INT(GetParent(INT2PTR(hwnd)))));
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj);
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6),
+ Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd))))));
childrenObj = Tcl_NewListObj(0, NULL);
EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("children", -1));
- Tcl_ListObjAppendElement(interp, resObj, childrenObj);
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj);
- Tcl_SetObjResult(interp, resObj);
+ Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
}
@@ -494,7 +567,7 @@ TestwinlocaleObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetSystemDefaultLCID()));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetThreadLocale()));
return TCL_OK;
}
diff --git a/win/tkWinWindow.c b/win/tkWinWindow.c
index 3dfc078..ade15bc 100644
--- a/win/tkWinWindow.c
+++ b/win/tkWinWindow.c
@@ -11,6 +11,7 @@
*/
#include "tkWinInt.h"
+#include "tkBusy.h"
typedef struct ThreadSpecificData {
int initialized; /* 0 means table below needs initializing. */
@@ -65,7 +66,7 @@ Tk_AttachHWND(
*/
if (twdPtr == NULL) {
- twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
+ twdPtr = ckalloc(sizeof(TkWinDrawable));
twdPtr->type = TWD_WINDOW;
twdPtr->window.winPtr = (TkWindow *) tkwin;
} else if (twdPtr->window.handle != NULL) {
@@ -80,7 +81,7 @@ Tk_AttachHWND(
twdPtr->window.handle = hwnd;
entryPtr = Tcl_CreateHashEntry(&tsdPtr->windowTable, (char *)hwnd, &new);
- Tcl_SetHashValue(entryPtr, (ClientData)tkwin);
+ Tcl_SetHashValue(entryPtr, tkwin);
return (Window)twdPtr;
}
@@ -172,12 +173,13 @@ TkpPrintWindowId(
/*
* Use pointer representation, because Win64 is P64 (*not* LP64). Windows
* doesn't print the 0x for %p, so we do it.
- * bug #2026405: cygwin does output 0x for %p so test and recover.
+ * Bug 2026405: cygwin does output 0x for %p so test and recover.
*/
sprintf(buf, "0x%p", hwnd);
- if (buf[2] == '0' && buf[3] == 'x')
+ if (buf[2] == '0' && buf[3] == 'x') {
sprintf(buf, "%p", hwnd);
+ }
}
/*
@@ -204,12 +206,15 @@ TkpPrintWindowId(
int
TkpScanWindowId(
Tcl_Interp *interp, /* Interpreter to use for error reporting. */
- CONST char *string, /* String containing a (possibly signed)
+ const char *string, /* String containing a (possibly signed)
* integer in a form acceptable to strtol. */
Window *idPtr) /* Place to store converted result. */
{
Tk_Window tkwin;
- void *number, *numberPtr = &number;
+ union {
+ HWND hwnd;
+ int number;
+ } win;
/*
* We want sscanf for the 64-bit check, but if that doesn't work, then
@@ -218,13 +223,13 @@ TkpScanWindowId(
if (
#ifdef _WIN64
- (sscanf(string, "0x%p", &number) != 1) &&
+ (sscanf(string, "0x%p", &win.hwnd) != 1) &&
#endif
- Tcl_GetInt(interp, string, (int *) numberPtr) != TCL_OK) {
+ Tcl_GetInt(interp, string, &win.number) != TCL_OK) {
return TCL_ERROR;
}
- tkwin = Tk_HWNDToWindow((HWND) number);
+ tkwin = Tk_HWNDToWindow(win.hwnd);
if (tkwin) {
*idPtr = Tk_WindowId(tkwin);
} else {
@@ -323,7 +328,7 @@ XDestroyWindow(
Tcl_DeleteHashEntry(entryPtr);
}
- ckfree((char *)twdPtr);
+ ckfree(twdPtr);
/*
* Don't bother destroying the window if we are going to destroy the
@@ -794,27 +799,174 @@ TkWinSetWindowPos(
/*
*----------------------------------------------------------------------
*
- * TkpWindowWasRecentlyDeleted --
+ * TkpShowBusyWindow --
*
- * Determines whether we know if the window given as argument was
- * recently deleted. Called by the generic code error handler to handle
- * BadWindow events.
+ * Makes a busy window "appear".
*
* Results:
- * Always 0. We do not keep this information on Windows.
+ * None.
*
* Side effects:
+ * Arranges for the busy window to start intercepting events and the
+ * cursor to change to the configured "hey, I'm busy!" setting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpShowBusyWindow(
+ TkBusy busy)
+{
+ Busy *busyPtr = (Busy *) busy;
+ HWND hWnd;
+ POINT point;
+ Display *display;
+ Window window;
+
+ if (busyPtr->tkBusy != NULL) {
+ Tk_MapWindow(busyPtr->tkBusy);
+ window = Tk_WindowId(busyPtr->tkBusy);
+ display = Tk_Display(busyPtr->tkBusy);
+ hWnd = Tk_GetHWND(window);
+ display->request++;
+ SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE);
+ }
+
+ /*
+ * Under Win32, cursors aren't associated with windows. Tk fakes this by
+ * watching Motion events on its windows. So Tk will automatically change
+ * the cursor when the pointer enters the Busy window. But Windows does
+ * not immediately change the cursor; it waits for the cursor position to
+ * change or a system call. We need to change the cursor before the
+ * application starts processing, so set the cursor position redundantly
+ * back to the current position.
+ */
+
+ GetCursorPos(&point);
+ SetCursorPos(point.x, point.y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpHideBusyWindow --
+ *
+ * Makes a busy window "disappear".
+ *
+ * Results:
* None.
*
+ * Side effects:
+ * Arranges for the busy window to stop intercepting events, and the
+ * cursor to change back to its normal setting.
+ *
*----------------------------------------------------------------------
*/
-int
-TkpWindowWasRecentlyDeleted(
- Window win,
- TkDisplay *dispPtr)
+void
+TkpHideBusyWindow(
+ TkBusy busy)
{
- return 0;
+ Busy *busyPtr = (Busy *) busy;
+ POINT point;
+
+ if (busyPtr->tkBusy != NULL) {
+ Tk_UnmapWindow(busyPtr->tkBusy);
+ }
+
+ /*
+ * Under Win32, cursors aren't associated with windows. Tk fakes this by
+ * watching Motion events on its windows. So Tk will automatically change
+ * the cursor when the pointer enters the Busy window. But Windows does
+ * not immediately change the cursor: it waits for the cursor position to
+ * change or a system call. We need to change the cursor before the
+ * application starts processing, so set the cursor position redundantly
+ * back to the current position.
+ */
+
+ GetCursorPos(&point);
+ SetCursorPos(point.x, point.y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeTransparentWindowExist --
+ *
+ * Construct the platform-specific resources for a transparent window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves the specified window in the stacking order.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeTransparentWindowExist(
+ Tk_Window tkwin, /* Token for window. */
+ Window parent) /* Parent window. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ HWND hParent = (HWND) parent, hWnd;
+ int style = WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS;
+ DWORD exStyle = WS_EX_TRANSPARENT | WS_EX_TOPMOST;
+
+ hWnd = CreateWindowEx(exStyle, TK_WIN_CHILD_CLASS_NAME, NULL, style,
+ Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin),
+ hParent, NULL, Tk_GetHINSTANCE(), NULL);
+ winPtr->window = Tk_AttachHWND(tkwin, hWnd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateBusy --
+ *
+ * Construct the platform-specific parts of a busy window. Note that this
+ * postpones the actual creation of the window resource until later.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up part of the busy window structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpCreateBusy(
+ Tk_FakeWin *winPtr,
+ Tk_Window tkRef,
+ Window *parentPtr,
+ Tk_Window tkParent,
+ TkBusy busy)
+{
+ Busy *busyPtr = (Busy *) busy;
+
+ if (winPtr->flags & TK_REPARENTED) {
+ /*
+ * This works around a bug in the implementation of menubars for
+ * non-Macintosh window systems (Win32 and X11). Tk doesn't reset the
+ * pointers to the parent window when the menu is reparented
+ * (winPtr->parentPtr points to the wrong window). We get around this
+ * by determining the parent via the native API calls.
+ */
+
+ HWND hWnd = GetParent(Tk_GetHWND(Tk_WindowId(tkRef)));
+ RECT rect;
+
+ if (GetWindowRect(hWnd, &rect)) {
+ busyPtr->width = rect.right - rect.left;
+ busyPtr->height = rect.bottom - rect.top;
+ }
+ } else {
+ *parentPtr = Tk_WindowId(tkParent);
+ *parentPtr = (Window) Tk_GetHWND(*parentPtr);
+ }
}
/*
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index 2c3b0e4..768ee69 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.c
@@ -58,7 +58,7 @@ typedef struct ProtocolHandler {
* same top-level window, or NULL for end of
* list. */
Tcl_Interp *interp; /* Interpreter in which to invoke command. */
- char command[4]; /* Tcl command to invoke when a client message
+ char command[1]; /* Tcl command to invoke when a client message
* for this protocol arrives. The actual size
* of the structure varies to accommodate the
* needs of the actual command. THIS MUST BE
@@ -66,7 +66,7 @@ typedef struct ProtocolHandler {
} ProtocolHandler;
#define HANDLER_SIZE(cmdLength) \
- ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength))
+ ((unsigned) ((Tk_Offset(ProtocolHandler, command) + 1) + cmdLength))
/*
* Helper type passed via lParam to TkWmStackorderToplevelEnumProc
@@ -74,7 +74,7 @@ typedef struct ProtocolHandler {
typedef struct TkWmStackorderToplevelPair {
Tcl_HashTable *table;
- TkWindow **window_ptr;
+ TkWindow **windowPtr;
} TkWmStackorderToplevelPair;
/*
@@ -148,7 +148,7 @@ typedef struct {
*/
typedef struct WinIconInstance {
- int refCount; /* Number of instances that share this data
+ size_t refCount; /* Number of instances that share this data
* structure. */
BlockOfIconImagesPtr iconBlock;
/* Pointer to icon resource data for image */
@@ -395,23 +395,6 @@ static Tcl_ThreadDataKey dataKey;
static int initialized; /* Flag indicating whether module has been
* initialized. */
-/*
- * A pointer to a shell proc which allows us to extract icons from any file.
- * We just initialize this when we start up (if we can) and then it never
- * changes
- */
-
-DWORD* (WINAPI *shgetfileinfoProc) (LPCTSTR pszPath, DWORD dwFileAttributes,
- SHFILEINFO* psfi, UINT cbFileInfo, UINT uFlags) = NULL;
-
-/*
- * A pointer to SetLayeredWindowAttributes (user32.dll) which we retrieve
- * dynamically because it is only valid on Win2K+.
- */
-
-BOOL (WINAPI *setLayeredWindowAttributesProc) (HWND hwnd, COLORREF crKey,
- BYTE bAlpha, DWORD dwFlags) = NULL;
-
TCL_DECLARE_MUTEX(winWmMutex)
/*
@@ -432,7 +415,7 @@ static int InstallColormaps(HWND hwnd, int message,
int isForemost);
static void InvalidateSubTree(TkWindow *winPtr, Colormap colormap);
static void InvalidateSubTreeDepth(TkWindow *winPtr);
-static int ParseGeometry(Tcl_Interp *interp, char *string,
+static int ParseGeometry(Tcl_Interp *interp, const char *string,
TkWindow *winPtr);
static void RefreshColormap(Colormap colormap, TkDisplay *dispPtr);
static void SetLimits(HWND hwnd, MINMAXINFO *info);
@@ -650,7 +633,7 @@ static LPSTR
FindDIBBits(
LPSTR lpbi)
{
- return lpbi + *(LPDWORD)lpbi + PaletteSize(lpbi);
+ return lpbi + *((LPDWORD) lpbi) + PaletteSize(lpbi);
}
/*
@@ -706,7 +689,7 @@ AdjustIconImagePointers(
* BITMAPINFO is at beginning of bits.
*/
- lpImage->lpbi = (LPBITMAPINFO)lpImage->lpBits;
+ lpImage->lpbi = (LPBITMAPINFO) lpImage->lpBits;
/*
* Width - simple enough.
@@ -732,14 +715,14 @@ AdjustIconImagePointers(
* XOR bits follow the header and color table.
*/
- lpImage->lpXOR = (LPBYTE)FindDIBBits(((LPSTR)lpImage->lpbi));
+ lpImage->lpXOR = (LPBYTE) FindDIBBits((LPSTR) lpImage->lpbi);
/*
* AND bits follow the XOR bits.
*/
- lpImage->lpAND = lpImage->lpXOR + (lpImage->Height*
- BytesPerLine((LPBITMAPINFOHEADER)(lpImage->lpbi)));
+ lpImage->lpAND = lpImage->lpXOR +
+ lpImage->Height*BytesPerLine((LPBITMAPINFOHEADER) lpImage->lpbi);
return TRUE;
}
@@ -762,49 +745,30 @@ MakeIconOrCursorFromResource(
LPICONIMAGE lpIcon,
BOOL isIcon)
{
- HICON hIcon ;
- static FARPROC pfnCreateIconFromResourceEx=NULL;
- static int initinfo=0;
+ HICON hIcon;
/*
* Sanity Check
*/
- if (lpIcon == NULL) {
+ if (lpIcon == NULL || lpIcon->lpBits == NULL) {
return NULL;
}
- if (lpIcon->lpBits == NULL) {
- return NULL;
- }
-
- if (!initinfo) {
- HMODULE hMod = GetModuleHandleA("USER32.DLL");
-
- initinfo = 1;
- if (hMod) {
- pfnCreateIconFromResourceEx =
- GetProcAddress(hMod, "CreateIconFromResourceEx");
- }
- }
/*
* Let the OS do the real work :)
*/
- if (pfnCreateIconFromResourceEx != NULL) {
- hIcon = (HICON) (pfnCreateIconFromResourceEx) (lpIcon->lpBits,
- lpIcon->dwNumBytes, isIcon, 0x00030000,
- (*(LPBITMAPINFOHEADER)(lpIcon->lpBits)).biWidth,
- (*(LPBITMAPINFOHEADER)(lpIcon->lpBits)).biHeight/2, 0);
- } else {
- hIcon = NULL;
- }
+ hIcon = (HICON) CreateIconFromResourceEx(lpIcon->lpBits,
+ lpIcon->dwNumBytes, isIcon, 0x00030000,
+ (*(LPBITMAPINFOHEADER) lpIcon->lpBits).biWidth,
+ (*(LPBITMAPINFOHEADER) lpIcon->lpBits).biHeight/2, 0);
/*
* It failed, odds are good we're on NT so try the non-Ex way.
*/
- if (hIcon == NULL) {
+ if (hIcon == NULL) {
/*
* We would break on NT if we try with a 16bpp image.
*/
@@ -892,40 +856,20 @@ static int
InitWindowClass(
WinIconPtr titlebaricon)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (! tsdPtr->initialized) {
+ if (!tsdPtr->initialized) {
tsdPtr->initialized = 1;
tsdPtr->firstWindow = 1;
tsdPtr->iconPtr = NULL;
}
- if (! initialized) {
+ if (!initialized) {
Tcl_MutexLock(&winWmMutex);
- if (! initialized) {
- Tcl_DString classString;
+ if (!initialized) {
WNDCLASS class;
- initialized = 1;
- if (shgetfileinfoProc == NULL) {
- HINSTANCE hInstance = LoadLibraryA("shell32");
- if (hInstance != NULL) {
- shgetfileinfoProc = (DWORD* (WINAPI *) (LPCTSTR pszPath,
- DWORD dwFileAttributes, SHFILEINFO* psfi,
- UINT cbFileInfo, UINT uFlags))
- GetProcAddress(hInstance, "SHGetFileInfo");
- FreeLibrary(hInstance);
- }
- }
- if (setLayeredWindowAttributesProc == NULL) {
- HINSTANCE hInstance = LoadLibraryA("user32");
- if (hInstance != NULL) {
- setLayeredWindowAttributesProc = (BOOL (WINAPI*)(HWND hwnd,
- COLORREF crKey, BYTE bAlpha, DWORD dwFlags))
- GetProcAddress(hInstance,"SetLayeredWindowAttributes");
- FreeLibrary(hInstance);
- }
- }
+ initialized = 1;
/*
* The only difference between WNDCLASSW and WNDCLASSA are in
@@ -936,11 +880,10 @@ InitWindowClass(
class.style = CS_HREDRAW | CS_VREDRAW;
class.hInstance = Tk_GetHINSTANCE();
- Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString);
- class.lpszClassName = (LPCTSTR) Tcl_DStringValue(&classString);
+ class.lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME;
class.lpfnWndProc = WmProc;
if (titlebaricon == NULL) {
- class.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
+ class.hIcon = LoadIcon(Tk_GetHINSTANCE(), TEXT("tk"));
} else {
class.hIcon = GetIcon(titlebaricon, ICON_BIG);
if (class.hIcon == NULL) {
@@ -956,11 +899,9 @@ InitWindowClass(
}
class.hCursor = LoadCursor(NULL, IDC_ARROW);
- if (!(*tkWinProcs->registerClass)(&class)) {
+ if (!RegisterClass(&class)) {
Tcl_Panic("Unable to register TkTopLevel class");
}
-
- Tcl_DStringFree(&classString);
}
Tcl_MutexUnlock(&winWmMutex);
}
@@ -1031,8 +972,10 @@ WinSetIcon(
}
if (!(Tk_IsTopLevel(tkw))) {
- Tcl_AppendResult(interp, "window \"", Tk_PathName(tkw),
- "\" isn't a top-level window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't a top-level window", Tk_PathName(tkw)));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", Tk_PathName(tkw),
+ NULL);
return TCL_ERROR;
}
if (Tk_WindowId(tkw) == None) {
@@ -1043,7 +986,7 @@ WinSetIcon(
* We must get the window's wrapper, not the window itself.
*/
- wmPtr = ((TkWindow*)tkw)->wmInfoPtr;
+ wmPtr = ((TkWindow *) tkw)->wmInfoPtr;
hwnd = wmPtr->wrapper;
if (application) {
@@ -1065,7 +1008,9 @@ WinSetIcon(
if (!initialized) {
if (InitWindowClass(titlebaricon) != TCL_OK) {
- Tcl_AppendResult(interp, "Unable to set icon", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Unable to set icon", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "FAILED", NULL);
return TCL_ERROR;
}
} else {
@@ -1104,7 +1049,7 @@ WinSetIcon(
/*
* The following code is exercised if you do
*
- * toplevel .t ; wm titlebaricon .t foo.icr
+ * toplevel .t ; wm titlebaricon .t foo.icr
*
* i.e. the wm hasn't had time to properly create the '.t' window
* before you set the icon.
@@ -1117,11 +1062,12 @@ WinSetIcon(
*/
UpdateWrapper(wmPtr->winPtr);
- wmPtr = ((TkWindow*)tkw)->wmInfoPtr;
+ wmPtr = ((TkWindow *) tkw)->wmInfoPtr;
hwnd = wmPtr->wrapper;
if (hwnd == NULL) {
- Tcl_AppendResult(interp,
- "Can't set icon; window has no wrapper.", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Can't set icon; window has no wrapper.", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "WRAPPER", NULL);
return TCL_ERROR;
}
}
@@ -1176,7 +1122,7 @@ TkWinGetIcon(
{
WmInfo *wmPtr;
HICON icon;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->iconPtr != NULL) {
@@ -1184,7 +1130,7 @@ TkWinGetIcon(
* return default toplevel icon
*/
- return GetIcon(tsdPtr->iconPtr, (int)iconsize);
+ return GetIcon(tsdPtr->iconPtr, (int) iconsize);
}
/*
@@ -1208,7 +1154,7 @@ TkWinGetIcon(
* return window toplevel icon
*/
- return GetIcon(wmPtr->iconPtr, (int)iconsize);
+ return GetIcon(wmPtr->iconPtr, (int) iconsize);
}
/*
@@ -1270,11 +1216,13 @@ ReadIconFromFile(
WinIconPtr titlebaricon = NULL;
BlockOfIconImagesPtr lpIR;
+#if 0 /* TODO: Dead code? */
if (0 /* If we already have an icon for this filename */) {
titlebaricon = NULL; /* Get the real value from a lookup */
titlebaricon->refCount++;
return titlebaricon;
}
+#endif
/*
* First check if it is a .ico file.
@@ -1288,7 +1236,7 @@ ReadIconFromFile(
* switching) display uses the right icon.
*/
- if (lpIR == NULL && shgetfileinfoProc != NULL) {
+ if (lpIR == NULL) {
SHFILEINFO sfiSM;
Tcl_DString ds, ds2;
DWORD *res;
@@ -1298,9 +1246,9 @@ ReadIconFromFile(
if (file == NULL) {
return NULL;
}
- Tcl_UtfToExternalDString(NULL, file, -1, &ds2);
+ Tcl_WinUtfToTChar(file, -1, &ds2);
Tcl_DStringFree(&ds);
- res = (*shgetfileinfoProc)(Tcl_DStringValue(&ds2), 0, &sfiSM,
+ res = (DWORD *)SHGetFileInfo((TCHAR *)Tcl_DStringValue(&ds2), 0, &sfiSM,
sizeof(SHFILEINFO), SHGFI_SMALLICON|SHGFI_ICON);
if (res != 0) {
@@ -1308,7 +1256,7 @@ ReadIconFromFile(
unsigned size;
Tcl_ResetResult(interp);
- res = (*shgetfileinfoProc)(Tcl_DStringValue(&ds2), 0, &sfi,
+ res = (DWORD *)SHGetFileInfo((TCHAR *)Tcl_DStringValue(&ds2), 0, &sfi,
sizeof(SHFILEINFO), SHGFI_ICON);
/*
@@ -1317,7 +1265,7 @@ ReadIconFromFile(
size = sizeof(BlockOfIconImages)
+ ((res != 0) ? sizeof(ICONIMAGE) : 0);
- lpIR = (BlockOfIconImagesPtr) ckalloc(size);
+ lpIR = ckalloc(size);
if (lpIR == NULL) {
if (res != 0) {
DestroyIcon(sfi.hIcon);
@@ -1348,7 +1296,7 @@ ReadIconFromFile(
Tcl_DStringFree(&ds2);
}
if (lpIR != NULL) {
- titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
+ titlebaricon = ckalloc(sizeof(WinIconInstance));
titlebaricon->iconBlock = lpIR;
titlebaricon->refCount = 1;
}
@@ -1393,7 +1341,7 @@ GetIconFromPixmap(
Pixmap pixmap)
{
WinIconPtr titlebaricon = NULL;
- TkWinDrawable *twdPtr = (TkWinDrawable*) pixmap;
+ TkWinDrawable *twdPtr = (TkWinDrawable *) pixmap;
BlockOfIconImagesPtr lpIR;
ICONINFO icon;
HICON hIcon;
@@ -1403,11 +1351,13 @@ GetIconFromPixmap(
return NULL;
}
+#if 0 /* TODO: Dead code?*/
if (0 /* If we already have an icon for this pixmap */) {
titlebaricon = NULL; /* Get the real value from a lookup */
titlebaricon->refCount++;
return titlebaricon;
}
+#endif
Tk_SizeOfBitmap(dsPtr, pixmap, &width, &height);
@@ -1422,7 +1372,7 @@ GetIconFromPixmap(
return NULL;
}
- lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages));
+ lpIR = ckalloc(sizeof(BlockOfIconImages));
if (lpIR == NULL) {
DestroyIcon(hIcon);
return NULL;
@@ -1443,7 +1393,7 @@ GetIconFromPixmap(
lpIR->IconImages[0].lpXOR = 0;
lpIR->IconImages[0].lpAND = 0;
- titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
+ titlebaricon = ckalloc(sizeof(WinIconInstance));
titlebaricon->iconBlock = lpIR;
titlebaricon->refCount = 1;
return titlebaricon;
@@ -1471,15 +1421,13 @@ static void
DecrIconRefCount(
WinIconPtr titlebaricon)
{
- titlebaricon->refCount--;
-
- if (titlebaricon->refCount <= 0) {
+ if (titlebaricon->refCount-- <= 1) {
if (titlebaricon->iconBlock != NULL) {
FreeIconBlock(titlebaricon->iconBlock);
}
titlebaricon->iconBlock = NULL;
- ckfree((char*)titlebaricon);
+ ckfree(titlebaricon);
}
}
@@ -1510,15 +1458,15 @@ FreeIconBlock(
* Free all the bits.
*/
- for (i=0; i< lpIR->nNumImages; i++) {
+ for (i=0 ; i<lpIR->nNumImages ; i++) {
if (lpIR->IconImages[i].lpBits != NULL) {
- ckfree((char*)lpIR->IconImages[i].lpBits);
+ ckfree(lpIR->IconImages[i].lpBits);
}
if (lpIR->IconImages[i].hIcon != NULL) {
DestroyIcon(lpIR->IconImages[i].hIcon);
}
}
- ckfree ((char*)lpIR);
+ ckfree(lpIR);
}
/*
@@ -1540,6 +1488,8 @@ GetIcon(
int icon_size)
{
BlockOfIconImagesPtr lpIR;
+ unsigned int size = (icon_size == 0 ? 16 : 32);
+ int i;
if (titlebaricon == NULL) {
return NULL;
@@ -1548,30 +1498,27 @@ GetIcon(
lpIR = titlebaricon->iconBlock;
if (lpIR == NULL) {
return NULL;
- } else {
- unsigned int size = (icon_size == 0 ? 16 : 32);
- int i;
-
- for (i = 0; i < lpIR->nNumImages; i++) {
- /*
- * Take the first or a 32x32 16 color icon
- */
-
- if ((lpIR->IconImages[i].Height == size)
- && (lpIR->IconImages[i].Width == size)
- && (lpIR->IconImages[i].Colors >= 4)) {
- return lpIR->IconImages[i].hIcon;
- }
- }
+ }
+ for (i=0 ; i<lpIR->nNumImages ; i++) {
/*
- * If we get here, then just return the first one, it will have to do!
+ * Take the first or a 32x32 16 color icon
*/
- if (lpIR->nNumImages >= 1) {
- return lpIR->IconImages[0].hIcon;
+ if ((lpIR->IconImages[i].Height == size)
+ && (lpIR->IconImages[i].Width == size)
+ && (lpIR->IconImages[i].Colors >= 4)) {
+ return lpIR->IconImages[i].hIcon;
}
}
+
+ /*
+ * If we get here, then just return the first one, it will have to do!
+ */
+
+ if (lpIR->nNumImages >= 1) {
+ return lpIR->IconImages[0].hIcon;
+ }
return NULL;
}
@@ -1589,7 +1536,7 @@ TclWinReadCursorFromFile(
return NULL;
}
if (lpIR->nNumImages >= 1) {
- res = CopyImage(lpIR->IconImages[0].hIcon, IMAGE_CURSOR,0,0,0);
+ res = CopyImage(lpIR->IconImages[0].hIcon, IMAGE_CURSOR, 0, 0, 0);
}
FreeIconBlock(lpIR);
return res;
@@ -1631,8 +1578,9 @@ ReadIconOrCursorFromFile(
channel = Tcl_FSOpenFileChannel(interp, fileName, "r", 0);
if (channel == NULL) {
- Tcl_AppendResult(interp,"Error opening file \"",
- Tcl_GetString(fileName), "\" for reading", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error opening file \"%s\" for reading: %s",
+ Tcl_GetString(fileName), Tcl_PosixError(interp)));
return NULL;
}
if (Tcl_SetChannelOption(interp, channel, "-translation", "binary")
@@ -1650,16 +1598,17 @@ ReadIconOrCursorFromFile(
* Allocate memory for the resource structure
*/
- lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages));
+ lpIR = ckalloc(sizeof(BlockOfIconImages));
/*
* Read in the header
*/
- if ((lpIR->nNumImages = ReadICOHeader(channel)) == -1) {
- Tcl_AppendResult(interp, "Invalid file header", NULL);
+ lpIR->nNumImages = ReadICOHeader(channel);
+ if (lpIR->nNumImages == -1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid file header", -1));
Tcl_Close(NULL, channel);
- ckfree((char*) lpIR);
+ ckfree(lpIR);
return NULL;
}
@@ -1667,27 +1616,28 @@ ReadIconOrCursorFromFile(
* Adjust the size of the struct to account for the images.
*/
- lpIR = (BlockOfIconImagesPtr) ckrealloc((char*) lpIR,
- sizeof(BlockOfIconImages)
- + ((lpIR->nNumImages - 1) * sizeof(ICONIMAGE)));
+ lpIR = ckrealloc(lpIR, sizeof(BlockOfIconImages)
+ + (lpIR->nNumImages - 1) * sizeof(ICONIMAGE));
/*
* Allocate enough memory for the icon directory entries.
*/
- lpIDE = (LPICONDIRENTRY) ckalloc(lpIR->nNumImages * sizeof(ICONDIRENTRY));
+ lpIDE = ckalloc(lpIR->nNumImages * sizeof(ICONDIRENTRY));
/*
* Read in the icon directory entries.
*/
- dwBytesRead = Tcl_Read(channel, (char*) lpIDE,
- (int)(lpIR->nNumImages * sizeof(ICONDIRENTRY)));
+ dwBytesRead = Tcl_Read(channel, (char *) lpIDE,
+ (int) (lpIR->nNumImages * sizeof(ICONDIRENTRY)));
if (dwBytesRead != lpIR->nNumImages * sizeof(ICONDIRENTRY)) {
- Tcl_AppendResult(interp, "Error reading file", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading file: %s", Tcl_PosixError(interp)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "READ", NULL);
Tcl_Close(NULL, channel);
- ckfree((char *) lpIDE);
- ckfree((char *) lpIR);
+ ckfree(lpIDE);
+ ckfree(lpIR);
return NULL;
}
@@ -1708,7 +1658,7 @@ ReadIconOrCursorFromFile(
* Allocate memory for the resource.
*/
- lpIR->IconImages[i].lpBits = (LPBYTE) ckalloc(lpIDE[i].dwBytesInRes);
+ lpIR->IconImages[i].lpBits = ckalloc(lpIDE[i].dwBytesInRes);
lpIR->IconImages[i].dwNumBytes = lpIDE[i].dwBytesInRes;
/*
@@ -1716,7 +1666,8 @@ ReadIconOrCursorFromFile(
*/
if (Tcl_Seek(channel, lpIDE[i].dwImageOffset, FILE_BEGIN) == -1) {
- Tcl_AppendResult(interp, "Error seeking in file", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error seeking in file: %s", Tcl_PosixError(interp)));
goto readError;
}
@@ -1724,10 +1675,11 @@ ReadIconOrCursorFromFile(
* Read it in.
*/
- dwBytesRead = Tcl_Read(channel, (char *) lpIR->IconImages[i].lpBits,
+ dwBytesRead = Tcl_Read(channel, (char *)lpIR->IconImages[i].lpBits,
(int) lpIDE[i].dwBytesInRes);
if (dwBytesRead != lpIDE[i].dwBytesInRes) {
- Tcl_AppendResult(interp, "Error reading file", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading file: %s", Tcl_PosixError(interp)));
goto readError;
}
@@ -1735,37 +1687,33 @@ ReadIconOrCursorFromFile(
* Set the internal pointers appropriately.
*/
- if (!AdjustIconImagePointers( &(lpIR->IconImages[i]))) {
- Tcl_AppendResult(interp, "Error converting to internal format",
- NULL);
+ if (!AdjustIconImagePointers(&lpIR->IconImages[i])) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Error converting to internal format", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "FORMAT", NULL);
goto readError;
}
lpIR->IconImages[i].hIcon =
- MakeIconOrCursorFromResource(&(lpIR->IconImages[i]), isIcon);
+ MakeIconOrCursorFromResource(&lpIR->IconImages[i], isIcon);
}
/*
* Clean up
*/
- ckfree((char *) lpIDE);
+ ckfree(lpIDE);
Tcl_Close(NULL, channel);
- if (lpIR == NULL){
- Tcl_AppendResult(interp, "Reading of ", Tcl_GetString(fileName),
- " failed!", NULL);
- return NULL;
- }
return lpIR;
readError:
Tcl_Close(NULL, channel);
for (i = 0; i < lpIR->nNumImages; i++) {
if (lpIR->IconImages[i].lpBits != NULL) {
- ckfree((char *) lpIR->IconImages[i].lpBits);
+ ckfree(lpIR->IconImages[i].lpBits);
}
}
- ckfree((char *) lpIDE);
- ckfree((char *) lpIR);
+ ckfree(lpIDE);
+ ckfree(lpIR);
return NULL;
}
@@ -1789,7 +1737,7 @@ static TkWindow *
GetTopLevel(
HWND hwnd)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
@@ -1931,8 +1879,7 @@ TkWinWmCleanup(
}
initialized = 0;
- tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (!tsdPtr->initialized) {
return;
@@ -1963,9 +1910,7 @@ void
TkWmNewWindow(
TkWindow *winPtr) /* Newly-created top-level window. */
{
- register WmInfo *wmPtr;
-
- wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
+ register WmInfo *wmPtr = ckalloc(sizeof(WmInfo));
/*
* Initialize full structure, then set what isn't NULL
@@ -2002,7 +1947,7 @@ TkWmNewWindow(
wmPtr->x = winPtr->changes.x;
wmPtr->y = winPtr->changes.y;
wmPtr->crefObj = NULL;
- wmPtr->colorref = (COLORREF)0;
+ wmPtr->colorref = (COLORREF) 0;
wmPtr->alpha = 1.0;
wmPtr->configWidth = -1;
@@ -2017,14 +1962,14 @@ TkWmNewWindow(
*/
Tk_CreateEventHandler((Tk_Window) winPtr, StructureNotifyMask,
- TopLevelEventProc, (ClientData) winPtr);
+ TopLevelEventProc, winPtr);
/*
* Arrange for geometry requests to be reflected from the window to the
* window manager.
*/
- Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0);
+ Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, NULL);
}
/*
@@ -2057,9 +2002,9 @@ UpdateWrapper(
WINDOWPLACEMENT place;
HICON hSmallIcon = NULL;
HICON hBigIcon = NULL;
- Tcl_DString titleString, classString;
+ Tcl_DString titleString;
int *childStateInfo = NULL;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr->window == None) {
@@ -2092,7 +2037,6 @@ UpdateWrapper(
if (!IsWindow(wmPtr->wrapper)) {
Tcl_Panic("UpdateWrapper: Container was destroyed");
}
-
} else {
/*
* Pick the decorative frame style. Override redirect windows get
@@ -2127,8 +2071,8 @@ UpdateWrapper(
wmPtr->style = WM_TRANSIENT_STYLE;
wmPtr->exStyle = EX_TRANSIENT_STYLE;
parentHWND = Tk_GetHWND(Tk_WindowId(wmPtr->masterPtr));
- if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
- (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) {
+ if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)
+ && (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) {
wmPtr->style |= WS_THICKFRAME;
}
} else {
@@ -2149,7 +2093,7 @@ UpdateWrapper(
*/
wmPtr->flags |= WM_CREATE_PENDING|WM_MOVE_PENDING;
- UpdateGeometryInfo((ClientData)winPtr);
+ UpdateGeometryInfo(winPtr);
wmPtr->flags &= ~(WM_CREATE_PENDING|WM_MOVE_PENDING);
width = wmPtr->borderWidth + winPtr->changes.width;
@@ -2185,33 +2129,30 @@ UpdateWrapper(
Tcl_WinUtfToTChar(((wmPtr->title != NULL) ?
wmPtr->title : winPtr->nameUid), -1, &titleString);
- Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString);
-
- wmPtr->wrapper = (*tkWinProcs->createWindowEx)(wmPtr->exStyle,
- (LPCTSTR) Tcl_DStringValue(&classString),
+ wmPtr->wrapper = CreateWindowEx(wmPtr->exStyle,
+ TK_WIN_TOPLEVEL_CLASS_NAME,
(LPCTSTR) Tcl_DStringValue(&titleString),
wmPtr->style, x, y, width, height,
parentHWND, NULL, Tk_GetHINSTANCE(), NULL);
- Tcl_DStringFree(&classString);
Tcl_DStringFree(&titleString);
- SetWindowLongPtr(wmPtr->wrapper, GWLP_USERDATA, (INT_PTR) winPtr);
+ SetWindowLongPtr(wmPtr->wrapper, GWLP_USERDATA, (LONG_PTR) winPtr);
tsdPtr->createWindow = NULL;
- if ((wmPtr->exStyleConfig & WS_EX_LAYERED)
- && setLayeredWindowAttributesProc != NULL) {
+ if (wmPtr->exStyleConfig & WS_EX_LAYERED) {
/*
* The user supplies a double from [0..1], but Windows wants an
* int (transparent) 0..255 (opaque), so do the translation. Add
* the 0.5 to round the value.
*/
- setLayeredWindowAttributesProc((HWND) wmPtr->wrapper,
+ SetLayeredWindowAttributes((HWND) wmPtr->wrapper,
wmPtr->colorref, (BYTE) (wmPtr->alpha * 255 + 0.5),
(unsigned)(LWA_ALPHA | (wmPtr->crefObj?LWA_COLORKEY:0)));
} else {
/*
* Layering not used or supported.
*/
+
wmPtr->alpha = 1.0;
if (wmPtr->crefObj) {
Tcl_DecrRefCount(wmPtr->crefObj);
@@ -2224,8 +2165,9 @@ UpdateWrapper(
wmPtr->x = place.rcNormalPosition.left;
wmPtr->y = place.rcNormalPosition.top;
- if( !(winPtr->flags & TK_ALREADY_DEAD) )
+ if (!(winPtr->flags & TK_ALREADY_DEAD)) {
TkInstallFrameMenu((Tk_Window) winPtr);
+ }
if (oldWrapper && (oldWrapper != wmPtr->wrapper)
&& !(wmPtr->exStyle & WS_EX_TOPMOST)) {
@@ -2248,20 +2190,20 @@ UpdateWrapper(
WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS);
if (winPtr->flags & TK_EMBEDDED) {
- SetWindowLongPtr(child, GWLP_WNDPROC, (INT_PTR) TopLevelProc);
+ SetWindowLongPtr(child, GWLP_WNDPROC, (LONG_PTR) TopLevelProc);
}
SetParent(child, wmPtr->wrapper);
if (oldWrapper) {
- hSmallIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_SMALL,
- (LPARAM) NULL);
- hBigIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_BIG,
- (LPARAM) NULL);
+ hSmallIcon = (HICON)
+ SendMessage(oldWrapper, WM_GETICON, ICON_SMALL, (LPARAM)NULL);
+ hBigIcon = (HICON)
+ SendMessage(oldWrapper, WM_GETICON, ICON_BIG, (LPARAM) NULL);
}
if (oldWrapper && (oldWrapper != wmPtr->wrapper)
&& (oldWrapper != GetDesktopWindow())) {
- SetWindowLongPtr(oldWrapper, GWLP_USERDATA, (LONG) 0);
+ SetWindowLongPtr(oldWrapper, GWLP_USERDATA, (LONG_PTR) 0);
if (wmPtr->numTransients > 0) {
/*
@@ -2271,8 +2213,7 @@ UpdateWrapper(
WmInfo *wmPtr2;
- childStateInfo = (int *)
- ckalloc((unsigned) wmPtr->numTransients * sizeof(int));
+ childStateInfo = ckalloc(wmPtr->numTransients * sizeof(int));
state = 0;
for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
wmPtr2 = wmPtr2->nextPtr) {
@@ -2294,11 +2235,11 @@ UpdateWrapper(
}
wmPtr->flags &= ~WM_NEVER_MAPPED;
- if (winPtr->flags & TK_EMBEDDED
- && SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM)child, 0)){
+ if (winPtr->flags & TK_EMBEDDED &&
+ SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM) child, 0)) {
SendMessage(wmPtr->wrapper, TK_GEOMETRYREQ,
- Tk_ReqWidth((Tk_Window)winPtr),
- Tk_ReqHeight((Tk_Window)winPtr));
+ Tk_ReqWidth((Tk_Window) winPtr),
+ Tk_ReqHeight((Tk_Window) winPtr));
SendMessage(wmPtr->wrapper, TK_SETMENU, (WPARAM) wmPtr->hMenu,
(LPARAM) Tk_GetMenuHWND((Tk_Window) winPtr));
}
@@ -2319,10 +2260,11 @@ UpdateWrapper(
wmPtr->hints.initial_state = state;
if (hSmallIcon != NULL) {
- SendMessage(wmPtr->wrapper,WM_SETICON,ICON_SMALL,(LPARAM)hSmallIcon);
+ SendMessage(wmPtr->wrapper, WM_SETICON, ICON_SMALL,
+ (LPARAM) hSmallIcon);
}
if (hBigIcon != NULL) {
- SendMessage(wmPtr->wrapper,WM_SETICON,ICON_BIG,(LPARAM)hBigIcon);
+ SendMessage(wmPtr->wrapper, WM_SETICON, ICON_BIG, (LPARAM) hBigIcon);
}
/*
@@ -2334,7 +2276,7 @@ UpdateWrapper(
*/
if (winPtr->flags & TK_EMBEDDED) {
- if(state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) {
+ if (state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) {
TkpWmSetState(winPtr, NormalState);
wmPtr->hints.initial_state = NormalState;
}
@@ -2370,7 +2312,7 @@ UpdateWrapper(
}
}
- ckfree((char *) childStateInfo);
+ ckfree(childStateInfo);
}
/*
@@ -2418,7 +2360,7 @@ TkWmMapWindow(
* mapped. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (!tsdPtr->initialized) {
@@ -2430,8 +2372,7 @@ TkWmMapWindow(
* Don't map a transient if the master is not mapped.
*/
- if (wmPtr->masterPtr != NULL &&
- !Tk_IsMapped(wmPtr->masterPtr)) {
+ if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) {
wmPtr->hints.initial_state = WithdrawnState;
return;
}
@@ -2523,7 +2464,7 @@ TkpWmSetState(
} else if (state == ZoomState) {
cmd = SW_SHOWMAXIMIZED;
} else {
- goto setStateEnd;
+ goto setStateEnd;
}
ShowWindow(wmPtr->wrapper, cmd);
@@ -2659,6 +2600,7 @@ TkWmDeadWindow(
winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
} else {
register WmInfo *prevPtr;
+
for (prevPtr = winPtr->dispPtr->firstWmPtr; ;
prevPtr = prevPtr->nextPtr) {
if (prevPtr == NULL) {
@@ -2681,7 +2623,7 @@ TkWmDeadWindow(
wmPtr->numTransients--;
Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr,
VisibilityChangeMask|StructureNotifyMask,
- WmWaitVisibilityOrMapProc, (ClientData) wmPtr2->winPtr);
+ WmWaitVisibilityOrMapProc, wmPtr2->winPtr);
wmPtr2->masterPtr = NULL;
if ((wmPtr2->wrapper != None)
&& !(wmPtr2->flags & (WM_NEVER_MAPPED))) {
@@ -2721,16 +2663,16 @@ TkWmDeadWindow(
protPtr = wmPtr->protPtr;
wmPtr->protPtr = protPtr->nextPtr;
- Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(protPtr, TCL_DYNAMIC);
}
if (wmPtr->cmdArgv != NULL) {
- ckfree((char *) wmPtr->cmdArgv);
+ ckfree(wmPtr->cmdArgv);
}
if (wmPtr->clientMachine != NULL) {
- ckfree((char *) wmPtr->clientMachine);
+ ckfree(wmPtr->clientMachine);
}
if (wmPtr->flags & WM_UPDATE_PENDING) {
- Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr);
}
if (wmPtr->masterPtr != NULL) {
wmPtr2 = wmPtr->masterPtr->wmInfoPtr;
@@ -2744,7 +2686,7 @@ TkWmDeadWindow(
}
Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
VisibilityChangeMask|StructureNotifyMask,
- WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ WmWaitVisibilityOrMapProc, winPtr);
wmPtr->masterPtr = NULL;
}
if (wmPtr->crefObj != NULL) {
@@ -2777,7 +2719,7 @@ TkWmDeadWindow(
DecrIconRefCount(wmPtr->iconPtr);
}
- ckfree((char *) wmPtr);
+ ckfree(wmPtr);
winPtr->wmInfoPtr = NULL;
}
@@ -2833,8 +2775,8 @@ Tk_WmObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
- static const char *optionStrings[] = {
+ Tk_Window tkwin = clientData;
+ static const char *const optionStrings[] = {
"aspect", "attributes", "client", "colormapwindows",
"command", "deiconify", "focusmodel", "forget", "frame",
"geometry", "grid", "group", "iconbitmap",
@@ -2847,17 +2789,20 @@ Tk_WmObjCmd(
};
enum options {
WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
- WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME,
+ WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET,
+ WMOPT_FRAME,
WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME,
WMOPT_ICONPHOTO, WMOPT_ICONPOSITION,
- WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
+ WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE,
+ WMOPT_OVERRIDEREDIRECT,
WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
WMOPT_WITHDRAW
};
- int index, length;
- char *argv1;
+ int index;
+ size_t length;
+ const char *argv1;
TkWindow *winPtr, **winPtrPtr = &winPtr;
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
@@ -2867,8 +2812,9 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
- argv1 = Tcl_GetStringFromObj(objv[1], &length);
- if ((argv1[0] == 't') && !strncmp(argv1, "tracing", (unsigned) length)
+ argv1 = Tcl_GetString(objv[1]);
+ length = objv[1]->length;
+ if ((argv1[0] == 't') && !strncmp(argv1, "tracing", length)
&& (length >= 3)) {
int wmTracing;
@@ -2877,9 +2823,8 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetResult(interp,
- ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ dispPtr->flags & TK_DISPLAY_WM_TRACING));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
@@ -2893,8 +2838,8 @@ Tk_WmObjCmd(
return TCL_OK;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -2906,10 +2851,12 @@ Tk_WmObjCmd(
!= TCL_OK) {
return TCL_ERROR;
}
- if (!Tk_IsTopLevel(winPtr) &&
- (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) {
- Tcl_AppendResult(interp, "window \"", winPtr->pathName,
- "\" isn't a top-level window", NULL);
+ if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE)
+ && (index != WMOPT_FORGET)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't a top-level window", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName,
+ NULL);
return TCL_ERROR;
}
@@ -3019,12 +2966,13 @@ WmAspectCmd(
}
if (objc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- char buf[TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *results[4];
- sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
- wmPtr->minAspect.y, wmPtr->maxAspect.x,
- wmPtr->maxAspect.y);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ results[0] = Tcl_NewIntObj(wmPtr->minAspect.x);
+ results[1] = Tcl_NewIntObj(wmPtr->minAspect.y);
+ results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x);
+ results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
}
@@ -3038,7 +2986,9 @@ WmAspectCmd(
return TCL_ERROR;
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) {
- Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "aspect number can't be <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "ASPECT", NULL);
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -3078,8 +3028,9 @@ WmAttributesCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
LONG style, exStyle, styleBit, *stylePtr = NULL;
- char *string;
- int i, boolean, length;
+ const char *string;
+ int i, boolean;
+ size_t length;
int config_fullscreen = 0, updatewrapper = 0;
int fullscreen_attr_changed = 0, fullscreen_attr = 0;
@@ -3126,23 +3077,24 @@ WmAttributesCmd(
return TCL_OK;
}
for (i = 3; i < objc; i += 2) {
- string = Tcl_GetStringFromObj(objv[i], &length);
+ string = Tcl_GetString(objv[i]);
+ length = objv[i]->length;
if ((length < 2) || (string[0] != '-')) {
goto configArgs;
}
- if (strncmp(string, "-disabled", (unsigned) length) == 0) {
+ if (strncmp(string, "-disabled", length) == 0) {
stylePtr = &style;
styleBit = WS_DISABLED;
- } else if ((strncmp(string, "-alpha", (unsigned) length) == 0)
+ } else if ((strncmp(string, "-alpha", length) == 0)
|| ((length > 2) && (strncmp(string, "-transparentcolor",
- (unsigned) length) == 0))) {
+ length) == 0))) {
stylePtr = &exStyle;
styleBit = WS_EX_LAYERED;
- } else if (strncmp(string, "-fullscreen", (unsigned) length) == 0) {
+ } else if (strncmp(string, "-fullscreen", length) == 0) {
config_fullscreen = 1;
styleBit = 0;
} else if ((length > 3)
- && (strncmp(string, "-toolwindow", (unsigned) length) == 0)) {
+ && (strncmp(string, "-toolwindow", length) == 0)) {
stylePtr = &exStyle;
styleBit = WS_EX_TOOLWINDOW;
if (objc != 4) {
@@ -3152,12 +3104,14 @@ WmAttributesCmd(
updatewrapper = 1;
}
} else if ((length > 3)
- && (strncmp(string, "-topmost", (unsigned) length) == 0)) {
+ && (strncmp(string, "-topmost", length) == 0)) {
stylePtr = &exStyle;
styleBit = WS_EX_TOPMOST;
if ((i < objc-1) && (winPtr->flags & TK_EMBEDDED)) {
- Tcl_AppendResult(interp, "can't set topmost flag on ",
- winPtr->pathName, ": it is an embedded window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set topmost flag on %s: it is an embedded window",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "TOPMOST", NULL);
return TCL_ERROR;
}
} else {
@@ -3192,8 +3146,9 @@ WmAttributesCmd(
}
wmPtr->alpha = dval;
} else { /* -transparentcolor */
- char *crefstr = Tcl_GetStringFromObj(objv[i+1], &length);
+ const char *crefstr = Tcl_GetString(objv[i+1]);
+ length = objv[i+1]->length;
if (length == 0) {
/* reset to no transparent color */
if (wmPtr->crefObj) {
@@ -3221,15 +3176,15 @@ WmAttributesCmd(
/*
* Only ever add the WS_EX_LAYERED bit, as it can cause
- * flashing to change this window style. This allows things
+ * flashing to change this window style. This allows things
* like fading tooltips to avoid flash ugliness without
* forcing all window to be layered.
*/
+
if ((wmPtr->alpha < 1.0) || (wmPtr->crefObj != NULL)) {
*stylePtr |= styleBit;
}
- if ((setLayeredWindowAttributesProc != NULL)
- && (wmPtr->wrapper != NULL)) {
+ if (wmPtr->wrapper != NULL) {
/*
* Set the window directly regardless of UpdateWrapper.
* The user supplies a double from [0..1], but Windows
@@ -3241,30 +3196,30 @@ WmAttributesCmd(
SetWindowLongPtr(wmPtr->wrapper, GWL_EXSTYLE,
*stylePtr);
}
- setLayeredWindowAttributesProc((HWND) wmPtr->wrapper,
+ SetLayeredWindowAttributes((HWND) wmPtr->wrapper,
wmPtr->colorref, (BYTE) (wmPtr->alpha * 255 + 0.5),
(unsigned) (LWA_ALPHA |
(wmPtr->crefObj ? LWA_COLORKEY : 0)));
}
}
} else {
- if ((i < objc-1) &&
- (Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean)
- != TCL_OK)) {
+ if ((i < objc-1)
+ && Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean)
+ != TCL_OK) {
return TCL_ERROR;
}
if (config_fullscreen) {
if (objc == 4) {
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- (wmPtr->flags & WM_FULLSCREEN));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ wmPtr->flags & WM_FULLSCREEN));
} else {
fullscreen_attr_changed = 1;
fullscreen_attr = boolean;
}
config_fullscreen = 0;
} else if (objc == 4) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- ((*stylePtr & styleBit) != 0));
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(*stylePtr & styleBit));
} else if (boolean) {
*stylePtr |= styleBit;
} else {
@@ -3276,6 +3231,7 @@ WmAttributesCmd(
* Force the topmost position aspect to ensure that switching
* between (no)topmost reflects properly when rewrapped.
*/
+
SetWindowPos(wmPtr->wrapper,
((exStyle & WS_EX_TOPMOST) ?
HWND_TOPMOST : HWND_NOTOPMOST), 0, 0, 0, 0,
@@ -3311,10 +3267,11 @@ WmAttributesCmd(
if (fullscreen_attr_changed) {
if (fullscreen_attr) {
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- Tcl_AppendResult(interp,
- "can't set fullscreen attribute for \"",
- winPtr->pathName, "\": override-redirect flag is set",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set fullscreen attribute for \"%s\":"
+ " override-redirect flag is set", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ATTR",
+ "OVERRIDE_REDIRECT", NULL);
return TCL_ERROR;
}
@@ -3328,10 +3285,10 @@ WmAttributesCmd(
(WidthOfScreen(Tk_Screen(winPtr)) > wmPtr->maxWidth)) ||
((wmPtr->maxHeight > 0) &&
(HeightOfScreen(Tk_Screen(winPtr)) > wmPtr->maxHeight))) {
- Tcl_AppendResult(interp,
- "can't set fullscreen attribute for \"",
- winPtr->pathName, "\": max width/height is too small",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set fullscreen attribute for \"%s\":"
+ " max width/height is too small", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "SMALL_MAX", NULL);
return TCL_ERROR;
}
}
@@ -3368,8 +3325,8 @@ WmClientCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- char *argv3;
- int length;
+ const char *argv3;
+ size_t length;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?name?");
@@ -3377,14 +3334,16 @@ WmClientCmd(
}
if (objc == 3) {
if (wmPtr->clientMachine != NULL) {
- Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(wmPtr->clientMachine, -1));
}
return TCL_OK;
}
- argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ argv3 = Tcl_GetString(objv[3]);
+ length = objv[3]->length;
if (argv3[0] == 0) {
if (wmPtr->clientMachine != NULL) {
- ckfree((char *) wmPtr->clientMachine);
+ ckfree(wmPtr->clientMachine);
wmPtr->clientMachine = NULL;
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
XDeleteProperty(winPtr->display, winPtr->window,
@@ -3394,11 +3353,10 @@ WmClientCmd(
return TCL_OK;
}
if (wmPtr->clientMachine != NULL) {
- ckfree((char *) wmPtr->clientMachine);
+ ckfree(wmPtr->clientMachine);
}
- wmPtr->clientMachine = (char *)
- ckalloc((unsigned) (length + 1));
- strcpy(wmPtr->clientMachine, argv3);
+ wmPtr->clientMachine = ckalloc(length + 1);
+ memcpy(wmPtr->clientMachine, argv3, length + 1);
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
XTextProperty textProp;
@@ -3438,10 +3396,9 @@ WmColormapwindowsCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- TkWindow **cmapList;
- TkWindow *winPtr2, **winPtr2Ptr = &winPtr2;
+ TkWindow **cmapList, *winPtr2, **winPtr2Ptr = &winPtr2;
int i, windowObjc, gotToplevel;
- Tcl_Obj **windowObjv;
+ Tcl_Obj **windowObjv, *resultObj;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?");
@@ -3449,26 +3406,28 @@ WmColormapwindowsCmd(
}
if (objc == 3) {
Tk_MakeWindowExist((Tk_Window) winPtr);
+ resultObj = Tcl_NewObj();
for (i = 0; i < wmPtr->cmapCount; i++) {
if ((i == (wmPtr->cmapCount-1))
&& (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) {
break;
}
- Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TkNewWindowObj((Tk_Window) wmPtr->cmapList[i]));
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv)
!= TCL_OK) {
return TCL_ERROR;
}
- cmapList = (TkWindow **) ckalloc((unsigned)
- ((windowObjc+1)*sizeof(TkWindow*)));
+ cmapList = ckalloc((windowObjc + 1) * sizeof(TkWindow*));
gotToplevel = 0;
for (i = 0; i < windowObjc; i++) {
if (TkGetWindowFromObj(interp, tkwin, windowObjv[i],
(Tk_Window *) winPtr2Ptr) != TCL_OK) {
- ckfree((char *) cmapList);
+ ckfree(cmapList);
return TCL_ERROR;
}
if (winPtr2 == winPtr) {
@@ -3488,7 +3447,7 @@ WmColormapwindowsCmd(
}
wmPtr->flags |= WM_COLORMAPS_EXPLICIT;
if (wmPtr->cmapList != NULL) {
- ckfree((char *)wmPtr->cmapList);
+ ckfree(wmPtr->cmapList);
}
wmPtr->cmapList = cmapList;
wmPtr->cmapCount = windowObjc;
@@ -3531,7 +3490,7 @@ WmCommandCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- char *argv3;
+ const char *argv3;
int cmdArgc;
const char **cmdArgv;
@@ -3541,15 +3500,17 @@ WmCommandCmd(
}
if (objc == 3) {
if (wmPtr->cmdArgv != NULL) {
- Tcl_SetResult(interp,
- Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), TCL_DYNAMIC);
+ char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(merged, -1));
+ ckfree(merged);
}
return TCL_OK;
}
argv3 = Tcl_GetString(objv[3]);
if (argv3[0] == 0) {
if (wmPtr->cmdArgv != NULL) {
- ckfree((char *) wmPtr->cmdArgv);
+ ckfree(wmPtr->cmdArgv);
wmPtr->cmdArgv = NULL;
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
XDeleteProperty(winPtr->display, winPtr->window,
@@ -3562,7 +3523,7 @@ WmCommandCmd(
return TCL_ERROR;
}
if (wmPtr->cmdArgv != NULL) {
- ckfree((char *) wmPtr->cmdArgv);
+ ckfree(wmPtr->cmdArgv);
}
wmPtr->cmdArgc = cmdArgc;
wmPtr->cmdArgv = cmdArgv;
@@ -3604,14 +3565,18 @@ WmDeiconifyCmd(
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]),
- ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't deiconify %s: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL);
return TCL_ERROR;
}
if (winPtr->flags & TK_EMBEDDED) {
if (!SendMessage(wmPtr->wrapper, TK_DEICONIFY, 0, 0)) {
- Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName,
- ": the container does not support the request", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't deiconify %s: the container does not support the request",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -3646,7 +3611,7 @@ WmFocusmodelCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"active", "passive", NULL
};
enum options {
@@ -3659,13 +3624,13 @@ WmFocusmodelCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ wmPtr->hints.input ? "passive" : "active", -1));
return TCL_OK;
}
- if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings,
+ sizeof(char *), "argument", 0,&index) != TCL_OK) {
return TCL_ERROR;
}
if (index == OPT_ACTIVE) {
@@ -3694,14 +3659,14 @@ WmFocusmodelCmd(
*/
static int
-WmForgetCmd(tkwin, winPtr, interp, objc, objv)
- Tk_Window tkwin; /* Main window of the application. */
- TkWindow *winPtr; /* Toplevel or Frame to work with */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *const objv[]; /* Argument objects. */
+WmForgetCmd(
+ Tk_Window tkwin, /* Main window of the application. */
+ TkWindow *winPtr, /* Toplevel or Frame to work with */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- register Tk_Window frameWin = (Tk_Window)winPtr;
+ register Tk_Window frameWin = (Tk_Window) winPtr;
if (Tk_IsTopLevel(frameWin)) {
Tk_UnmapWindow(frameWin);
@@ -3716,7 +3681,8 @@ WmForgetCmd(tkwin, winPtr, interp, objc, objv)
/* Already not managed by wm - ignore it */
}
return TCL_OK;
-}
+}
+
/*
*----------------------------------------------------------------------
*
@@ -3744,7 +3710,6 @@ WmFrameCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
HWND hwnd;
- char buf[TCL_INTEGER_SPACE];
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window");
@@ -3757,8 +3722,7 @@ WmFrameCmd(
if (hwnd == NULL) {
hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
}
- sprintf(buf, "0x%x", PTR2INT(hwnd));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", PTR2INT(hwnd)));
return TCL_OK;
}
@@ -3790,16 +3754,14 @@ WmGeometryCmd(
register WmInfo *wmPtr = winPtr->wmInfoPtr;
char xSign, ySign;
int width, height;
- char *argv3;
+ const char *argv3;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
return TCL_ERROR;
}
- if (objc == 3) {
- char buf[16 + TCL_INTEGER_SPACE * 4];
- int x, y;
+ if (objc == 3) {
xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
if (wmPtr->gridWin != NULL) {
@@ -3811,17 +3773,17 @@ WmGeometryCmd(
width = winPtr->changes.width;
height = winPtr->changes.height;
}
- if(winPtr->flags & TK_EMBEDDED) {
+ if (winPtr->flags & TK_EMBEDDED) {
int result = SendMessage(wmPtr->wrapper, TK_MOVEWINDOW, -1, -1);
+
wmPtr->x = result >> 16;
wmPtr->y = result & 0x0000ffff;
}
- x = wmPtr->x;
- y = wmPtr->y;
- sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, x, ySign, y);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d",
+ width, height, xSign, wmPtr->x, ySign, wmPtr->y));
return TCL_OK;
}
+
argv3 = Tcl_GetString(objv[3]);
if (*argv3 == '\0') {
wmPtr->width = -1;
@@ -3867,12 +3829,13 @@ WmGridCmd(
}
if (objc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- char buf[TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *results[4];
- sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
- wmPtr->reqGridHeight, wmPtr->widthInc,
- wmPtr->heightInc);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth);
+ results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight);
+ results[2] = Tcl_NewIntObj(wmPtr->widthInc);
+ results[3] = Tcl_NewIntObj(wmPtr->heightInc);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
}
@@ -3899,19 +3862,27 @@ WmGridCmd(
return TCL_ERROR;
}
if (reqWidth < 0) {
- Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "baseWidth can't be < 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
if (reqHeight < 0) {
- Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "baseHeight can't be < 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
if (widthInc <= 0) {
- Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "widthInc can't be <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
if (heightInc <= 0) {
- Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "heightInc can't be <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
@@ -3948,8 +3919,8 @@ WmGroupCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
Tk_Window tkwin2;
- char *argv3;
- int length;
+ const char *argv3;
+ size_t length;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?");
@@ -3957,11 +3928,12 @@ WmGroupCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & WindowGroupHint) {
- Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1));
}
return TCL_OK;
}
- argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ argv3 = Tcl_GetString(objv[3]);
+ length = objv[3]->length;
if (*argv3 == '\0') {
wmPtr->hints.flags &= ~WindowGroupHint;
if (wmPtr->leaderName != NULL) {
@@ -3978,8 +3950,8 @@ WmGroupCmd(
}
wmPtr->hints.window_group = Tk_WindowId(tkwin2);
wmPtr->hints.flags |= WindowGroupHint;
- wmPtr->leaderName = ckalloc((unsigned) (length + 1));
- strcpy(wmPtr->leaderName, argv3);
+ wmPtr->leaderName = ckalloc(length + 1);
+ memcpy(wmPtr->leaderName, argv3, length + 1);
}
return TCL_OK;
}
@@ -4011,7 +3983,7 @@ WmIconbitmapCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */
- char *string;
+ const char *string;
if ((objc < 3) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? ?image?");
@@ -4021,11 +3993,12 @@ WmIconbitmapCmd(
* If we have 5 arguments, we must have a '-default' flag.
*/
- char *argv3 = Tcl_GetString(objv[3]);
+ const char *argv3 = Tcl_GetString(objv[3]);
if (strcmp(argv3, "-default")) {
- Tcl_AppendResult(interp, "illegal option \"", argv3,
- "\" must be \"-default\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal option \"%s\" must be \"-default\"", argv3));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONBITMAP", "OPTION",NULL);
return TCL_ERROR;
}
useWinPtr = NULL;
@@ -4035,9 +4008,9 @@ WmIconbitmapCmd(
*/
if (wmPtr->hints.flags & IconPixmapHint) {
- Tcl_SetResult(interp, (char *)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
- TCL_STATIC);
+ -1));
}
return TCL_OK;
}
@@ -4096,6 +4069,7 @@ WmIconbitmapCmd(
*/
Pixmap pixmap;
+
Tcl_ResetResult(interp);
pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string);
if (pixmap == None) {
@@ -4149,25 +4123,34 @@ WmIconifyCmd(
return TCL_ERROR;
}
if (winPtr->flags & TK_EMBEDDED) {
- if(!SendMessage(wmPtr->wrapper, TK_ICONIFY, 0, 0)) {
- Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
- ": the container does not support the request", NULL);
+ if (!SendMessage(wmPtr->wrapper, TK_ICONIFY, 0, 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify %s: the container does not support the request",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL);
return TCL_ERROR;
}
}
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": override-redirect flag is set", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": override-redirect flag is set",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT",
+ NULL);
return TCL_ERROR;
}
if (wmPtr->masterPtr != NULL) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": it is a transient", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": it is a transient",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL);
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
- ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify %s: it is an icon for %s",
+ winPtr->pathName, Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL);
return TCL_ERROR;
}
TkpWmSetState(winPtr, IconicState);
@@ -4201,7 +4184,7 @@ WmIconmaskCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
Pixmap pixmap;
- char *argv3;
+ const char *argv3;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?");
@@ -4209,9 +4192,9 @@ WmIconmaskCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- Tcl_SetResult(interp, (char *)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
- TCL_STATIC);
+ -1));
}
return TCL_OK;
}
@@ -4258,25 +4241,25 @@ WmIconnameCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- char *argv3;
- int length;
+ const char *argv3;
+ size_t length;
if (objc > 4) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?");
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp,
- ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ (wmPtr->iconName ? wmPtr->iconName : ""), -1));
return TCL_OK;
} else {
if (wmPtr->iconName != NULL) {
- ckfree((char *) wmPtr->iconName);
+ ckfree(wmPtr->iconName);
}
- argv3 = Tcl_GetStringFromObj(objv[3], &length);
- wmPtr->iconName = ckalloc((unsigned) (length + 1));
- strcpy(wmPtr->iconName, argv3);
+ argv3 = Tcl_GetString(objv[3]);
+ length = objv[3]->length;
+ wmPtr->iconName = ckalloc(length + 1);
+ memcpy(wmPtr->iconName, argv3, length + 1);
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
}
@@ -4314,7 +4297,7 @@ WmIconphotoCmd(
Tk_PhotoImageBlock block;
int i, width, height, idx, bufferSize, startObj = 3;
union {unsigned char *ptr; void *voidPtr;} bgraPixel;
- void *bgraMaskPtr;
+ union {unsigned char *ptr; void *voidPtr;} bgraMask;
BlockOfIconImagesPtr lpIR;
WinIconPtr titlebaricon = NULL;
HICON hIcon;
@@ -4344,8 +4327,10 @@ WmIconphotoCmd(
for (i = startObj; i < objc; i++) {
photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
if (photo == NULL) {
- Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]),
- "\" as iconphoto: not a photo image", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use \"%s\" as iconphoto: not a photo image",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL);
return TCL_ERROR;
}
}
@@ -4356,7 +4341,7 @@ WmIconphotoCmd(
*/
size = sizeof(BlockOfIconImages) + (sizeof(ICONIMAGE) * (objc-startObj-1));
- lpIR = (BlockOfIconImagesPtr) attemptckalloc(size);
+ lpIR = attemptckalloc(size);
if (lpIR == NULL) {
return TCL_ERROR;
}
@@ -4371,18 +4356,19 @@ WmIconphotoCmd(
/*
* Don't use CreateIcon to create the icon, as it requires color
- * bitmap data in device-dependent format. Instead we use
- * CreateIconIndirect which takes device-independent bitmaps
- * and converts them as required. Initialise icon info structure.
+ * bitmap data in device-dependent format. Instead we use
+ * CreateIconIndirect which takes device-independent bitmaps and
+ * converts them as required. Initialise icon info structure.
*/
- ZeroMemory( &iconInfo, sizeof iconInfo );
+ ZeroMemory(&iconInfo, sizeof(iconInfo));
iconInfo.fIcon = TRUE;
/*
* Create device-independant color bitmap.
*/
- ZeroMemory(&bmInfo,sizeof bmInfo);
+
+ ZeroMemory(&bmInfo, sizeof bmInfo);
bmInfo.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
bmInfo.bmiHeader.biWidth = width;
bmInfo.bmiHeader.biHeight = -height;
@@ -4390,18 +4376,21 @@ WmIconphotoCmd(
bmInfo.bmiHeader.biBitCount = 32;
bmInfo.bmiHeader.biCompression = BI_RGB;
- iconInfo.hbmColor = CreateDIBSection( NULL, &bmInfo,
- DIB_RGB_COLORS, &bgraPixel.voidPtr, NULL, 0 );
- if ( !iconInfo.hbmColor ) {
- ckfree((char *) lpIR);
- Tcl_AppendResult(interp, "failed to create color bitmap for \"",
- Tcl_GetString(objv[i]), "\"", NULL);
+ iconInfo.hbmColor = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS,
+ &bgraPixel.voidPtr, NULL, 0);
+ if (!iconInfo.hbmColor) {
+ ckfree(lpIR);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "failed to create color bitmap for \"%s\"",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "BITMAP", NULL);
return TCL_ERROR;
}
/*
* Convert the photo image data into BGRA format (RGBQUAD).
*/
+
bufferSize = height * width * 4;
for (idx = 0 ; idx < bufferSize ; idx += 4) {
bgraPixel.ptr[idx] = block.pixelPtr[idx+2];
@@ -4411,28 +4400,32 @@ WmIconphotoCmd(
}
/*
- * Create a dummy mask bitmap. The contents of this don't
- * appear to matter, as CreateIconIndirect will setup the icon
- * mask based on the alpha channel in our color bitmap.
+ * Create a dummy mask bitmap. The contents of this don't appear to
+ * matter, as CreateIconIndirect will setup the icon mask based on the
+ * alpha channel in our color bitmap.
*/
+
bmInfo.bmiHeader.biBitCount = 1;
- iconInfo.hbmMask = CreateDIBSection( NULL, &bmInfo,
- DIB_RGB_COLORS, &bgraMaskPtr, NULL, 0 );
- if ( !iconInfo.hbmMask ) {
+ iconInfo.hbmMask = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS,
+ &bgraMask.voidPtr, NULL, 0);
+ if (!iconInfo.hbmMask) {
DeleteObject(iconInfo.hbmColor);
- ckfree((char *) lpIR);
- Tcl_AppendResult(interp, "failed to create mask bitmap for \"",
- Tcl_GetString(objv[i]), "\"", NULL);
+ ckfree(lpIR);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "failed to create mask bitmap for \"%s\"",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "MASK", NULL);
return TCL_ERROR;
}
- ZeroMemory( bgraMaskPtr, width*height/8 );
+ ZeroMemory(bgraMask.ptr, width*height/8);
/*
* Create an icon from the bitmaps.
*/
- hIcon = CreateIconIndirect( &iconInfo);
+
+ hIcon = CreateIconIndirect(&iconInfo);
DeleteObject(iconInfo.hbmColor);
DeleteObject(iconInfo.hbmMask);
if (hIcon == NULL) {
@@ -4440,9 +4433,11 @@ WmIconphotoCmd(
* XXX should free up created icons.
*/
- ckfree((char *) lpIR);
- Tcl_AppendResult(interp, "failed to create icon for \"",
- Tcl_GetString(objv[i]), "\"", NULL);
+ ckfree(lpIR);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "failed to create icon for \"%s\"",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "ICON", NULL);
return TCL_ERROR;
}
lpIR->IconImages[i-startObj].Width = width;
@@ -4451,7 +4446,7 @@ WmIconphotoCmd(
lpIR->IconImages[i-startObj].hIcon = hIcon;
}
- titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
+ titlebaricon = ckalloc(sizeof(WinIconInstance));
titlebaricon->iconBlock = lpIR;
titlebaricon->refCount = 1;
if (WinSetIcon(interp, titlebaricon, (Tk_Window) useWinPtr) != TCL_OK) {
@@ -4499,11 +4494,11 @@ WmIconpositionCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *results[2];
- sprintf(buf, "%d %d", wmPtr->hints.icon_x,
- wmPtr->hints.icon_y);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x);
+ results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
}
return TCL_OK;
}
@@ -4511,7 +4506,7 @@ WmIconpositionCmd(
wmPtr->hints.flags &= ~IconPositionHint;
} else {
if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
- || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
return TCL_ERROR;
}
wmPtr->hints.icon_x = x;
@@ -4557,7 +4552,7 @@ WmIconwindowCmd(
}
if (objc == 3) {
if (wmPtr->icon != NULL) {
- Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon));
}
return TCL_OK;
}
@@ -4582,15 +4577,18 @@ WmIconwindowCmd(
return TCL_ERROR;
}
if (!Tk_IsTopLevel(tkwin2)) {
- Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
- " as icon window: not at top level", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use %s as icon window: not at top level",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "INNER", NULL);
return TCL_ERROR;
}
wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
if (wmPtr2->iconFor != NULL) {
- Tcl_AppendResult(interp, Tcl_GetString(objv[3]),
- " is already an icon for ", Tk_PathName(wmPtr2->iconFor),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s is already an icon for %s",
+ Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL);
return TCL_ERROR;
}
if (wmPtr->icon != NULL) {
@@ -4646,21 +4644,22 @@ WmIconwindowCmd(
*/
static int
-WmManageCmd(tkwin, winPtr, interp, objc, objv)
- Tk_Window tkwin; /* Main window of the application. */
- TkWindow *winPtr; /* Toplevel or Frame to work with */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *const objv[]; /* Argument objects. */
+WmManageCmd(
+ Tk_Window tkwin, /* Main window of the application. */
+ TkWindow *winPtr, /* Toplevel or Frame to work with */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- register Tk_Window frameWin = (Tk_Window)winPtr;
+ register Tk_Window frameWin = (Tk_Window) winPtr;
register WmInfo *wmPtr = winPtr->wmInfoPtr;
if (!Tk_IsTopLevel(frameWin)) {
if (!Tk_IsManageable(frameWin)) {
- Tcl_AppendResult(interp, "window \"",
- Tk_PathName(frameWin), "\" is not manageable: must be "
- "a frame, labelframe or toplevel", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" is not manageable: must be a frame,"
+ " labelframe or toplevel", Tk_PathName(frameWin)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL);
return TCL_ERROR;
}
TkFocusSplit(winPtr);
@@ -4714,11 +4713,12 @@ WmMaxsizeCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *results[2];
GetMaxSize(wmPtr, &width, &height);
- sprintf(buf, "%d %d", width, height);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ results[0] = Tcl_NewIntObj(width);
+ results[1] = Tcl_NewIntObj(height);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
@@ -4764,11 +4764,12 @@ WmMinsizeCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *results[2];
GetMinSize(wmPtr, &width, &height);
- sprintf(buf, "%d %d", width, height);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ results[0] = Tcl_NewIntObj(width);
+ results[1] = Tcl_NewIntObj(height);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
@@ -4814,25 +4815,26 @@ WmOverrideredirectCmd(
Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
return TCL_ERROR;
}
- if(winPtr->flags & TK_EMBEDDED) {
+ if (winPtr->flags & TK_EMBEDDED) {
curValue = SendMessage(wmPtr->wrapper, TK_OVERRIDEREDIRECT, -1, -1)-1;
if (curValue < 0) {
- Tcl_AppendResult(interp,
- "Container does not support overrideredirect", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Container does not support overrideredirect", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
} else {
curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
}
if (objc == 3) {
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(curValue));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
return TCL_ERROR;
}
if (curValue != boolean) {
- if(winPtr->flags & TK_EMBEDDED) {
+ if (winPtr->flags & TK_EMBEDDED) {
SendMessage(wmPtr->wrapper, TK_OVERRIDEREDIRECT, boolean, 0);
} else {
/*
@@ -4844,7 +4846,7 @@ WmOverrideredirectCmd(
Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
&atts);
if (!(wmPtr->flags & (WM_NEVER_MAPPED))
- && !(winPtr->flags & TK_EMBEDDED)) {
+ && !(winPtr->flags & TK_EMBEDDED)) {
UpdateWrapper(winPtr);
}
}
@@ -4878,7 +4880,7 @@ WmPositionfromCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"program", "user", NULL
};
enum options {
@@ -4891,18 +4893,21 @@ WmPositionfromCmd(
return TCL_ERROR;
}
if (objc == 3) {
+ const char *sourceStr = "";
+
if (wmPtr->sizeHintsFlags & USPosition) {
- Tcl_SetResult(interp, "user", TCL_STATIC);
+ sourceStr = "user";
} else if (wmPtr->sizeHintsFlags & PPosition) {
- Tcl_SetResult(interp, "program", TCL_STATIC);
+ sourceStr = "program";
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1));
return TCL_OK;
}
if (*Tcl_GetString(objv[3]) == '\0') {
wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
} else {
- if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings,
+ sizeof(char *), "argument", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == OPT_USER) {
@@ -4945,8 +4950,9 @@ WmProtocolCmd(
register WmInfo *wmPtr = winPtr->wmInfoPtr;
register ProtocolHandler *protPtr, *prevPtr;
Atom protocol;
- char *cmd;
- int cmdLength;
+ const char *cmd;
+ size_t cmdLength;
+ Tcl_Obj *resultObj;
if ((objc < 3) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
@@ -4957,11 +4963,13 @@ WmProtocolCmd(
* Return a list of all defined protocols for the window.
*/
+ resultObj = Tcl_NewObj();
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
- Tcl_AppendElement(interp,
- Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol), -1));
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3]));
@@ -4973,7 +4981,8 @@ WmProtocolCmd(
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(protPtr->command, -1));
return TCL_OK;
}
}
@@ -4993,13 +5002,14 @@ WmProtocolCmd(
} else {
prevPtr->nextPtr = protPtr->nextPtr;
}
- Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(protPtr, TCL_DYNAMIC);
break;
}
}
- cmd = Tcl_GetStringFromObj(objv[4], &cmdLength);
+ cmd = Tcl_GetString(objv[4]);
+ cmdLength = objv[4]->length;
if (cmdLength > 0) {
- protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength));
+ protPtr = ckalloc(HANDLER_SIZE(cmdLength));
protPtr->protocol = protocol;
protPtr->nextPtr = wmPtr->protPtr;
wmPtr->protPtr = protPtr;
@@ -5042,12 +5052,11 @@ WmResizableCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *results[2];
- sprintf(buf, "%d %d",
- (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
- (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE));
+ results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
@@ -5098,7 +5107,7 @@ WmSizefromCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"program", "user", NULL
};
enum options {
@@ -5111,19 +5120,22 @@ WmSizefromCmd(
return TCL_ERROR;
}
if (objc == 3) {
+ const char *sourceStr = "";
+
if (wmPtr->sizeHintsFlags & USSize) {
- Tcl_SetResult(interp, "user", TCL_STATIC);
+ sourceStr = "user";
} else if (wmPtr->sizeHintsFlags & PSize) {
- Tcl_SetResult(interp, "program", TCL_STATIC);
+ sourceStr = "program";
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1));
return TCL_OK;
}
if (*Tcl_GetString(objv[3]) == '\0') {
wmPtr->sizeHintsFlags &= ~(USSize|PSize);
} else {
- if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings,
+ sizeof(char *), "argument", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == OPT_USER) {
@@ -5163,13 +5175,14 @@ WmStackorderCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- TkWindow **windows, **window_ptr;
- static const char *optionStrings[] = {
+ TkWindow **windows, **windowPtr;
+ static const char *const optionStrings[] = {
"isabove", "isbelow", NULL
};
enum options {
OPT_ISABOVE, OPT_ISBELOW
};
+ Tcl_Obj *resultObj;
int index;
if ((objc != 3) && (objc != 5)) {
@@ -5181,16 +5194,19 @@ WmStackorderCmd(
windows = TkWmStackorderToplevel(winPtr);
if (windows == NULL) {
Tcl_Panic("TkWmStackorderToplevel failed");
- } else {
- for (window_ptr = windows; *window_ptr ; window_ptr++) {
- Tcl_AppendElement(interp, (*window_ptr)->pathName);
- }
- ckfree((char *) windows);
- return TCL_OK;
}
+
+ resultObj = Tcl_NewObj();
+ for (windowPtr = windows; *windowPtr ; windowPtr++) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TkNewWindowObj((Tk_Window) *windowPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ ckfree(windows);
+ return TCL_OK;
} else {
TkWindow *winPtr2, **winPtr2Ptr = &winPtr2;
- int index1=-1, index2=-1, result;
+ int index1 = -1, index2 = -1, result;
if (TkGetWindowFromObj(interp, tkwin, objv[4],
(Tk_Window *) winPtr2Ptr) != TCL_OK) {
@@ -5198,20 +5214,24 @@ WmStackorderCmd(
}
if (!Tk_IsTopLevel(winPtr2)) {
- Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
- "\" isn't a top-level window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't a top-level window",
+ winPtr2->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL);
return TCL_ERROR;
}
if (!Tk_IsMapped(winPtr)) {
- Tcl_AppendResult(interp, "window \"", winPtr->pathName,
- "\" isn't mapped", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't mapped", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL);
return TCL_ERROR;
}
if (!Tk_IsMapped(winPtr2)) {
- Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
- "\" isn't mapped", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't mapped", winPtr2->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL);
return TCL_ERROR;
}
@@ -5221,31 +5241,31 @@ WmStackorderCmd(
*/
windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
-
if (windows == NULL) {
- Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "TkWmStackorderToplevel failed", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
- } else {
- for (window_ptr = windows; *window_ptr ; window_ptr++) {
- if (*window_ptr == winPtr) {
- index1 = (window_ptr - windows);
- }
- if (*window_ptr == winPtr2) {
- index2 = (window_ptr - windows);
- }
- }
- if (index1 == -1) {
- Tcl_Panic("winPtr window not found");
+ }
+
+ for (windowPtr = windows; *windowPtr ; windowPtr++) {
+ if (*windowPtr == winPtr) {
+ index1 = (windowPtr - windows);
}
- if (index2 == -1) {
- Tcl_Panic("winPtr2 window not found");
+ if (*windowPtr == winPtr2) {
+ index2 = (windowPtr - windows);
}
-
- ckfree((char *) windows);
}
+ if (index1 == -1) {
+ Tcl_Panic("winPtr window not found");
+ } else if (index2 == -1) {
+ Tcl_Panic("winPtr2 window not found");
+ }
+
+ ckfree(windows);
- if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings,
+ sizeof(char *), "argument", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == OPT_ISABOVE) {
@@ -5253,10 +5273,9 @@ WmStackorderCmd(
} else { /* OPT_ISBELOW */
result = index1 < index2;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
return TCL_OK;
}
- return TCL_OK;
}
/*
@@ -5285,7 +5304,7 @@ WmStateCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"normal", "iconic", "withdrawn", "zoomed", NULL
};
enum options {
@@ -5299,13 +5318,14 @@ WmStateCmd(
}
if (objc == 4) {
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't change state of ",
- Tcl_GetString(objv[2]), ": it is an icon for ",
- Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't change state of %s: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL);
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings,
+ sizeof(char *), "argument", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -5330,9 +5350,10 @@ WmStateCmd(
}
if (state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) {
- Tcl_AppendResult(interp, "can't change state of ",
- winPtr->pathName,
- ": the container does not support the request", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't change state of %s: the container does not support the request",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -5348,13 +5369,19 @@ WmStateCmd(
*/
} else if (index == OPT_ICONIC) {
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": override-redirect flag is set", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": override-redirect flag is set",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STATE",
+ "OVERRIDE_REDIRECT", NULL);
return TCL_ERROR;
}
if (wmPtr->masterPtr != NULL) {
- Tcl_AppendResult(interp, "can't iconify \"",
- winPtr->pathName, "\": it is a transient", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": it is a transient",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT",
+ NULL);
return TCL_ERROR;
}
TkpWmSetState(winPtr, IconicState);
@@ -5367,31 +5394,26 @@ WmStateCmd(
Tcl_Panic("wm state not matched");
}
} else {
+ const char *stateStr = "";
+
if (wmPtr->iconFor != NULL) {
- Tcl_SetResult(interp, "icon", TCL_STATIC);
+ stateStr = "icon";
} else {
int state;
if (winPtr->flags & TK_EMBEDDED) {
- state = SendMessage(wmPtr->wrapper, TK_STATE, -1, -1)-1;
+ state = SendMessage(wmPtr->wrapper, TK_STATE, -1, -1) - 1;
} else {
state = wmPtr->hints.initial_state;
}
switch (state) {
- case NormalState:
- Tcl_SetResult(interp, "normal", TCL_STATIC);
- break;
- case IconicState:
- Tcl_SetResult(interp, "iconic", TCL_STATIC);
- break;
- case WithdrawnState:
- Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
- break;
- case ZoomState:
- Tcl_SetResult(interp, "zoomed", TCL_STATIC);
- break;
+ case NormalState: stateStr = "normal"; break;
+ case IconicState: stateStr = "iconic"; break;
+ case WithdrawnState: stateStr = "withdrawn"; break;
+ case ZoomState: stateStr = "zoomed"; break;
}
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(stateStr, -1));
}
return TCL_OK;
}
@@ -5422,8 +5444,8 @@ WmTitleCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- char *argv3;
- int length;
+ const char *argv3;
+ size_t length;
HWND wrapper;
if (objc > 4) {
@@ -5431,39 +5453,41 @@ WmTitleCmd(
return TCL_ERROR;
}
- if(winPtr->flags & TK_EMBEDDED) {
- wrapper = (HWND)SendMessage(wmPtr->wrapper, TK_GETFRAMEWID, 0, 0);
+ if (winPtr->flags & TK_EMBEDDED) {
+ wrapper = (HWND) SendMessage(wmPtr->wrapper, TK_GETFRAMEWID, 0, 0);
} else {
wrapper = wmPtr->wrapper;
}
if (objc == 3) {
if (wrapper) {
- char buf[512];
+ TCHAR buf[256];
Tcl_DString titleString;
- int size = tkWinProcs->useWide ? 256 : 512;
+ int size = 256;
- (*tkWinProcs->getWindowText)(wrapper, (LPCTSTR)buf, size);
+ GetWindowText(wrapper, buf, size);
Tcl_WinTCharToUtf(buf, -1, &titleString);
- Tcl_SetResult(interp, Tcl_DStringValue(&titleString),TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_DStringValue(&titleString),
+ Tcl_DStringLength(&titleString)));
Tcl_DStringFree(&titleString);
} else {
- Tcl_SetResult(interp, (char *)
- ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ (wmPtr->title ? wmPtr->title : winPtr->nameUid), -1));
}
} else {
if (wmPtr->title != NULL) {
- ckfree((char *) wmPtr->title);
+ ckfree(wmPtr->title);
}
- argv3 = Tcl_GetStringFromObj(objv[3], &length);
- wmPtr->title = ckalloc((unsigned) (length + 1));
- strcpy(wmPtr->title, argv3);
+ argv3 = Tcl_GetString(objv[3]);
+ length = objv[3]->length;
+ wmPtr->title = ckalloc(length + 1);
+ memcpy(wmPtr->title, argv3, length + 1);
if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) {
Tcl_DString titleString;
+
Tcl_WinUtfToTChar(wmPtr->title, -1, &titleString);
- (*tkWinProcs->setWindowText)(wrapper,
- (LPCTSTR) Tcl_DStringValue(&titleString));
+ SetWindowText(wrapper, (LPCTSTR) Tcl_DStringValue(&titleString));
Tcl_DStringFree(&titleString);
}
}
@@ -5505,7 +5529,7 @@ WmTransientCmd(
}
if (objc == 3) {
if (masterPtr != NULL) {
- Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) masterPtr));
}
return TCL_OK;
}
@@ -5519,7 +5543,7 @@ WmTransientCmd(
masterPtr->wmInfoPtr->numTransients--;
Tk_DeleteEventHandler((Tk_Window) masterPtr,
VisibilityChangeMask|StructureNotifyMask,
- WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ WmWaitVisibilityOrMapProc, winPtr);
}
wmPtr->masterPtr = NULL;
@@ -5538,24 +5562,27 @@ WmTransientCmd(
Tk_MakeWindowExist((Tk_Window) masterPtr);
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]),
- "\" a transient: it is an icon for ",
- Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't make \"%s\" a transient: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
return TCL_ERROR;
}
wmPtr2 = masterPtr->wmInfoPtr;
if (wmPtr2->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]),
- "\" a master: it is an icon for ",
- Tk_PathName(wmPtr2->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't make \"%s\" a master: it is an icon for %s",
+ Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
return TCL_ERROR;
}
if (masterPtr == winPtr) {
- Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr),
- "\" its own master", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't make \"%s\" its own master", Tk_PathName(winPtr)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
return TCL_ERROR;
} else if (masterPtr != wmPtr->masterPtr) {
/*
@@ -5568,21 +5595,21 @@ WmTransientCmd(
wmPtr->masterPtr->wmInfoPtr->numTransients--;
Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr,
VisibilityChangeMask|StructureNotifyMask,
- WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ WmWaitVisibilityOrMapProc, winPtr);
}
masterPtr->wmInfoPtr->numTransients++;
Tk_CreateEventHandler((Tk_Window) masterPtr,
VisibilityChangeMask|StructureNotifyMask,
- WmWaitVisibilityOrMapProc, (ClientData) winPtr);
+ WmWaitVisibilityOrMapProc, winPtr);
wmPtr->masterPtr = masterPtr;
}
}
if (!((wmPtr->flags & WM_NEVER_MAPPED)
&& !(winPtr->flags & TK_EMBEDDED))) {
- if (wmPtr->masterPtr != NULL &&
- !Tk_IsMapped(wmPtr->masterPtr)) {
+ if (wmPtr->masterPtr != NULL
+ && !Tk_IsMapped(wmPtr->masterPtr)) {
TkpWmSetState(winPtr, WithdrawnState);
} else {
UpdateWrapper(winPtr);
@@ -5623,15 +5650,19 @@ WmWithdrawCmd(
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
- ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't withdraw %s: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL);
return TCL_ERROR;
}
if (winPtr->flags & TK_EMBEDDED) {
if (SendMessage(wmPtr->wrapper, TK_WITHDRAW, 0, 0) < 0) {
- Tcl_AppendResult(interp, "can't withdraw", Tcl_GetString(objv[2]),
- ": the container does not support the request", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't withdraw %s: the container does not support the request",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
} else {
@@ -5652,7 +5683,7 @@ WmUpdateGeom(
TkWindow *winPtr)
{
if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
}
@@ -5663,7 +5694,7 @@ WmWaitVisibilityOrMapProc(
ClientData clientData, /* Pointer to window. */
XEvent *eventPtr) /* Information about event. */
{
- TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *winPtr = clientData;
TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr;
if (masterPtr == NULL)
@@ -5792,7 +5823,7 @@ Tk_SetGrid(
wmPtr->heightInc = heightInc;
wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc;
if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
}
@@ -5852,7 +5883,7 @@ Tk_UnsetGrid(
wmPtr->heightInc = 1;
if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
}
@@ -5880,7 +5911,7 @@ TopLevelEventProc(
ClientData clientData, /* Window for which event occurred. */
XEvent *eventPtr) /* Event that just happened. */
{
- register TkWindow *winPtr = (TkWindow *) clientData;
+ register TkWindow *winPtr = clientData;
if (eventPtr->type == DestroyNotify) {
Tk_ErrorHandler handler;
@@ -5895,7 +5926,7 @@ TopLevelEventProc(
*/
handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
- (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ NULL, NULL);
Tk_DestroyWindow((Tk_Window) winPtr);
Tk_DeleteErrorHandler(handler);
}
@@ -5971,7 +6002,7 @@ UpdateGeometryInfo(
int width, height; /* Size of client area. */
int min, max;
RECT rect;
- register TkWindow *winPtr = (TkWindow *) clientData;
+ register TkWindow *winPtr = clientData;
register WmInfo *wmPtr = winPtr->wmInfoPtr;
wmPtr->flags &= ~WM_UPDATE_PENDING;
@@ -6247,7 +6278,7 @@ UpdateGeometryInfo(
static int
ParseGeometry(
Tcl_Interp *interp, /* Used for error reporting. */
- char *string, /* String containing new geometry. Has the
+ const char *string, /* String containing new geometry. Has the
* standard form "=wxh+x+y". */
TkWindow *winPtr) /* Pointer to top-level window whose geometry
* is to be changed. */
@@ -6255,7 +6286,7 @@ ParseGeometry(
register WmInfo *wmPtr = winPtr->wmInfoPtr;
int x, y, width, height, flags;
char *end;
- register char *p = string;
+ register const char *p = string;
/*
* The leading "=" is optional.
@@ -6328,7 +6359,7 @@ ParseGeometry(
* them.
*/
- if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) {
wmPtr->sizeHintsFlags |= USPosition;
}
}
@@ -6347,13 +6378,15 @@ ParseGeometry(
wmPtr->flags = flags;
if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
return TCL_OK;
error:
- Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad geometry specifier \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL);
return TCL_ERROR;
}
@@ -6520,7 +6553,7 @@ Tk_MoveToplevelWindow(
wmPtr->y = y;
wmPtr->flags |= WM_MOVE_PENDING;
wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
- if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) {
wmPtr->sizeHintsFlags |= USPosition;
}
@@ -6532,9 +6565,9 @@ Tk_MoveToplevelWindow(
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
if (wmPtr->flags & WM_UPDATE_PENDING) {
- Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr);
}
- UpdateGeometryInfo((ClientData) winPtr);
+ UpdateGeometryInfo(winPtr);
}
}
@@ -6582,18 +6615,18 @@ TkWmProtocolEventProc(
const char *name = Tk_GetAtomName((Tk_Window) winPtr, protocol);
- Tcl_Preserve((ClientData) protPtr);
+ Tcl_Preserve(protPtr);
interp = protPtr->interp;
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(interp);
result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
- Tcl_AddErrorInfo(interp, "\n (command for \"");
- Tcl_AddErrorInfo(interp, name);
- Tcl_AddErrorInfo(interp, "\" window manager protocol)");
- Tcl_BackgroundError(interp);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (command for \"%s\" window manager protocol)",
+ name));
+ Tcl_BackgroundException(interp, result);
}
- Tcl_Release((ClientData) interp);
- Tcl_Release((ClientData) protPtr);
+ Tcl_Release(interp);
+ Tcl_Release(protPtr);
return;
}
}
@@ -6640,7 +6673,7 @@ TkWmStackorderToplevelEnumProc(
hPtr = Tcl_FindHashEntry(pair->table, (char *) hwnd);
if (hPtr != NULL) {
- childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr);
+ childWinPtr = Tcl_GetHashValue(hPtr);
/*
* Double check that same HWND does not get passed twice.
@@ -6655,7 +6688,7 @@ TkWmStackorderToplevelEnumProc(
fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd,
childWinPtr, childWinPtr->pathName);
*/
- *(pair->window_ptr)-- = childWinPtr;
+ *(pair->windowPtr)-- = childWinPtr;
}
return TRUE;
}
@@ -6688,8 +6721,8 @@ TkWmStackorderToplevelWrapperMap(
HWND wrapper;
int newEntry;
- if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) &&
- !Tk_IsEmbedded(winPtr) && (winPtr->display == display)) {
+ if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr)
+ && !Tk_IsEmbedded(winPtr) && (winPtr->display == display)) {
wrapper = TkWinGetWrapperWindow((Tk_Window) winPtr);
/*
@@ -6740,8 +6773,7 @@ TkWmStackorderToplevel(
Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
TkWmStackorderToplevelWrapperMap(parentPtr, parentPtr->display, &table);
- windows = (TkWindow **) ckalloc((table.numEntries+1)
- * sizeof(TkWindow *));
+ windows = ckalloc((table.numEntries+1) * sizeof(TkWindow *));
/*
* Special cases: If zero or one toplevels were mapped there is no need to
@@ -6754,7 +6786,7 @@ TkWmStackorderToplevel(
goto done;
case 1:
hPtr = Tcl_FirstHashEntry(&table, &search);
- windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr);
+ windows[0] = Tcl_GetHashValue(hPtr);
windows[1] = NULL;
goto done;
}
@@ -6766,14 +6798,14 @@ TkWmStackorderToplevel(
*/
pair.table = &table;
- pair.window_ptr = windows + table.numEntries;
- *pair.window_ptr-- = NULL;
+ pair.windowPtr = windows + table.numEntries;
+ *pair.windowPtr-- = NULL;
if (EnumWindows((WNDENUMPROC) TkWmStackorderToplevelEnumProc,
(LPARAM) &pair) == 0) {
- ckfree((char *) windows);
+ ckfree(windows);
windows = NULL;
- } else if (pair.window_ptr != (windows-1)) {
+ } else if (pair.windowPtr != (windows-1)) {
Tcl_Panic("num matched toplevel windows does not equal num children");
}
@@ -6840,7 +6872,7 @@ TkWmRestackToplevel(
if (winPtr->flags & TK_EMBEDDED) {
SendMessage(winPtr->wmInfoPtr->wrapper, TK_RAISEWINDOW,
- (WPARAM)insertAfter, aboveBelow);
+ (WPARAM) insertAfter, aboveBelow);
} else {
TkWinSetWindowPos(hwnd, insertAfter, aboveBelow);
}
@@ -6919,7 +6951,7 @@ TkWmAddToColormapWindows(
* Automatically add the toplevel itself as the last element of the list.
*/
- newPtr = (TkWindow **) ckalloc((unsigned) ((count+2)*sizeof(TkWindow*)));
+ newPtr = ckalloc((count+2) * sizeof(TkWindow *));
if (count > 0) {
memcpy(newPtr, oldPtr, count * sizeof(TkWindow*));
}
@@ -6929,7 +6961,7 @@ TkWmAddToColormapWindows(
newPtr[count-1] = winPtr;
newPtr[count] = topPtr;
if (oldPtr != NULL) {
- ckfree((char *) oldPtr);
+ ckfree(oldPtr);
}
topPtr->wmInfoPtr->cmapList = newPtr;
@@ -7061,12 +7093,12 @@ TkWinSetMenu(
}
if (!(winPtr->flags & TK_EMBEDDED)) {
if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING|WM_MOVE_PENDING;
}
} else {
- SendMessage(wmPtr->wrapper, TK_SETMENU,
- (WPARAM)hMenu, (LPARAM)Tk_GetMenuHWND(tkwin));
+ SendMessage(wmPtr->wrapper, TK_SETMENU, (WPARAM) hMenu,
+ (LPARAM) Tk_GetMenuHWND(tkwin));
}
}
@@ -7146,7 +7178,7 @@ ConfigureTopLevel(
*/
if (!(wmPtr->flags & WM_UPDATE_PENDING)) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
/* fall through */
@@ -7349,7 +7381,7 @@ InstallColormaps(
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (winPtr == NULL || (winPtr->flags & TK_ALREADY_DEAD) ) {
+ if (winPtr == NULL || (winPtr->flags & TK_ALREADY_DEAD)) {
return 0;
}
@@ -7379,11 +7411,9 @@ InstallColormaps(
SelectPalette(dc, oldPalette, TRUE);
RealizePalette(dc);
ReleaseDC(hwnd, dc);
- SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM)hwnd,
- (LPARAM)NULL);
+ SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM) hwnd, (LPARAM) NULL);
return TRUE;
}
-
} else {
/*
* Window is being notified of a change in the system palette. If this
@@ -7845,7 +7875,7 @@ WmProc(
break;
case WM_ACTIVATE:
- if ( WA_ACTIVE == LOWORD(wParam) ) {
+ if (WA_ACTIVE == LOWORD(wParam)) {
winPtr = GetTopLevel(hwnd);
if (winPtr && (TkGrabState(winPtr) == TK_GRAB_EXCLUDED)) {
/*
@@ -7922,7 +7952,7 @@ WmProc(
case WM_PALETTECHANGED:
result = InstallColormaps(hwnd, WM_PALETTECHANGED,
- hwnd == (HWND)wParam);
+ hwnd == (HWND) wParam);
goto done;
case WM_QUERYNEWPALETTE:
@@ -7968,8 +7998,7 @@ WmProc(
* 2272]
*/
- result = (*tkWinProcs->defWindowProc)(hwnd, message,
- wParam, lParam);
+ result = DefWindowProc(hwnd, message, wParam, lParam);
goto done;
}
@@ -8043,7 +8072,7 @@ WmProc(
case WM_ENTERIDLE:
case WM_INITMENUPOPUP:
if (winPtr) {
- HWND hMenuHWnd = Tk_GetEmbeddedMenuHWND((Tk_Window)winPtr);
+ HWND hMenuHWnd = Tk_GetEmbeddedMenuHWND((Tk_Window) winPtr);
if (hMenuHWnd) {
if (SendMessage(hMenuHWnd, message, wParam, lParam)) {
@@ -8065,11 +8094,10 @@ WmProc(
result = 0;
} else if (!Tk_TranslateWinEvent(child, message, wParam, lParam,
&result)) {
- result = (*tkWinProcs->defWindowProc)(hwnd, message,
- wParam, lParam);
+ result = DefWindowProc(hwnd, message, wParam, lParam);
}
} else {
- result = (*tkWinProcs->defWindowProc)(hwnd, message, wParam, lParam);
+ result = DefWindowProc(hwnd, message, wParam, lParam);
}
done:
@@ -8115,8 +8143,8 @@ TkpMakeMenuWindow(
if ((atts.override_redirect != Tk_Attributes(tkwin)->override_redirect)
|| (atts.save_under != Tk_Attributes(tkwin)->save_under)) {
- Tk_ChangeWindowAttributes(tkwin,
- CWOverrideRedirect|CWSaveUnder, &atts);
+ Tk_ChangeWindowAttributes(tkwin, CWOverrideRedirect|CWSaveUnder,
+ &atts);
}
}
@@ -8141,8 +8169,9 @@ HWND
TkWinGetWrapperWindow(
Tk_Window tkwin) /* The window we need the wrapper from */
{
- TkWindow *winPtr = (TkWindow *)tkwin;
- return (winPtr->wmInfoPtr->wrapper);
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ return winPtr->wmInfoPtr->wrapper;
}
/*
@@ -8218,8 +8247,8 @@ TkpGetWrapperWindow(
static void
GenerateActivateEvent(TkWindow * winPtr, const int *flagPtr)
{
- ActivateEvent *eventPtr;
- eventPtr = (ActivateEvent *)ckalloc(sizeof(ActivateEvent));
+ ActivateEvent *eventPtr = ckalloc(sizeof(ActivateEvent));
+
eventPtr->ev.proc = ActivateWindow;
eventPtr->winPtr = winPtr;
eventPtr->flagPtr = flagPtr;
@@ -8352,6 +8381,7 @@ TkpWinToplevelWithDraw(
TkWindow *winPtr)
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
wmPtr->flags |= WM_WITHDRAWN;
TkpWmSetState(winPtr, WithdrawnState);
}
@@ -8411,10 +8441,10 @@ TkpWinToplevelDeiconify(
* deiconified by TkpWmSetState. Don't bother if we've never been mapped.
*/
- if ((wmPtr->flags & WM_UPDATE_PENDING) &&
- !(wmPtr->flags & WM_NEVER_MAPPED)) {
- Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
- UpdateGeometryInfo((ClientData) winPtr);
+ if ((wmPtr->flags & WM_UPDATE_PENDING)
+ && !(wmPtr->flags & WM_NEVER_MAPPED)) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr);
+ UpdateGeometryInfo(winPtr);
}
/*
@@ -8471,11 +8501,10 @@ TkpWinToplevelIsControlledByWm(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- if (wmPtr) {
- return ((wmPtr->width != -1) && (wmPtr->height != -1))? 1:0;
- } else {
+ if (!wmPtr) {
return 0;
}
+ return ((wmPtr->width != -1) && (wmPtr->height != -1)) ? 1 : 0;
}
/*
@@ -8503,7 +8532,7 @@ TkpWinToplevelMove(
register WmInfo *wmPtr = winPtr->wmInfoPtr;
if (wmPtr && x >= 0 && y >= 0 && !TkpWinToplevelIsControlledByWm(winPtr)) {
- Tk_MoveToplevelWindow((Tk_Window)winPtr, x, y);
+ Tk_MoveToplevelWindow((Tk_Window) winPtr, x, y);
}
return ((winPtr->changes.x << 16) & 0xffff0000)
| (winPtr->changes.y & 0xffff);
@@ -8535,7 +8564,9 @@ TkpWinToplevelOverrideRedirect(
register WmInfo *wmPtr = winPtr->wmInfoPtr;
curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
- if(reqValue < 0) return curValue;
+ if (reqValue < 0) {
+ return curValue;
+ }
if (curValue != reqValue) {
XSetWindowAttributes atts;
@@ -8601,8 +8632,7 @@ TkpWinToplevelDetachWindow(
*
* RemapWindows
*
- * Adjust parent/child relation ships of
- * the given window hierarchy.
+ * Adjust parent/child relation ships of the given window hierarchy.
*
* Results:
* none
@@ -8614,14 +8644,17 @@ TkpWinToplevelDetachWindow(
*/
static void
-RemapWindows(winPtr, parentHWND)
- TkWindow *winPtr;
- HWND parentHWND;
+RemapWindows(
+ TkWindow *winPtr,
+ HWND parentHWND)
{
TkWindow *childPtr;
const char *className = Tk_Class(winPtr);
- /* Skip Menus as they are handled differently */
+ /*
+ * Skip menus as they are handled differently.
+ */
+
if (className != NULL && strcmp(className, "Menu") == 0) {
return;
}
@@ -8629,9 +8662,12 @@ RemapWindows(winPtr, parentHWND)
SetParent(Tk_GetHWND(winPtr->window), parentHWND);
}
- /* Repeat for all the children */
+ /*
+ * Repeat for all the children.
+ */
+
for (childPtr = winPtr->childList; childPtr != NULL;
- childPtr = childPtr->nextPtr) {
+ childPtr = childPtr->nextPtr) {
RemapWindows(childPtr,
winPtr->window ? Tk_GetHWND(winPtr->window) : NULL);
}
diff --git a/win/tkWinX.c b/win/tkWinX.c
index cbd6032..6c44059 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -11,14 +11,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-/*
- * Make sure the SendInput API is available (NT SP 3):
- */
-#if (_WIN32_WINNT <= 0x0400)
-#undef _WIN32_WINNT
-#define _WIN32_WINNT 0x0403
-#endif
-
#include "tkWinInt.h"
/*
@@ -28,7 +20,7 @@
*/
#ifndef _WIN32_IE
-#define _WIN32_IE 0x0501 /* IE 5 */
+#define _WIN32_IE 0x0550 /* IE 5.5 */
#endif
#include <commctrl.h>
@@ -61,49 +53,11 @@
#define UNICODE_NOCHAR 0xFFFF
#endif
-static TkWinProcs asciiProcs = {
- 0,
-
- (LRESULT (WINAPI *)(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg,
- WPARAM wParam, LPARAM lParam)) CallWindowProcA,
- (LRESULT (WINAPI *)(HWND hWnd, UINT Msg, WPARAM wParam,
- LPARAM lParam)) DefWindowProcA,
- (ATOM (WINAPI *)(CONST WNDCLASS *lpWndClass)) RegisterClassA,
- (BOOL (WINAPI *)(HWND hWnd, LPCTSTR lpString)) SetWindowTextA,
- (HWND (WINAPI *)(DWORD dwExStyle, LPCTSTR lpClassName,
- LPCTSTR lpWindowName, DWORD dwStyle, int x, int y,
- int nWidth, int nHeight, HWND hWndParent, HMENU hMenu,
- HINSTANCE hInstance, LPVOID lpParam)) CreateWindowExA,
- (BOOL (WINAPI *)(HMENU hMenu, UINT uPosition, UINT uFlags,
- UINT uIDNewItem, LPCTSTR lpNewItem)) InsertMenuA,
- (int (WINAPI *)(HWND hWnd, LPCTSTR lpString, int nMaxCount)) GetWindowTextA,
-};
-
-static TkWinProcs unicodeProcs = {
- 1,
-
- (LRESULT (WINAPI *)(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg,
- WPARAM wParam, LPARAM lParam)) CallWindowProcW,
- (LRESULT (WINAPI *)(HWND hWnd, UINT Msg, WPARAM wParam,
- LPARAM lParam)) DefWindowProcW,
- (ATOM (WINAPI *)(CONST WNDCLASS *lpWndClass)) RegisterClassW,
- (BOOL (WINAPI *)(HWND hWnd, LPCTSTR lpString)) SetWindowTextW,
- (HWND (WINAPI *)(DWORD dwExStyle, LPCTSTR lpClassName,
- LPCTSTR lpWindowName, DWORD dwStyle, int x, int y,
- int nWidth, int nHeight, HWND hWndParent, HMENU hMenu,
- HINSTANCE hInstance, LPVOID lpParam)) CreateWindowExW,
- (BOOL (WINAPI *)(HMENU hMenu, UINT uPosition, UINT uFlags,
- UINT uIDNewItem, LPCTSTR lpNewItem)) InsertMenuW,
- (int (WINAPI *)(HWND hWnd, LPCTSTR lpString, int nMaxCount)) GetWindowTextW,
-};
-
-TkWinProcs *tkWinProcs;
-
/*
* Declarations of static variables used in this file.
*/
-static char winScreenName[] = ":0"; /* Default name of windows display. */
+static const char winScreenName[] = ":0"; /* Default name of windows display. */
static HINSTANCE tkInstance = NULL; /* Application instance handle. */
static int childClassInitialized; /* Registered child class? */
static WNDCLASS childClass; /* Window class for child windows. */
@@ -191,7 +145,7 @@ TkGetServerInfo(
);
buffer[0] = 'W';
}
- Tcl_SetResult(interp, buffer, TCL_STATIC);
+ Tcl_AppendResult(interp, buffer, NULL);
}
/*
@@ -278,12 +232,6 @@ TkWinXInit(
Tcl_Panic("Unable to load common controls?!");
}
- if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- tkWinProcs = &unicodeProcs;
- } else {
- tkWinProcs = &asciiProcs;
- }
-
childClass.style = CS_HREDRAW | CS_VREDRAW;
childClass.cbClsExtra = 0;
childClass.cbWndExtra = 0;
@@ -376,9 +324,10 @@ TkWinXCleanup(
*
* Results:
* The return value is one of:
- * VER_PLATFORM_WIN32s Win32s on Windows 3.1.
- * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1 (not supported)
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported)
+ * VER_PLATFORM_WIN32_NT Win32 on Windows XP, Vista, Windows 7, Windows 8
+ * VER_PLATFORM_WIN32_CE Win32 on Windows CE
*
* Side effects:
* None.
@@ -405,8 +354,8 @@ TkWinGetPlatformId(void)
if ((os.dwPlatformId == VER_PLATFORM_WIN32_NT) &&
(os.dwMajorVersion == 5 && os.dwMinorVersion == 1)) {
HKEY hKey;
- LPCSTR szSubKey = TEXT("Control Panel\\Appearance");
- LPCSTR szCurrent = TEXT("Current");
+ LPCTSTR szSubKey = TEXT("Control Panel\\Appearance");
+ LPCTSTR szCurrent = TEXT("Current");
DWORD dwSize = 200;
char pBuffer[200];
@@ -474,10 +423,10 @@ TkWinGetPlatformTheme(void)
*----------------------------------------------------------------------
*/
-CONST char *
+const char *
TkGetDefaultScreenName(
Tcl_Interp *interp, /* Not used. */
- CONST char *screenName) /* If NULL, use default string. */
+ const char *screenName) /* If NULL, use default string. */
{
if ((screenName == NULL) || (screenName[0] == '\0')) {
screenName = winScreenName;
@@ -535,9 +484,9 @@ TkWinDisplayChanged(
screen->root_depth = GetDeviceCaps(dc, BITSPIXEL) * PTR2INT(screen->ext_data);
if (screen->root_visual != NULL) {
- ckfree((char *) screen->root_visual);
+ ckfree(screen->root_visual);
}
- screen->root_visual = (Visual *) ckalloc(sizeof(Visual));
+ screen->root_visual = ckalloc(sizeof(Visual));
screen->root_visual->visualid = 0;
if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) {
screen->root_visual->map_entries = GetDeviceCaps(dc, SIZEPALETTE);
@@ -599,12 +548,12 @@ TkWinDisplayChanged(
TkDisplay *
TkpOpenDisplay(
- CONST char *display_name)
+ const char *display_name)
{
Screen *screen;
TkWinDrawable *twdPtr;
Display *display;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->winDisplay != NULL) {
@@ -615,10 +564,10 @@ TkpOpenDisplay(
}
}
- display = (Display *) ckalloc(sizeof(Display));
+ display = ckalloc(sizeof(Display));
ZeroMemory(display, sizeof(Display));
- display->display_name = (char *) ckalloc(strlen(display_name)+1);
+ display->display_name = ckalloc(strlen(display_name) + 1);
strcpy(display->display_name, display_name);
display->cursor_font = 1;
@@ -626,7 +575,7 @@ TkpOpenDisplay(
display->request = 1;
display->qlen = 0;
- screen = (Screen *) ckalloc(sizeof(Screen));
+ screen = ckalloc(sizeof(Screen));
ZeroMemory(screen, sizeof(Screen));
screen->display = display;
@@ -634,7 +583,7 @@ TkpOpenDisplay(
* Set up the root window.
*/
- twdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
+ twdPtr = ckalloc(sizeof(TkWinDrawable));
if (twdPtr == NULL) {
return None;
}
@@ -657,7 +606,7 @@ TkpOpenDisplay(
TkWinDisplayChanged(display);
- tsdPtr->winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ tsdPtr->winDisplay = ckalloc(sizeof(TkDisplay));
ZeroMemory(tsdPtr->winDisplay, sizeof(TkDisplay));
tsdPtr->winDisplay->display = display;
tsdPtr->updatingClipboard = FALSE;
@@ -702,17 +651,17 @@ TkpCloseDisplay(
}
if (display->screens != NULL) {
if (display->screens->root_visual != NULL) {
- ckfree((char *) display->screens->root_visual);
+ ckfree(display->screens->root_visual);
}
if (display->screens->root != None) {
- ckfree((char *) display->screens->root);
+ ckfree(display->screens->root);
}
if (display->screens->cmap != None) {
XFreeColormap(display, display->screens->cmap);
}
- ckfree((char *) display->screens);
+ ckfree(display->screens);
}
- ckfree((char *) display);
+ ckfree(display);
}
/*
@@ -1017,7 +966,23 @@ GenerateXEvent(
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- winPtr = (TkWindow *)Tk_HWNDToWindow(hwnd);
+ if (message == WM_MOUSEWHEEL) {
+ union {LPARAM lParam; POINTS point;} root;
+ POINT pos;
+ root.lParam = lParam;
+
+ /*
+ * Redirect mousewheel events to the window containing the cursor.
+ * That feels much less strange to users, and is how all the other
+ * platforms work.
+ */
+
+ pos.x = root.point.x;
+ pos.y = root.point.y;
+ hwnd = WindowFromPoint(pos);
+ }
+
+ winPtr = (TkWindow *) Tk_HWNDToWindow(hwnd);
if (!winPtr || winPtr->window == None) {
return;
}
@@ -1116,11 +1081,6 @@ GenerateXEvent(
break;
case WM_MOUSEWHEEL:
- /*
- * The mouse wheel event is closer to a key event than a mouse event
- * in that the message is sent to the window that has focus.
- */
-
case WM_CHAR:
case WM_UNICHAR:
case WM_SYSKEYDOWN:
@@ -1399,12 +1359,12 @@ GetTranslatedKey(
xkey->nbytes = 0;
while ((xkey->nbytes < XMaxTransChars)
- && PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
+ && PeekMessageA(&msg, NULL, 0, 0, PM_NOREMOVE)) {
if ((msg.message != WM_CHAR) && (msg.message != WM_SYSCHAR)) {
break;
}
- GetMessage(&msg, NULL, 0, 0);
+ GetMessageA(&msg, NULL, 0, 0);
/*
* If this is a normal character message, we may need to strip off the
@@ -1575,7 +1535,6 @@ HandleIMEComposition(
{
HIMC hIMC;
int n;
- BOOL isWinNT = (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT);
if ((lParam & GCS_RESULTSTR) == 0) {
/*
@@ -1590,47 +1549,15 @@ HandleIMEComposition(
return 0;
}
- if (isWinNT) {
- n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, NULL, 0);
- } else {
- n = ImmGetCompositionStringA(hIMC, GCS_RESULTSTR, NULL, 0);
- }
+ n = ImmGetCompositionString(hIMC, GCS_RESULTSTR, NULL, 0);
if (n > 0) {
- char *buff = ckalloc((unsigned) n);
+ char *buff = ckalloc(n);
TkWindow *winPtr;
XEvent event;
int i;
- if (isWinNT) {
- n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, buff,
- (unsigned) n);
- } else {
- Tcl_DString utfString, unicodeString;
- Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
-
- n = ImmGetCompositionStringA(hIMC, GCS_RESULTSTR, buff,
- (unsigned) n);
- Tcl_DStringInit(&utfString);
- Tcl_ExternalToUtfDString(keyInputEncoding, buff, n, &utfString);
- Tcl_UtfToExternalDString(unicodeEncoding,
- Tcl_DStringValue(&utfString), -1, &unicodeString);
- i = Tcl_DStringLength(&unicodeString);
- if (n < i) {
- /*
- * Only alloc more space if we need, otherwise just use what
- * we've created. Don't realloc as that may copy data we no
- * longer need.
- */
-
- ckfree((char *) buff);
- buff = (char *) ckalloc((unsigned) i);
- }
- n = i;
- memcpy(buff, Tcl_DStringValue(&unicodeString), (unsigned) n);
- Tcl_DStringFree(&utfString);
- Tcl_DStringFree(&unicodeString);
- }
+ n = ImmGetCompositionString(hIMC, GCS_RESULTSTR, buff, (unsigned) n);
/*
* Set up the fields pertinent to key event.
@@ -1943,32 +1870,10 @@ long
Tk_GetUserInactiveTime(
Display *dpy) /* Ignored on Windows */
{
- struct tagLASTINPUTINFO {
- UINT cbSize;
- DWORD dwTime;
- } li;
+ LASTINPUTINFO li;
- /*
- * Multiple settings of either of these variables should be OK; any thread
- * hazards should just cause inefficiency...
- */
-
- static FARPROC pfnGetLastInputInfo = NULL;
- static int initinfo = 0;
-
- if (!initinfo) {
- HMODULE hMod = GetModuleHandleA("USER32.DLL");
-
- initinfo = 1;
- if (hMod){
- pfnGetLastInputInfo = GetProcAddress(hMod, "GetLastInputInfo");
- }
- }
- if (pfnGetLastInputInfo == NULL) {
- return -1;
- }
li.cbSize = sizeof(li);
- if (!(BOOL)(pfnGetLastInputInfo)(&li)) {
+ if (!(BOOL)GetLastInputInfo(&li)) {
return -1;
}
diff --git a/win/ttkWinMonitor.c b/win/ttkWinMonitor.c
index 25c9c0c..c6e906b 100644
--- a/win/ttkWinMonitor.c
+++ b/win/ttkWinMonitor.c
@@ -74,7 +74,7 @@ CreateThemeMonitorWindow(HINSTANCE hinst, Tcl_Interp *interp)
HWND hwnd = NULL;
TCHAR title[32] = TEXT("TtkMonitorWindow");
TCHAR name[32] = TEXT("TtkMonitorClass");
-
+
wc.cbSize = sizeof(WNDCLASSEX);
wc.style = CS_HREDRAW | CS_VREDRAW;
wc.lpfnWndProc = (WNDPROC)WndProc;
@@ -92,14 +92,14 @@ CreateThemeMonitorWindow(HINSTANCE hinst, Tcl_Interp *interp)
hwnd = CreateWindow( name, title, WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
NULL, NULL, hinst, NULL );
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)interp);
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) interp);
ShowWindow(hwnd, SW_HIDE);
UpdateWindow(hwnd);
}
return hwnd;
}
-static void
+static void
DestroyThemeMonitorWindow(void *clientData)
{
HWND hwnd = (HWND)clientData;
diff --git a/win/ttkWinTheme.c b/win/ttkWinTheme.c
index e0a0eda..63e9704 100644
--- a/win/ttkWinTheme.c
+++ b/win/ttkWinTheme.c
@@ -490,7 +490,7 @@ static void TroughClientDataDeleteProc(void *clientData)
static TroughClientData *TroughClientDataInit(Tcl_Interp *interp)
{
- TroughClientData *cd = (TroughClientData*)ckalloc(sizeof(*cd));
+ TroughClientData *cd = ckalloc(sizeof(*cd));
cd->PatternBitmap = CreateBitmap(8, 8, 1, 1, Pattern);
cd->PatternBrush = CreatePatternBrush(cd->PatternBitmap);
Ttk_RegisterCleanup(interp, cd, TroughClientDataDeleteProc);
diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c
index 80b616d..08569a3 100644
--- a/win/ttkWinXPTheme.c
+++ b/win/ttkWinXPTheme.c
@@ -25,7 +25,7 @@ int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd) { return TCL_OK; }
#include <windows.h>
#include <uxtheme.h>
-#ifdef HAVE_VSSYM32_H
+#if defined(HAVE_VSSYM32_H) || _MSC_VER > 1500
# include <vssym32.h>
#else
# include <tmschema.h>
@@ -106,7 +106,7 @@ LoadXPThemeProcs(HINSTANCE *phlib)
* We have successfully loaded the library. Proceed in storing the
* addresses of the functions we want to use.
*/
- XPThemeProcs *procs = (XPThemeProcs*)ckalloc(sizeof(XPThemeProcs));
+ XPThemeProcs *procs = ckalloc(sizeof(XPThemeProcs));
#define LOADPROC(name) \
(0 != (procs->name = (name ## Proc *)GetProcAddress(handle, #name) ))
@@ -124,7 +124,7 @@ LoadXPThemeProcs(HINSTANCE *phlib)
return procs;
}
#undef LOADPROC
- ckfree((char*)procs);
+ ckfree(procs);
}
return 0;
}
@@ -411,7 +411,7 @@ typedef struct
static ElementData *
NewElementData(XPThemeProcs *procs, ElementInfo *info)
{
- ElementData *elementData = (ElementData*)ckalloc(sizeof(ElementData));
+ ElementData *elementData = ckalloc(sizeof(ElementData));
elementData->procs = procs;
elementData->info = info;
@@ -429,10 +429,10 @@ static void DestroyElementData(void *clientData)
{
ElementData *elementData = clientData;
if (elementData->info->flags & HEAP_ELEMENT) {
- ckfree((char *)elementData->info->statemap);
- ckfree((char *)elementData->info->className);
- ckfree((char *)elementData->info->elementName);
- ckfree((char *)elementData->info);
+ ckfree(elementData->info->statemap);
+ ckfree(elementData->info->className);
+ ckfree(elementData->info->elementName);
+ ckfree(elementData->info);
}
ckfree(clientData);
}
@@ -1062,13 +1062,14 @@ GetSysFlagFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr)
if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK)
return TCL_ERROR;
if (objc != 2) {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args", -1));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
for (i = 0; i < objc; ++i) {
int option;
- if (Tcl_GetIndexFromObj(interp, objv[i], names, "system constant", 0, &option)
- != TCL_OK)
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], names,
+ sizeof(char *), "system constant", 0, &option) != TCL_OK)
return TCL_ERROR;
*resultPtr |= (flags[option] << (8 * (1 - i)));
}
@@ -1116,8 +1117,9 @@ Ttk_CreateVsapiElement(
O_HALFHEIGHT, O_HALFWIDTH };
if (objc < 2) {
- Tcl_AppendResult(interp,
- "missing required arguments 'class' and/or 'partId'", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing required arguments 'class' and/or 'partId'", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VSAPI", "REQUIRED", NULL);
return TCL_ERROR;
}
@@ -1132,12 +1134,14 @@ Ttk_CreateVsapiElement(
for (i = 3; i < objc; i += 2) {
int tmp = 0;
if (i == objc -1) {
- Tcl_AppendResult(interp, "Missing value for \"",
- Tcl_GetString(objv[i]), "\".", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Missing value for \"%s\".",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL);
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings,
- "option", 0, &option) != TCL_OK)
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &option) != TCL_OK)
return TCL_ERROR;
switch (option) {
case O_PADDING:
@@ -1197,8 +1201,7 @@ Ttk_CreateVsapiElement(
if (Tcl_ListObjGetElements(interp, objv[2], &count, &specs) != TCL_OK)
return TCL_ERROR;
/* we over-allocate to ensure there is a terminating entry */
- stateTable = (Ttk_StateTable *)
- ckalloc(sizeof(Ttk_StateTable) * (count + 1));
+ stateTable = ckalloc(sizeof(Ttk_StateTable) * (count + 1));
memset(stateTable, 0, sizeof(Ttk_StateTable) * (count + 1));
for (n = 0, j = 0; status == TCL_OK && n < count; n += 2, ++j) {
Ttk_StateSpec spec = {0,0};
@@ -1211,15 +1214,15 @@ Ttk_CreateVsapiElement(
}
}
if (status != TCL_OK) {
- ckfree((char *)stateTable);
+ ckfree(stateTable);
return status;
}
} else {
- stateTable = (Ttk_StateTable *)ckalloc(sizeof(Ttk_StateTable));
+ stateTable = ckalloc(sizeof(Ttk_StateTable));
memset(stateTable, 0, sizeof(Ttk_StateTable));
}
- elementPtr = (ElementInfo *)ckalloc(sizeof(ElementInfo));
+ elementPtr = ckalloc(sizeof(ElementInfo));
elementPtr->elementSpec = elementSpec;
elementPtr->partId = partId;
elementPtr->statemap = stateTable;
@@ -1232,7 +1235,7 @@ Ttk_CreateVsapiElement(
elementPtr->elementName = name;
/* set the class name to an allocated copy */
- wname = (LPWSTR) ckalloc(sizeof(WCHAR) * (length + 1));
+ wname = ckalloc(sizeof(WCHAR) * (length + 1));
wcscpy(wname, className);
elementPtr->className = wname;
@@ -1279,7 +1282,7 @@ MODULE_SCOPE int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd)
* Set theme data and cleanup proc
*/
- themeData = (XPThemeData *)ckalloc(sizeof(XPThemeData));
+ themeData = ckalloc(sizeof(XPThemeData));
themeData->procs = procs;
themeData->hlibrary = hlibrary;
diff --git a/win/winMain.c b/win/winMain.c
index 01a5e23..62bcbd8 100644
--- a/win/winMain.c
+++ b/win/winMain.c
@@ -1,29 +1,29 @@
/*
* winMain.c --
*
- * Main entry point for wish and other Tk-based applications.
+ * Provides a default version of the main program and Tcl_AppInit
+ * procedure for wish and other Tk-based applications.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tkInt.h"
+#include "tk.h"
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <locale.h>
+#include <stdlib.h>
+#include <tchar.h>
#if defined(__GNUC__)
int _CRT_glob = 0;
#endif /* __GNUC__ */
-/*
- * The following declarations refer to internal Tk routines. These interfaces
- * are available for use, but are not supported.
- */
#ifdef TK_TEST
extern Tcl_PackageInitProc Tktest_Init;
#endif /* TK_TEST */
@@ -34,12 +34,14 @@ extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
#endif
+#ifdef TCL_BROKEN_MAINARGS
+static void setargv(int *argcPtr, TCHAR ***argvPtr);
+#endif
+
/*
* Forward declarations for procedures defined later in this file:
*/
-static void WishPanic(CONST char *format, ...);
-
static BOOL consoleRequired = TRUE;
/*
@@ -51,7 +53,10 @@ static BOOL consoleRequired = TRUE;
#ifndef TK_LOCAL_APPINIT
#define TK_LOCAL_APPINIT Tcl_AppInit
#endif
-extern int TK_LOCAL_APPINIT(Tcl_Interp *interp);
+#ifndef MODULE_SCOPE
+# define MODULE_SCOPE extern
+#endif
+MODULE_SCOPE int TK_LOCAL_APPINIT(Tcl_Interp *interp);
/*
* The following #if block allows you to change how Tcl finds the startup
@@ -60,13 +65,17 @@ extern int TK_LOCAL_APPINIT(Tcl_Interp *interp);
*/
#ifdef TK_LOCAL_MAIN_HOOK
-extern int TK_LOCAL_MAIN_HOOK(int *argc, char ***argv);
+MODULE_SCOPE int TK_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
#endif
+
+/* Make sure the stubbed variants of those are never used. */
+#undef Tcl_ObjSetVar2
+#undef Tcl_NewStringObj
/*
*----------------------------------------------------------------------
*
- * WinMain --
+ * _tWinMain --
*
* Main entry point from Windows.
*
@@ -80,17 +89,23 @@ extern int TK_LOCAL_MAIN_HOOK(int *argc, char ***argv);
*/
int APIENTRY
+#ifdef TCL_BROKEN_MAINARGS
WinMain(
HINSTANCE hInstance,
HINSTANCE hPrevInstance,
LPSTR lpszCmdLine,
int nCmdShow)
+#else
+_tWinMain(
+ HINSTANCE hInstance,
+ HINSTANCE hPrevInstance,
+ LPTSTR lpszCmdLine,
+ int nCmdShow)
+#endif
{
- char **argv;
+ TCHAR **argv;
int argc;
- char *p;
-
- Tcl_SetPanicProc(WishPanic);
+ TCHAR *p;
/*
* Create the console channels and install them as the standard channels.
@@ -111,8 +126,12 @@ WinMain(
* Get our args from the c-runtime. Ignore lpszCmdLine.
*/
+#if defined(TCL_BROKEN_MAINARGS)
+ setargv(&argc, &argv);
+#else
argc = __argc;
- argv = __argv;
+ argv = __targv;
+#endif
/*
* Forward slashes substituted for backslashes.
@@ -129,7 +148,7 @@ WinMain(
#endif
Tk_Main(argc, argv, TK_LOCAL_APPINIT);
- return 1;
+ return 0; /* Needed only to prevent compiler warning. */
}
/*
@@ -155,14 +174,11 @@ int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
-#define TK_MAX_WARN_LEN 1024
- WCHAR msgString[TK_MAX_WARN_LEN + 5];
-
- if (Tcl_Init(interp) == TCL_ERROR) {
- goto error;
+ if ((Tcl_Init)(interp) == TCL_ERROR) {
+ return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
- goto error;
+ return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
@@ -173,26 +189,26 @@ Tcl_AppInit(
if (consoleRequired) {
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
- goto error;
+ return TCL_ERROR;
}
}
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
if (Registry_Init(interp) == TCL_ERROR) {
- goto error;
+ return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+ Tcl_StaticPackage(interp, "registry", Registry_Init, 0);
if (Dde_Init(interp) == TCL_ERROR) {
- goto error;
+ return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
+ Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
#endif
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
- goto error;
+ return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "Tktest", Tktest_Init, NULL);
+ Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 0);
#endif /* TK_TEST */
/*
@@ -208,7 +224,7 @@ Tcl_AppInit(
*/
/*
- * Call Tcl_CreateCommand for application-specific commands, if they
+ * Call Tcl_CreateObjCommand for application-specific commands, if they
* weren't already created by the init procedures called above.
*/
@@ -219,76 +235,16 @@ Tcl_AppInit(
* specific startup file will be run under any conditions.
*/
- Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
+ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_NewStringObj("~/wishrc.tcl", -1), TCL_GLOBAL_ONLY);
return TCL_OK;
-
-error:
- MultiByteToWideChar(CP_UTF8, 0, Tcl_GetStringResult(interp), -1,
- msgString, TK_MAX_WARN_LEN);
- /*
- * Truncate MessageBox string if it is too long to not overflow the screen
- * and cause possible oversized window error.
- */
- memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR));
- MessageBeep(MB_ICONEXCLAMATION);
- MessageBoxW(NULL, msgString, L"Error in Wish",
- MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
- ExitProcess(1);
-
- /*
- * We won't reach this, but we need the return.
- */
-
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * WishPanic --
- *
- * Display a message and exit.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Exits the program.
- *
- *----------------------------------------------------------------------
- */
-
-void
-WishPanic(
- CONST char *format, ...)
-{
- va_list argList;
- char buf[TK_MAX_WARN_LEN];
- WCHAR msgString[TK_MAX_WARN_LEN + 5];
-
- va_start(argList, format);
- vsprintf(buf, format, argList);
-
- MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TK_MAX_WARN_LEN);
- /*
- * Truncate MessageBox string if it is too long to not overflow the screen
- * and cause possible oversized window error.
- */
- memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR));
- MessageBeep(MB_ICONEXCLAMATION);
- MessageBoxW(NULL, msgString, L"Fatal Error in Wish",
- MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
-#ifdef _MSC_VER
- DebugBreak();
-#endif
- ExitProcess(1);
}
#if defined(TK_TEST)
/*
*----------------------------------------------------------------------
*
- * main --
+ * _tmain --
*
* Main entry point from the console.
*
@@ -302,13 +258,20 @@ WishPanic(
*----------------------------------------------------------------------
*/
+#ifdef TCL_BROKEN_MAINARGS
int
main(
int argc,
- char **argv)
+ char **dummy)
{
- Tcl_SetPanicProc(WishPanic);
-
+ TCHAR **argv;
+#else
+int
+_tmain(
+ int argc,
+ TCHAR **argv)
+{
+#endif
/*
* Set up the default locale to be standard "C" locale so parsing is
* performed correctly.
@@ -316,6 +279,13 @@ main(
setlocale(LC_ALL, "C");
+#ifdef TCL_BROKEN_MAINARGS
+ /*
+ * Get our args from the c-runtime. Ignore argc/argv.
+ */
+
+ setargv(&argc, &argv);
+#endif
/*
* Console emulation widget not required as this entry is from the
* console subsystem, thus stdin,out,err already have end-points.
@@ -323,10 +293,140 @@ main(
consoleRequired = FALSE;
+#ifdef TK_LOCAL_MAIN_HOOK
+ TK_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
Tk_Main(argc, argv, Tcl_AppInit);
return 0;
}
-#endif /* TK_TEST */
+#endif /* !__GNUC__ || TK_TEST */
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * setargv --
+ *
+ * Parse the Windows command line string into argc/argv. Done here
+ * because we don't trust the builtin argument parser in crt0. Windows
+ * applications are responsible for breaking their command line into
+ * arguments.
+ *
+ * 2N backslashes + quote -> N backslashes + begin quoted string
+ * 2N + 1 backslashes + quote -> literal
+ * N backslashes + non-quote -> literal
+ * quote + quote in a quoted string -> single quote
+ * quote + quote not in quoted string -> empty string
+ * quote -> begin quoted string
+ *
+ * Results:
+ * Fills argcPtr with the number of arguments and argvPtr with the array
+ * of arguments.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+#ifdef TCL_BROKEN_MAINARGS
+static void
+setargv(
+ int *argcPtr, /* Filled with number of argument strings. */
+ TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
+{
+ TCHAR *cmdLine, *p, *arg, *argSpace;
+ TCHAR **argv;
+ int argc, size, inquote, copy, slashes;
+
+ cmdLine = GetCommandLine();
+
+ /*
+ * Precompute an overly pessimistic guess at the number of arguments in
+ * the command line by counting non-space spans.
+ */
+
+ size = 2;
+ for (p = cmdLine; *p != '\0'; p++) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ size++;
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+ }
+ }
+
+ /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
+ #undef Tcl_Alloc
+ #undef Tcl_DbCkalloc
+
+ argSpace = ckalloc(size * sizeof(char *)
+ + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
+ argv = (TCHAR **) argSpace;
+ argSpace += size * (sizeof(char *)/sizeof(TCHAR));
+ size--;
+
+ p = cmdLine;
+ for (argc = 0; argc < size; argc++) {
+ argv[argc] = arg = argSpace;
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ inquote = 0;
+ slashes = 0;
+ while (1) {
+ copy = 1;
+ while (*p == '\\') {
+ slashes++;
+ p++;
+ }
+ if (*p == '"') {
+ if ((slashes & 1) == 0) {
+ copy = 0;
+ if ((inquote) && (p[1] == '"')) {
+ p++;
+ copy = 1;
+ } else {
+ inquote = !inquote;
+ }
+ }
+ slashes >>= 1;
+ }
+
+ while (slashes) {
+ *arg = '\\';
+ arg++;
+ slashes--;
+ }
+
+ if ((*p == '\0') || (!inquote &&
+ ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
+ break;
+ }
+ if (copy != 0) {
+ *arg = *p;
+ arg++;
+ }
+ p++;
+ }
+ *arg = '\0';
+ argSpace = arg + 1;
+ }
+ argv[argc] = NULL;
+
+ *argcPtr = argc;
+ *argvPtr = argv;
+}
+#endif /* TCL_BROKEN_MAINARGS */
+
/*
* Local Variables:
* mode: c