summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rwxr-xr-xwin/buildall.vc.bat69
-rwxr-xr-xwin/configure12
-rw-r--r--win/makefile.vc213
-rw-r--r--win/nmakehlp.c161
-rw-r--r--win/rules.vc62
-rw-r--r--win/tcl.m412
-rw-r--r--win/tkWinClipboard.c7
-rw-r--r--win/tkWinCursor.c20
-rw-r--r--win/tkWinDialog.c153
-rw-r--r--win/tkWinEmbed.c27
-rw-r--r--win/tkWinMenu.c158
-rw-r--r--win/tkWinSend.c136
-rw-r--r--win/tkWinSendCom.c102
-rw-r--r--win/tkWinSendCom.h6
-rw-r--r--win/tkWinWm.c456
-rw-r--r--win/tkWinX.c9
-rw-r--r--win/ttkWinXPTheme.c14
17 files changed, 881 insertions, 736 deletions
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index 58360b9..162490e 100755
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -23,18 +23,27 @@ goto OPTIONS_DONE
:: reset errorlevel
cd > nul
+:: You might have installed your developer studio to add itself to the
+:: path or have already run vcvars32.bat. Testing these envars proves
+:: cl.exe and friends are in your path.
+::
+if defined VCINSTALLDIR (goto :startBuilding)
+if defined MSDEVDIR (goto :startBuilding)
+if defined MSVCDIR (goto :startBuilding)
+if defined MSSDK (goto :startBuilding)
+if defined WINDOWSSDKDIR (goto :startBuilding)
+
:: We need to run the development environment batch script that comes
-:: with developer studio (v4,5,6,7,etc...) All have it. These paths
-:: might not be correct. You may need to edit these.
+:: with developer studio (v4,5,6,7,etc...) All have it. This path
+:: might not be correct. You should call it yourself prior to running
+:: this batchfile.
::
-if not defined MSDevDir (
- call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
- ::call "C:\Program Files\Microsoft Developer Studio\vc\bin\vcvars32.bat"
- ::call c:\dev\devstudio60\vc98\bin\vcvars32.bat
- if errorlevel 1 goto no_vcvars
-)
+call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
+if errorlevel 1 (goto no_vcvars)
+:startBuilding
+echo.
echo Sit back and have a cup of coffee while this grinds through ;)
echo You asked for *everything*, remember?
echo.
@@ -59,42 +68,14 @@ 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, dlls and shell.
-::
-set OPTS=static
-if not %SYMBOLS%.==. set OPTS=symbols,static
-nmake -nologo -f makefile.vc release OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the special static libraries that use the dynamic runtime.
+:: Build the static core and shell.
::
set OPTS=static,msvcrt
if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
-nmake -nologo -f makefile.vc core OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the core and shell for thread support.
-::
-set OPTS=threads
-if not %SYMBOLS%.==. set OPTS=symbols,threads
-nmake -nologo -f makefile.vc release OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build a static, thread support core library (no shell).
-::
-set OPTS=static,threads
-if not %SYMBOLS%.==. set OPTS=symbols,static,threads
-nmake -nologo -f makefile.vc core OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the special static libraries the use the dynamic runtime,
-:: but now with thread support.
-::
-set OPTS=static,msvcrt,threads
-if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
-nmake -nologo -f makefile.vc core OPTS=%OPTS% %1
+nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
+set OPTS=
set SYMBOLS=
goto end
@@ -103,16 +84,16 @@ echo *** BOOM! ***
goto end
:no_vcvars
-echo vcvars32.bat not found. You'll need to edit this batch script.
+echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path.
goto out
:help
title buildall.vc.bat help message
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 : 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.
goto out
diff --git a/win/configure b/win/configure
index ad99837..67bff85 100755
--- a/win/configure
+++ b/win/configure
@@ -840,11 +840,11 @@ if test -n "$ac_init_help"; then
Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-threads build with threads
- --enable-shared build and link with shared libraries --enable-shared
+ --enable-threads build with threads (default: on)
+ --enable-shared build and link with shared libraries (default: on)
--enable-64bit enable 64bit support (where applicable)
--enable-wince enable Win/CE support (where applicable)
- --enable-symbols build with debugging symbols --disable-symbols
+ --enable-symbols build with debugging symbols (default: off)
--enable-embedded-manifest
embed manifest if possible (default: yes)
@@ -3051,8 +3051,8 @@ else
fi;
if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+ echo "$as_me:$LINENO: result: yes (default)" >&5
+echo "${ECHO_T}yes (default)" >&6
TCL_THREADS=1
cat >>confdefs.h <<\_ACEOF
#define TCL_THREADS 1
@@ -3650,8 +3650,8 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
MAKE_EXE="\${CC} -o \$@"
LIBPREFIX="lib"
- extra_ldflags="$extra_ldflags -pipe"
extra_cflags="$extra_cflags -pipe"
+ extra_ldflags="$extra_ldflags -pipe"
if test "${SHARED_BUILD}" = "0" ; then
# static
diff --git a/win/makefile.vc b/win/makefile.vc
index 14dc2d0..584a11b 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -13,10 +13,9 @@
# Copyright (c) 2003-2008 Pat Thoyts.
#------------------------------------------------------------------------------
-# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
-# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define
-# VCINSTALLDIR instead.
-!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR)
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
Platform SDK first to setup the environment. Jump to this line to read^
@@ -43,23 +42,28 @@ the build instructions.
# turn on the 64-bit compiler, if your SDK has it.
#
# 3) Targets are:
-# release -- builds the core, the shell. (default)
-# core -- Only builds the core.
-# all -- builds everything.
-# test -- builds and runs the test suite.
-# tktest -- just builds the binaries for the test suite.
-# install -- installs the built binaries and libraries to $(INSTALLDIR)
+# release -- Builds the core, the shell. (default)
+# dlls -- Just builds the windows extensions.
+# shell -- Just builds the shell and the core.
+# core -- Only builds the core [tkXX.(dll|lib)].
+# all -- Builds everything.
+# test -- Builds and runs the test suite.
+# tktest -- Just builds the binaries for the test suite.
+# install -- Installs the built binaries and libraries to $(INSTALLDIR)
# as the root of the install tree.
-# cwish -- builds a console version of wish.
-# clean -- removes the contents of $(TMP_DIR)
-# hose -- removes the contents of $(TMP_DIR) and $(OUT_DIR)
-# genstubs -- rebuilds the Stubs table and support files (dev only).
+# cwish -- Builds a console version of wish.
+# tidy/clean/hose -- varying levels of cleaning.
+# genstubs -- Rebuilds the Stubs table and support files (dev only).
# depend -- Generates an accurate set of source dependancies for this
# makefile. Helpful to avoid problems when the sources are
# refreshed and you rebuild, but can "overbuild" when common
# headers like tkInt.h just get small changes.
-# winhelp -- builds the windows .hlp file for Tcl from the troff man
-# files.
+# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
+# troff manual pages found in $(ROOT)\doc. You need to
+# have installed the HTML Help Compiler package from Microsoft
+# to produce the .chm file.
+# winhelp -- Builds the windows .hlp file for Tcl from the troff man
+# files found in $(ROOT)\doc.
#
# 4) Macros usable on the commandline:
# TCLDIR=<path>
@@ -72,57 +76,60 @@ the build instructions.
# Sets where to install Tcl from the built binaries.
# C:\Progra~1\Tcl is assumed when not specified.
#
-# OPTS=static,msvcrt,linkexten,threads,symbols,profile,unchecked,none
+# OPTS=loimpact,msvcrt,nothreads,noxp,pdbs,profile,square,static,staticpkg,symbols,unchecked,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
#
-# static = Builds a static library of the core instead of a
-# dll. The shell will be static (and large), as well.
-# msvcrt = Effects the static option only to switch it from
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# msvcrt = Affects the static option only to switch it from
# using libcmt(d) as the C runtime [by default] to
# msvcrt(d). This is useful for static embedding
# support.
+# nothreads= Turns off full multithreading support.
+# noxp = If you do not have the uxtheme.h header then you
+# cannot include support for XP themeing.
+# square = Include the demo square widget.
+# static = Builds a static library of the core instead of a
+# dll. The shell will be static (and large), as well.
# staticpkg= Affects the static option only to switch wishXX.exe
# to have the dde and reg extension linked inside it.
-# threads = Turns on full multithreading support.
+# pdbs = Build detached symbols for release builds.
+# profile = Adds profiling hooks. Map file is assumed.
# thrdalloc = Use the thread allocator (shared global free pool)
# This is the default on threaded builds.
-# tclalloc = Use the old non-thread allocator
-# symbols = Adds symbols for step debugging.
-# profile = Adds profiling hooks. Map file is assumed.
-# loimpact = Adds a flag for how NT treats the heap to keep
-# memory in use, low. This is said to impact alloc
-# performance.
-# unchecked= Allows a symbols build to not use the debug
+# tclalloc = Use the old non-thread allocator
+# symbols = Debug build. Links to the debug C runtime, disables
+# optimizations and creates pdb symbols files.
+# unchecked = Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
-# noxp = If you do not have the uxtheme.h header then you
-# cannot include support for XP themeing.
-# square = Include the demo square widget.
#
-# STATS=memdbg,compdbg,none
+# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
# to the core. The default is for none. Any combination of the
# above may be used (comma separated). 'none' will over-ride
# everything to nothing.
#
-# memdbg = Enables the debugging memory allocator.
# compdbg = Enables byte compilation logging.
+# memdbg = Enables the debugging memory allocator.
#
-# CHECKS=nodep,fullwarn,none
+# CHECKS=64bit,fullwarn,nodep,none
# Sets special macros for checking compatability.
#
-# nodep = Turns off compatability macros to ensure Tk isn't
-# being built with deprecated functions.
+# 64bit = Enable 64bit portability warnings (if available)
# fullwarn = Builds with full compiler and link warnings enabled.
# Very verbose.
+# nodep = Turns off compatability macros to ensure the core
+# isn't being built with deprecated functions.
#
-# MACHINE=(IX86|IA64|AMD64|ALPHA)
+# MACHINE=(ALPHA|AMD64|IA64|IX86)
# Set the machine type used for the compiler, linker, and
# resource compiler. This hook is needed to tell the tools
# when alternate platforms are requested. IX86 is the default
-# when not specified.
+# when not specified. If the CPU environment variable has been
+# set (ie: recent Platform SDK) then MACHINE is set from CPU.
#
# TMP_DIR=<path>
# OUT_DIR=<path>
@@ -175,7 +182,7 @@ Please `cd` to its location first.
!error $(MSG)
!endif
-PROJECT = tk
+PROJECT = tk
!include "rules.vc"
!if $(TCLINSTALL)
@@ -206,8 +213,8 @@ TTK_SQUARE_WIDGET = 0
STUBPREFIX = $(PROJECT)stub
WISHNAMEPREFIX = wish
-BINROOT = .
-ROOT = ..
+BINROOT = $(MAKEDIR) # originally .
+ROOT = $(MAKEDIR)\.. # originally ..
TK_LIBRARY = $(ROOT)\library
@@ -235,7 +242,6 @@ WISHOBJS = \
!if $(TCL_USE_STATIC_PACKAGES)
$(TCLDDELIB) \
$(TCLREGLIB) \
- $(TCLSTUBLIB) \
!endif
$(TMP_DIR)\wish.res
@@ -359,7 +365,7 @@ TKOBJS = \
$(TMP_DIR)\tkVisual.obj \
$(TMP_DIR)\tkStubInit.obj \
$(TMP_DIR)\tkWindow.obj \
- $(TTK_OBJS) \
+ $(TTK_OBJS) \
!if !$(STATIC_BUILD)
$(TMP_DIR)\tk.res
!endif
@@ -400,7 +406,8 @@ TTK_OBJS = \
$(TMP_DIR)\ttkStubInit.obj
TKSTUBOBJS = \
- $(TMP_DIR)\tkStubLib.obj $(TMP_DIR)\ttkStubLib.obj
+ $(TMP_DIR)\tkStubLib.obj \
+ $(TMP_DIR)\ttkStubLib.obj
WINDIR = $(ROOT)\win
@@ -440,7 +447,7 @@ cdebug = $(OPTIMIZATIONS)
cdebug =
!endif
!if $(SYMBOLS)
-cdebug = $(cdebug) -Zi
+cdebug = $(cdebug) -Zi
!endif
!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
### Warnings are too many, can't support warnings into errors.
@@ -468,15 +475,10 @@ crt = -MT
!endif
BASE_CFLAGS = $(cdebug) $(cflags) $(crt) $(TK_INCLUDES)
-TK_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES)
+TK_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES) -DUSE_TCL_STUBS
CON_CFLAGS = $(cdebug) $(cflags) $(crt) -DCONSOLE
WISH_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES)
-### Stubs files should not be compiled with -GL
-STUB_CFLAGS = $(cflags) $(cdebug:-GL=) $(TK_DEFINES)
-
-!if !$(STATIC_BUILD)
-TK_CFLAGS = $(TK_CFLAGS) -DUSE_TCL_STUBS
-!endif
+STUB_CFLAGS = $(cflags) $(cdebug) $(TK_DEFINES)
#---------------------------------------------------------------------
# Link flags
@@ -514,10 +516,7 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-tcllibs = $(TCLIMPLIB)
-!if !$(STATIC_BUILD)
-tcllibs = $(TCLSTUBLIB) $(tcllibs)
-!endif
+tcllibs = $(TCLSTUBLIB) $(TCLIMPLIB)
baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
@@ -535,7 +534,7 @@ guilibs = $(baselibs) gdi32.lib
#---------------------------------------------------------------------
!if "$(TESTPAT)" != ""
-TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
+TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
!endif
@@ -562,11 +561,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) | $(CAT32)
-!endif
+ $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) | $(CAT32)
test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -577,11 +572,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) | $(CAT32)
-!endif
+ $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) | $(CAT32)
runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -603,7 +594,7 @@ rundemo: setup $(TKTEST) $(TKLIB) $(CAT32)
!else
@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
!endif
- $(TKTEST) $(ROOT)\library\demos\widget
+ $(TKTEST) $(ROOT:\=/)\library\demos\widget
shell: setup $(WISH)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -618,6 +609,17 @@ shell: setup $(WISH)
console show
<<
+dbgshell: setup $(WISH)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ windbg $(WISH)
+
setup:
@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
@@ -665,9 +667,8 @@ $(CAT32): $(_TCLDIR)\win\cat.c
$(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj $(baselibs)
$(_VC_MANIFEST_EMBED_EXE)
-
#---------------------------------------------------------------------
-# Regenerate the stubs files.
+# Regenerate the stubs files. [Development use only]
#---------------------------------------------------------------------
genstubs:
@@ -681,9 +682,49 @@ genstubs:
#---------------------------------------------------------------------
-# Regenerate the windows help files.
+# Build the Windows HTML help file.
#---------------------------------------------------------------------
+# NOTE: you can define HHC on the command-line to override this
+!ifndef HHC
+HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
+!endif
+HTMLDIR=$(ROOT)\html
+HTMLBASE=TclTk$(VERSION)
+HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
+CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
+
+htmlhelp: chmsetup $(CHMFILE)
+
+$(CHMFILE): $(DOCDIR)\*
+ @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl
+ @echo Compiling HTML help project
+ @$(HHC) <<$(HHPFILE) >NUL
+[OPTIONS]
+Compatibility=1.1 or later
+Compiled file=$(HTMLBASE).chm
+Display compile progress=no
+Error log file=$(HTMLBASE).log
+Language=0x409 English (United States)
+Title=Tcl/Tk $(DOT_VERSION) Help
+[FILES]
+contents.htm
+docs.css
+Keywords
+TclCmd
+TclLib
+TkCmd
+TkLib
+UserCmd
+<<
+
+chmsetup:
+ @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
+
+#-------------------------------------------------------------------------
+# Build the old-style Windows .hlp file
+#-------------------------------------------------------------------------
+
HLPBASE = $(PROJECT)$(TK_VERSION)
HELPFILE = $(OUT_DIR)\$(HLPBASE).hlp
HELPCNT = $(OUT_DIR)\$(HLPBASE).cnt
@@ -732,8 +773,8 @@ CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
<<
cd $(MAKEDIR)
- $(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
- $(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
$(MAN2TCL): $(TCLTOOLSDIR)\$$(@B).c
$(cc32) $(TK_CFLAGS) -Fo$(@D)\ $(TCLTOOLSDIR)\$(@B).c
@@ -810,11 +851,15 @@ $(TMP_DIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c
$(TMP_DIR)\wish.exe.manifest: $(WINDIR)\wish.exe.manifest.in
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
-@TK_WIN_VERSION@ $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION).0.0
+@TK_WIN_VERSION@ $(TK_DOTVERSION).0.0
<<
#---------------------------------------------------------------------
-# Generate the makefile depedancies.
+# Generate the source dependencies. Having dependency rules will
+# improve incremental build accuracy without having to resort to a
+# full rebuild just because some non-global header file like
+# tclCompile.h was changed. These rules aren't needed when building
+# from scratch.
#---------------------------------------------------------------------
depend:
@@ -822,7 +867,7 @@ depend:
@echo Build tclsh first!
!else
set TCL_LIBRARY=$(TCL_LIBRARY)
- $(TCLSH) $(TCLTOOLSDIR)\mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
+ $(TCLSH) $(TCLTOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
-passthru:"-DBUILD_tk $(TK_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
$(WINDIR),$$(WINDIR) $(TTKDIR),$$(TTKDIR) $(XLIBDIR),$$(XLIBDIR) \
$(BITMAPDIR),$$(BITMAPDIR) @<<
@@ -830,9 +875,8 @@ $(TKOBJS)
<<
!endif
-
#---------------------------------------------------------------------
-# Dedependency rules
+# Dependency rules
#---------------------------------------------------------------------
$(TMP_DIR)\tk.res: \
@@ -842,7 +886,7 @@ $(TMP_DIR)\tk.res: \
!if exist("$(OUT_DIR)\depend.mk")
!include "$(OUT_DIR)\depend.mk"
-!message *** Dependency rules in effect.
+!message *** Dependency rules in use.
!else
!message *** Dependency rules are not being used.
!endif
@@ -908,8 +952,13 @@ install-binaries:
!if !$(STATIC_BUILD)
@echo creating package index
@type << > $(OUT_DIR)\pkgIndex.tcl
-if {[package vcompare [package provide Tcl] $(TCL_PATCH_LEVEL)] != 0} { return }
-package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin $(TKLIBNAME)] Tk]
+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]
+} else {
+ package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin $(TKLIBNAME)] Tk]
+}
<<
@$(CPY) $(OUT_DIR)\pkgIndex.tcl "$(SCRIPT_INSTALL_DIR)\"
!endif
@@ -971,6 +1020,8 @@ clean:
@echo Cleaning $(WINDIR)\versions.vc ...
@if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+realclean: hose
+
hose:
@echo Hosing $(OUT_DIR)\* ...
@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index 4803b43..d0edcf0 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -14,16 +14,21 @@
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
+#define NO_SHLWAPI_GDI
+#define NO_SHLWAPI_STREAM
+#define NO_SHLWAPI_REG
+#include <shlwapi.h>
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
+#pragma comment (lib, "shlwapi.lib")
#include <stdio.h>
#include <math.h>
/*
- * This library is required for x64 builds with _some_ versions
+ * This library is required for x64 builds with _some_ versions of MSVC
*/
#if defined(_M_IA64) || defined(_M_AMD64)
-#if _MSC_FULL_VER > 140000000 && _MSC_FULL_VER <= 140040310
+#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")
#endif
#endif
@@ -37,13 +42,13 @@
/* protos */
-int CheckForCompilerFeature(const char *option);
-int CheckForLinkerFeature(const char *option);
-int IsIn(const char *string, const char *substring);
-int GrepForDefine(const char *file, const char *string);
-int SubstituteFile(const char *substs, const char *filename);
-const char * GetVersionFromFile(const char *filename, const char *match);
-DWORD WINAPI ReadFromPipe(LPVOID args);
+static int CheckForCompilerFeature(const char *option);
+static int CheckForLinkerFeature(const char *option);
+static int IsIn(const char *string, const char *substring);
+static int SubstituteFile(const char *substs, const char *filename);
+static int QualifyPath(const char *path);
+static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
+static DWORD WINAPI ReadFromPipe(LPVOID args);
/* globals */
@@ -125,18 +130,6 @@ main(
} else {
return IsIn(argv[2], argv[3]);
}
- case 'g':
- if (argc == 2) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -g <file> <string>\n"
- "grep for a #define\n"
- "exitcodes: integer of the found string (no decimals)\n",
- argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- }
- return GrepForDefine(argv[2], argv[3]);
case 's':
if (argc == 2) {
chars = snprintf(msg, sizeof(msg) - 1,
@@ -160,12 +153,23 @@ main(
&dwWritten, NULL);
return 0;
}
- printf("%s\n", GetVersionFromFile(argv[2], argv[3]));
+ printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0'));
return 0;
+ case 'Q':
+ if (argc != 3) {
+ chars = snprintf(msg, sizeof(msg) - 1,
+ "usage: %s -Q path\n"
+ "Emit the fully qualified path\n"
+ "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+ &dwWritten, NULL);
+ return 2;
+ }
+ return QualifyPath(argv[2]);
}
}
chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c|-l|-f|-g|-V ...\n"
+ "usage: %s -c|-f|-l|-Q|-s|-V ...\n"
"This is a little helper app to equalize shell differences between WinNT and\n"
"Win9x and get nmake.exe to accomplish its job.\n",
argv[0]);
@@ -173,7 +177,7 @@ main(
return 2;
}
-int
+static int
CheckForCompilerFeature(
const char *option)
{
@@ -258,7 +262,7 @@ CheckForCompilerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -307,7 +311,7 @@ CheckForCompilerFeature(
|| strstr(Err.buffer, "D2021") != NULL);
}
-int
+static int
CheckForLinkerFeature(
const char *option)
{
@@ -386,7 +390,7 @@ CheckForLinkerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -432,7 +436,7 @@ CheckForLinkerFeature(
strstr(Err.buffer, "LNK4044") != NULL);
}
-DWORD WINAPI
+static DWORD WINAPI
ReadFromPipe(
LPVOID args)
{
@@ -457,7 +461,7 @@ ReadFromPipe(
return 0; /* makes the compiler happy */
}
-int
+static int
IsIn(
const char *string,
const char *substring)
@@ -466,73 +470,17 @@ IsIn(
}
/*
- * Find a specified #define by name.
- *
- * If the line is '#define TCL_VERSION "8.5"', it returns 85 as the result.
- */
-
-int
-GrepForDefine(
- const char *file,
- const char *string)
-{
- char s1[51], s2[51], s3[51];
- FILE *f = fopen(file, "rt");
-
- if (f == NULL) {
- return 0;
- }
-
- do {
- int r = fscanf(f, "%50s", s1);
-
- if (r == 1 && !strcmp(s1, "#define")) {
- /*
- * Get next two words.
- */
-
- r = fscanf(f, "%50s %50s", s2, s3);
- if (r != 2) {
- continue;
- }
-
- /*
- * Is the first word what we're looking for?
- */
-
- if (!strcmp(s2, string)) {
- double d1;
-
- fclose(f);
-
- /*
- * Add 1 past first double quote char. "8.5"
- */
-
- d1 = atof(s3 + 1); /* 8.5 */
- while (floor(d1) != d1) {
- d1 *= 10.0;
- }
- return ((int) d1); /* 85 */
- }
- }
- } while (!feof(f));
-
- fclose(f);
- return 0;
-}
-
-/*
* GetVersionFromFile --
* Looks for a match string in a file and then returns the version
* following the match where a version is anything acceptable to
* package provide or package ifneeded.
*/
-const char *
+static const char *
GetVersionFromFile(
const char *filename,
- const char *match)
+ const char *match,
+ int numdots)
{
size_t cbBuffer = 100;
static char szBuffer[100];
@@ -562,7 +510,8 @@ GetVersionFromFile(
*/
q = p;
- while (*q && (isalnum(*q) || *q == '.')) {
+ while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q)
+ && (!strchr("ab", q[-1])) || --numdots))) {
++q;
}
@@ -589,10 +538,7 @@ typedef struct list_item_t {
/* insert a list item into the list (list may be null) */
static list_item_t *
-list_insert(
- list_item_t **listPtrPtr,
- const char *key,
- const char *value)
+list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
{
list_item_t *itemPtr = malloc(sizeof(list_item_t));
if (itemPtr) {
@@ -609,8 +555,7 @@ list_insert(
}
static void
-list_free(
- list_item_t **listPtrPtr)
+list_free(list_item_t **listPtrPtr)
{
list_item_t *tmpPtr, *listPtr = *listPtrPtr;
while (listPtr) {
@@ -639,7 +584,7 @@ list_free(
* <<
*/
-int
+static int
SubstituteFile(
const char *substitutions,
const char *filename)
@@ -715,6 +660,30 @@ SubstituteFile(
fclose(fp);
return 0;
}
+
+/*
+ * QualifyPath --
+ *
+ * This composes the current working directory with a provided path
+ * and returns the fully qualified and normalized path.
+ * Mostly needed to setup paths for testing.
+ */
+
+static int
+QualifyPath(
+ const char *szPath)
+{
+ char szCwd[MAX_PATH + 1];
+ char szTmp[MAX_PATH + 1];
+ char *p;
+ GetCurrentDirectory(MAX_PATH, szCwd);
+ while ((p = strchr(szPath, '/')) && *p)
+ *p = '\\';
+ PathCombine(szTmp, szCwd, szPath);
+ PathCanonicalize(szCwd, szTmp);
+ printf("%s\n", szCwd);
+ return 0;
+}
/*
* Local variables:
diff --git a/win/rules.vc b/win/rules.vc
index f2ee135..adc3165 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -8,7 +8,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2001-2003 David Gravereaux.
-# Copyright (c) 2003-2007 Patrick Thoyts
+# Copyright (c) 2003-2008 Patrick Thoyts
#------------------------------------------------------------------------------
!ifndef _RULES_VC
@@ -218,7 +218,7 @@ DEBUG = 0
SYMBOLS = 0
PROFILE = 0
PGO = 0
-MSVCRT = 0
+MSVCRT = 1
LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
USE_THREAD_ALLOC = 1
@@ -234,18 +234,23 @@ STATIC_BUILD = 0
!message *** Doing msvcrt
MSVCRT = 1
!else
+!if !$(STATIC_BUILD)
+MSVCRT = 1
+!else
MSVCRT = 0
!endif
-!if [nmakehlp -f $(OPTS) "staticpkg"]
+!endif
+!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
!message *** Doing staticpkg
TCL_USE_STATIC_PACKAGES = 1
!else
TCL_USE_STATIC_PACKAGES = 0
!endif
!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
TCL_THREADS = 0
+USE_THREAD_ALLOC= 0
!else
-!message *** Doing threads
TCL_THREADS = 1
USE_THREAD_ALLOC= 1
!endif
@@ -287,7 +292,7 @@ LOIMPACT = 0
USE_THREAD_ALLOC = 1
!endif
!if [nmakehlp -f $(OPTS) "tclalloc"]
-!message *** Doing thrdalloc
+!message *** Doing tclalloc
USE_THREAD_ALLOC = 0
!endif
!if [nmakehlp -f $(OPTS) "unchecked"]
@@ -298,15 +303,6 @@ UNCHECKED = 0
!endif
!endif
-
-!if !$(STATIC_BUILD)
-# Make sure we don't build overly fat DLLs.
-MSVCRT = 1
-# We shouldn't statically put the extensions inside the shell when dynamic.
-TCL_USE_STATIC_PACKAGES = 0
-!endif
-
-
#----------------------------------------------------------
# Figure-out how to name our intermediate and output directories.
# We wouldn't want different builds to use the same .obj files
@@ -348,10 +344,8 @@ TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
TMP_DIRFULL = $(TMP_DIRFULL:Static=)
SUFX = $(SUFX:s=)
EXT = dll
-!if $(MSVCRT)
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX = $(SUFX:x=)
-!endif
!else
TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
EXT = lib
@@ -583,35 +577,35 @@ Failed to find tcl.h. The TCLDIR macro does not appear correct.
TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-!if $(TCL_VERSION) < 81
-TCL_DOES_STUBS = 0
-!else
-TCL_DOES_STUBS = 1
-!endif
-
!if $(TCLINSTALL)
TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
-!if !exist($(TCLSH)) && $(TCL_THREADS)
-TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
+!if !exist($(TCLSH))
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:x=).exe"
!endif
TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
+!if !exist($(TCLIMPLIB))
+TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
TCL_LIBRARY = $(_TCLDIR)\lib
TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
COFFBASE = \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES = -I"$(_TCLDIR)\include"
!else
TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
-!if !exist($(TCLSH)) && $(TCL_THREADS)
-TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
+!if !exist($(TCLSH))
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:x=).exe"
!endif
TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
+!if !exist($(TCLIMPLIB))
+TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
TCL_LIBRARY = $(_TCLDIR)\library
TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
@@ -681,13 +675,25 @@ TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
!if "$(PROJECT)" != "tk"
!if $(TKINSTALL)
WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
+!if !exist($(WISH))
+WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX:x=).exe"
+!endif
TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
+!if !exist($(TKIMPLIB))
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
TK_INCLUDES = -I"$(_TKDIR)\include"
!else
WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(WISH))
+WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX:x=).exe"
+!endif
TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
+!if !exist($(TKIMPLIB))
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!endif
!endif
diff --git a/win/tcl.m4 b/win/tcl.m4
index bbea9a3..5e8e135 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -211,7 +211,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
AC_DEFUN([SC_ENABLE_SHARED], [
AC_MSG_CHECKING([how to build libraries])
AC_ARG_ENABLE(shared,
- [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [ --enable-shared build and link with shared libraries (default: on)],
[tcl_ok=$enableval], [tcl_ok=yes])
if test "${enable_shared+set}" = set; then
@@ -250,11 +250,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [
AC_DEFUN([SC_ENABLE_THREADS], [
AC_MSG_CHECKING(for building with threads)
- AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)],
[tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT(yes)
+ AC_MSG_RESULT([yes (default)])
TCL_THREADS=1
AC_DEFINE(TCL_THREADS)
# USE_THREAD_ALLOC tells us to try the special thread-based
@@ -297,7 +297,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
AC_DEFUN([SC_ENABLE_SYMBOLS], [
AC_MSG_CHECKING([for build with symbols])
- AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
@@ -533,8 +533,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
MAKE_EXE="\${CC} -o \[$]@"
LIBPREFIX="lib"
- extra_ldflags="$extra_ldflags -pipe"
extra_cflags="$extra_cflags -pipe"
+ extra_ldflags="$extra_ldflags -pipe"
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -1071,7 +1071,7 @@ AC_DEFUN([SC_BUILD_TCLSH], [
#--------------------------------------------------------------------
AC_DEFUN([SC_TCL_CFG_ENCODING], [
- AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
+ AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
if test x"${with_tcencoding}" != x ; then
AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}")
diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c
index dcbce6c..2501688 100644
--- a/win/tkWinClipboard.c
+++ b/win/tkWinClipboard.c
@@ -162,9 +162,10 @@ TkSelGetSelection(
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;
}
diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c
index 8366db3..622ba4d 100644
--- a/win/tkWinCursor.c
+++ b/win/tkWinCursor.c
@@ -72,8 +72,7 @@ static struct CursorName {
*/
#define TK_DEFAULT_CURSOR IDC_ARROW
-
-
+
/*
*----------------------------------------------------------------------
*
@@ -131,8 +130,9 @@ TkGetCursorByName(
*/
if (Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "can't get cursor from a file in",
- " a safe interpreter", NULL);
+ 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;
@@ -166,13 +166,15 @@ TkGetCursorByName(
ckfree(cursorPtr);
badCursorSpec:
ckfree(argv);
- Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad cursor spec \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL);
return NULL;
}
ckfree(argv);
return (TkCursor *) cursorPtr;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -201,7 +203,7 @@ TkCreateCursorFromData(
{
return NULL;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -225,7 +227,7 @@ TkpFreeCursor(
{
/* TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr; */
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -260,7 +262,7 @@ TkpSetCursor(
SetCursor(hcursor);
}
}
-
+
/*
* Local Variables:
* mode: c
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 4d60105..9263830 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -361,9 +361,9 @@ Tk_ChooseColorObjCmd(
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;
}
@@ -424,13 +424,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;
}
@@ -583,7 +581,7 @@ GetFileName(
Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
Tcl_DString utfFilterString, utfDirString, ds;
Tcl_DString extString, filterString, dirString, titleString;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
static const char *const saveOptionStrings[] = {
"-confirmoverwrite", "-defaultextension", "-filetypes", "-initialdir",
@@ -594,8 +592,8 @@ GetFileName(
"-multiple", "-parent", "-title", "-typevariable", NULL
};
enum options {
- FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
- FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
+ FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
};
file[0] = '\0';
@@ -619,9 +617,9 @@ GetFileName(
}
if (i + 1 == objc) {
- string = Tcl_GetString(objv[i]);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
goto end;
}
@@ -647,9 +645,9 @@ GetFileName(
if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
goto end;
}
- Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds), 0, NULL, (char *) file,
- sizeof(file), NULL, NULL, NULL);
+ Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
+ Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
+ (char *) file, sizeof(file), NULL, NULL, NULL);
Tcl_DStringFree(&ds);
break;
case FILE_PARENT:
@@ -870,8 +868,8 @@ 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);
}
@@ -895,9 +893,11 @@ GetFileName(
}
}
} 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;
@@ -962,14 +962,16 @@ OFNHookProc(
OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam;
/*
- * This is weird... or not. The CDN_FILEOK is NOT sent when the selection
- * exceeds declared buffer size (the nMaxFile member of the OPENFILENAME
- * struct passed to GetOpenFileName function). So, we have to rely on
- * the most recent CDN_SELCHANGE then. Unfortunately this means, that
- * gathering the selected filenames happens twice when they fit into the
- * declared buffer. Luckily, it's not frequent operation so it should
- * not incur any noticeable delay. See [tktoolkit-Bugs-2987995]
+ * This is weird... or not. The CDN_FILEOK is NOT sent when the
+ * selection exceeds declared buffer size (the nMaxFile member of the
+ * OPENFILENAME struct passed to GetOpenFileName function). So, we
+ * have to rely on the most recent CDN_SELCHANGE then. Unfortunately
+ * this means, that gathering the selected filenames happens twice
+ * when they fit into the declared buffer. Luckily, it's not frequent
+ * operation so it should not incur any noticeable delay. See [Bug
+ * 2987995]
*/
+
if (notifyPtr->hdr.code == CDN_FILEOK ||
notifyPtr->hdr.code == CDN_SELCHANGE) {
int dirsize, selsize;
@@ -991,8 +993,10 @@ OFNHookProc(
buffersize = (selsize + dirsize + 1);
/*
- * Just empty the buffer if dirsize indicates an error [Bug 3071836]
+ * Just empty the buffer if dirsize indicates an error. [Bug
+ * 3071836]
*/
+
if ((selsize > 1) && (dirsize > 0)) {
if (ofnData->dynFileBufferSize < buffersize) {
buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR));
@@ -1357,9 +1361,9 @@ Tk_ChooseDirectoryObjCmd(
goto cleanup;
}
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", "DIRDIALOG", "VALUE", NULL);
goto cleanup;
}
@@ -1369,7 +1373,8 @@ Tk_ChooseDirectoryObjCmd(
if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
goto cleanup;
}
- Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, &tempString);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1,
+ &tempString);
uniStr = (TCHAR *) Tcl_DStringValue(&tempString);
/*
@@ -1461,10 +1466,11 @@ Tk_ChooseDirectoryObjCmd(
pidl = SHBrowseForFolder(&bInfo);
/*
- * This is a fix for Windows 2000, which seems to modify the folder name
- * buffer even when the dialog is canceled (in this case the buffer
- * contains garbage). See [Bug #3002230]
+ * This is a fix for Windows 2000, which seems to modify the folder
+ * name buffer even when the dialog is canceled (in this case the
+ * buffer contains garbage). See [Bug #3002230]
*/
+
path[0] = '\0';
/*
@@ -1473,9 +1479,10 @@ Tk_ChooseDirectoryObjCmd(
if (pidl != NULL) {
if (!SHGetPathFromIDList(pidl, path)) {
- Tcl_SetResult(interp, "Error: Not a file system folder\n",
- TCL_VOLATILE);
- };
+ 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 (_tcslen(cdCBData.retDir) > 0) {
_tcscpy(path, cdCBData.retDir);
@@ -1502,8 +1509,8 @@ 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);
}
@@ -1578,7 +1585,8 @@ ChooseDirectoryValidateProc(
Tcl_DStringFree(&initDirString);
Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString);
Tcl_DStringFree(&tempString);
- _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString), MAX_PATH);
+ _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString),
+ MAX_PATH);
Tcl_DStringFree(&initDirString);
if (SetCurrentDirectory(string) == 0) {
@@ -1596,7 +1604,9 @@ ChooseDirectoryValidateProc(
* User HAS to select a valid directory.
*/
- wsprintf(selDir, TEXT("Directory '%s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->retDir);
+ wsprintf(selDir, TEXT("Directory '%s' does not exist,\n")
+ TEXT("please select or enter an existing directory."),
+ chooseDirSharedData->retDir);
MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
chooseDirSharedData->retDir[0] = '\0';
return 1;
@@ -1732,7 +1742,6 @@ Tk_MessageBoxObjCmd(
for (i = 1; i < objc; i += 2) {
int index;
- const char *string;
Tcl_Obj *optionPtr, *valuePtr;
optionPtr = objv[i];
@@ -1743,9 +1752,9 @@ Tk_MessageBoxObjCmd(
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", "MSGBOX", "VALUE", NULL);
return TCL_ERROR;
}
@@ -1814,9 +1823,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;
@@ -1864,9 +1874,8 @@ Tk_MessageBoxObjCmd(
EnableWindow(hWnd, 1);
Tcl_DecrRefCount(tmpObj);
-
- Tcl_SetResult(interp,
- (char *)TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TkFindStateString(buttonMap, winCode), -1));
return TCL_OK;
}
@@ -1934,6 +1943,7 @@ SetTkDialog(
/*
* Factored out a common pattern in use in this file.
*/
+
static const char *
ConvertExternalFilename(
TCHAR *filename,
@@ -1969,7 +1979,9 @@ ConvertExternalFilename(
*/
static Tcl_Obj *
-GetFontObj(HDC hdc, LOGFONT *plf)
+GetFontObj(
+ HDC hdc,
+ LOGFONT *plf)
{
Tcl_DString ds;
Tcl_Obj *resObj;
@@ -2001,7 +2013,11 @@ GetFontObj(HDC hdc, LOGFONT *plf)
}
static void
-ApplyLogfont(Tcl_Interp *interp, Tcl_Obj *cmdObj, HDC hdc, LOGFONT *logfontPtr)
+ApplyLogfont(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ HDC hdc,
+ LOGFONT *logfontPtr)
{
int objc;
Tcl_Obj **objv, **tmpv;
@@ -2036,7 +2052,11 @@ typedef struct HookData {
} HookData;
static UINT_PTR CALLBACK
-HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam)
+HookProc(
+ HWND hwndDlg,
+ UINT msg,
+ WPARAM wParam,
+ LPARAM lParam)
{
CHOOSEFONT *pcf = (CHOOSEFONT *) lParam;
HWND hwndCtrl;
@@ -2048,7 +2068,7 @@ HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam)
phd = (HookData *) pcf->lCustData;
phd->hwnd = hwndDlg;
if (tsdPtr->debugFlag) {
- tsdPtr->debugInterp = (Tcl_Interp *) phd->interp;
+ tsdPtr->debugInterp = phd->interp;
Tcl_DoWhenIdle(SetTkDialog, hwndDlg);
}
if (phd->titleObj != NULL) {
@@ -2115,7 +2135,9 @@ enum FontchooserOption {
};
static Tcl_Obj *
-FontchooserCget(HookData *hdPtr, int optionIndex)
+FontchooserCget(
+ HookData *hdPtr,
+ int optionIndex)
{
Tcl_Obj *resObj = NULL;
@@ -2225,16 +2247,18 @@ FontchooserConfigureCmd(
return TCL_OK;
}
if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"",
- Tcl_GetString(objv[i]), "\" missing", NULL);
+ 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: {
- const char *msg = "cannot change read-only option "
+ 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: {
@@ -2367,9 +2391,10 @@ FontchooserShowCmd(
}
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);
+ 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);
diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c
index 43cd419..a908a1f 100644
--- a/win/tkWinEmbed.c
+++ b/win/tkWinEmbed.c
@@ -134,7 +134,7 @@ Tk_DetachEmbeddedWindow(
TkpWinToplevelOverrideRedirect(winPtr, 0);
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -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 {
/*
@@ -300,7 +305,9 @@ TkpUseWindow(
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 == 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;
}
}
@@ -935,7 +942,7 @@ Tk_GetEmbeddedHWnd(
}
return NULL;
}
-
+
/*
*----------------------------------------------------------------------
*
diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c
index 245639d..26f08f4 100644
--- a/win/tkWinMenu.c
+++ b/win/tkWinMenu.c
@@ -155,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 char * GetEntryText(TkMenuEntry *mePtr);
+static char * GetEntryText(TkMenuEntry *mePtr);
static void GetMenuAccelGeometry(TkMenu *menuPtr,
TkMenuEntry *mePtr, Tk_Font tkfont,
const Tk_FontMetrics *fmPtr, int *widthPtr,
@@ -188,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);
+ }
+}
+
/*
*----------------------------------------------------------------------
*
@@ -213,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;
@@ -265,7 +285,7 @@ static void
FreeID(
WORD commandID)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
@@ -274,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);
}
@@ -307,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;
}
@@ -353,11 +374,11 @@ TkpDestroyMenu(
{
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
const char *searchName;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ 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) {
@@ -400,6 +421,7 @@ TkpDestroyMenu(
if (tsdPtr->menuHWND != NULL) {
Tcl_HashEntry *hashEntryPtr =
Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl);
+
if (hashEntryPtr != NULL) {
Tcl_DeleteHashEntry(hashEntryPtr);
}
@@ -437,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;
@@ -549,7 +568,7 @@ static void
ReconfigureWindowsMenu(
ClientData clientData) /* The menu we are rebuilding */
{
- TkMenu *menuPtr = (TkMenu *) clientData;
+ TkMenu *menuPtr = clientData;
TkMenuEntry *mePtr;
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
char *itemText = NULL;
@@ -676,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);
}
}
}
@@ -752,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) {
@@ -855,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;
@@ -923,11 +928,12 @@ UpdateEmbeddedMenu(
{
RECT rc;
HWND hMenuWnd = (HWND)clientData;
+
GetClientRect(hMenuWnd, &rc);
InvalidateRect(hMenuWnd, &rc, FALSE);
UpdateWindow(hMenuWnd);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -954,7 +960,7 @@ TkWinEmbeddedMenuProc(
{
static int nIdles = 0;
LRESULT lResult = 1;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
switch(message) {
@@ -997,7 +1003,7 @@ TkWinEmbeddedMenuProc(
}
return lResult;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1030,7 +1036,7 @@ TkWinHandleMenuEvent(
int returnResult = 0;
TkMenu *menuPtr;
TkMenuEntry *mePtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
switch (*pMessage) {
@@ -1038,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,
@@ -1053,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_BackgroundException(interp, code);
}
- Tcl_Release((ClientData)interp);
+ Tcl_Release(interp);
}
TkActivateMenuEntry(menuPtr, -1);
*plResult = 0;
@@ -1090,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;
@@ -1126,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_BackgroundException(interp, code);
}
- Tcl_Release((ClientData)interp);
+ Tcl_Release(interp);
*plResult = 0;
returnResult = 1;
}
@@ -1147,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.
@@ -1279,7 +1280,7 @@ TkWinHandleMenuEvent(
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
(char *) *plParam);
if (hashEntryPtr != NULL) {
- menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ menuPtr = Tcl_GetHashValue(hashEntryPtr);
}
}
@@ -1292,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);
}
}
}
@@ -1384,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) {
@@ -1402,10 +1402,7 @@ TkpSetWindowMenuBar(
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);
}
@@ -1784,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);
}
@@ -1851,6 +1848,7 @@ DrawMenuEntryArrow(
mePtr->menuPtr->tkwin, (mePtr->activeBorderPtr == NULL)
? mePtr->menuPtr->activeBorderPtr
: mePtr->activeBorderPtr));
+
gc->background = activeBgColor->pixel;
}
@@ -2207,6 +2205,7 @@ 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;
}
@@ -2316,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,
@@ -2450,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;
}
@@ -2671,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 {
@@ -3029,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);
}
}
}
@@ -3063,8 +3056,9 @@ HWND
Tk_GetMenuHWND(
Tk_Window tkwin)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
TkMenuInit();
return tsdPtr->embeddedMenuHWND;
}
@@ -3114,7 +3108,7 @@ static void
MenuThreadExitHandler(
ClientData clientData) /* Not used */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
DestroyWindow(tsdPtr->menuHWND);
@@ -3332,7 +3326,7 @@ TkpMenuInit(void)
Tcl_Panic("Failed to register embedded menu window class");
}
- TkCreateExitHandler(MenuExitHandler, (ClientData) NULL);
+ TkCreateExitHandler(MenuExitHandler, NULL);
SetDefaults(1);
}
@@ -3356,7 +3350,7 @@ TkpMenuInit(void)
void
TkpMenuThreadInit(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, TEXT("MenuWindow"), WS_POPUP,
@@ -3377,7 +3371,7 @@ TkpMenuThreadInit(void)
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/tkWinSend.c b/win/tkWinSend.c
index b3edc62..43cb741 100644
--- a/win/tkWinSend.c
+++ b/win/tkWinSend.c
@@ -55,7 +55,7 @@ typedef struct {
int initialized;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* Functions internal to this file.
@@ -66,12 +66,12 @@ 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,
@@ -85,7 +85,7 @@ static Tcl_EventProc SendEventProc;
#define TRACE SendTrace
#else
#define TRACE 1 ? ((void)0) : SendTrace
-#endif
+#endif /* DEBUG || _DEBUG */
/*
*--------------------------------------------------------------
@@ -136,9 +136,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.
@@ -147,8 +145,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;
@@ -363,8 +362,10 @@ Tk_SendObjCmd(
*/
if (displayPtr) {
- Tcl_SetResult(interp, "option not implemented: \"displayof\" is "
- "not available for this platform.", TCL_STATIC);
+ 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;
}
@@ -436,9 +437,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;
}
@@ -553,7 +555,7 @@ RevokeObjectRegistration(
riPtr->name = NULL;
}
}
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* ----------------------------------------------------------------------
@@ -580,7 +582,7 @@ InterpDeleteProc(
{
CoUninitialize();
}
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* ----------------------------------------------------------------------
@@ -701,7 +703,7 @@ RegisterInterp(
Tcl_DStringFree(&dString);
return hr;
}
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
/*
* ----------------------------------------------------------------------
@@ -782,21 +784,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;
- const 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);
}
/*
@@ -852,7 +847,7 @@ Win32ErrorObj(
errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer));
#else
errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
-#endif
+#endif /* _UNICODE */
if (lpBuffer != sBuffer) {
LocalFree((HLOCAL)lpBuffer);
@@ -864,7 +859,7 @@ Win32ErrorObj(
/*
* ----------------------------------------------------------------------
*
- * SetErrorInfo --
+ * TkWinSend_SetExcepInfo --
*
* Convert the error information from a Tcl interpreter into a COM
* exception structure. This information is then registered with the COM
@@ -881,48 +876,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);
}
/*
diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c
index c67e533..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
@@ -380,17 +377,15 @@ Async(
if (FAILED(hr)) {
Tcl_SetObjResult(obj->interp, Tcl_NewStringObj(
"invalid args: Async(command)", -1));
- SetExcepInfo(obj->interp, pExcepInfo);
+ 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));
+ if (SUCCEEDED(hr) && obj->interp) {
+ Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
+ (int) SysStringLen(vCmd.bstrVal));
- TkWinSend_QueueCommand(obj->interp, scriptPtr);
- }
+ TkWinSend_QueueCommand(obj->interp, scriptPtr);
}
VariantClear(&vCmd);
@@ -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/tkWinWm.c b/win/tkWinWm.c
index 45ccbe2..efed842 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.c
@@ -74,7 +74,7 @@ typedef struct ProtocolHandler {
typedef struct TkWmStackorderToplevelPair {
Tcl_HashTable *table;
- TkWindow **window_ptr;
+ TkWindow **windowPtr;
} TkWmStackorderToplevelPair;
/*
@@ -972,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) {
@@ -1006,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 {
@@ -1061,8 +1065,9 @@ WinSetIcon(
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;
}
}
@@ -1575,8 +1580,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")
@@ -1602,7 +1608,7 @@ ReadIconOrCursorFromFile(
lpIR->nNumImages = ReadICOHeader(channel);
if (lpIR->nNumImages == -1) {
- Tcl_AppendResult(interp, "Invalid file header", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid file header", -1));
Tcl_Close(NULL, channel);
ckfree(lpIR);
return NULL;
@@ -1628,7 +1634,9 @@ ReadIconOrCursorFromFile(
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(lpIDE);
ckfree(lpIR);
@@ -1660,7 +1668,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;
}
@@ -1671,7 +1680,8 @@ ReadIconOrCursorFromFile(
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: ", Tcl_PosixError(interp)));
goto readError;
}
@@ -1680,8 +1690,9 @@ ReadIconOrCursorFromFile(
*/
if (!AdjustIconImagePointers(&lpIR->IconImages[i])) {
- Tcl_AppendResult(interp, "Error converting to internal format",
- NULL);
+ 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 =
@@ -1694,11 +1705,6 @@ ReadIconOrCursorFromFile(
ckfree(lpIDE);
Tcl_Close(NULL, channel);
- if (lpIR == NULL) {
- Tcl_AppendResult(interp, "Reading of ", Tcl_GetString(fileName),
- " failed!", NULL);
- return NULL;
- }
return lpIR;
readError:
@@ -2817,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) {
@@ -2848,8 +2853,10 @@ Tk_WmObjCmd(
}
if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE)
&& (index != WMOPT_FORGET)) {
- Tcl_AppendResult(interp, "window \"", winPtr->pathName,
- "\" isn't a top-level window", NULL);
+ 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;
}
@@ -2959,9 +2966,13 @@ WmAspectCmd(
}
if (objc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d",
- wmPtr->minAspect.x, wmPtr->minAspect.y,
- wmPtr->maxAspect.x, wmPtr->maxAspect.y));
+ Tcl_Obj *results[4];
+
+ 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;
}
@@ -2975,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;
@@ -3093,8 +3106,10 @@ WmAttributesCmd(
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 {
@@ -3249,10 +3264,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;
}
@@ -3266,10 +3282,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;
}
}
@@ -3315,7 +3331,8 @@ 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;
}
@@ -3375,10 +3392,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?");
@@ -3386,13 +3402,16 @@ 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)
@@ -3477,8 +3496,10 @@ WmCommandCmd(
}
if (objc == 3) {
if (wmPtr->cmdArgv != NULL) {
- char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- Tcl_SetResult(interp, merged, TCL_DYNAMIC);
+ char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(merged, -1));
+ ckfree(merged);
}
return TCL_OK;
}
@@ -3540,14 +3561,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;
@@ -3595,8 +3620,8 @@ 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;
}
@@ -3800,9 +3825,13 @@ WmGridCmd(
}
if (objc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d",
- wmPtr->reqGridWidth, wmPtr->reqGridHeight,
- wmPtr->widthInc, wmPtr->heightInc));
+ Tcl_Obj *results[4];
+
+ 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;
}
@@ -3829,19 +3858,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,
@@ -3887,7 +3924,7 @@ 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;
}
@@ -3954,8 +3991,9 @@ WmIconbitmapCmd(
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;
@@ -3965,9 +4003,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;
}
@@ -4026,6 +4064,7 @@ WmIconbitmapCmd(
*/
Pixmap pixmap;
+
Tcl_ResetResult(interp);
pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string);
if (pixmap == None) {
@@ -4080,24 +4119,33 @@ WmIconifyCmd(
}
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);
+ 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);
@@ -4139,9 +4187,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;
}
@@ -4196,9 +4244,8 @@ WmIconnameCmd(
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) {
@@ -4274,8 +4321,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;
}
}
@@ -4325,8 +4374,10 @@ WmIconphotoCmd(
&bgraPixel.voidPtr, NULL, 0);
if (!iconInfo.hbmColor) {
ckfree(lpIR);
- Tcl_AppendResult(interp, "failed to create color bitmap for \"",
- Tcl_GetString(objv[i]), "\"", NULL);
+ 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;
}
@@ -4355,8 +4406,10 @@ WmIconphotoCmd(
if (!iconInfo.hbmMask) {
DeleteObject(iconInfo.hbmColor);
ckfree(lpIR);
- Tcl_AppendResult(interp, "failed to create mask bitmap for \"",
- Tcl_GetString(objv[i]), "\"", NULL);
+ 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;
}
@@ -4375,8 +4428,10 @@ WmIconphotoCmd(
*/
ckfree(lpIR);
- Tcl_AppendResult(interp, "failed to create icon for \"",
- Tcl_GetString(objv[i]), "\"", NULL);
+ 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;
@@ -4433,8 +4488,11 @@ WmIconpositionCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d",
- wmPtr->hints.icon_x, wmPtr->hints.icon_y));
+ Tcl_Obj *results[2];
+
+ 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;
}
@@ -4488,7 +4546,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;
}
@@ -4513,15 +4571,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) {
@@ -4589,9 +4650,10 @@ WmManageCmd(
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);
@@ -4645,8 +4707,12 @@ WmMaxsizeCmd(
return TCL_ERROR;
}
if (objc == 3) {
+ Tcl_Obj *results[2];
+
GetMaxSize(wmPtr, &width, &height);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", width, height));
+ 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)
@@ -4692,8 +4758,12 @@ WmMinsizeCmd(
return TCL_ERROR;
}
if (objc == 3) {
+ Tcl_Obj *results[2];
+
GetMinSize(wmPtr, &width, &height);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", width, height));
+ 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)
@@ -4742,8 +4812,9 @@ WmOverrideredirectCmd(
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 {
@@ -4816,11 +4887,14 @@ 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') {
@@ -4872,6 +4946,7 @@ WmProtocolCmd(
Atom protocol;
const char *cmd;
int cmdLength;
+ Tcl_Obj *resultObj;
if ((objc < 3) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?");
@@ -4882,11 +4957,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]));
@@ -4898,7 +4975,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;
}
}
@@ -4967,9 +5045,11 @@ WmResizableCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d",
- (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
- (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1));
+ Tcl_Obj *results[2];
+
+ 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)
@@ -5033,11 +5113,14 @@ 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;
}
@@ -5085,13 +5168,14 @@ WmStackorderCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- TkWindow **windows, **window_ptr;
+ 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)) {
@@ -5104,14 +5188,18 @@ WmStackorderCmd(
if (windows == NULL) {
Tcl_Panic("TkWmStackorderToplevel failed");
}
- for (window_ptr = windows; *window_ptr ; window_ptr++) {
- Tcl_AppendElement(interp, (*window_ptr)->pathName);
+
+ 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) {
@@ -5119,20 +5207,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;
}
@@ -5143,22 +5235,23 @@ 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;
}
- for (window_ptr = windows; *window_ptr ; window_ptr++) {
- if (*window_ptr == winPtr) {
- index1 = (window_ptr - windows);
+ for (windowPtr = windows; *windowPtr ; windowPtr++) {
+ if (*windowPtr == winPtr) {
+ index1 = (windowPtr - windows);
}
- if (*window_ptr == winPtr2) {
- index2 = (window_ptr - windows);
+ if (*windowPtr == winPtr2) {
+ index2 = (windowPtr - windows);
}
}
if (index1 == -1) {
Tcl_Panic("winPtr window not found");
- }
- if (index2 == -1) {
+ } else if (index2 == -1) {
Tcl_Panic("winPtr2 window not found");
}
@@ -5218,9 +5311,10 @@ 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,
@@ -5254,9 +5348,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;
@@ -5272,13 +5367,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);
@@ -5291,31 +5392,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;
}
@@ -5368,12 +5464,13 @@ WmTitleCmd(
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) {
@@ -5429,7 +5526,7 @@ WmTransientCmd(
}
if (objc == 3) {
if (masterPtr != NULL) {
- Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj(masterPtr));
}
return TCL_OK;
}
@@ -5462,24 +5559,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) {
/*
@@ -5547,15 +5647,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 {
@@ -6252,7 +6356,7 @@ ParseGeometry(
* them.
*/
- if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) {
wmPtr->sizeHintsFlags |= USPosition;
}
}
@@ -6277,7 +6381,9 @@ ParseGeometry(
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;
}
@@ -6444,7 +6550,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;
}
@@ -6579,7 +6685,7 @@ TkWmStackorderToplevelEnumProc(
fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd,
childWinPtr, childWinPtr->pathName);
*/
- *(pair->window_ptr)-- = childWinPtr;
+ *(pair->windowPtr)-- = childWinPtr;
}
return TRUE;
}
@@ -6689,14 +6795,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(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");
}
diff --git a/win/tkWinX.c b/win/tkWinX.c
index e85b7e7..22edb60 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -120,20 +120,19 @@ TkGetServerInfo(
Tk_Window tkwin) /* Token for window; this selects a particular
* display and server. */
{
- char buffer[60];
OSVERSIONINFO os;
os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&os);
- sprintf(buffer, "Windows %d.%d %d %s", (int)os.dwMajorVersion,
- (int)os.dwMinorVersion, (int)os.dwBuildNumber,
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("Windows %d.%d %d %s",
+ (int) os.dwMajorVersion, (int) os.dwMinorVersion,
+ (int) os.dwBuildNumber,
#ifdef _WIN64
"Win64"
#else
"Win32"
#endif
- );
- Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+ ));
}
/*
diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c
index 08e8a8e..8666b65 100644
--- a/win/ttkWinXPTheme.c
+++ b/win/ttkWinXPTheme.c
@@ -1062,7 +1062,8 @@ 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) {
@@ -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,8 +1134,10 @@ 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,
generated by cgit v0.12 at 2024-11-25 00:12:53 (GMT)