diff options
Diffstat (limited to 'win')
45 files changed, 4641 insertions, 2472 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: @@ -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..8671721 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 -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 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..1b55cdf 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 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 Binary files differindex 834c0f9..1e2f9d4 100644 --- a/win/rc/lamp.bmp +++ b/win/rc/lamp.bmp diff --git a/win/rc/tk.ico b/win/rc/tk.ico Binary files differindex 5fdb9a7..e254318 100644 --- a/win/rc/tk.ico +++ b/win/rc/tk.ico diff --git a/win/rc/wish.ico b/win/rc/wish.ico Binary files differindex 1825751..5801fb8 100644 --- a/win/rc/wish.ico +++ b/win/rc/wish.ico 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; +} @@ -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 -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 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 a1a76c7..11c3e6d 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 "" @@ -418,7 +418,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 @@ -427,7 +427,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 "" @@ -454,7 +454,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" @@ -481,8 +481,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" @@ -501,8 +502,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 "" @@ -524,4 +525,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..dc385e3 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,16 +1076,28 @@ 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; @@ -610,100 +1106,478 @@ GetFileName( 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 (Tcl_GetBooleanFromObj(interp, valuePtr, + &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; } 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) { + 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_DString dirString; + Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString), + Tcl_DStringLength(&optsPtr->utfDirString), &dirString); + hr = ShellProcs.SHCreateItemFromParsingName( + (TCHAR *) Tcl_DStringValue(&dirString), NULL, + &IIDIShellItem, (void **) &dirIf); + /* XXX - Note on failure we do not raise error, simply ignore ini dir */ + if (SUCCEEDED(hr)) { + /* Note we use SetFolder, not SetDefaultFolder - see MSDN docs */ + fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */ + } + Tcl_DStringFree(&dirString); + } + + 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 +1586,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 +1613,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 +1624,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 +1636,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 +1693,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 +1739,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 +1793,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 +1802,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 +1881,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 +1905,7 @@ OFNHookProc( if (notifyPtr->hdr.code == CDN_FILEOK || notifyPtr->hdr.code == CDN_SELCHANGE) { int dirsize, selsize; - WCHAR *buffer; + TCHAR *buffer; int buffersize; /* @@ -980,8 +1918,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 +1929,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 +1946,7 @@ OFNHookProc( if (buffer[0] == '"') { BOOL findquote = TRUE; - WCHAR *tmp = buffer; + TCHAR *tmp = buffer; while (*buffer != '\0') { if (findquote) { @@ -1037,8 +1975,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 +2000,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 +2075,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 +2098,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,11 +2168,150 @@ MakeFilter( } Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr)); - ckfree((char *) filterStr); + ckfree(filterStr); + + TkFreeFileFilters(&flist); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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; } + /* *---------------------------------------------------------------------- @@ -1312,103 +2390,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 +2453,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 +2495,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 +2516,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 +2547,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 +2579,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 +2617,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 +2629,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 +2649,7 @@ ChooseDirectoryValidateProc( * directory in utfRetDir. */ - GetCurrentDirectoryW(MAX_PATH, chooseDirSharedData->retDir); + GetCurrentDirectory(MAX_PATH, chooseDirSharedData->retDir); return 0; } return 0; @@ -1628,13 +2664,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 +2681,9 @@ ChooseDirectoryValidateProc( * specified parameter. */ - WCHAR *initDir = chooseDirSharedData->initDir; + TCHAR *initDir = chooseDirSharedData->initDir; - SetCurrentDirectoryW(initDir); + SetCurrentDirectory(initDir); if (*initDir == '\\') { /* @@ -1664,10 +2700,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 +2712,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 +2747,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 +2761,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 +2779,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 +2855,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 +2890,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 +2906,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 +2917,7 @@ MsgBoxCBTProc( WPARAM wParam, LPARAM lParam) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (nCode == HCBT_CREATEWND) { @@ -1897,9 +2934,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 +2964,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 +2978,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 +2998,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 8d7778c..9f5fa9c 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 @@ -91,14 +98,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. */ @@ -106,7 +105,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 |
