diff options
| author | fvogel <fvogelnew1@free.fr> | 2021-11-16 20:39:47 (GMT) |
|---|---|---|
| committer | fvogel <fvogelnew1@free.fr> | 2021-11-16 20:39:47 (GMT) |
| commit | d8f50ac067d2f0df387ca0b0c46278c2464efc8b (patch) | |
| tree | 4c40167ca8b673d38459b4478944b8bc60cc4a7f | |
| parent | c56ea97892bf4b5716fd0c88709b0ef0cb130995 (diff) | |
| parent | a9827f93eadc2978316098553e09406dae1f5520 (diff) | |
| download | tk-d8f50ac067d2f0df387ca0b0c46278c2464efc8b.zip tk-d8f50ac067d2f0df387ca0b0c46278c2464efc8b.tar.gz tk-d8f50ac067d2f0df387ca0b0c46278c2464efc8b.tar.bz2 | |
Merge 8.6bug-b1d115fa60
277 files changed, 3418 insertions, 2252 deletions
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob index c0e62c7..8100756 100644 --- a/.fossil-settings/ignore-glob +++ b/.fossil-settings/ignore-glob @@ -24,7 +24,7 @@ */versions.vc */version.vc */libtk.vfs -*/libtk_*.zip +*/libtk*.zip doc/man.macros html macosx/configure diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md new file mode 100644 index 0000000..35a56fb --- /dev/null +++ b/.github/ISSUE_TEMPLATE.md @@ -0,0 +1,3 @@ +Important Note +========== +Please do not file issues with Tk on Github. They are unlikely to be noticed in a timely fashion. Tk issues are hosted in the [tk fossil repository on core.tcl-lang.org](https://core.tcl-lang.org/tk/tktnew); please post them there. diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..dc07555 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,3 @@ +Important Note +========== +Please do not file pull requests with Tk on Github. They are unlikely to be noticed in a timely fashion. Tk issues (including patches) are hosted in the [tk fossil repository on core.tcl-lang.org](https://core.tcl-lang.org/tk/tktnew); please post them there. diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index 70bbd5e..ce382a1 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -93,7 +93,7 @@ jobs: if: ${{ env.BUILD_CONFIG_ID == 'gcc-no' }} uses: actions/upload-artifact@v2 with: - name: Tk ${{ env.VERSION }} Source distribution (unofficial) + name: Tk ${{ env.VERSION }} Source distribution (snapshot) path: | /tmp/dist/tk* !/tmp/dist/tk*/html/** @@ -101,7 +101,7 @@ jobs: if: ${{ env.BUILD_CONFIG_ID == 'gcc-no' }} uses: actions/upload-artifact@v2 with: - name: Tk ${{ env.VERSION }} HTML documentation (unofficial) + name: Tk ${{ env.VERSION }} HTML documentation (snapshot) path: /tmp/dist/tk*/html test: runs-on: ubuntu-20.04 diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index ae0ec24..2600858 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -4,7 +4,7 @@ env: ERROR_ON_FAILURES: 1 jobs: xcode: - runs-on: macos-11.0 + runs-on: macos-11 defaults: run: shell: bash @@ -37,8 +37,17 @@ jobs: echo "::error::Failure during Build" exit 1 } + - name: Run Tests + run: | + make test | tee out.txt + nmatches=$( grep -c "Failed 0" out.txt ) + if [ $nmatches -lt 4 ] + then + echo "::error::Failure during Test" + exit 1 + fi clang: - runs-on: macos-11.0 + runs-on: macos-11 strategy: matrix: symbols: @@ -63,18 +72,17 @@ jobs: ref: core-8-6-branch path: tcl - name: Prepare checked out repositories + env: + SET_DISPLAY: ${{ contains(matrix.options, '--disable-aqua') }} run: | touch ../generic/tkStubInit.c ../doc/man.macros mkdir "$HOME/install dir" echo "USE_XVFB=$SET_DISPLAY" >> $GITHUB_ENV - env: - SET_DISPLAY: ${{ contains(matrix.options, '--disable-aqua') }} - name: Add X11 (if required) - if: ${{ env.USE_XVFB }} - # This involves black magic + if: ${{ env.USE_XVFB == 'true' }} run: | brew install --cask xquartz - sudo /opt/X11/lib/X11/xinit/privileged_startx.d/10-tmpdirs || true + sudo /opt/X11/libexec/privileged_startx || true working-directory: . - name: Build Tcl # Note that macOS is always a 64 bit platform @@ -125,23 +133,25 @@ jobs: } else function runXvfb { - : do nothing + echo Xvfb not used, this is a --enable-aqua build } fi ( runXvfb :0; make test-classic; exit $? ) | tee out-classic.txt || { - echo "::error::Failure during Test" + echo "::error::Failure during Test (classic)" exit 1 } ( runXvfb :0; make test-ttk; exit $? ) | tee out-ttk.txt || { - echo "::error::Failure during Test" + echo "::error::Failure during Test (ttk)" exit 1 } - cat out-classic.txt out-ttk.txt | grep -q "Failed[[:space:]][[:space:]]*[1-9]" && { - echo "::error::Failure during Test" + cat out-classic.txt | grep -q "Failed 0" || { + echo "::error::Failure in classic test results" + exit 1 + } + cat out-ttk.txt | grep -q "Failed 0" || { + echo "::error::Failure in ttk test results" exit 1 } - env: - MAC_CI: 1 - name: Carry out trial installation run: | make install || { diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 2f0b328..70de8f8 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -87,7 +87,7 @@ jobs: runs-on: windows-2019 defaults: run: - shell: bash + shell: msys2 {0} working-directory: win strategy: matrix: @@ -95,8 +95,12 @@ jobs: - "no" - "mem" - "all" - # Using powershell means we need to explicitly stop on failure steps: + - name: Install MSYS2 + uses: msys2/setup-msys2@v2 + with: + msystem: MINGW64 + install: git mingw-w64-x86_64-toolchain make - name: Checkout uses: actions/checkout@v2 - name: Checkout @@ -105,8 +109,6 @@ jobs: repository: tcltk/tcl ref: core-8-6-branch path: tcl - - name: Install MSYS2, Make - run: choco install -y msys2 make - name: Prepare run: | touch tkStubInit.c @@ -3203,7 +3203,7 @@ a better first place to look now. 2009-03-25 Jan Nijtmans <nijtmans@users.sf.net> * doc/wish.1: Bring doc and demos in line with - * library/demos/hello: http://wiki.tcl.tk/812 + * library/demos/hello: https://wiki.tcl-lang.org/page/exec+magic * library/demos/rmt * library/demos/square * library/demos/tcolor @@ -1,6 +1,6 @@ # README: Tk -This is the **Tk 8.6.11** source distribution. +This is the **Tk 8.6.12** source distribution. You can get any source release of Tk from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). @@ -15,7 +15,7 @@ This directory contains the sources and documentation for Tk, a cross-platform GUI toolkit implemented with the Tcl scripting language. For details on features, incompatibilities, and potential problems with -this release, see [the Tcl/Tk 8.6 Web page](https://www.tcl.tk/software/tcltk/8.6.html) +this release, see [the Tcl/Tk 8.6 Web page](https://www.tcl-lang.org/software/tcltk/8.6.html) or refer to the "changes" file in this directory, which contains a historical record of all changes to Tk. @@ -7842,3 +7842,64 @@ Tk Cocoa 2.0: More drawing internals refinements (culler,walzer) 2020-12-24 (bug)[6157a8] Aqua: file dialog -filetypes (davis,culler) - Released 8.6.11, Dec 31, 2020 - https://core.tcl-lang.org/tk/ for details + +2021-01-04 (bug)[19fb7a] Mac: [tk_messageBox] use proper icons (ericwb,culler) + +2021-01-11 (bug)[7beaed] ttk::bindMouseWheel syntax error (nemethi) + +2021-01-15 (new) support 4 new keycodes: CodeInput, SingleCandidate, + MultipleCandidate, PreviousCandidate (nijtmans) + +2021-01-18 (new) Portable keycodes: OE, oe, Ydiaeresis (nijtmans) + +2021-01-27 (bug)[bdcab8] Mac crash on non-BMP menu label (nab,culler) + +2021-02-07 (bug)[9e1312] <Enter> to parent after child destroyed (leunissen) + +2021-02-10 (bug)[d3cd4c] more robust notebook processing (nemethi) + +2021-02-25 (bug)[234ee4] crash in [clipboard get] invalid encoding (nijtmans) + +2021-02-25 (bug)[be9cad] Poor trace housekeeping -> tkwait segfault (michael) + +2021-03-02 (bug)[1626ed] Mac: crash with dead key as menu accelerator (culler) + +2021-03-22 (bug)[9b6065] restore Tcl [update], see window-2.12 (leunissen) + +2021-04-07 (bug)[58222c] Mac: entry and spinbox bg colors (chavez,culler) + +2021-04-18 (bug)[34db75,ea876b] cursor motion in peer text (vogel) + +2021-04-26 (bug)[c97464] memleak in TkpDrawAngledChars (nab,culler) + +2021-04-29 Mac: explicit backing CALayer to fix rendering issues (culler) + +2021-05-02 Mac: respect key repeat system setting (culler) + +2021-05-10 (bug)[171ba7] crash when grab and focus are not coordinated (culler) + +2021-05-24 crash due to failed transient record housekeeping (culler) + +2021-05-25 (bug)[7bda98] Mac: <Double-1> bindings fire twice on app activation + +2021-06-03 (bug)[4401d3] Mac: improved support of pixel formats (chavez,culler) + +2021-06-03 (bug)[8ecc3e] Mac: window exposed by Mission Control (chavez,culler) + +2021-06-04 (bug)[099109] segfault reusing a container toplevel (culler) + +2021-06-22 (bug)[4efbfe] static package init order in wish (werner) + +2021-09-21 (bug)[033886] Win: hang in font loading (e-paine,vogel) + +2021-10-14 (bug)[8ebed3] multi-thread safety in Xft use (werner) + +2021-10-22 (new)[TIP 608] New virtual event <<TkWorldChanged>> (griffin) + +2021-10-27 (bug) file dialog compatibility with Mac OS 12 (culler) + +2021-10-29 (bug) Mac: stop crash when non-Tk windows go full screen (werner) + +2021-10-30 (bug)[6ea0b3] Mac: grab from menu makes dead window (culler) + +- Released 8.6.12, Nov 5, 2021 - https://core.tcl-lang.org/tk/ for details diff --git a/doc/3DBorder.3 b/doc/3DBorder.3 index f2f0eb8..f589e66 100644 --- a/doc/3DBorder.3 +++ b/doc/3DBorder.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_Alloc3DBorderFromObj 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/BindTable.3 b/doc/BindTable.3 index 5130bfc..772f39f 100644 --- a/doc/BindTable.3 +++ b/doc/BindTable.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateBindingTable 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CanvPsY.3 b/doc/CanvPsY.3 index 5e104ce..f789d3c 100644 --- a/doc/CanvPsY.3 +++ b/doc/CanvPsY.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CanvasPs 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CanvTkwin.3 b/doc/CanvTkwin.3 index 3534989..5cb29fa 100644 --- a/doc/CanvTkwin.3 +++ b/doc/CanvTkwin.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CanvasTkwin 3 4.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CanvTxtInfo.3 b/doc/CanvTxtInfo.3 index 92a2bc3..1dd2354 100644 --- a/doc/CanvTxtInfo.3 +++ b/doc/CanvTxtInfo.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CanvasTextInfo 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/Clipboard.3 b/doc/Clipboard.3 index 3087777..cc09018 100644 --- a/doc/Clipboard.3 +++ b/doc/Clipboard.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_ClipboardClear 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/ClrSelect.3 b/doc/ClrSelect.3 index c56f63c..1b942b5 100644 --- a/doc/ClrSelect.3 +++ b/doc/ClrSelect.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_ClearSelection 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/ConfigWind.3 b/doc/ConfigWind.3 index 7c7adab..3e83387 100644 --- a/doc/ConfigWind.3 +++ b/doc/ConfigWind.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_ConfigureWindow 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CoordToWin.3 b/doc/CoordToWin.3 index 5fe96a6..1ebd681 100644 --- a/doc/CoordToWin.3 +++ b/doc/CoordToWin.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CoordsToWindow 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtCmHdlr.3 b/doc/CrtCmHdlr.3 index bcc9493..1ba6f63 100644 --- a/doc/CrtCmHdlr.3 +++ b/doc/CrtCmHdlr.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateClientMessageHandler 3 "8.4" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtConsoleChan.3 b/doc/CrtConsoleChan.3 index 7fd8a6a..d8e0740 100644 --- a/doc/CrtConsoleChan.3 +++ b/doc/CrtConsoleChan.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_InitConsoleChannels 3 8.5 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtErrHdlr.3 b/doc/CrtErrHdlr.3 index e506220..e6ebafe 100644 --- a/doc/CrtErrHdlr.3 +++ b/doc/CrtErrHdlr.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateErrorHandler 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtGenHdlr.3 b/doc/CrtGenHdlr.3 index 671d105..1d6f3d5 100644 --- a/doc/CrtGenHdlr.3 +++ b/doc/CrtGenHdlr.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateGenericHandler 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtImgType.3 b/doc/CrtImgType.3 index ac8c9bb..250f537 100644 --- a/doc/CrtImgType.3 +++ b/doc/CrtImgType.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateImageType 3 8.5 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtItemType.3 b/doc/CrtItemType.3 index 005d2e2..f9198f3 100644 --- a/doc/CrtItemType.3 +++ b/doc/CrtItemType.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateItemType 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/CrtPhImgFmt.3 b/doc/CrtPhImgFmt.3 index c7e792a..92f2441 100644 --- a/doc/CrtPhImgFmt.3 +++ b/doc/CrtPhImgFmt.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" '\" Author: Paul Mackerras (paulus@cs.anu.edu.au), '\" Department of Computer Science, '\" Australian National University. diff --git a/doc/DeleteImg.3 b/doc/DeleteImg.3 index 507be72..eb6db1e 100644 --- a/doc/DeleteImg.3 +++ b/doc/DeleteImg.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_DeleteImage 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/DrawFocHlt.3 b/doc/DrawFocHlt.3 index e2d1578..59cd069 100644 --- a/doc/DrawFocHlt.3 +++ b/doc/DrawFocHlt.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_DrawFocusHighlight 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/EventHndlr.3 b/doc/EventHndlr.3 index d06de86..a2cbf8d 100644 --- a/doc/EventHndlr.3 +++ b/doc/EventHndlr.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_CreateEventHandler 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/FreeXId.3 b/doc/FreeXId.3 index dd1d141..56c7804 100644 --- a/doc/FreeXId.3 +++ b/doc/FreeXId.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_FreeXId 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GeomReq.3 b/doc/GeomReq.3 index 895f683..7670521 100644 --- a/doc/GeomReq.3 +++ b/doc/GeomReq.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GeometryRequest 3 "8.4" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetAnchor.3 b/doc/GetAnchor.3 index 6526772..5d41ad6 100644 --- a/doc/GetAnchor.3 +++ b/doc/GetAnchor.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetAnchorFromObj 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetBitmap.3 b/doc/GetBitmap.3 index c4ac44e..88418c7 100644 --- a/doc/GetBitmap.3 +++ b/doc/GetBitmap.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_AllocBitmapFromObj 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetCapStyl.3 b/doc/GetCapStyl.3 index 28f1a1c..4e5d1d5 100644 --- a/doc/GetCapStyl.3 +++ b/doc/GetCapStyl.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetCapStyle 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetClrmap.3 b/doc/GetClrmap.3 index 9e6da12..4b72b6c 100644 --- a/doc/GetClrmap.3 +++ b/doc/GetClrmap.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetColormap 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetDash.3 b/doc/GetDash.3 index d1eeb70..2087424 100644 --- a/doc/GetDash.3 +++ b/doc/GetDash.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetDash 3 8.3 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetGC.3 b/doc/GetGC.3 index 44e06fb..6ee63a9 100644 --- a/doc/GetGC.3 +++ b/doc/GetGC.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetGC 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetHINSTANCE.3 b/doc/GetHINSTANCE.3 index de38051..980b374 100644 --- a/doc/GetHINSTANCE.3 +++ b/doc/GetHINSTANCE.3 @@ -1,7 +1,7 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" .TH Tk_GetHISTANCE 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetHWND.3 b/doc/GetHWND.3 index 1a5ec2d..15d2ff0 100644 --- a/doc/GetHWND.3 +++ b/doc/GetHWND.3 @@ -1,7 +1,7 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" .TH HWND 3 8.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetImage.3 b/doc/GetImage.3 index f2407bc..744f9ac 100644 --- a/doc/GetImage.3 +++ b/doc/GetImage.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetImage 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetJoinStl.3 b/doc/GetJoinStl.3 index a717b72..616719c 100644 --- a/doc/GetJoinStl.3 +++ b/doc/GetJoinStl.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetJoinStyle 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetJustify.3 b/doc/GetJustify.3 index b51cb8d..2e871cb 100644 --- a/doc/GetJustify.3 +++ b/doc/GetJustify.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetJustifyFromObj 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetOption.3 b/doc/GetOption.3 index 81846ad..799786d 100644 --- a/doc/GetOption.3 +++ b/doc/GetOption.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetOption 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetPixels.3 b/doc/GetPixels.3 index e7a9043..6c31af9 100644 --- a/doc/GetPixels.3 +++ b/doc/GetPixels.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetPixelsFromObj 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetPixmap.3 b/doc/GetPixmap.3 index 927c75c..65fae2d 100644 --- a/doc/GetPixmap.3 +++ b/doc/GetPixmap.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetPixmap 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetRelief.3 b/doc/GetRelief.3 index 6e8681a..5979662 100644 --- a/doc/GetRelief.3 +++ b/doc/GetRelief.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetReliefFromObj 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetRootCrd.3 b/doc/GetRootCrd.3 index a9d2cd9..20520ea 100644 --- a/doc/GetRootCrd.3 +++ b/doc/GetRootCrd.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetRootCoords 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetScroll.3 b/doc/GetScroll.3 index 2615301..43aaa48 100644 --- a/doc/GetScroll.3 +++ b/doc/GetScroll.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetScrollInfo 3 8.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetSelect.3 b/doc/GetSelect.3 index 8c30a2b..11e837e 100644 --- a/doc/GetSelect.3 +++ b/doc/GetSelect.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetSelection 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetUid.3 b/doc/GetUid.3 index 06b466a..2cd95ad 100644 --- a/doc/GetUid.3 +++ b/doc/GetUid.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetUid 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetVRoot.3 b/doc/GetVRoot.3 index a65ef78..7e6003a 100644 --- a/doc/GetVRoot.3 +++ b/doc/GetVRoot.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetVRootGeometry 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/GetVisual.3 b/doc/GetVisual.3 index fe3d50c..fc6b6f8 100644 --- a/doc/GetVisual.3 +++ b/doc/GetVisual.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_GetVisual 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS @@ -1,7 +1,7 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" .TH Tk_Grab 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/HWNDToWindow.3 b/doc/HWNDToWindow.3 index 9795099..a2e5a6c 100644 --- a/doc/HWNDToWindow.3 +++ b/doc/HWNDToWindow.3 @@ -1,7 +1,7 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" .TH Tk_HWNDToWindow 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/HandleEvent.3 b/doc/HandleEvent.3 index 38b5660..af3fde6 100644 --- a/doc/HandleEvent.3 +++ b/doc/HandleEvent.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_HandleEvent 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/IdToWindow.3 b/doc/IdToWindow.3 index f6e397d..f8ce1f9 100644 --- a/doc/IdToWindow.3 +++ b/doc/IdToWindow.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_IdToWindow 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/ImgChanged.3 b/doc/ImgChanged.3 index 6d8ae91..69ba43c 100644 --- a/doc/ImgChanged.3 +++ b/doc/ImgChanged.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_ImageChanged 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/Inactive.3 b/doc/Inactive.3 index 0d2a1b7..42ae5b8 100644 --- a/doc/Inactive.3 +++ b/doc/Inactive.3 @@ -1,7 +1,7 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" .TH Tk_GetUserInactiveTime 3 8.5 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/InternAtom.3 b/doc/InternAtom.3 index a16eee1..e6756a5 100644 --- a/doc/InternAtom.3 +++ b/doc/InternAtom.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_InternAtom 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/MainLoop.3 b/doc/MainLoop.3 index ed4d0ea..770f254 100644 --- a/doc/MainLoop.3 +++ b/doc/MainLoop.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_MainLoop 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/MainWin.3 b/doc/MainWin.3 index c3af3e7..94bd7e2 100644 --- a/doc/MainWin.3 +++ b/doc/MainWin.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_MainWindow 3 7.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/MaintGeom.3 b/doc/MaintGeom.3 index a509b0b..d6418b5 100644 --- a/doc/MaintGeom.3 +++ b/doc/MaintGeom.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_MaintainGeometry 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/ManageGeom.3 b/doc/ManageGeom.3 index fd2fac9..4d7ac53 100644 --- a/doc/ManageGeom.3 +++ b/doc/ManageGeom.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_ManageGeometry 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/MoveToplev.3 b/doc/MoveToplev.3 index 00bbaa5..f67627f 100644 --- a/doc/MoveToplev.3 +++ b/doc/MoveToplev.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_MoveToplevelWindow 3 "" Tk "Tk Library Procedures" .so man.macros .BS @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_Name 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/OwnSelect.3 b/doc/OwnSelect.3 index ed9bcab..0e16eac 100644 --- a/doc/OwnSelect.3 +++ b/doc/OwnSelect.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_OwnSelection 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/ParseArgv.3 b/doc/ParseArgv.3 index 7749d92..4d85d15 100644 --- a/doc/ParseArgv.3 +++ b/doc/ParseArgv.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_ParseArgv 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/QWinEvent.3 b/doc/QWinEvent.3 index caa5026..9c43ce5 100644 --- a/doc/QWinEvent.3 +++ b/doc/QWinEvent.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_QueueWindowEvent 3 7.5 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/Restack.3 b/doc/Restack.3 index 2b9097f..5cd02eb 100644 --- a/doc/Restack.3 +++ b/doc/Restack.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_RestackWindow 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/RestrictEv.3 b/doc/RestrictEv.3 index 22014a7..8b3af07 100644 --- a/doc/RestrictEv.3 +++ b/doc/RestrictEv.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_RestrictEvents 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetAppName.3 b/doc/SetAppName.3 index 3978850..91516a0 100644 --- a/doc/SetAppName.3 +++ b/doc/SetAppName.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetAppName 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetCaret.3 b/doc/SetCaret.3 index fd63f18..24cc18c 100644 --- a/doc/SetCaret.3 +++ b/doc/SetCaret.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetCaretPos 3 8.4 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetClass.3 b/doc/SetClass.3 index 707975d..0ea81bb 100644 --- a/doc/SetClass.3 +++ b/doc/SetClass.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetClass 3 "" Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetClassProcs.3 b/doc/SetClassProcs.3 index 99eb81c..389d21b 100644 --- a/doc/SetClassProcs.3 +++ b/doc/SetClassProcs.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetClassProcs 3 8.4 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetGrid.3 b/doc/SetGrid.3 index 28e428b..ea32afb 100644 --- a/doc/SetGrid.3 +++ b/doc/SetGrid.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetGrid 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetOptions.3 b/doc/SetOptions.3 index 2a37de7..a35522f 100644 --- a/doc/SetOptions.3 +++ b/doc/SetOptions.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetOptions 3 8.1 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/SetVisual.3 b/doc/SetVisual.3 index 6d3fd83..a5b9efd 100644 --- a/doc/SetVisual.3 +++ b/doc/SetVisual.3 @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_SetWindowVisual 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/StrictMotif.3 b/doc/StrictMotif.3 index 4319d53..ec9319f 100644 --- a/doc/StrictMotif.3 +++ b/doc/StrictMotif.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_StrictMotif 3 4.0 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/TkInitStubs.3 b/doc/TkInitStubs.3 index 04f5611..57ec9e6 100644 --- a/doc/TkInitStubs.3 +++ b/doc/TkInitStubs.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_InitStubs 3 8.4 Tk "Tk Library Procedures" .so man.macros .BS diff --git a/doc/Tk_Init.3 b/doc/Tk_Init.3 index 7bc46dd..fc29318 100644 --- a/doc/Tk_Init.3 +++ b/doc/Tk_Init.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tk_Init 3 8.0 Tk "Tk Library Procedures" .so man.macros .BS @@ -5,7 +5,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH bell n 8.4 Tk "Tk Built-In Commands" .so man.macros .BS @@ -54,12 +54,12 @@ tags provide the following behavior: If a tag is the name of an internal window the binding applies to that window. .IP \(bu 3 +If the tag is the name of a class of widgets, such as \fBButton\fR, +the binding applies to all widgets in that class. +.IP \(bu 3 If the tag is the name of a toplevel window the binding applies to the toplevel window and all its internal windows. .IP \(bu 3 -If the tag is the name of a class of widgets, such as \fBButton\fR, -the binding applies to all widgets in that class; -.IP \(bu 3 If \fItag\fR has the value \fBall\fR, the binding applies to all windows in the application. .SH "EVENT PATTERNS" diff --git a/doc/bindtags.n b/doc/bindtags.n index dc3973b..51c2ca9 100644 --- a/doc/bindtags.n +++ b/doc/bindtags.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH bindtags n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/bitmap.n b/doc/bitmap.n index ead3311..1751913 100644 --- a/doc/bitmap.n +++ b/doc/bitmap.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH bitmap n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/chooseColor.n b/doc/chooseColor.n index 015b17d..3fa6de3 100644 --- a/doc/chooseColor.n +++ b/doc/chooseColor.n @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_chooseColor n 4.2 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/console.n b/doc/console.n index 86dbd46..40b7426 100644 --- a/doc/console.n +++ b/doc/console.n @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH console n 8.4 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/cursors.n b/doc/cursors.n index 1662de4..a728755 100644 --- a/doc/cursors.n +++ b/doc/cursors.n @@ -1,9 +1,9 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" '\" Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net> -'\" +'\" .TH cursors n 8.3 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/destroy.n b/doc/destroy.n index 3d4743a..b10c679 100644 --- a/doc/destroy.n +++ b/doc/destroy.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH destroy n "" Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/dialog.n b/doc/dialog.n index d2031d3..e4938d2 100644 --- a/doc/dialog.n +++ b/doc/dialog.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_dialog n 4.1 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/entry.n b/doc/entry.n index dc2f896..713929b 100644 --- a/doc/entry.n +++ b/doc/entry.n @@ -5,7 +5,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH entry n 8.3 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/event.n b/doc/event.n index 9ab48e5..afb5e4c 100644 --- a/doc/event.n +++ b/doc/event.n @@ -343,6 +343,15 @@ This is sent to all widgets when the ttk theme changed. The ttk widgets listen to this event and redisplay themselves when it fires. The legacy widgets ignore this event. .TP +\fB<<TkWorldChanged>>\fR +. +This event is sent to all widgets when a font is changed, for example, +by the use of [font configure]. The user_data field (%d) will have the +value "FontChanged". For other system wide changes, this event will +be sent to all widgets, and the user_data field will indicate the +cause of the change. NOTE: all tk and ttk widgets already handle this +event internally. +.TP \fB<<TraverseIn>>\fR This is sent to a widget when the focus enters the widget because of a user-driven diff --git a/doc/focus.n b/doc/focus.n index 4b8bb2a..e3efcd3 100644 --- a/doc/focus.n +++ b/doc/focus.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH focus n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/focusNext.n b/doc/focusNext.n index ffcf971..3283d4b 100644 --- a/doc/focusNext.n +++ b/doc/focusNext.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_focusNext n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/fontchooser.n b/doc/fontchooser.n index bdd51c7..65aa8e7 100644 --- a/doc/fontchooser.n +++ b/doc/fontchooser.n @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH fontchooser n "" Tk "Tk Built-In Commands" .so man.macros .BS @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH grab n "" Tk "Tk Built-In Commands" .so man.macros .BS @@ -296,7 +296,7 @@ to be returned. .TP \fBgrid content \fIwindow\fR ?\fI\-option value\fR? . -Synonym for . \fBgrid slaves \fIwindow\fR ?\fI\-option value\fR? +Synonym for \fBgrid slaves \fIwindow\fR ?\fI\-option value\fR?. .VE "TIP 581" .SH "RELATIVE PLACEMENT" .PP diff --git a/doc/image.n b/doc/image.n index fd51cc0..70f5acf 100644 --- a/doc/image.n +++ b/doc/image.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH image n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/label.n b/doc/label.n index f2ba88c..107175e 100644 --- a/doc/label.n +++ b/doc/label.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH label n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/lower.n b/doc/lower.n index 8159a8b..d0b0551 100644 --- a/doc/lower.n +++ b/doc/lower.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH lower n 3.3 Tk "Tk Built-In Commands" .so man.macros .BS @@ -267,7 +267,7 @@ toplevels are automatically appended after all the Tk-defined items and a separator. The Window menu on the Mac also allows toggling the window into a fullscreen state, and managing a tabbed window interface (multiple windows grouped into a single window) if supported by that -version of the operating system. +version of the operating system. .PP When Tk sees a .menubar.help menu on the Macintosh, the menu's contents are appended to the standard Help menu of the user's menubar whenever diff --git a/doc/menubar.n b/doc/menubar.n index 023bf37..c3be85d 100644 --- a/doc/menubar.n +++ b/doc/menubar.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_menuBar n "" Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/menubutton.n b/doc/menubutton.n index 08b52a0..1f596ce 100644 --- a/doc/menubutton.n +++ b/doc/menubutton.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH menubutton n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/message.n b/doc/message.n index bd635ac..280c072 100644 --- a/doc/message.n +++ b/doc/message.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH message n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/option.n b/doc/option.n index 2763d64..6042010 100644 --- a/doc/option.n +++ b/doc/option.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH option n "" Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/optionMenu.n b/doc/optionMenu.n index 42275ce..eff6e86 100644 --- a/doc/optionMenu.n +++ b/doc/optionMenu.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_optionMenu n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/pack-old.n b/doc/pack-old.n index 217dba9..5ef5da1 100644 --- a/doc/pack-old.n +++ b/doc/pack-old.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH pack-old n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS @@ -159,7 +159,7 @@ If \fIwindow\fR has no content then an empty string is returned. .TP \fBpack content \fIwindow\fR . -Synonym for . \fBpack slaves \fIwindow\fR +Synonym for \fBpack slaves \fIwindow\fR. .VE "TIP 581" .SH "THE PACKER ALGORITHM" .PP diff --git a/doc/palette.n b/doc/palette.n index 085c4c6..6a04450 100644 --- a/doc/palette.n +++ b/doc/palette.n @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_setPalette n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/photo.n b/doc/photo.n index 0fe0c61..84cf618 100644 --- a/doc/photo.n +++ b/doc/photo.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" '\" Author: Paul Mackerras (paulus@cs.anu.edu.au), '\" Department of Computer Science, '\" Australian National University. diff --git a/doc/place.n b/doc/place.n index 6a30c55..c86579c 100644 --- a/doc/place.n +++ b/doc/place.n @@ -198,7 +198,7 @@ If there is no content for \fIwindow\fR then an empty string is returned. .TP \fBplace content \fIwindow\fR . -Synonym for . \fBplace slaves \fIwindow\fR +Synonym for \fBplace slaves \fIwindow\fR. .VE "TIP 581" .PP If the configuration of a window has been retrieved with diff --git a/doc/popup.n b/doc/popup.n index 0d32362..6e6fd95 100644 --- a/doc/popup.n +++ b/doc/popup.n @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk_popup n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/raise.n b/doc/raise.n index c8feb71..7741001 100644 --- a/doc/raise.n +++ b/doc/raise.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH raise n 3.3 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/scale.n b/doc/scale.n index b1f1981..d6407a0 100644 --- a/doc/scale.n +++ b/doc/scale.n @@ -78,7 +78,7 @@ specified by the \fB\-activebackground\fR option. .OP \-tickinterval tickInterval TickInterval Must be a real value. Determines the spacing between numerical -tick marks displayed below or to the left of the slider. The values will all be displayed with the same number of decimal places, which will be enough to ensure they are all accurate to within 20% of a tick interval. +tick marks displayed below or to the left of the slider. The values will all be displayed with the same number of decimal places, which will be enough to ensure they are all accurate to within 20% of a tick interval. If 0, no tick marks will be displayed. .OP \-to to To Specifies a real value corresponding diff --git a/doc/scrollbar.n b/doc/scrollbar.n index 4d148af..4b1d4ba 100644 --- a/doc/scrollbar.n +++ b/doc/scrollbar.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH scrollbar n 4.1 Tk "Tk Built-In Commands" .so man.macros .BS @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH send n 4.0 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/spinbox.n b/doc/spinbox.n index ad7123b..a2e7d05 100644 --- a/doc/spinbox.n +++ b/doc/spinbox.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH spinbox n 8.4 Tk "Tk Built-In Commands" .so man.macros .BS @@ -2031,7 +2031,7 @@ In the descriptions below, is dependent on the value of the \fBtcl_wordchars\fR variable. See \fBtclvars\fR(n). .IP [1] -Clicking mouse button 1 positions the insertion cursor just before the +Clicking mouse button 1 positions the insertion cursor at the closest edge of the character underneath the mouse cursor, sets the input focus to this widget, and clears any selection in the widget. Dragging with mouse button 1 strokes out a selection between the insertion cursor and the character under the @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk n 8.4 Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/tk_mac.n b/doc/tk_mac.n index f42fa66..2ce1374 100644 --- a/doc/tk_mac.n +++ b/doc/tk_mac.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tk::mac n 8.6 Tk "Tk Built-In Commands" .so man.macros .BS @@ -48,10 +48,10 @@ the command is absent, no action will be taken. .TP \fB::tk::mac::DoScriptFile\fR . -The default Apple Event handler for AEDoScriptHandler. This command +The default Apple Event handler for AEDoScriptHandler. This command executes a Tcl file when an AppleScript sends a .QW "do script" -command to Wish with a file path as a parameter. +command to Wish with a file path as a parameter. .TP \fB::tk::mac::DoScriptText\fR . @@ -131,7 +131,7 @@ If a proc of this name is defined it is the default Apple Event handler for kAEPrintDocuments, .QW pdoc , the Apple Event sent when your application is asked to print a -document. It takes a single absolute file path as an argument. +document. It takes a single absolute file path as an argument. .TP \fB::tk::mac::Quit\fR . @@ -165,15 +165,15 @@ set). .TP \fB::tk::mac::PerformService\fR . -Executes a Tcl procedure called from the macOS -.QW Services +Executes a Tcl procedure called from the macOS +.QW Services menu in the Application menu item. The .QW Services menu item allows for inter-application communication; data from one application, such as selected text, can be sent to another application for processing, for example to Safari as a search item for Google, or to TextEdit to be appended to a file. An example of the proc is below, -and should be rewritten in an application script for customization: +and should be rewritten in an application script for customization: .RS .PP .CS @@ -184,7 +184,7 @@ proc ::tk::mac::PerformService {} { .CE .RE Note that the mechanism for retrieving the data is from the clipboard; -there is no other supported way to obtain the data. If the Services +there is no other supported way to obtain the data. If the Services process is not desired, the NSServices keys can be deleted from the application's Info.plist file. The underlying code supporting this command also allows the text, entry and ttk::entry widgets to access @@ -203,7 +203,7 @@ URL, although it can defined as such. Wish includes a stub URL scheme of .QW foo:// in the CFBundleURLSchemes key of its Info.plist file; this should be customized for the specific URL -scheme the developer wants to support. +scheme the developer wants to support. .TP \fB::tk::mac::GetAppPath\fR . diff --git a/doc/tkvars.n b/doc/tkvars.n index a80fd54..5ffa40a 100644 --- a/doc/tkvars.n +++ b/doc/tkvars.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tkvars n 4.1 Tk "Tk Built-In Commands" .so man.macros .BS @@ -26,7 +26,7 @@ plus other files containing procedures that implement default behaviors for widgets. .RS .PP -The initial value of \fBtcl_library\fR is set when Tk is added to +The initial value of \fBtk_library\fR is set when Tk is added to an interpreter; this is done by searching several different directories until one is found that contains an appropriate Tk startup script. If the \fBTK_LIBRARY\fR environment variable exists, then diff --git a/doc/tkwait.n b/doc/tkwait.n index a31aee7..82d51ba 100644 --- a/doc/tkwait.n +++ b/doc/tkwait.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH tkwait n "" Tk "Tk Built-In Commands" .so man.macros .BS diff --git a/doc/ttk_Theme.3 b/doc/ttk_Theme.3 index 8031b8a..a42dd38 100644 --- a/doc/ttk_Theme.3 +++ b/doc/ttk_Theme.3 @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Ttk_CreateTheme 3 8.5 Tk "Tk Themed Widget" .so man.macros .BS diff --git a/doc/ttk_scale.n b/doc/ttk_scale.n index aa851b9..32686a6 100644 --- a/doc/ttk_scale.n +++ b/doc/ttk_scale.n @@ -99,7 +99,7 @@ The class name for a \fBttk::scale\fP is \fBTScale\fP. .PP Dynamic states: \fBactive\fP. .PP -\fBTProgressbar\fP styling options configurable with \fBttk::style\fP +\fBTScale\fP styling options configurable with \fBttk::style\fP are: .PP \fB\-background\fP \fIcolor\fP diff --git a/doc/ttk_style.n b/doc/ttk_style.n index 0de3311..5d7b5d1 100644 --- a/doc/ttk_style.n +++ b/doc/ttk_style.n @@ -134,7 +134,7 @@ as \fB\-expand\fR 1). \fB\-sticky\fR \fB[\fInswe\fB]\fR Specifies the actual parcel position and size inside the allocated parcel. If specified as an empty string then the actual parcel is centered in -the allocated parcel. Default is \fBnswe\fR. +the allocated parcel. Default is \fBnswe\fR. .\" -unit should remain undocumented for now (dubious usefulness) .\" .TP .\" \fB\-unit\fR \fIboolean\fR diff --git a/doc/ttk_widget.n b/doc/ttk_widget.n index 82a1520..9b34259 100644 --- a/doc/ttk_widget.n +++ b/doc/ttk_widget.n @@ -77,7 +77,7 @@ in the case both \fB\-text\fR and \fB\-image\fR are present. If set to the empty string (the default), the rules described in the "Elements" section of \fIttk::intro(n)\fR explain which value is actually used. -Valid values are: +The other valid values are: .RS .IP text Display text only. diff --git a/doc/winfo.n b/doc/winfo.n index a833e31..fed5c39 100644 --- a/doc/winfo.n +++ b/doc/winfo.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH winfo n 4.3 Tk "Tk Built-In Commands" .so man.macros .BS @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH wish 1 8.0 Tk "Tk Applications" .so man.macros .BS @@ -77,7 +77,7 @@ If there exists a file in the home directory of the user, \fBwish\fR evaluates the file as a Tcl script just before reading the first command from standard input. .PP -If arguments to \fBwish\fR do specify a \fIfileName\fR, then +If arguments to \fBwish\fR do specify a \fIfileName\fR, then \fIfileName\fR is treated as the name of a script file. \fBWish\fR will evaluate the script in \fIfileName\fR (which presumably creates a user interface), then it will respond to events @@ -120,7 +120,7 @@ color with some alpha, e.g. .PP On X11, the following attributes may be set. These are not supported by all window managers, and will have no effect under older WMs. -.\" See http://www.freedesktop.org/Standards/wm-spec +.\" See https://www.freedesktop.org/wiki/Specifications/wm-spec/ .TP \fB\-type\fR .VS 8.6 @@ -494,7 +494,7 @@ other contexts. At the script level the command will accept only the first image passed in the parameters as support for multiple sizes/resolutions on macOS is outside Tk's scope. Developers should use the largest icon they can support -(preferably 512 pixels) to ensure smooth rendering on the Mac. +(preferably 512 pixels) to ensure smooth rendering on the Mac. .RE .TP \fBwm iconposition \fIwindow\fR ?\fIx y\fR? diff --git a/generic/tk.h b/generic/tk.h index af8e5ca..d3c2466 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -75,10 +75,10 @@ extern "C" { #define TK_MAJOR_VERSION 8 #define TK_MINOR_VERSION 6 #define TK_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TK_RELEASE_SERIAL 11 +#define TK_RELEASE_SERIAL 12 #define TK_VERSION "8.6" -#define TK_PATCH_LEVEL "8.6.11" +#define TK_PATCH_LEVEL "8.6.12" /* * A special definition used to allow this header file to be included from @@ -93,6 +93,9 @@ extern "C" { #ifndef RC_INVOKED #if !defined(_XLIB_H) && !defined(_X11_XLIB_H_) +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif # include <X11/Xlib.h> # ifdef MAC_OSX_TK # include <X11/X.h> diff --git a/generic/tkArgv.c b/generic/tkArgv.c index 6c2c5c5..8fe8514 100644 --- a/generic/tkArgv.c +++ b/generic/tkArgv.c @@ -67,12 +67,12 @@ Tk_ParseArgv( int flags) /* Or'ed combination of various flag bits, * such as TK_ARGV_NO_DEFAULTS. */ { - register const Tk_ArgvInfo *infoPtr; + const Tk_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ const Tk_ArgvInfo *matchPtr;/* Descriptor that matches current argument. */ const char *curArg; /* Current argument */ - register char c; /* Second character of current arg (used for + char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ @@ -338,7 +338,7 @@ PrintUsage( * this word, then don't generate information * for default options. */ { - register const Tk_ArgvInfo *infoPtr; + const Tk_ArgvInfo *infoPtr; size_t width, i, numSpaces; Tcl_Obj *message; diff --git a/generic/tkAtom.c b/generic/tkAtom.c index 2491fb2..475f9d2 100644 --- a/generic/tkAtom.c +++ b/generic/tkAtom.c @@ -154,11 +154,11 @@ Tk_GetAtomName( if (mustFree) { XFree(mustFree); } - name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr); + name = (const char *)Tcl_GetHashKey(&dispPtr->nameTable, hPtr); hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew); Tcl_SetHashValue(hPtr, name); } - return Tcl_GetHashValue(hPtr); + return (const char *)Tcl_GetHashValue(hPtr); } /* @@ -200,7 +200,7 @@ AtomInit( name = atomNameArray[atom - 1]; hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew); Tcl_SetHashValue(hPtr, INT2PTR(atom)); - name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr); + name = (const char *)Tcl_GetHashKey(&dispPtr->nameTable, hPtr); hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew); Tcl_SetHashValue(hPtr, name); } diff --git a/generic/tkBind.c b/generic/tkBind.c index ad59299..7873d29 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -793,6 +793,7 @@ static Time CurrentTimeInMilliSecs(void) { Tcl_Time now; + Tcl_GetTime(&now); return ((Time) now.sec)*1000 + ((Time) now.usec)/1000; } @@ -946,6 +947,7 @@ FreePatSeqEntry( PSEntry *entry) { PSEntry *next = PSList_Next(entry); + PSModMaskArr_Free(&entry->lastModMaskArr); ckfree(entry); return next; @@ -1621,7 +1623,7 @@ Tk_CreateBinding( ClientData object, /* Token for object with which binding is associated. */ const char *eventString, /* String describing event sequence that triggers binding. */ const char *script, /* Contains Tcl script to execute when binding triggers. */ - int append) /* 0 means replace any existing binding for eventString; + int append) /* 0 means replace any existing binding for eventString; * 1 means append to that binding. If the existing binding is * for a callback function and not a Tcl command string, the * existing binding will always be replaced. */ @@ -4490,13 +4492,13 @@ NameToWindow( * * DoWarp -- * - * Perform Warping of X pointer. Executed as an idle handler only. + * Perform warping of mouse pointer. Executed as an idle handler only. * * Results: * None * * Side effects: - * X Pointer will move to a new location. + * Mouse pointer moves to a new location. * *------------------------------------------------------------------------- */ @@ -4505,7 +4507,7 @@ static void DoWarp( ClientData clientData) { - TkDisplay *dispPtr = clientData; + TkDisplay *dispPtr = (TkDisplay *)clientData; assert(clientData); @@ -4610,7 +4612,7 @@ FindSequence( * associated. For virtual event table, NULL. */ const char *eventString, /* String description of pattern to match on. See user * documentation for details. */ - int create, /* 0 means don't create the entry if it doesn't already exist. + int create, /* 0 means don't create the entry if it doesn't already exist. * 1 means create. */ int allowVirtual, /* 0 means that virtual events are not allowed in the sequence. * 1 otherwise. */ diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index 54bab69..ccc97a4 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -167,7 +167,7 @@ Tk_AllocBitmapFromObj( if (objPtr->typePtr != &tkBitmapObjType) { InitBitmapObj(objPtr); } - bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1; + bitmapPtr = (TkBitmap *)objPtr->internalRep.twoPtrValue.ptr1; /* * If the object currently points to a TkBitmap, see if it's the one we @@ -197,7 +197,7 @@ Tk_AllocBitmapFromObj( */ if (bitmapPtr != NULL) { - TkBitmap *firstBitmapPtr = Tcl_GetHashValue(bitmapPtr->nameHashPtr); + TkBitmap *firstBitmapPtr = (TkBitmap *)Tcl_GetHashValue(bitmapPtr->nameHashPtr); FreeBitmapObj(objPtr); for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL; @@ -307,7 +307,7 @@ GetBitmap( Pixmap bitmap; int isNew, width = 0, height = 0, dummy2; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!dispPtr->bitmapInit) { @@ -317,7 +317,7 @@ GetBitmap( nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &isNew); if (!isNew) { - existingBitmapPtr = Tcl_GetHashValue(nameHashPtr); + existingBitmapPtr = (TkBitmap *)Tcl_GetHashValue(nameHashPtr); for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { if ((Tk_Display(tkwin) == bitmapPtr->display) && @@ -395,7 +395,7 @@ GetBitmap( goto error; } } else { - predefPtr = Tcl_GetHashValue(predefHashPtr); + predefPtr = (TkPredefBitmap *)Tcl_GetHashValue(predefHashPtr); width = predefPtr->width; height = predefPtr->height; if (predefPtr->native) { @@ -407,7 +407,7 @@ GetBitmap( } else { bitmap = XCreateBitmapFromData(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), - predefPtr->source, (unsigned)width, (unsigned)height); + (const char *)predefPtr->source, (unsigned)width, (unsigned)height); } } } @@ -416,7 +416,7 @@ GetBitmap( * Add information about this bitmap to our database. */ - bitmapPtr = ckalloc(sizeof(TkBitmap)); + bitmapPtr = (TkBitmap *)ckalloc(sizeof(TkBitmap)); bitmapPtr->bitmap = bitmap; bitmapPtr->width = width; bitmapPtr->height = height; @@ -474,7 +474,7 @@ Tk_DefineBitmap( int isNew; Tcl_HashEntry *predefHashPtr; TkPredefBitmap *predefPtr; - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -497,7 +497,7 @@ Tk_DefineBitmap( Tcl_SetErrorCode(interp, "TK", "BITMAP", "EXISTS", NULL); return TCL_ERROR; } - predefPtr = ckalloc(sizeof(TkPredefBitmap)); + predefPtr = (TkPredefBitmap *)ckalloc(sizeof(TkPredefBitmap)); predefPtr->source = source; predefPtr->width = width; predefPtr->height = height; @@ -540,7 +540,7 @@ Tk_NameOfBitmap( if (idHashPtr == NULL) { goto unknown; } - bitmapPtr = Tcl_GetHashValue(idHashPtr); + bitmapPtr = (TkBitmap *)Tcl_GetHashValue(idHashPtr); return bitmapPtr->nameHashPtr->key.string; } @@ -582,7 +582,7 @@ Tk_SizeOfBitmap( if (idHashPtr == NULL) { goto unknownBitmap; } - bitmapPtr = Tcl_GetHashValue(idHashPtr); + bitmapPtr = (TkBitmap *)Tcl_GetHashValue(idHashPtr); *widthPtr = bitmapPtr->width; *heightPtr = bitmapPtr->height; } @@ -612,14 +612,13 @@ FreeBitmap( { TkBitmap *prevPtr; - bitmapPtr->resourceRefCount--; - if (bitmapPtr->resourceRefCount > 0) { + if (bitmapPtr->resourceRefCount-- > 1) { return; } Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap); Tcl_DeleteHashEntry(bitmapPtr->idHashPtr); - prevPtr = Tcl_GetHashValue(bitmapPtr->nameHashPtr); + prevPtr = (TkBitmap *)Tcl_GetHashValue(bitmapPtr->nameHashPtr); if (prevPtr == bitmapPtr) { if (bitmapPtr->nextPtr == NULL) { Tcl_DeleteHashEntry(bitmapPtr->nameHashPtr); @@ -671,7 +670,7 @@ Tk_FreeBitmap( if (idHashPtr == NULL) { Tcl_Panic("Tk_FreeBitmap received unknown bitmap argument"); } - FreeBitmap(Tcl_GetHashValue(idHashPtr)); + FreeBitmap((TkBitmap *)Tcl_GetHashValue(idHashPtr)); } /* @@ -735,7 +734,7 @@ static void FreeBitmapObj( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkBitmap *bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1; + TkBitmap *bitmapPtr = (TkBitmap *)objPtr->internalRep.twoPtrValue.ptr1; if (bitmapPtr != NULL) { bitmapPtr->objRefCount--; @@ -770,7 +769,7 @@ DupBitmapObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkBitmap *bitmapPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; + TkBitmap *bitmapPtr = (TkBitmap *)srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; dupObjPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr; @@ -806,7 +805,6 @@ DupBitmapObjProc( *---------------------------------------------------------------------- */ - /* ARGSUSED */ Pixmap Tk_GetBitmapFromData( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ @@ -820,20 +818,20 @@ Tk_GetBitmapFromData( char string[16 + TCL_INTEGER_SPACE]; char *name; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { BitmapInit(dispPtr); } - nameKey.source = source; + nameKey.source = (const char *)source; nameKey.width = width; nameKey.height = height; dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable, (char *) &nameKey, &isNew); if (!isNew) { - name = Tcl_GetHashValue(dataHashPtr); + name = (char *)Tcl_GetHashValue(dataHashPtr); } else { dispPtr->bitmapAutoNumber++; sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber); @@ -911,7 +909,7 @@ GetBitmapFromObj( InitBitmapObj(objPtr); } - bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1; + bitmapPtr = (TkBitmap *)objPtr->internalRep.twoPtrValue.ptr1; if (bitmapPtr != NULL) { if ((bitmapPtr->resourceRefCount > 0) && (Tk_Display(tkwin) == bitmapPtr->display)) { @@ -932,7 +930,7 @@ GetBitmapFromObj( * more TkBitmap structures. See if any of them will work. */ - for (bitmapPtr = Tcl_GetHashValue(hashPtr); bitmapPtr != NULL; + for (bitmapPtr = (TkBitmap *)Tcl_GetHashValue(hashPtr); bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { if (Tk_Display(tkwin) == bitmapPtr->display) { objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr; @@ -1012,7 +1010,7 @@ BitmapInit( * or NULL if unavailable. */ { Tcl_Interp *dummy; - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1150,7 +1148,7 @@ TkDebugBitmap( resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, name); if (hashPtr != NULL) { - bitmapPtr = Tcl_GetHashValue(hashPtr); + bitmapPtr = (TkBitmap *)Tcl_GetHashValue(hashPtr); if (bitmapPtr == NULL) { Tcl_Panic("TkDebugBitmap found empty hash table entry"); } @@ -1190,7 +1188,7 @@ TkDebugBitmap( Tcl_HashTable * TkGetBitmapPredefTable(void) { - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return &tsdPtr->predefBitmapTable; diff --git a/generic/tkBusy.c b/generic/tkBusy.c index 1e4e91f..6f58c52 100644 --- a/generic/tkBusy.c +++ b/generic/tkBusy.c @@ -340,7 +340,7 @@ DestroyBusy( RefWinEventProc, busyPtr); if (busyPtr->tkBusy != NULL) { - Tk_FreeConfigOptions(data, busyPtr->optionTable, busyPtr->tkBusy); + Tk_FreeConfigOptions((char *)data, busyPtr->optionTable, busyPtr->tkBusy); Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask, BusyEventProc, busyPtr); Tk_ManageGeometry(busyPtr->tkBusy, NULL, busyPtr); diff --git a/generic/tkButton.c b/generic/tkButton.c index 3c15bf6..9e7c87d 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -105,7 +105,7 @@ static const Tk_OptionSpec labelOptionSpecs[] = { {TK_OPTION_FONT, "-font", "font", "Font", DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", - DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0}, + DEF_LABEL_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0}, {TK_OPTION_STRING, "-height", "height", "Height", DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0}, {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", @@ -1036,7 +1036,7 @@ DestroyButton( static int ConfigureButton( Tcl_Interp *interp, /* Used for error reporting. */ - register TkButton *butPtr, /* Information about widget; may or may + TkButton *butPtr, /* Information about widget; may or may * not already have values for some fields. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -1612,7 +1612,7 @@ ButtonVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register TkButton *butPtr = clientData; + TkButton *butPtr = clientData; const char *value; Tcl_Obj *valuePtr; @@ -1817,7 +1817,7 @@ ButtonImageProc( * <= 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkButton *butPtr = clientData; + TkButton *butPtr = clientData; if (butPtr->tkwin != NULL) { TkpComputeButtonGeometry(butPtr); @@ -1855,7 +1855,7 @@ ButtonSelectImageProc( * <= 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkButton *butPtr = clientData; + TkButton *butPtr = clientData; #ifdef MAC_OSX_TK if (butPtr->tkwin != NULL) { @@ -1902,7 +1902,7 @@ ButtonTristateImageProc( * <= 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkButton *butPtr = clientData; + TkButton *butPtr = clientData; #ifdef MAC_OSX_TK if (butPtr->tkwin != NULL) { diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index 1feef73..65af3da 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -332,7 +332,7 @@ Tk_CanvasSetOffset( * redisplaying the canvas. */ Tk_TSOffset *offset) /* Offset (may be NULL pointer)*/ { - register TkCanvas *canvasPtr = Canvas(canvas); + TkCanvas *canvasPtr = Canvas(canvas); int flags = 0; int x = - canvasPtr->drawableXOrigin; int y = - canvasPtr->drawableYOrigin; @@ -406,7 +406,7 @@ Tk_CanvasTagsParseProc( char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item (ignored). */ { - register Tk_Item *itemPtr = (Tk_Item *) widgRec; + Tk_Item *itemPtr = (Tk_Item *) widgRec; int argc, i; const char **argv; Tk_Uid *newPtr; @@ -474,7 +474,7 @@ Tk_CanvasTagsPrintProc( * information about how to reclaim storage * for return string. */ { - register Tk_Item *itemPtr = (Tk_Item *) widgRec; + Tk_Item *itemPtr = (Tk_Item *) widgRec; if (itemPtr->numTags == 0) { *freeProcPtr = NULL; @@ -733,7 +733,7 @@ TkSmoothParseProc( char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item. */ { - register const Tk_SmoothMethod **smoothPtr = + const Tk_SmoothMethod **smoothPtr = (const Tk_SmoothMethod **) (widgRec + offset); const Tk_SmoothMethod *smooth = NULL; int b; @@ -826,7 +826,7 @@ TkSmoothPrintProc( * information about how to reclaim storage * for return string. */ { - register const Tk_SmoothMethod *smoothPtr = + const Tk_SmoothMethod *smoothPtr = * (Tk_SmoothMethod **) (widgRec + offset); return smoothPtr ? smoothPtr->name : "0"; diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index 8bc4237..e800da9 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -134,22 +134,22 @@ ClipboardAppHandler( char *buffer, /* Place to store converted selection. */ int maxBytes) /* Maximum # of bytes to store at buffer. */ { - TkDisplay *dispPtr = clientData; - size_t length; + TkDisplay *dispPtr = (TkDisplay *)clientData; + int length; const char *p; p = dispPtr->clipboardAppPtr->winPtr->nameUid; length = strlen(p); - length -= offset; - if (length <= 0) { + if (length <= offset) { return 0; } - if (length > (size_t) maxBytes) { + length -= offset; + if (length > maxBytes) { length = maxBytes; } memcpy(buffer, p, length); buffer[length] = 0; - return (int)length; + return length; } /* diff --git a/generic/tkColor.c b/generic/tkColor.c index f6650f9..6b6405a 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -128,7 +128,7 @@ Tk_AllocColorFromObj( */ if (tkColPtr != NULL) { - TkColor *firstColorPtr = Tcl_GetHashValue(tkColPtr->hashPtr); + TkColor *firstColorPtr = (TkColor *)Tcl_GetHashValue(tkColPtr->hashPtr); FreeColorObj(objPtr); for (tkColPtr = firstColorPtr; tkColPtr != NULL; @@ -203,7 +203,7 @@ Tk_GetColor( nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &isNew); if (!isNew) { - existingColPtr = Tcl_GetHashValue(nameHashPtr); + existingColPtr = (TkColor *)Tcl_GetHashValue(nameHashPtr); for (tkColPtr = existingColPtr; tkColPtr != NULL; tkColPtr = tkColPtr->nextPtr) { if ((tkColPtr->screen == Tk_Screen(tkwin)) @@ -314,7 +314,7 @@ Tk_GetColorByValue( valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable, (char *) &valueKey, &isNew); if (!isNew) { - tkColPtr = Tcl_GetHashValue(valueHashPtr); + tkColPtr = (TkColor *)Tcl_GetHashValue(valueHashPtr); tkColPtr->resourceRefCount++; return &tkColPtr->color; } @@ -363,12 +363,12 @@ const char * Tk_NameOfColor( XColor *colorPtr) /* Color whose name is desired. */ { - register TkColor *tkColPtr = (TkColor *) colorPtr; + TkColor *tkColPtr = (TkColor *) colorPtr; if (tkColPtr->magic==COLOR_MAGIC && tkColPtr->type==TK_COLOR_BY_NAME) { return tkColPtr->hashPtr->key.string; } else { - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, @@ -480,8 +480,7 @@ Tk_FreeColor( Tcl_Panic("Tk_FreeColor called with bogus color"); } - tkColPtr->resourceRefCount--; - if (tkColPtr->resourceRefCount > 0) { + if (tkColPtr->resourceRefCount-- > 1) { return; } @@ -497,7 +496,7 @@ Tk_FreeColor( } TkpFreeColor(tkColPtr); - prevPtr = Tcl_GetHashValue(tkColPtr->hashPtr); + prevPtr = (TkColor *)Tcl_GetHashValue(tkColPtr->hashPtr); if (prevPtr == tkColPtr) { if (tkColPtr->nextPtr == NULL) { Tcl_DeleteHashEntry(tkColPtr->hashPtr); @@ -584,11 +583,10 @@ static void FreeColorObj( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkColor *tkColPtr = objPtr->internalRep.twoPtrValue.ptr1; + TkColor *tkColPtr = (TkColor *)objPtr->internalRep.twoPtrValue.ptr1; if (tkColPtr != NULL) { - tkColPtr->objRefCount--; - if ((tkColPtr->objRefCount == 0) + if ((tkColPtr->objRefCount-- <= 1) && (tkColPtr->resourceRefCount == 0)) { ckfree(tkColPtr); } @@ -619,7 +617,7 @@ DupColorObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkColor *tkColPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; + TkColor *tkColPtr = (TkColor *)srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; dupObjPtr->internalRep.twoPtrValue.ptr1 = tkColPtr; @@ -669,7 +667,7 @@ Tk_GetColorFromObj( * map. If it is, we are done. */ - tkColPtr = objPtr->internalRep.twoPtrValue.ptr1; + tkColPtr = (TkColor *)objPtr->internalRep.twoPtrValue.ptr1; if ((tkColPtr != NULL) && (tkColPtr->resourceRefCount > 0) && (Tk_Screen(tkwin) == tkColPtr->screen) @@ -695,7 +693,7 @@ Tk_GetColorFromObj( if (hashPtr == NULL) { goto error; } - for (tkColPtr = Tcl_GetHashValue(hashPtr); + for (tkColPtr = (TkColor *)Tcl_GetHashValue(hashPtr); (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { if ((Tk_Screen(tkwin) == tkColPtr->screen) && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { @@ -811,7 +809,7 @@ TkDebugColor( resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name); if (hashPtr != NULL) { - TkColor *tkColPtr = Tcl_GetHashValue(hashPtr); + TkColor *tkColPtr = (TkColor *)Tcl_GetHashValue(hashPtr); if (tkColPtr == NULL) { Tcl_Panic("TkDebugColor found empty hash table entry"); diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 65e28a6..6a0ffd8 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -664,7 +664,7 @@ DoObjConfig( if (internalPtr != NULL) { if (valuePtr != NULL) { value = Tcl_GetStringFromObj(valuePtr, &length); - newStr = ckalloc(length + 1); + newStr = (char *)ckalloc(length + 1); strcpy(newStr, value); } else { newStr = NULL; @@ -1400,7 +1400,7 @@ Tk_RestoreSavedOptions( = savePtr->items[i].valuePtr; } if (specPtr->internalOffset >= 0) { - register char *ptr = (char *) &savePtr->items[i].internalForm; + char *ptr = (char *) &savePtr->items[i].internalForm; CLANG_ASSERT(internalPtr); switch (specPtr->type) { diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 21c713a..902472b 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -100,7 +100,7 @@ Tk_AllocCursorFromObj( if (objPtr->typePtr != &tkCursorObjType) { InitCursorObj(objPtr); } - cursorPtr = objPtr->internalRep.twoPtrValue.ptr1; + cursorPtr = (TkCursor *)objPtr->internalRep.twoPtrValue.ptr1; /* * If the object currently points to a TkCursor, see if it's the one we @@ -129,7 +129,7 @@ Tk_AllocCursorFromObj( */ if (cursorPtr != NULL) { - TkCursor *firstCursorPtr = Tcl_GetHashValue(cursorPtr->hashPtr); + TkCursor *firstCursorPtr = (TkCursor *)Tcl_GetHashValue(cursorPtr->hashPtr); FreeCursorObj(objPtr); for (cursorPtr = firstCursorPtr; cursorPtr != NULL; @@ -229,7 +229,7 @@ TkcGetCursor( * details on legal syntax. */ { Tcl_HashEntry *nameHashPtr; - register TkCursor *cursorPtr; + TkCursor *cursorPtr; TkCursor *existingCursorPtr = NULL; int isNew; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -241,7 +241,7 @@ TkcGetCursor( nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, string, &isNew); if (!isNew) { - existingCursorPtr = Tcl_GetHashValue(nameHashPtr); + existingCursorPtr = (TkCursor *)Tcl_GetHashValue(nameHashPtr); for (cursorPtr = existingCursorPtr; cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { @@ -320,7 +320,7 @@ Tk_GetCursorFromData( { DataKey dataKey; Tcl_HashEntry *dataHashPtr; - register TkCursor *cursorPtr; + TkCursor *cursorPtr; int isNew; XColor fgColor, bgColor; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -341,7 +341,7 @@ Tk_GetCursorFromData( dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, (char *) &dataKey, &isNew); if (!isNew) { - cursorPtr = Tcl_GetHashValue(dataHashPtr); + cursorPtr = (TkCursor *)Tcl_GetHashValue(dataHashPtr); cursorPtr->resourceRefCount++; return cursorPtr->cursor; } @@ -432,7 +432,7 @@ Tk_NameOfCursor( if (idHashPtr == NULL) { goto printid; } - cursorPtr = Tcl_GetHashValue(idHashPtr); + cursorPtr = (TkCursor *)Tcl_GetHashValue(idHashPtr); if (cursorPtr->otherTable != &dispPtr->cursorNameTable) { goto printid; } @@ -463,13 +463,12 @@ FreeCursor( { TkCursor *prevPtr; - cursorPtr->resourceRefCount--; - if (cursorPtr->resourceRefCount > 0) { + if (cursorPtr->resourceRefCount-- > 1) { return; } Tcl_DeleteHashEntry(cursorPtr->idHashPtr); - prevPtr = Tcl_GetHashValue(cursorPtr->hashPtr); + prevPtr = (TkCursor *)Tcl_GetHashValue(cursorPtr->hashPtr); if (prevPtr == cursorPtr) { if (cursorPtr->nextPtr == NULL) { Tcl_DeleteHashEntry(cursorPtr->hashPtr); @@ -522,7 +521,7 @@ Tk_FreeCursor( if (idHashPtr == NULL) { Tcl_Panic("Tk_FreeCursor received unknown cursor argument"); } - FreeCursor(Tcl_GetHashValue(idHashPtr)); + FreeCursor((TkCursor *)Tcl_GetHashValue(idHashPtr)); } /* @@ -587,11 +586,10 @@ static void FreeCursorObj( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkCursor *cursorPtr = objPtr->internalRep.twoPtrValue.ptr1; + TkCursor *cursorPtr = (TkCursor *)objPtr->internalRep.twoPtrValue.ptr1; if (cursorPtr != NULL) { - cursorPtr->objRefCount--; - if ((cursorPtr->objRefCount == 0) + if ((cursorPtr->objRefCount-- <= 1) && (cursorPtr->resourceRefCount == 0)) { ckfree(cursorPtr); } @@ -622,7 +620,7 @@ DupCursorObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkCursor *cursorPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; + TkCursor *cursorPtr = (TkCursor *)srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; dupObjPtr->internalRep.twoPtrValue.ptr1 = cursorPtr; @@ -707,7 +705,7 @@ GetCursorFromObj( * cached is the one that is needed. */ - cursorPtr = objPtr->internalRep.twoPtrValue.ptr1; + cursorPtr = (TkCursor *)objPtr->internalRep.twoPtrValue.ptr1; if ((cursorPtr != NULL) && (Tk_Display(tkwin) == cursorPtr->display)) { return cursorPtr; } @@ -722,7 +720,7 @@ GetCursorFromObj( if (hashPtr == NULL) { goto error; } - for (cursorPtr = Tcl_GetHashValue(hashPtr); + for (cursorPtr = (TkCursor *)Tcl_GetHashValue(hashPtr); cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { FreeCursorObj(objPtr); @@ -857,7 +855,7 @@ TkDebugCursor( resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name); if (hashPtr != NULL) { - cursorPtr = Tcl_GetHashValue(hashPtr); + cursorPtr = (TkCursor *)Tcl_GetHashValue(hashPtr); if (cursorPtr == NULL) { Tcl_Panic("TkDebugCursor found empty hash table entry"); } diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 4ffb48b..a6684c7 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -477,7 +477,7 @@ Tk_EntryObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Entry *entryPtr; + Entry *entryPtr; Tk_OptionTable optionTable; Tk_Window tkwin; char *tmp; @@ -3234,11 +3234,11 @@ EntryTextVarProc( static int EntryValidate( - register Entry *entryPtr, /* Entry that needs validation. */ - register char *cmd) /* Validation command (NULL-terminated + Entry *entryPtr, /* Entry that needs validation. */ + char *cmd) /* Validation command (NULL-terminated * string). */ { - register Tcl_Interp *interp = entryPtr->interp; + Tcl_Interp *interp = entryPtr->interp; int code, isOK; code = Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); @@ -3294,7 +3294,7 @@ EntryValidate( static int EntryValidateChange( - register Entry *entryPtr, /* Entry that needs validation. */ + Entry *entryPtr, /* Entry that needs validation. */ const char *change, /* Characters to be added/deleted * (NUL-terminated string). */ const char *newValue, /* Potential new value of entry string */ @@ -3437,8 +3437,8 @@ EntryValidateChange( static void ExpandPercents( - register Entry *entryPtr, /* Entry that needs validation. */ - register const char *before, + Entry *entryPtr, /* Entry that needs validation. */ + const char *before, /* Command containing percent expressions to * be replaced. */ const char *change, /* Characters to added/deleted (NUL-terminated @@ -3452,7 +3452,7 @@ ExpandPercents( int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl * list element. */ int number, length; - register const char *string; + const char *string; int ch; char numStorage[2*TCL_INTEGER_SPACE]; @@ -3607,8 +3607,8 @@ Tk_SpinboxObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Entry *entryPtr; - register Spinbox *sbPtr; + Entry *entryPtr; + Spinbox *sbPtr; Tk_OptionTable optionTable; Tk_Window tkwin; char *tmp; @@ -4285,8 +4285,8 @@ GetSpinboxElement( static int SpinboxInvoke( - register Tcl_Interp *interp,/* Current interpreter. */ - register Spinbox *sbPtr, /* Spinbox to invoke. */ + Tcl_Interp *interp,/* Current interpreter. */ + Spinbox *sbPtr, /* Spinbox to invoke. */ int element) /* Element to invoke, either the "up" or * "down" button. */ { diff --git a/generic/tkError.c b/generic/tkError.c index 277d7f0..6ff5475 100644 --- a/generic/tkError.c +++ b/generic/tkError.c @@ -107,7 +107,7 @@ Tk_CreateErrorHandler( * Create the handler record. */ - errorPtr = ckalloc(sizeof(TkErrorHandler)); + errorPtr = (TkErrorHandler *)ckalloc(sizeof(TkErrorHandler)); errorPtr->dispPtr = dispPtr; errorPtr->firstRequest = NextRequest(display); errorPtr->lastRequest = (unsigned) -1; diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c index 8588d70..c8dbc52 100644 --- a/generic/tkFileFilter.c +++ b/generic/tkFileFilter.c @@ -164,7 +164,7 @@ TkFreeFileFilters( FileFilterClause *clausePtr; GlobPattern *globPtr; MacFileType *mfPtr; - register void *toFree; /* A pointer that we are about to free. */ + void *toFree; /* A pointer that we are about to free. */ for (filterPtr = flistPtr->filters; filterPtr != NULL; ) { for (clausePtr = filterPtr->clauses; clausePtr != NULL; ) { diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 4d46e4b..8066afd 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -113,8 +113,8 @@ Tk_FocusObjCmd( static const char *const focusOptions[] = { "-displayof", "-force", "-lastfor", NULL }; - Tk_Window tkwin = clientData; - TkWindow *winPtr = clientData; + Tk_Window tkwin = (Tk_Window)clientData; + TkWindow *winPtr = (TkWindow *)clientData; TkWindow *newPtr, *topLevelPtr; ToplevelFocusInfo *tlFocusPtr; const char *windowName; @@ -415,7 +415,7 @@ TkFocusFilterEvent( } } if (tlFocusPtr == NULL) { - tlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo)); + tlFocusPtr = (ToplevelFocusInfo *)ckalloc(sizeof(ToplevelFocusInfo)); tlFocusPtr->topLevelPtr = tlFocusPtr->focusWinPtr = winPtr; tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr; winPtr->mainPtr->tlFocusPtr = tlFocusPtr; @@ -622,7 +622,7 @@ TkSetFocusWin( } } if (tlFocusPtr == NULL) { - tlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo)); + tlFocusPtr = (ToplevelFocusInfo *)ckalloc(sizeof(ToplevelFocusInfo)); tlFocusPtr->topLevelPtr = topLevelPtr; tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr; winPtr->mainPtr->tlFocusPtr = tlFocusPtr; @@ -807,7 +807,7 @@ TkFocusKeyEvent( void TkFocusDeadWindow( - register TkWindow *winPtr) /* Information about the window that is being + TkWindow *winPtr) /* Information about the window that is being * deleted. */ { ToplevelFocusInfo *tlFocusPtr, *prevPtr; @@ -961,7 +961,7 @@ FocusMapProc( ClientData clientData, /* Toplevel window. */ XEvent *eventPtr) /* Information about event. */ { - TkWindow *winPtr = clientData; + TkWindow *winPtr = (TkWindow *)clientData; DisplayFocusInfo *displayFocusPtr; if (eventPtr->type == VisibilityNotify) { @@ -1015,7 +1015,7 @@ FindDisplayFocusInfo( * The record doesn't exist yet. Make a new one. */ - displayFocusPtr = ckalloc(sizeof(DisplayFocusInfo)); + displayFocusPtr = (DisplayFocusInfo *)ckalloc(sizeof(DisplayFocusInfo)); displayFocusPtr->dispPtr = dispPtr; displayFocusPtr->focusWinPtr = NULL; displayFocusPtr->focusOnMapPtr = NULL; @@ -1143,7 +1143,7 @@ TkFocusSplit( * Move focus to new toplevel. */ - ToplevelFocusInfo *newTlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo)); + ToplevelFocusInfo *newTlFocusPtr = (ToplevelFocusInfo *)ckalloc(sizeof(ToplevelFocusInfo)); newTlFocusPtr->topLevelPtr = winPtr; newTlFocusPtr->focusWinPtr = tlFocusPtr->focusWinPtr; diff --git a/generic/tkFont.c b/generic/tkFont.c index 3e4044f..71008bc 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -897,6 +897,7 @@ RecomputeWidgets( { Tk_ClassWorldChangedProc *proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc); + TkWindow *tkwinPtr; if (proc != NULL) { proc(winPtr->instanceData); @@ -912,18 +913,25 @@ RecomputeWidgets( * * However, the additional overhead of the recursive calls may become a * performance problem if typical usage alters such that -font'ed widgets - * appear high in the heirarchy, causing deep recursion. This could happen - * with text widgets, or more likely with the (not yet existant) labeled - * frame widget. With these widgets it is possible, even likely, that a - * -font'ed widget (text or labeled frame) will not be a leaf node, but + * appear high in the hierarchy, causing deep recursion. This could happen + * with text widgets, or more likely with the labelframe + * widget. With these widgets it is possible, even likely, that a + * -font'ed widget (text or labelframe) will not be a leaf node, but * will instead have many descendants. If this is ever found to cause a * performance problem, it may be worth investigating an iterative version * of the code below. */ - for (winPtr=winPtr->childList ; winPtr!=NULL ; winPtr=winPtr->nextPtr) { - RecomputeWidgets(winPtr); + for (tkwinPtr=winPtr->childList ; tkwinPtr!=NULL ; tkwinPtr=tkwinPtr->nextPtr) { + RecomputeWidgets(tkwinPtr); } + + /* + * Broadcast font change virtually for mega-widget layout managers. + * Do this after the font change has been propagated to core widgets. + */ + TkSendVirtualEvent((Tk_Window)winPtr, "TkWorldChanged", + Tcl_NewStringObj("FontChanged",-1)); } /* @@ -3780,7 +3788,7 @@ NewChunk( if (layoutPtr->numChunks == maxChunks) { maxChunks *= 2; s = Tk_Offset(TextLayout, chunks) + (maxChunks * sizeof(LayoutChunk)); - layoutPtr = ckrealloc(layoutPtr, s); + layoutPtr = (TextLayout *)ckrealloc(layoutPtr, s); *layoutPtrPtr = layoutPtr; *maxPtr = maxChunks; diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 54ba8e8..b5c20e8 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -741,7 +741,7 @@ FrameWidgetObjCmd( enum options { FRAME_CGET, FRAME_CONFIGURE }; - register Frame *framePtr = clientData; + Frame *framePtr = clientData; int result = TCL_OK, index; int c, i, length; Tcl_Obj *objPtr; @@ -859,8 +859,8 @@ static void DestroyFrame( void *memPtr) /* Info about frame widget. */ { - register Frame *framePtr = memPtr; - register Labelframe *labelframePtr = memPtr; + Frame *framePtr = memPtr; + Labelframe *labelframePtr = memPtr; if (framePtr->type == TYPE_LABELFRAME) { Tk_FreeTextLayout(labelframePtr->textLayout); @@ -896,7 +896,7 @@ static void DestroyFramePartly( Frame *framePtr) /* Info about frame widget. */ { - register Labelframe *labelframePtr = (Labelframe *) framePtr; + Labelframe *labelframePtr = (Labelframe *) framePtr; if (framePtr->type == TYPE_LABELFRAME && labelframePtr->labelWin != NULL) { Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask, @@ -936,7 +936,7 @@ DestroyFramePartly( static int ConfigureFrame( Tcl_Interp *interp, /* Used for error reporting. */ - register Frame *framePtr, /* Information about widget; may or may not + Frame *framePtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in objv. */ Tcl_Obj *const objv[]) /* Arguments. */ @@ -1263,7 +1263,7 @@ FrameWorldChanged( static void ComputeFrameGeometry( - register Frame *framePtr) /* Information about widget. */ + Frame *framePtr) /* Information about widget. */ { int otherWidth, otherHeight, otherWidthT, otherHeightT, padding; int maxWidth, maxHeight; @@ -1412,8 +1412,8 @@ static void DisplayFrame( ClientData clientData) /* Information about widget. */ { - register Frame *framePtr = clientData; - register Tk_Window tkwin = framePtr->tkwin; + Frame *framePtr = clientData; + Tk_Window tkwin = framePtr->tkwin; int bdX1, bdY1, bdX2, bdY2, hlWidth; Pixmap pixmap; TkRegion clipRegion = NULL; @@ -1635,9 +1635,9 @@ DisplayFrame( static void FrameEventProc( ClientData clientData, /* Information about window. */ - register XEvent *eventPtr) /* Information about event. */ + XEvent *eventPtr) /* Information about event. */ { - register Frame *framePtr = clientData; + Frame *framePtr = clientData; if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { goto redraw; diff --git a/generic/tkGC.c b/generic/tkGC.c index c424e30..8744ec4 100644 --- a/generic/tkGC.c +++ b/generic/tkGC.c @@ -66,17 +66,17 @@ static void GCInit(TkDisplay *dispPtr); GC Tk_GetGC( Tk_Window tkwin, /* Window in which GC will be used. */ - register unsigned long valueMask, + unsigned long valueMask, /* 1 bits correspond to values specified in * *valuesPtr; other values are set from * defaults. */ - register XGCValues *valuePtr) + XGCValues *valuePtr) /* Values are specified here for bits set in * valueMask. */ { ValueKey valueKey; Tcl_HashEntry *valueHashPtr, *idHashPtr; - register TkGC *gcPtr; + TkGC *gcPtr; int isNew; Drawable d, freeDrawable; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -218,7 +218,7 @@ Tk_GetGC( valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable, (char *) &valueKey, &isNew); if (!isNew) { - gcPtr = Tcl_GetHashValue(valueHashPtr); + gcPtr = (TkGC *)Tcl_GetHashValue(valueHashPtr); gcPtr->refCount++; return gcPtr->gc; } @@ -228,7 +228,7 @@ Tk_GetGC( * and add a new structure to the database. */ - gcPtr = ckalloc(sizeof(TkGC)); + gcPtr = (TkGC *)ckalloc(sizeof(TkGC)); /* * Find or make a drawable to use to specify the screen and depth of the @@ -291,7 +291,7 @@ Tk_FreeGC( GC gc) /* Graphics context to be released. */ { Tcl_HashEntry *idHashPtr; - register TkGC *gcPtr; + TkGC *gcPtr; TkDisplay *dispPtr = TkGetDisplay(display); if (!dispPtr->gcInit) { @@ -311,9 +311,8 @@ Tk_FreeGC( if (idHashPtr == NULL) { Tcl_Panic("Tk_FreeGC received unknown gc argument"); } - gcPtr = Tcl_GetHashValue(idHashPtr); - gcPtr->refCount--; - if (gcPtr->refCount == 0) { + gcPtr = (TkGC *)Tcl_GetHashValue(idHashPtr); + if (gcPtr->refCount-- <= 1) { XFreeGC(gcPtr->display, gcPtr->gc); Tcl_DeleteHashEntry(gcPtr->valueHashPtr); Tcl_DeleteHashEntry(idHashPtr); @@ -348,7 +347,7 @@ TkGCCleanup( for (entryPtr = Tcl_FirstHashEntry(&dispPtr->gcIdTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - gcPtr = Tcl_GetHashValue(entryPtr); + gcPtr = (TkGC *)Tcl_GetHashValue(entryPtr); XFreeGC(gcPtr->display, gcPtr->gc); Tcl_DeleteHashEntry(gcPtr->valueHashPtr); diff --git a/generic/tkGrab.c b/generic/tkGrab.c index a1ff46c..787a2e2 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -16,6 +16,8 @@ #include "tkWinInt.h" #elif !defined(MAC_OSX_TK) #include "tkUnixInt.h" +#else +#include "tkMacOSXInt.h" #endif /* diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 76e48d4..ab4bc37 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -1035,13 +1035,13 @@ ReadImage( { unsigned char initialCodeSize; int xpos = 0, ypos = 0, pass = 0, i, count; - register unsigned char *pixelPtr; + unsigned char *pixelPtr; static const int interlaceStep[] = { 8, 8, 4, 2 }; static const int interlaceStart[] = { 0, 4, 2, 1 }; unsigned short prefix[(1 << MAX_LWZ_BITS)]; unsigned char append[(1 << MAX_LWZ_BITS)]; unsigned char stack[(1 << MAX_LWZ_BITS)*2]; - register unsigned char *top; + unsigned char *top; int codeSize, clearCode, inCode, endCode, oldCode, maxCode; int code, firstCode, v; @@ -1425,7 +1425,7 @@ Mread( size_t numChunks, /* number of chunks */ MFile *handle) /* mmdecode "file" handle */ { - register int i, c; + int i, c; int count = chunkSize * numChunks; for (i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) { @@ -2157,9 +2157,9 @@ ClearHashTable( /* Reset code table. */ GIFState_t *statePtr, int hSize) { - register int *hashTablePtr = statePtr->hashTable + hSize; - register long i; - register long m1 = -1; + int *hashTablePtr = statePtr->hashTable + hSize; + long i; + long m1 = -1; i = hSize - 16; do { /* might use Sys V memset(3) here */ diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 7e22f26..03bb4f8 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -2237,14 +2237,14 @@ ApplyAlpha( PNGImage *pngPtr) { if (pngPtr->alpha != 1.0) { - register unsigned char *p = pngPtr->block.pixelPtr; + unsigned char *p = pngPtr->block.pixelPtr; unsigned char *endPtr = p + pngPtr->blockLen; int offset = pngPtr->block.offset[3]; p += offset; if (16 == pngPtr->bitDepth) { - register unsigned int channel; + unsigned int channel; while (p < endPtr) { channel = (unsigned int) diff --git a/generic/tkImgPhInstance.c b/generic/tkImgPhInstance.c index a40ee7f..37ee3d9 100644 --- a/generic/tkImgPhInstance.c +++ b/generic/tkImgPhInstance.c @@ -31,7 +31,7 @@ extern int _XInitImageFuncPtrs(XImage *image); * Forward declarations */ -#ifndef TKPUTIMAGE_CAN_BLEND +#ifndef TK_CAN_RENDER_RGBA static void BlendComplexAlpha(XImage *bgImg, PhotoInstance *iPtr, int xOffset, int yOffset, int width, int height); #endif @@ -409,7 +409,7 @@ TkImgPhotoGet( * *---------------------------------------------------------------------- */ -#ifndef TKPUTIMAGE_CAN_BLEND +#ifndef TK_CAN_RENDER_RGBA #ifndef _WIN32 #define GetRValue(rgb) (UCHAR(((rgb) & red_mask) >> red_shift)) #define GetGValue(rgb) (UCHAR(((rgb) & green_mask) >> green_shift)) @@ -575,7 +575,7 @@ BlendComplexAlpha( } #undef ALPHA_BLEND } -#endif /* TKPUTIMAGE_CAN_BLEND */ +#endif /* TK_CAN_RENDER_RGBA */ /* *---------------------------------------------------------------------- @@ -607,7 +607,7 @@ TkImgPhotoDisplay( * to imageX and imageY. */ { PhotoInstance *instancePtr = clientData; -#ifndef TKPUTIMAGE_CAN_BLEND +#ifndef TK_CAN_RENDER_RGBA XVisualInfo visInfo = instancePtr->visualInfo; #endif @@ -620,9 +620,10 @@ TkImgPhotoDisplay( return; } -#ifdef TKPUTIMAGE_CAN_BLEND +#ifdef TK_CAN_RENDER_RGBA + /* - * If TkPutImage can handle RGBA Ximages directly there is + * We can use TkpPutRGBAImage to render RGBA Ximages directly so there is * no need to call XGetImage or to do the Porter-Duff compositing by hand. */ @@ -631,11 +632,12 @@ TkImgPhotoDisplay( (unsigned int)instancePtr->width, (unsigned int)instancePtr->height, 0, (unsigned int)(4 * instancePtr->width)); - TkPutImage(NULL, 0, display, drawable, instancePtr->gc, + TkpPutRGBAImage(display, drawable, instancePtr->gc, photo, imageX, imageY, drawableX, drawableY, (unsigned int) width, (unsigned int) height); photo->data = NULL; XDestroyImage(photo); + #else if ((instancePtr->masterPtr->flags & COMPLEX_ALPHA) diff --git a/generic/tkInt.h b/generic/tkInt.h index a98b6d6..fe8f16e 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -679,6 +679,10 @@ typedef struct TkMainInfo { struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by * this process. */ Tcl_HashTable busyTable; /* Information used by [tk busy] command. */ + Tcl_ObjCmdProc *tclUpdateObjProc; + /* Saved Tcl [update] command, used to restore + * Tcl's version of [update] after Tk is shut + * down */ } TkMainInfo; /* @@ -1037,7 +1041,7 @@ MODULE_SCOPE const char *const tkWebColors[20]; #endif /* - * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> + * Support for Clang Static Analyzer <https://clang-analyzer.llvm.org/> */ #if defined(PURIFY) && defined(__clang__) @@ -1198,9 +1202,6 @@ MODULE_SCOPE int Tk_SelectionObjCmd(ClientData clientData, MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_SpinboxObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1322,7 +1323,8 @@ MODULE_SCOPE void TkUnixSetXftClipRegion(TkRegion clipRegion); # define c_class class #endif -#if TCL_UTF_MAX > 4 +/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */ +#if TCL_UTF_MAX > (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6)) # define TkUtfToUniChar Tcl_UtfToUniChar # define TkUniCharToUtf Tcl_UniCharToUtf # define TkUtfPrev Tcl_UtfPrev diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 514b349..cba8954 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -478,7 +478,7 @@ Tk_ListboxObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Listbox *listPtr; + Listbox *listPtr; Tk_Window tkwin; ListboxOptionTables *optionTables; @@ -607,7 +607,7 @@ ListboxWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Arguments as Tcl_Obj's. */ { - register Listbox *listPtr = clientData; + Listbox *listPtr = clientData; int cmdIndex, index; int result = TCL_OK; Tcl_Obj *objPtr; @@ -1082,7 +1082,7 @@ ListboxBboxSubCmd( Listbox *listPtr, /* Information about the listbox */ int index) /* Index of the element to get bbox info on */ { - register Tk_Window tkwin = listPtr->tkwin; + Tk_Window tkwin = listPtr->tkwin; int lastVisibleIndex; /* @@ -1446,7 +1446,7 @@ static void DestroyListbox( void *memPtr) /* Info about listbox widget. */ { - register Listbox *listPtr = memPtr; + Listbox *listPtr = memPtr; Tcl_HashEntry *entry; Tcl_HashSearch search; @@ -1555,7 +1555,7 @@ DestroyListboxOptionTables( static int ConfigureListbox( Tcl_Interp *interp, /* Used for error reporting. */ - register Listbox *listPtr, /* Information about widget; may or may not + Listbox *listPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in argv. */ Tcl_Obj *const objv[]) /* Arguments. */ @@ -1715,7 +1715,7 @@ ConfigureListbox( static int ConfigureListboxItem( Tcl_Interp *interp, /* Used for error reporting. */ - register Listbox *listPtr, /* Information about widget; may or may not + Listbox *listPtr, /* Information about widget; may or may not * already have values for some fields. */ ItemAttr *attrs, /* Information about the item to configure */ int objc, /* Number of valid entries in argv. */ @@ -1837,8 +1837,8 @@ static void DisplayListbox( ClientData clientData) /* Information about window. */ { - register Listbox *listPtr = clientData; - register Tk_Window tkwin = listPtr->tkwin; + Listbox *listPtr = clientData; + Tk_Window tkwin = listPtr->tkwin; GC gc; int i, limit, x, y, prevSelected, freeGC, stringLen; Tk_FontMetrics fm; @@ -2317,7 +2317,7 @@ ListboxComputeGeometry( static int ListboxInsertSubCmd( - register Listbox *listPtr, /* Listbox that is to get the new elements. */ + Listbox *listPtr, /* Listbox that is to get the new elements. */ int index, /* Add the new elements before this * element. */ int objc, /* Number of new elements to add. */ @@ -2433,7 +2433,7 @@ ListboxInsertSubCmd( static int ListboxDeleteSubCmd( - register Listbox *listPtr, /* Listbox widget to modify. */ + Listbox *listPtr, /* Listbox widget to modify. */ int first, /* Index of first element to delete. */ int last) /* Index of last element to delete. */ { @@ -2828,7 +2828,7 @@ GetListboxIndex( static void ChangeListboxView( - register Listbox *listPtr, /* Information about widget. */ + Listbox *listPtr, /* Information about widget. */ int index) /* Index of element in listPtr that should now * appear at the top of the listbox. */ { @@ -2863,7 +2863,7 @@ ChangeListboxView( static void ChangeListboxOffset( - register Listbox *listPtr, /* Information about widget. */ + Listbox *listPtr, /* Information about widget. */ int offset) /* Desired new "xOffset" for listbox. */ { int maxOffset; @@ -2911,7 +2911,7 @@ ChangeListboxOffset( static void ListboxScanTo( - register Listbox *listPtr, /* Information about widget. */ + Listbox *listPtr, /* Information about widget. */ int x, /* X-coordinate to use for scan operation. */ int y) /* Y-coordinate to use for scan operation. */ { @@ -2978,7 +2978,7 @@ ListboxScanTo( static int NearestListboxElement( - register Listbox *listPtr, /* Information about widget. */ + Listbox *listPtr, /* Information about widget. */ int y) /* Y-coordinate in listPtr's window. */ { int index; @@ -3019,7 +3019,7 @@ NearestListboxElement( static int ListboxSelect( - register Listbox *listPtr, /* Information about widget. */ + Listbox *listPtr, /* Information about widget. */ int first, /* Index of first element to select or * deselect. */ int last, /* Index of last element to select or @@ -3120,7 +3120,7 @@ ListboxFetchSelection( * not including terminating NULL * character. */ { - register Listbox *listPtr = clientData; + Listbox *listPtr = clientData; Tcl_DString selection; int length, count, needNewline, stringLen, i; Tcl_Obj *curElement; @@ -3196,7 +3196,7 @@ static void ListboxLostSelection( ClientData clientData) /* Information about listbox widget. */ { - register Listbox *listPtr = clientData; + Listbox *listPtr = clientData; if ((listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp)) && (listPtr->nElements > 0)) { @@ -3248,7 +3248,7 @@ GenerateListboxSelectEvent( static void EventuallyRedrawRange( - register Listbox *listPtr, /* Information about widget. */ + Listbox *listPtr, /* Information about widget. */ int first, /* Index of first element in list that needs * to be redrawn. */ int last) /* Index of last element in list that needs to @@ -3256,7 +3256,7 @@ EventuallyRedrawRange( * just bracket a range. */ { /* - * We don't have to register a redraw callback if one is already pending, + * We don't have to a redraw callback if one is already pending, * or if the window doesn't exist, or if the window isn't mapped. */ @@ -3291,7 +3291,7 @@ EventuallyRedrawRange( static void ListboxUpdateVScrollbar( - register Listbox *listPtr) /* Information about widget. */ + Listbox *listPtr) /* Information about widget. */ { char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE]; double first, last; @@ -3361,7 +3361,7 @@ ListboxUpdateVScrollbar( static void ListboxUpdateHScrollbar( - register Listbox *listPtr) /* Information about widget. */ + Listbox *listPtr) /* Information about widget. */ { char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE]; int result, windowWidth; @@ -3642,7 +3642,7 @@ MigrateHashEntries( *---------------------------------------------------------------------- */ static int GetMaxOffset( - register Listbox *listPtr) + Listbox *listPtr) { int maxOffset; diff --git a/generic/tkMacWinMenu.c b/generic/tkMacWinMenu.c index ab92fec..7749c6d 100644 --- a/generic/tkMacWinMenu.c +++ b/generic/tkMacWinMenu.c @@ -67,7 +67,7 @@ PreprocessMenu( do { finished = 1; for (index = 0; index < menuPtr->numEntries; index++) { - register TkMenuEntry *entryPtr = menuPtr->entries[index]; + TkMenuEntry *entryPtr = menuPtr->entries[index]; if ((entryPtr->type == CASCADE_ENTRY) && (entryPtr->namePtr != NULL) diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 1cd7a16..18f59a8 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -406,7 +406,7 @@ Tk_MenuObjCmd( { Tk_Window tkwin = clientData; Tk_Window newWin; - register TkMenu *menuPtr; + TkMenu *menuPtr; TkMenuReferences *menuRefPtr; int i, index, toplevel; const char *windowName; @@ -617,8 +617,8 @@ MenuWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - register TkMenu *menuPtr = clientData; - register TkMenuEntry *mePtr; + TkMenu *menuPtr = clientData; + TkMenuEntry *mePtr; int result = TCL_OK; int option; ThreadSpecificData *tsdPtr = @@ -1385,7 +1385,7 @@ static void DestroyMenuEntry( void *memPtr) /* Pointer to entry to be freed. */ { - register TkMenuEntry *mePtr = memPtr; + TkMenuEntry *mePtr = memPtr; TkMenu *menuPtr = mePtr->menuPtr; if (menuPtr->postedCascade == mePtr) { @@ -1519,7 +1519,7 @@ MenuWorldChanged( static int ConfigureMenu( Tcl_Interp *interp, /* Used for error reporting. */ - register TkMenu *menuPtr, /* Information about widget; may or may not + TkMenu *menuPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in argv. */ Tcl_Obj *const objv[]) /* Arguments. */ @@ -1901,7 +1901,7 @@ PostProcessEntry( static int ConfigureMenuEntry( - register TkMenuEntry *mePtr,/* Information about menu entry; may or may + TkMenuEntry *mePtr,/* Information about menu entry; may or may * not already have values for some fields. */ int objc, /* Number of valid entries in argv. */ Tcl_Obj *const objv[]) /* Arguments. */ @@ -2589,11 +2589,11 @@ MenuVarProc( int TkActivateMenuEntry( - register TkMenu *menuPtr, /* Menu in which to activate. */ + TkMenu *menuPtr, /* Menu in which to activate. */ int index) /* Index of entry to activate, or -1 to * deactivate all entries. */ { - register TkMenuEntry *mePtr; + TkMenuEntry *mePtr; int result = TCL_OK; if (menuPtr->active >= 0) { diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c index 89f4a2b..3851a06 100644 --- a/generic/tkMenuDraw.c +++ b/generic/tkMenuDraw.c @@ -483,8 +483,8 @@ TkRecomputeMenu( void TkEventuallyRedrawMenu( - register TkMenu *menuPtr, /* Information about menu to redraw. */ - register TkMenuEntry *mePtr)/* Entry to redraw. NULL means redraw all the + TkMenu *menuPtr, /* Information about menu to redraw. */ + TkMenuEntry *mePtr)/* Entry to redraw. NULL means redraw all the * entries in the menu. */ { int i; @@ -586,7 +586,7 @@ TkMenuSelectImageProc( * <=0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkMenuEntry *mePtr = clientData; + TkMenuEntry *mePtr = clientData; if ((mePtr->entryFlags & ENTRY_SELECTED) && !(mePtr->menuPtr->menuFlags & REDRAW_PENDING)) { @@ -615,9 +615,9 @@ static void DisplayMenu( ClientData clientData) /* Information about widget. */ { - register TkMenu *menuPtr = clientData; - register TkMenuEntry *mePtr; - register Tk_Window tkwin = menuPtr->tkwin; + TkMenu *menuPtr = clientData; + TkMenuEntry *mePtr; + Tk_Window tkwin = menuPtr->tkwin; int index, strictMotif; Tk_Font tkfont; Tk_FontMetrics menuMetrics; @@ -824,7 +824,7 @@ TkMenuImageProc( * <=0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkMenu *menuPtr = ((TkMenuEntry *) clientData)->menuPtr; + TkMenu *menuPtr = ((TkMenuEntry *) clientData)->menuPtr; if ((menuPtr->tkwin != NULL) && !(menuPtr->menuFlags & RESIZE_PENDING)) { menuPtr->menuFlags |= RESIZE_PENDING; @@ -882,8 +882,8 @@ int TkPostSubmenu( Tcl_Interp *interp, /* Used for invoking sub-commands and * reporting errors. */ - register TkMenu *menuPtr, /* Information about menu as a whole. */ - register TkMenuEntry *mePtr)/* Info about submenu that is to be posted. + TkMenu *menuPtr, /* Information about menu as a whole. */ + TkMenuEntry *mePtr)/* Info about submenu that is to be posted. * NULL means make sure that no submenu is * posted. */ { diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 2228a2e..5f4f40f 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -217,7 +217,7 @@ Tk_MenubuttonObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register TkMenuButton *mbPtr; + TkMenuButton *mbPtr; Tk_OptionTable optionTable; Tk_Window tkwin; @@ -347,7 +347,7 @@ MenuButtonWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register TkMenuButton *mbPtr = clientData; + TkMenuButton *mbPtr = clientData; int result, index; Tcl_Obj *objPtr; @@ -422,7 +422,7 @@ static void DestroyMenuButton( char *memPtr) /* Info about button widget. */ { - register TkMenuButton *mbPtr = (TkMenuButton *) memPtr; + TkMenuButton *mbPtr = (TkMenuButton *) memPtr; TkpDestroyMenuButton(mbPtr); if (mbPtr->flags & REDRAW_PENDING) { @@ -490,7 +490,7 @@ DestroyMenuButton( static int ConfigureMenuButton( Tcl_Interp *interp, /* Used for error reporting. */ - register TkMenuButton *mbPtr, + TkMenuButton *mbPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in objv. */ @@ -877,7 +877,7 @@ MenuButtonTextVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register TkMenuButton *mbPtr = clientData; + TkMenuButton *mbPtr = clientData; const char *value; unsigned len; @@ -964,7 +964,7 @@ MenuButtonImageProc( * 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkMenuButton *mbPtr = clientData; + TkMenuButton *mbPtr = clientData; if (mbPtr->tkwin != NULL) { TkpComputeMenuButtonGeometry(mbPtr); diff --git a/generic/tkMessage.c b/generic/tkMessage.c index 1a3c6de..cc67b46 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -219,7 +219,7 @@ Tk_MessageObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - register Message *msgPtr; + Message *msgPtr; Tk_OptionTable optionTable; Tk_Window tkwin; @@ -306,7 +306,7 @@ MessageWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - register Message *msgPtr = clientData; + Message *msgPtr = clientData; static const char *const optionStrings[] = { "cget", "configure", NULL }; enum options { MESSAGE_CGET, MESSAGE_CONFIGURE }; int index; @@ -384,7 +384,7 @@ static void DestroyMessage( char *memPtr) /* Info about message widget. */ { - register Message *msgPtr = (Message *) memPtr; + Message *msgPtr = (Message *) memPtr; msgPtr->flags |= MESSAGE_DELETED; @@ -437,7 +437,7 @@ DestroyMessage( static int ConfigureMessage( Tcl_Interp *interp, /* Used for error reporting. */ - register Message *msgPtr, /* Information about widget; may or may not + Message *msgPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in argv. */ Tcl_Obj *const objv[], /* Arguments. */ @@ -582,7 +582,7 @@ MessageWorldChanged( static void ComputeMessageGeometry( - register Message *msgPtr) /* Information about window. */ + Message *msgPtr) /* Information about window. */ { int width, inc, height; int thisWidth, thisHeight, maxWidth; @@ -666,8 +666,8 @@ static void DisplayMessage( ClientData clientData) /* Information about window. */ { - register Message *msgPtr = clientData; - register Tk_Window tkwin = msgPtr->tkwin; + Message *msgPtr = clientData; + Tk_Window tkwin = msgPtr->tkwin; int x, y; int borderWidth = msgPtr->highlightWidth; @@ -835,7 +835,7 @@ MessageTextVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register Message *msgPtr = clientData; + Message *msgPtr = clientData; const char *value; /* diff --git a/generic/tkObj.c b/generic/tkObj.c index 716c7e1..1552d11 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -929,13 +929,13 @@ SetWindowFromAny( static void DupWindowInternalRep( - register Tcl_Obj *srcPtr, - register Tcl_Obj *copyPtr) + Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr) { - register WindowRep *oldPtr, *newPtr; + WindowRep *oldPtr, *newPtr; - oldPtr = srcPtr->internalRep.twoPtrValue.ptr1; - newPtr = ckalloc(sizeof(WindowRep)); + oldPtr = (WindowRep *)srcPtr->internalRep.twoPtrValue.ptr1; + newPtr = (WindowRep *)ckalloc(sizeof(WindowRep)); newPtr->tkwin = oldPtr->tkwin; newPtr->mainPtr = oldPtr->mainPtr; newPtr->epoch = oldPtr->epoch; @@ -997,7 +997,7 @@ TkNewWindowObj( SetWindowFromAny(NULL, objPtr); - winPtr = objPtr->internalRep.twoPtrValue.ptr1; + winPtr = (WindowRep *)objPtr->internalRep.twoPtrValue.ptr1; winPtr->tkwin = tkwin; winPtr->mainPtr = mainPtr; winPtr->epoch = mainPtr->deletionEpoch; diff --git a/generic/tkScale.c b/generic/tkScale.c index 825f661..fa2a5d5 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -253,7 +253,7 @@ Tk_ScaleObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - register TkScale *scalePtr; + TkScale *scalePtr; Tk_OptionTable optionTable; Tk_Window tkwin; @@ -542,7 +542,7 @@ static void DestroyScale( char *memPtr) /* Info about scale widget. */ { - register TkScale *scalePtr = (TkScale *) memPtr; + TkScale *scalePtr = (TkScale *) memPtr; scalePtr->flags |= SCALE_DELETED; @@ -599,7 +599,7 @@ DestroyScale( static int ConfigureScale( Tcl_Interp *interp, /* Used for error reporting. */ - register TkScale *scalePtr, /* Information about widget; may or may not + TkScale *scalePtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in objv. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -1017,7 +1017,7 @@ ComputeFormat( static void ComputeScaleGeometry( - register TkScale *scalePtr) /* Information about widget. */ + TkScale *scalePtr) /* Information about widget. */ { char valueString[TCL_DOUBLE_SPACE]; int tmp, valuePixels, tickPixels, x, y, extraSpace; @@ -1246,7 +1246,7 @@ ScaleCmdDeletedProc( void TkEventuallyRedrawScale( - register TkScale *scalePtr, /* Information about widget. */ + TkScale *scalePtr, /* Information about widget. */ int what) /* What to redraw: REDRAW_SLIDER or * REDRAW_ALL. */ { @@ -1344,7 +1344,7 @@ ScaleVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register TkScale *scalePtr = clientData; + TkScale *scalePtr = clientData; const char *resultStr; double value; Tcl_Obj *valuePtr; @@ -1439,7 +1439,7 @@ ScaleVarProc( void TkScaleSetValue( - register TkScale *scalePtr, /* Info about widget. */ + TkScale *scalePtr, /* Info about widget. */ double value, /* New value for scale. Gets adjusted if it's * off the scale. */ int setVar, /* Non-zero means reflect new value through to @@ -1497,7 +1497,7 @@ TkScaleSetValue( static void ScaleSetVariable( - register TkScale *scalePtr) /* Info about widget. */ + TkScale *scalePtr) /* Info about widget. */ { if (scalePtr->varNamePtr != NULL) { char string[TCL_DOUBLE_SPACE]; @@ -1533,7 +1533,7 @@ ScaleSetVariable( double TkScalePixelToValue( - register TkScale *scalePtr, /* Information about widget. */ + TkScale *scalePtr, /* Information about widget. */ int x, int y) /* Coordinates of point within window. */ { double value, pixelRange; @@ -1591,7 +1591,7 @@ TkScalePixelToValue( int TkScaleValueToPixel( - register TkScale *scalePtr, /* Information about widget. */ + TkScale *scalePtr, /* Information about widget. */ double value) /* Reading of the widget. */ { int y, pixelRange; diff --git a/generic/tkSelect.c b/generic/tkSelect.c index 9584be4..ef636da 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -1191,7 +1191,7 @@ TkSelInit( * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us to * support older X servers that didn't have UTF8_STRING yet. This is * necessary on Unix systems. For more information, see: - * http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11 + * https://www.cl.cam.ac.uk/~mgk25/unicode.html#x11 */ #if !defined(_WIN32) @@ -1325,7 +1325,7 @@ HandleTclCommand( char *buffer, /* Place to store converted selection. */ int maxBytes) /* Maximum # of bytes to store at buffer. */ { - CommandInfo *cmdInfoPtr = clientData; + CommandInfo *cmdInfoPtr = (CommandInfo *)clientData; int length; Tcl_Obj *command; const char *string; @@ -1399,12 +1399,12 @@ HandleTclCommand( cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1); cmdInfoPtr->buffer[0] = '\0'; } else { - int ch; + Tcl_UniChar ch = 0; p = string; string += count; numChars = 0; while (p < string) { - p += TkUtfToUniChar(p, &ch); + p += Tcl_UtfToUniChar(p, &ch); numChars++; } cmdInfoPtr->charOffset += numChars; diff --git a/generic/tkSquare.c b/generic/tkSquare.c index e92c03c..61f86c5 100644 --- a/generic/tkSquare.c +++ b/generic/tkSquare.c @@ -581,7 +581,7 @@ SquareDestroy( static void KeepInWindow( - register Square *squarePtr) /* Pointer to widget record. */ + Square *squarePtr) /* Pointer to widget record. */ { int i, bd, relief; int borderWidth, size; diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index ea48894..0400bfa 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -80,7 +80,7 @@ Tk_InitStubs( ClientData clientData = NULL; const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, 0, &clientData); - const TkStubs *stubsPtr = clientData; + const TkStubs *stubsPtr = (const TkStubs *)clientData; if (actualVersion == NULL) { return NULL; diff --git a/generic/tkStyle.c b/generic/tkStyle.c index 1289f14..14bae66 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -1402,14 +1402,10 @@ Tk_AllocStyleFromObj( Tcl_Obj *objPtr) /* Object containing name of the style to * retrieve. */ { - Style *stylePtr; - if (objPtr->typePtr != &styleObjType) { SetStyleFromAny(interp, objPtr); } - stylePtr = objPtr->internalRep.twoPtrValue.ptr1; - - return (Tk_Style) stylePtr; + return (Tk_Style)objPtr->internalRep.twoPtrValue.ptr1; } /* @@ -1439,7 +1435,7 @@ Tk_GetStyleFromObj( SetStyleFromAny(NULL, objPtr); } - return objPtr->internalRep.twoPtrValue.ptr1; + return (Tk_Style)objPtr->internalRep.twoPtrValue.ptr1; } /* diff --git a/generic/tkText.c b/generic/tkText.c index c41fc67..90ec575 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -3297,7 +3297,7 @@ DeleteIndexRange( TkTextSetYView(tPtr, &indexTmp, 0); } } else { - TkTextMakeByteIndex(sharedTextPtr->tree, tPtr, line, + TkTextMakeByteIndex(sharedTextPtr->tree, NULL, line, byteIndex, &indexTmp); /* * line may be before -startline of tPtr and must be @@ -3306,20 +3306,12 @@ DeleteIndexRange( * would be displayed. * There is no need to worry about -endline however, * because the view will only be reset if the deletion - * involves the TOP line of the screen + * involves the TOP line of the screen. That said, + * the following call adjusts to both. */ - if (tPtr->start != NULL) { - int start; - TkTextIndex indexStart; + TkTextIndexAdjustToStartEnd(tPtr, &indexTmp, 0); - start = TkBTreeLinesTo(NULL, tPtr->start); - TkTextMakeByteIndex(sharedTextPtr->tree, NULL, start, - 0, &indexStart); - if (TkTextIndexCmp(&indexTmp, &indexStart) < 0) { - indexTmp = indexStart; - } - } TkTextSetYView(tPtr, &indexTmp, 0); } } diff --git a/generic/tkText.h b/generic/tkText.h index 9a9495a..9898462 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -1160,6 +1160,8 @@ MODULE_SCOPE int TkTextYviewCmd(TkText *textPtr, Tcl_Interp *interp, MODULE_SCOPE void TkTextWinFreeClient(Tcl_HashEntry *hPtr, TkTextEmbWindowClient *client); MODULE_SCOPE void TkTextRunAfterSyncCmd(ClientData clientData); +MODULE_SCOPE int TkTextIndexAdjustToStartEnd(TkText *textPtr, + TkTextIndex *indexPtr, int err); #endif /* _TKTEXT */ /* diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c index 7832992..1b65cbc 100644 --- a/generic/tkTextBTree.c +++ b/generic/tkTextBTree.c @@ -1727,6 +1727,26 @@ TkBTreeFindPixelLine( } pixels -= linePtr->pixels[2 * pixelReference]; } + + /* + * Check for any start/end offset for this text widget. + */ + + if (textPtr->start != NULL) { + int lineBoundary = TkBTreeLinesTo(NULL, textPtr->start); + + if (TkBTreeLinesTo(NULL, linePtr) < lineBoundary) { + linePtr = TkBTreeFindLine(tree, NULL, lineBoundary); + } + } + if (textPtr->end != NULL) { + int lineBoundary = TkBTreeLinesTo(NULL, textPtr->end); + + if (TkBTreeLinesTo(NULL, linePtr) > lineBoundary) { + linePtr = TkBTreeFindLine(tree, NULL, lineBoundary); + } + } + if (pixelOffset != NULL && linePtr != NULL) { *pixelOffset = pixels; } diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index bc0da0a..776eb04 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -284,7 +284,7 @@ TkTextImageCmd( for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), -1)); + (const char *)Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), -1)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; @@ -764,9 +764,9 @@ EmbImageBboxProc( * index corresponding to the image's position in the text. * * Results: - * The return value is 1 if there is an embedded image by the given name - * in the text widget, 0 otherwise. If the image exists, *indexPtr is - * filled in with its index. + * The return value is TCL_OK if there is an embedded image by the given + * name in the text widget, TCL_ERROR otherwise. If the image exists, + * *indexPtr is filled in with its index. * * Side effects: * None. @@ -784,18 +784,29 @@ TkTextImageIndex( TkTextSegment *eiPtr; if (textPtr == NULL) { - return 0; + return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->imageTable, name); if (hPtr == NULL) { - return 0; + return TCL_ERROR; } eiPtr = (TkTextSegment *)Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->sharedTextPtr->tree; indexPtr->linePtr = eiPtr->body.ei.linePtr; indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr); - return 1; + + /* + * If indexPtr refers to somewhere outside the -startline/-endline + * range limits of the widget, error out since the image indeed is not + * reachable from this text widget (it may be reachable from a peer). + */ + + if (TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 1) == TCL_ERROR) { + return TCL_ERROR; + } + + return TCL_OK; } /* diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index 1628389..e6632d0 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -480,7 +480,7 @@ TkTextMakeCharIndex( TkTextSegment *segPtr; char *p, *start, *end; int index, offset; - int ch; + Tcl_UniChar ch = 0; indexPtr->tree = tree; if (lineIndex < 0) { @@ -527,7 +527,7 @@ TkTextMakeCharIndex( return indexPtr; } charIndex--; - offset = TkUtfToUniChar(p, &ch); + offset = Tcl_UtfToUniChar(p, &ch); index += offset; } } else { @@ -761,11 +761,11 @@ GetIndex( goto done; } - if (TkTextWindowIndex(textPtr, string, indexPtr) != 0) { + if (TkTextWindowIndex(textPtr, string, indexPtr) == TCL_OK) { goto done; } - if (TkTextImageIndex(textPtr, string, indexPtr) != 0) { + if (TkTextImageIndex(textPtr, string, indexPtr) == TCL_OK) { goto done; } @@ -917,7 +917,7 @@ GetIndex( *endOfBase = 0; result = TkTextWindowIndex(textPtr, Tcl_DStringValue(©), indexPtr); *endOfBase = c; - if (result != 0) { + if (result == TCL_OK) { goto gotBase; } } @@ -954,7 +954,7 @@ GetIndex( *endOfBase = 0; result = TkTextImageIndex(textPtr, Tcl_DStringValue(©), indexPtr); *endOfBase = c; - if (result != 0) { + if (result == TCL_OK) { goto gotBase; } } @@ -997,6 +997,7 @@ GetIndex( if (indexPtr->linePtr == NULL) { Tcl_Panic("Bad index created"); } + TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 0); return TCL_OK; error: @@ -1009,6 +1010,67 @@ GetIndex( /* *--------------------------------------------------------------------------- * + * TkTextIndexAdjustToStartEnd -- + * + * Adjust indexPtr to the -startline/-endline range, or just check + * if indexPtr is out of this range. + * + * Results: + * The return value is a standard Tcl return result. If check is true, + * return TCL_ERROR if indexPtr is outside the -startline/-endline + * range (indexPtr is not modified). + * If check is false, adjust indexPtr to -startline/-endline. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TkTextIndexAdjustToStartEnd( + TkText *textPtr, + TkTextIndex *indexPtr, /* Pointer to index. */ + int check) /* 1 means only check indexPtr against + * the -startline/-endline range + * 0 means adjust to this range */ +{ + int bound; + TkTextIndex indexBound; + + if (!textPtr) { + return TCL_OK; + } + if (textPtr->start != NULL) { + bound = TkBTreeLinesTo(NULL, textPtr->start); + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + &indexBound); + if (TkTextIndexCmp(indexPtr, &indexBound) < 0) { + if (check) { + return TCL_ERROR; + } + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + indexPtr); + } + } + if (textPtr->end != NULL) { + bound = TkBTreeLinesTo(NULL, textPtr->end); + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + &indexBound); + if (TkTextIndexCmp(indexPtr, &indexBound) > 0) { + if (check) { + return TCL_ERROR; + } + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, bound, 0, + indexPtr); + } + } + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * * TkTextPrintIndex -- * * This function generates a string description of an index, suitable for diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index dcd7008..f77e6b4 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -434,8 +434,6 @@ TkTextMarkNameToIndex( TkTextIndex *indexPtr) /* Index information gets stored here. */ { TkTextSegment *segPtr; - TkTextIndex index; - int start, end; if (textPtr == NULL) { return TCL_ERROR; @@ -456,28 +454,17 @@ TkTextMarkNameToIndex( } TkTextMarkSegToIndex(textPtr, segPtr, indexPtr); - /* If indexPtr refers to somewhere outside the -startline/-endline + /* + * If indexPtr refers to somewhere outside the -startline/-endline * range limits of the widget, error out since the mark indeed is not * reachable from this text widget (it may be reachable from a peer) * (bug 1630271). */ - if (textPtr->start != NULL) { - start = TkBTreeLinesTo(NULL, textPtr->start); - TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, start, 0, - &index); - if (TkTextIndexCmp(indexPtr, &index) < 0) { - return TCL_ERROR; - } - } - if (textPtr->end != NULL) { - end = TkBTreeLinesTo(NULL, textPtr->end); - TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, end, 0, - &index); - if (TkTextIndexCmp(indexPtr, &index) > 0) { - return TCL_ERROR; - } + if (TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 1) == TCL_ERROR) { + return TCL_ERROR; } + return TCL_OK; } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index c9f34e4..fdd5378 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -1320,9 +1320,9 @@ EmbWinDelayedUnmap( * index corresponding to the window's position in the text. * * Results: - * The return value is 1 if there is an embedded window by the given name - * in the text widget, 0 otherwise. If the window exists, *indexPtr is - * filled in with its index. + * The return value is TCL_OK if there is an embedded window by the given + * name in the text widget, TCL_ERROR otherwise. If the window exists, + * *indexPtr is filled in with its index. * * Side effects: * None. @@ -1340,19 +1340,30 @@ TkTextWindowIndex( TkTextSegment *ewPtr; if (textPtr == NULL) { - return 0; + return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->windowTable, name); if (hPtr == NULL) { - return 0; + return TCL_ERROR; } ewPtr = (TkTextSegment *)Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->sharedTextPtr->tree; indexPtr->linePtr = ewPtr->body.ew.linePtr; indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr); - return 1; + + /* + * If indexPtr refers to somewhere outside the -startline/-endline + * range limits of the widget, error out since the window indeed is not + * reachable from this text widget (it may be reachable from a peer). + */ + + if (TkTextIndexAdjustToStartEnd(textPtr, indexPtr, 1) == TCL_ERROR) { + return TCL_ERROR; + } + + return TCL_OK; } /* diff --git a/generic/tkTrig.c b/generic/tkTrig.c index a2bf456..2e11db0 100644 --- a/generic/tkTrig.c +++ b/generic/tkTrig.c @@ -39,9 +39,9 @@ double TkLineToPoint( - double end1Ptr[2], /* Coordinates of first end-point of line. */ - double end2Ptr[2], /* Coordinates of second end-point of line. */ - double pointPtr[2]) /* Points to coords for point. */ + double end1Ptr[], /* Coordinates of first end-point of line. */ + double end2Ptr[], /* Coordinates of second end-point of line. */ + double pointPtr[]) /* Points to coords for point. */ { double x, y; @@ -143,11 +143,11 @@ TkLineToPoint( int TkLineToArea( - double end1Ptr[2], /* X and y coordinates for one endpoint of + double end1Ptr[], /* X and y coordinates for one endpoint of * line. */ - double end2Ptr[2], /* X and y coordinates for other endpoint of + double end2Ptr[], /* X and y coordinates for other endpoint of * line. */ - double rectPtr[4]) /* Points to coords for rectangle, in the + double rectPtr[]) /* Points to coords for rectangle, in the * order x1, y1, x2, y2. X1 must be no larger * than x2, and y1 no larger than y2. */ { @@ -440,7 +440,7 @@ TkPolygonToPoint( * intersect a ray extending vertically * upwards from the point to infinity. */ int count; - register double *pPtr; + double *pPtr; /* * Iterate through all of the edges in the polygon, updating bestDist and @@ -588,7 +588,7 @@ TkPolygonToArea( * polygon: x0, y0, x1, y1, ... The polygon * may be self-intersecting. */ int numPoints, /* Total number of points at *polyPtr. */ - register double *rectPtr) /* Points to coords for rectangle, in the + double *rectPtr) /* Points to coords for rectangle, in the * order x1, y1, x2, y2. X1 and y1 must be * lower-left corner. */ { @@ -596,7 +596,7 @@ TkPolygonToArea( * outside, 1 means inside, won't ever be * 0). */ int count; - register double *pPtr; + double *pPtr; /* * Iterate over all of the edges of the polygon and test them against the @@ -655,14 +655,14 @@ TkPolygonToArea( /* ARGSUSED */ double TkOvalToPoint( - double ovalPtr[4], /* Pointer to array of four coordinates (x1, + double ovalPtr[], /* Pointer to array of four coordinates (x1, * y1, x2, y2) defining oval's bounding * box. */ double width, /* Width of outline for oval. */ int filled, /* Non-zero means oval should be treated as * filled; zero means only consider * outline. */ - double pointPtr[2]) /* Coordinates of point. */ + double pointPtr[]) /* Coordinates of point. */ { double xDelta, yDelta, scaledDistance, distToOutline, distToCenter; double xDiam, yDiam; @@ -751,11 +751,11 @@ TkOvalToPoint( int TkOvalToArea( - register double *ovalPtr, /* Points to coordinates defining the + double *ovalPtr, /* Points to coordinates defining the * bounding rectangle for the oval: x1, y1, * x2, y2. X1 must be less than x2 and y1 less * than y2. */ - register double *rectPtr) /* Points to coords for rectangle, in the + double *rectPtr) /* Points to coords for rectangle, in the * order x1, y1, x2, y2. X1 and y1 must be * lower-left corner. */ { @@ -870,7 +870,7 @@ TkOvalToArea( /* ARGSUSED */ void TkIncludePoint( - register Tk_Item *itemPtr, /* Item whose bounding box is being + Tk_Item *itemPtr, /* Item whose bounding box is being * calculated. */ double *pointPtr) /* Address of two doubles giving x and y * coordinates of point. */ @@ -919,7 +919,7 @@ TkBezierScreenPoints( double control[], /* Array of coordinates for four control * points: x0, y0, x1, y1, ... x3 y3. */ int numSteps, /* Number of curve points to generate. */ - register XPoint *xPointPtr) /* Where to put new points. */ + XPoint *xPointPtr) /* Where to put new points. */ { int i; double u, u2, u3, t, t2, t3; @@ -965,7 +965,7 @@ TkBezierPoints( double control[], /* Array of coordinates for four control * points: x0, y0, x1, y1, ... x3 y3. */ int numSteps, /* Number of curve points to generate. */ - register double *coordPtr) /* Where to put new points. */ + double *coordPtr) /* Where to put new points. */ { int i; double u, u2, u3, t, t2, t3; diff --git a/generic/tkUndo.c b/generic/tkUndo.c index c66905d..7494332 100644 --- a/generic/tkUndo.c +++ b/generic/tkUndo.c @@ -94,7 +94,7 @@ TkUndoInsertSeparator( TkUndoAtom *separator; if (*stack!=NULL && (*stack)->type!=TK_UNDO_SEPARATOR) { - separator = ckalloc(sizeof(TkUndoAtom)); + separator = (TkUndoAtom *)ckalloc(sizeof(TkUndoAtom)); separator->type = TK_UNDO_SEPARATOR; TkUndoPushStack(stack,separator); return 1; @@ -181,7 +181,7 @@ TkUndoPushAction( { TkUndoAtom *atom; - atom = ckalloc(sizeof(TkUndoAtom)); + atom = (TkUndoAtom *)ckalloc(sizeof(TkUndoAtom)); atom->type = TK_UNDO_ACTION; atom->apply = apply; atom->revert = revert; @@ -237,7 +237,7 @@ TkUndoMakeCmdSubAtom( Tcl_Panic("NULL command and actionScript in TkUndoMakeCmdSubAtom"); } - atom = ckalloc(sizeof(TkUndoSubAtom)); + atom = (TkUndoSubAtom *)ckalloc(sizeof(TkUndoSubAtom)); atom->command = command; atom->funcPtr = NULL; atom->clientData = NULL; @@ -299,7 +299,7 @@ TkUndoMakeSubAtom( Tcl_Panic("NULL funcPtr in TkUndoMakeSubAtom"); } - atom = ckalloc(sizeof(TkUndoSubAtom)); + atom = (TkUndoSubAtom *)ckalloc(sizeof(TkUndoSubAtom)); atom->command = NULL; atom->funcPtr = funcPtr; atom->clientData = clientData; @@ -341,7 +341,7 @@ TkUndoInitStack( { TkUndoRedoStack *stack; /* An Undo/Redo stack */ - stack = ckalloc(sizeof(TkUndoRedoStack)); + stack = (TkUndoRedoStack *)ckalloc(sizeof(TkUndoRedoStack)); stack->undoStack = NULL; stack->redoStack = NULL; stack->interp = interp; diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 00ac7be..3cc8dbf 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -57,8 +57,7 @@ TkStateParseProc( int flags = PTR2INT(clientData); size_t length; Tcl_Obj *msgObj; - - register Tk_State *statePtr = (Tk_State *) (widgRec + offset); + Tk_State *statePtr = (Tk_State *) (widgRec + offset); if (value == NULL || *value == 0) { *statePtr = TK_STATE_NULL; @@ -134,7 +133,7 @@ TkStatePrintProc( * information about how to reclaim storage * for return string. */ { - register Tk_State *statePtr = (Tk_State *) (widgRec + offset); + Tk_State *statePtr = (Tk_State *) (widgRec + offset); switch (*statePtr) { case TK_STATE_NORMAL: @@ -179,8 +178,7 @@ TkOrientParseProc( { int c; size_t length; - - register int *orientPtr = (int *) (widgRec + offset); + int *orientPtr = (int *) (widgRec + offset); if (value == NULL || *value == 0) { *orientPtr = 0; @@ -237,7 +235,7 @@ TkOrientPrintProc( * information about how to reclaim storage * for return string. */ { - register int *statePtr = (int *) (widgRec + offset); + int *statePtr = (int *) (widgRec + offset); if (*statePtr) { return "vertical"; @@ -424,7 +422,7 @@ TkOffsetPrintProc( if (offsetPtr->flags >= INT_MAX) { return "end"; } - p = ckalloc(32); + p = (char *)ckalloc(32); sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX); *freeProcPtr = TCL_DYNAMIC; return p; @@ -454,7 +452,7 @@ TkOffsetPrintProc( return "se"; } } - q = p = ckalloc(32); + q = p = (char *)ckalloc(32); if (offsetPtr->flags & TK_OFFSET_RELATIVE) { *q++ = '#'; } @@ -519,7 +517,7 @@ TkPixelPrintProc( Tcl_FreeProc **freeProcPtr) /* not used */ { double *doublePtr = (double *) (widgRec + offset); - char *p = ckalloc(24); + char *p = (char *)ckalloc(24); Tcl_PrintDouble(NULL, *doublePtr, p); *freeProcPtr = TCL_DYNAMIC; @@ -1088,7 +1086,7 @@ TkBackgroundEvalObjv( Tcl_Command TkMakeEnsemble( Tcl_Interp *interp, - const char *namespace, + const char *namesp, const char *name, ClientData clientData, const TkEnsemble map[]) @@ -1105,11 +1103,11 @@ TkMakeEnsemble( Tcl_DStringInit(&ds); - namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0); + namespacePtr = Tcl_FindNamespace(interp, namesp, NULL, 0); if (namespacePtr == NULL) { - namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL); + namespacePtr = Tcl_CreateNamespace(interp, namesp, NULL, NULL); if (namespacePtr == NULL) { - Tcl_Panic("failed to create namespace \"%s\"", namespace); + Tcl_Panic("failed to create namespace \"%s\"", namesp); } } @@ -1125,8 +1123,8 @@ TkMakeEnsemble( } Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, namespace, -1); - if (!(strlen(namespace) == 2 && namespace[1] == ':')) { + Tcl_DStringAppend(&ds, namesp, -1); + if (!(strlen(namesp) == 2 && namesp[1] == ':')) { Tcl_DStringAppend(&ds, "::", -1); } Tcl_DStringAppend(&ds, name, -1); @@ -1188,11 +1186,13 @@ TkSendVirtualEvent( event.general.xany.display = Tk_Display(target); event.virt.name = Tk_GetUid(eventName); event.virt.user_data = detail; + if (detail) Tcl_IncrRefCount(detail); // Event code will DecrRefCount Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); } -#if TCL_UTF_MAX <= 4 +/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */ +#if TCL_UTF_MAX <= (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6)) /* *--------------------------------------------------------------------------- * @@ -1221,11 +1221,11 @@ TkUtfToUniChar( Tcl_UniChar uniChar = 0; int len = Tcl_UtfToUniChar(src, &uniChar); - if ((sizeof(Tcl_UniChar) == 2) && ((uniChar & 0xFC00) == 0xD800)) { + if ((uniChar & 0xFC00) == 0xD800) { Tcl_UniChar low = uniChar; - /* This can only happen if Tcl is compiled with TCL_UTF_MAX=4, - * or when a high surrogate character is detected in UTF-8 form */ - int len2 = Tcl_UtfToUniChar(src+len, &low); + /* This can only happen if sizeof(Tcl_UniChar)== 2 and src points + * to a character > U+FFFF */ + size_t len2 = Tcl_UtfToUniChar(src+len, &low); if ((low & 0xFC00) == 0xDC00) { *chPtr = (((uniChar & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; return len + len2; @@ -1256,7 +1256,7 @@ TkUtfToUniChar( int TkUniCharToUtf(int ch, char *buf) { - if ((sizeof(Tcl_UniChar) == 2) && (((unsigned)(ch - 0x10000) <= 0xFFFFF))) { + if ((unsigned)(ch - 0x10000) <= 0xFFFFF) { /* Spit out a 4-byte UTF-8 character or 2 x 3-byte UTF-8 characters, depending on Tcl * version and/or TCL_UTF_MAX build value */ int len = Tcl_UniCharToUtf(0xD800 | ((ch - 0x10000) >> 10), buf); @@ -1333,7 +1333,6 @@ TkUtfAtIndex( return p; } #endif - /* * Local Variables: * mode: c diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 567c552..9324499 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -96,10 +96,10 @@ Tk_GetVisual( * Tk_FreeColormap. */ { Tk_Window tkwin2; - XVisualInfo template, *visInfoList, *bestPtr; + XVisualInfo templ, *visInfoList, *bestPtr; long mask; Visual *visual; - ptrdiff_t length; + size_t length; int c, numVisuals, prio, bestPrio, i; const char *p; const VisualDictionary *dictPtr; @@ -137,20 +137,20 @@ Tk_GetVisual( for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == *colormapPtr) { - cmapPtr->refCount += 1; + cmapPtr->refCount++; break; } } } return visual; } - template.depth = Tk_Depth(tkwin2); - template.c_class = visual->c_class; - template.red_mask = visual->red_mask; - template.green_mask = visual->green_mask; - template.blue_mask = visual->blue_mask; - template.colormap_size = visual->map_entries; - template.bits_per_rgb = visual->bits_per_rgb; + templ.depth = Tk_Depth(tkwin2); + templ.c_class = visual->c_class; + templ.red_mask = visual->red_mask; + templ.green_mask = visual->green_mask; + templ.blue_mask = visual->blue_mask; + templ.colormap_size = visual->map_entries; + templ.bits_per_rgb = visual->bits_per_rgb; mask = VisualDepthMask|VisualClassMask|VisualRedMaskMask |VisualGreenMaskMask|VisualBlueMaskMask|VisualColormapSizeMask |VisualBitsPerRGBMask; @@ -178,7 +178,7 @@ Tk_GetVisual( Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL); return NULL; } - template.visualid = visualId; + templ.visualid = visualId; mask = VisualIDMask; } else { /* @@ -192,16 +192,15 @@ Tk_GetVisual( } } length = p - string; - template.c_class = -1; + templ.c_class = -1; for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { - if ((dictPtr->name[0] == c) && (length >= dictPtr->minLength) - && (strncmp(string, dictPtr->name, - (size_t) length) == 0)) { - template.c_class = dictPtr->c_class; + if ((dictPtr->name[0] == c) && (length >= (size_t)dictPtr->minLength) + && (strncmp(string, dictPtr->name, length) == 0)) { + templ.c_class = dictPtr->c_class; break; } } - if (template.c_class == -1) { + if (templ.c_class == -1) { Tcl_Obj *msgObj = Tcl_ObjPrintf( "unknown or ambiguous visual name \"%s\": class must be ", string); @@ -218,8 +217,8 @@ Tk_GetVisual( p++; } if (*p == 0) { - template.depth = 10000; - } else if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { + templ.depth = 10000; + } else if (Tcl_GetInt(interp, p, &templ.depth) != TCL_OK) { return NULL; } if (c == 'b') { @@ -234,9 +233,9 @@ Tk_GetVisual( * an error if there are none that match. */ - template.screen = Tk_ScreenNumber(tkwin); + templ.screen = Tk_ScreenNumber(tkwin); mask |= VisualScreenMask; - visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template, + visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &templ, &numVisuals); if (visInfoList == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -286,11 +285,11 @@ Tk_GetVisual( goto newBest; } if (visInfoList[i].depth < bestPtr->depth) { - if (visInfoList[i].depth >= template.depth) { + if (visInfoList[i].depth >= templ.depth) { goto newBest; } } else if (visInfoList[i].depth > bestPtr->depth) { - if (bestPtr->depth < template.depth) { + if (bestPtr->depth < templ.depth) { goto newBest; } } else { @@ -324,11 +323,11 @@ Tk_GetVisual( cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->shareable && (cmapPtr->visual == visual)) { *colormapPtr = cmapPtr->colormap; - cmapPtr->refCount += 1; + cmapPtr->refCount++; goto done; } } - cmapPtr = ckalloc(sizeof(TkColormap)); + cmapPtr = (TkColormap *)ckalloc(sizeof(TkColormap)); cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), visual, AllocNone); @@ -383,7 +382,7 @@ Tk_GetColormap( */ if (strcmp(string, "new") == 0) { - cmapPtr = ckalloc(sizeof(TkColormap)); + cmapPtr = (TkColormap *)ckalloc(sizeof(TkColormap)); cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), Tk_Visual(tkwin), AllocNone); @@ -427,7 +426,7 @@ Tk_GetColormap( for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == colormap) { - cmapPtr->refCount += 1; + cmapPtr->refCount++; } } return colormap; @@ -476,8 +475,7 @@ Tk_FreeColormap( for (prevPtr = NULL, cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; prevPtr = cmapPtr, cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == colormap) { - cmapPtr->refCount -= 1; - if (cmapPtr->refCount == 0) { + if (cmapPtr->refCount-- <= 1) { XFreeColormap(display, colormap); if (prevPtr == NULL) { dispPtr->cmapPtr = cmapPtr->nextPtr; @@ -534,7 +532,7 @@ Tk_PreserveColormap( for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == colormap) { - cmapPtr->refCount += 1; + cmapPtr->refCount++; return; } } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 9750ed8..f48e469 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -93,6 +93,7 @@ static const XSetWindowAttributes defAtts= { #define PASSMAINWINDOW 2 #define WINMACONLY 4 #define USEINITPROC 8 +#define SAVEUPDATECMD 16 /* better only be one of these! */ typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); typedef struct { @@ -126,7 +127,7 @@ static const TkCmd commands[] = { {"selection", Tk_SelectionObjCmd, PASSMAINWINDOW}, {"tk", (Tcl_ObjCmdProc *)(void *)TkInitTkCmd, USEINITPROC|PASSMAINWINDOW|ISSAFE}, {"tkwait", Tk_TkwaitObjCmd, PASSMAINWINDOW|ISSAFE}, - {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE}, + {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE|SAVEUPDATECMD}, {"winfo", Tk_WinfoObjCmd, PASSMAINWINDOW|ISSAFE}, {"wm", Tk_WmObjCmd, PASSMAINWINDOW}, @@ -316,8 +317,8 @@ CreateTopLevelWindow( * parent. */ unsigned int flags) /* Additional flags to set on the window. */ { - register TkWindow *winPtr; - register TkDisplay *dispPtr; + TkWindow *winPtr; + TkDisplay *dispPtr; int screenId; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -419,7 +420,7 @@ GetScreen( * DISPLAY envariable. */ int *screenPtr) /* Where to store screen number. */ { - register TkDisplay *dispPtr; + TkDisplay *dispPtr; const char *p; int screenId; size_t length; @@ -620,7 +621,7 @@ TkAllocWindow( * inherit visual information. NULL means use * screen defaults instead of inheriting. */ { - register TkWindow *winPtr = ckalloc(sizeof(TkWindow)); + TkWindow *winPtr = ckalloc(sizeof(TkWindow)); winPtr->display = dispPtr->display; winPtr->dispPtr = dispPtr; @@ -701,7 +702,7 @@ TkAllocWindow( static int NameWindow( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - register TkWindow *winPtr, /* Window that is to be named and inserted. */ + TkWindow *winPtr, /* Window that is to be named and inserted. */ TkWindow *parentPtr, /* Pointer to logical parent for winPtr (used * for naming, options, etc.). */ const char *name) /* Name for winPtr; must be unique among @@ -832,9 +833,9 @@ TkCreateMainWindow( Tk_Window tkwin; int dummy, isSafe; Tcl_HashEntry *hPtr; - register TkMainInfo *mainPtr; - register TkWindow *winPtr; - register const TkCmd *cmdPtr; + TkMainInfo *mainPtr; + TkWindow *winPtr; + const TkCmd *cmdPtr; ClientData clientData; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -880,6 +881,7 @@ TkCreateMainWindow( Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS); mainPtr->strictMotif = 0; mainPtr->alwaysShowSelection = 0; + mainPtr->tclUpdateObjProc = NULL; if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif, TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); @@ -919,6 +921,8 @@ TkCreateMainWindow( isSafe = Tcl_IsSafe(interp); for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { + Tcl_CmdInfo cmdInfo; + if (cmdPtr->objProc == NULL) { Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs"); } @@ -938,6 +942,11 @@ TkCreateMainWindow( } else { clientData = NULL; } + if ((cmdPtr->flags & SAVEUPDATECMD) && + Tcl_GetCommandInfo(interp, cmdPtr->name, &cmdInfo) && + cmdInfo.isNativeObjectProc && !cmdInfo.objClientData && !cmdInfo.deleteProc) { + mainPtr->tclUpdateObjProc = cmdInfo.objProc; + } if (cmdPtr->flags & USEINITPROC) { ((TkInitProc *)(void *)cmdPtr->objProc)(interp, clientData); } else { @@ -1488,7 +1497,7 @@ Tk_DestroyWindow( winPtr->mainPtr->deletionEpoch++; } if (winPtr->mainPtr->refCount-- <= 1) { - register const TkCmd *cmdPtr; + const TkCmd *cmdPtr; /* * We just deleted the last window in the application. Delete the @@ -1502,10 +1511,20 @@ Tk_DestroyWindow( */ if ((winPtr->mainPtr->interp != NULL) && - !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { + !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { - Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name, - TkDeadAppObjCmd, NULL, NULL); + if ((cmdPtr->flags & SAVEUPDATECMD) && + winPtr->mainPtr->tclUpdateObjProc != NULL) { + /* Restore Tcl's version of [update] */ + Tcl_CreateObjCommand(winPtr->mainPtr->interp, + cmdPtr->name, + winPtr->mainPtr->tclUpdateObjProc, + NULL, NULL); + } else { + Tcl_CreateObjCommand(winPtr->mainPtr->interp, + cmdPtr->name, TkDeadAppObjCmd, + NULL, NULL); + } } Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send", TkDeadAppObjCmd, NULL, NULL); @@ -1675,7 +1694,7 @@ void Tk_MakeWindowExist( Tk_Window tkwin) /* Token for window. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; TkWindow *winPtr2; Window parent; Tcl_HashEntry *hPtr; @@ -1784,7 +1803,7 @@ void Tk_UnmapWindow( Tk_Window tkwin) /* Token for window to unmap. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; if (!(winPtr->flags & TK_MAPPED) || (winPtr->flags & TK_ALREADY_DEAD)) { return; @@ -1821,7 +1840,7 @@ Tk_ConfigureWindow( * are to be used. */ XWindowChanges *valuePtr) /* New values. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; if (valueMask & CWX) { winPtr->changes.x = valuePtr->x; @@ -1857,7 +1876,7 @@ Tk_MoveWindow( Tk_Window tkwin, /* Window to move. */ int x, int y) /* New location for window (within parent). */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->changes.x = x; winPtr->changes.y = y; @@ -1875,7 +1894,7 @@ Tk_ResizeWindow( Tk_Window tkwin, /* Window to resize. */ int width, int height) /* New dimensions for window. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->changes.width = (unsigned) width; winPtr->changes.height = (unsigned) height; @@ -1895,7 +1914,7 @@ Tk_MoveResizeWindow( int x, int y, /* New location for window (within parent). */ int width, int height) /* New dimensions for window. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->changes.x = x; winPtr->changes.y = y; @@ -1916,7 +1935,7 @@ Tk_SetWindowBorderWidth( Tk_Window tkwin, /* Window to modify. */ int width) /* New border width for window. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->changes.border_width = width; if (winPtr->window != None) { @@ -1934,10 +1953,10 @@ Tk_ChangeWindowAttributes( Tk_Window tkwin, /* Window to manipulate. */ unsigned long valueMask, /* OR'ed combination of bits, indicating which * fields of *attsPtr are to be used. */ - register XSetWindowAttributes *attsPtr) + XSetWindowAttributes *attsPtr) /* New values for some attributes. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; if (valueMask & CWBackPixmap) { winPtr->atts.background_pixmap = attsPtr->background_pixmap; @@ -2000,7 +2019,7 @@ Tk_SetWindowBackground( unsigned long pixel) /* Pixel value to use for window's * background. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->atts.background_pixel = pixel; @@ -2017,7 +2036,7 @@ Tk_SetWindowBackgroundPixmap( Tk_Window tkwin, /* Window to manipulate. */ Pixmap pixmap) /* Pixmap to use for window's background. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->atts.background_pixmap = pixmap; @@ -2035,7 +2054,7 @@ Tk_SetWindowBorder( Tk_Window tkwin, /* Window to manipulate. */ unsigned long pixel) /* Pixel value to use for window's border. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->atts.border_pixel = pixel; @@ -2052,7 +2071,7 @@ Tk_SetWindowBorderPixmap( Tk_Window tkwin, /* Window to manipulate. */ Pixmap pixmap) /* Pixmap to use for window's border. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->atts.border_pixmap = pixmap; @@ -2070,7 +2089,7 @@ Tk_DefineCursor( Tk_Window tkwin, /* Window to manipulate. */ Tk_Cursor cursor) /* Cursor to use for window (may be None). */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; #if defined(MAC_OSX_TK) winPtr->atts.cursor = (XCursor) cursor; @@ -2097,7 +2116,7 @@ Tk_SetWindowColormap( Tk_Window tkwin, /* Window to manipulate. */ Colormap colormap) /* Colormap to use for window. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->atts.colormap = colormap; @@ -2139,7 +2158,7 @@ Tk_SetWindowVisual( int depth, /* New depth for window. */ Colormap colormap) /* An appropriate colormap for the visual. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; if (winPtr->window != None) { /* Too late! */ @@ -2182,7 +2201,7 @@ Tk_SetWindowVisual( void TkDoConfigureNotify( - register TkWindow *winPtr) /* Window whose configuration was just + TkWindow *winPtr) /* Window whose configuration was just * changed. */ { XEvent event; @@ -2228,7 +2247,7 @@ Tk_SetClass( Tk_Window tkwin, /* Token for window to assign class. */ const char *className) /* New class for tkwin. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->classUid = Tk_GetUid(className); if (winPtr->flags & TK_WIN_MANAGED) { @@ -2261,7 +2280,7 @@ Tk_SetClassProcs( const Tk_ClassProcs *procs, /* Class procs structure. */ ClientData instanceData) /* Data to be passed to class functions. */ { - register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr = (TkWindow *) tkwin; winPtr->classProcsPtr = procs; winPtr->instanceData = instanceData; diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl index 82704b3..af8a2a5 100644 --- a/generic/ttk/ttkGenStubs.tcl +++ b/generic/ttk/ttkGenStubs.tcl @@ -689,7 +689,7 @@ proc genStubs::makeInit {name decl index} { # have the interface name, the declaration, and # the index appended. # guardProc The proc to invoke to add guards. It will have -# the slot status and text appended. +# the slot status and text appended. # textVar The variable to use for output. # skipString The string to emit if a slot is skipped. This # string will be subst'ed in the loop so "$i" can diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c index 0cfc119..f5bfb4d 100644 --- a/generic/ttk/ttkWidget.c +++ b/generic/ttk/ttkWidget.c @@ -8,10 +8,6 @@ #include "ttkTheme.h" #include "ttkWidget.h" -#ifdef MAC_OSX_TK -#define TK_NO_DOUBLE_BUFFERING 1 -#endif - /*------------------------------------------------------------------------ * +++ Internal helper routines. */ diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index d210c7d..c88bfa9 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -114,7 +114,7 @@ if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8 # Support for mousewheels on Linux/Unix commonly comes through mapping # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: - # http://linuxreviews.org/howtos/xfree/mouse/ + # https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X bind $c <Button-4> { if {!$tk_strictMotif} { %W yview scroll -5 units diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 9d49c57..fb6c6d3 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -247,6 +247,7 @@ proc ::tk::fontchooser::Create {} { grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news grid $WE x $WS - - x ^ -in $outer -sticky news -pady {15 30} grid configure $bbox -sticky n + grid rowconfigure $outer 2 -weight 1 grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) grid columnconfigure $outer {0 2 4} -weight 1 grid columnconfigure $outer 0 -minsize $minsize(fonts) diff --git a/library/icons.tcl b/library/icons.tcl index e53a1bd..87af75a 100644 --- a/library/icons.tcl +++ b/library/icons.tcl @@ -4,7 +4,7 @@ # were provided by the Tango Desktop project which provides a # unified set of high quality icons licensed under the # Creative Commons Attribution Share-Alike license -# (http://creativecommons.org/licenses/by-sa/3.0/) +# (https://creativecommons.org/licenses/by-sa/3.0/) # # See http://tango.freedesktop.org/Tango_Desktop_Project # diff --git a/library/listbox.tcl b/library/listbox.tcl index 9e628a8..44abfb9 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -214,7 +214,7 @@ if {[tk windowingsystem] eq "x11"} { # Support for mousewheels on Linux/Unix commonly comes through mapping # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: - # http://linuxreviews.org/howtos/xfree/mouse/ + # https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X bind Listbox <4> { if {!$tk_strictMotif} { %W yview scroll -5 units @@ -296,7 +296,7 @@ proc ::tk::ListboxMotion {w el} { } extended { set i $Priv(listboxPrev) - if {$i eq ""} { + if {$i < 0} { set i $el $w selection set $el } diff --git a/library/menu.tcl b/library/menu.tcl index c4991f8..823fd69 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution @@ -269,8 +269,8 @@ proc ::tk::MbPost {w {x {}} {y {}}} { MenuUnpost {} } if {$::tk_strictMotif} { - set Priv(cursor) [$w cget -cursor] - $w configure -cursor arrow + set Priv(cursor) [$w cget -cursor] + $w configure -cursor arrow } if {[tk windowingsystem] ne "aqua"} { set Priv(relief) [$w cget -relief] @@ -343,7 +343,7 @@ proc ::tk::MenuUnpost menu { $menu unpost set Priv(postedMb) {} if {$::tk_strictMotif} { - $mb configure -cursor $Priv(cursor) + $mb configure -cursor $Priv(cursor) } if {[tk windowingsystem] ne "aqua"} { $mb configure -relief $Priv(relief) @@ -475,7 +475,7 @@ proc ::tk::MbButtonUp w { proc ::tk::MenuMotion {menu x y state} { variable ::tk::Priv if {$menu eq $Priv(window)} { - set activeindex [$menu index active] + set active [$menu index active] if {[$menu cget -type] eq "menubar"} { if {[info exists Priv(focus)] && $menu ne $Priv(focus)} { $menu activate @$x,$y @@ -485,24 +485,24 @@ proc ::tk::MenuMotion {menu x y state} { $menu activate @$x,$y GenerateMenuSelect $menu } - set index [$menu index @$x,$y] - if {[info exists Priv(menuActivated)] \ - && $index ne "none" \ - && $index ne $activeindex} { - set mode [option get $menu clickToFocus ClickToFocus] - if {[string is false $mode]} { - set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}] - if {[$menu type $index] eq "cascade"} { - # Catch these postcascade commands since the menu could be - # destroyed before they run. - set Priv(menuActivatedTimer) \ - [after $delay "catch {$menu postcascade active}"] - } else { - set Priv(menuDeactivatedTimer) \ - [after $delay "catch {$menu postcascade none}"] - } - } - } + set index [$menu index @$x,$y] + if {[info exists Priv(menuActivated)] \ + && $index ne "none" \ + && $index ne $active} { + set mode [option get $menu clickToFocus ClickToFocus] + if {[string is false $mode]} { + set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}] + if {[$menu type $index] eq "cascade"} { + # Catch these postcascade commands since the menu could be + # destroyed before they run. + set Priv(menuActivatedTimer) \ + [after $delay "catch {$menu postcascade active}"] + } else { + set Priv(menuDeactivatedTimer) \ + [after $delay "catch {$menu postcascade none}"] + } + } + } } } @@ -525,13 +525,13 @@ proc ::tk::MenuButtonDown menu { variable ::tk::Priv if {![winfo viewable $menu]} { - return + return } if {[$menu index active] eq "none"} { - if {[$menu cget -type] ne "menubar" } { - set Priv(window) {} - } - return + if {[$menu cget -type] ne "menubar" } { + set Priv(window) {} + } + return } $menu postcascade active if {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} { @@ -552,7 +552,7 @@ proc ::tk::MenuButtonDown menu { if {[$menu type active] eq "cascade"} { set Priv(menuActivated) 1 } - } + } # Don't update grab information if the grab window isn't changing. # Otherwise, we'll get an error when we unpost the menus and @@ -893,7 +893,7 @@ proc ::tk::MenuFind {w char} { foreach child $windowlist { # Don't descend into other toplevels. - if {[winfo toplevel $w] ne [winfo toplevel $child]} { + if {[winfo toplevel $w] ne [winfo toplevel $child]} { continue } if {[winfo class $child] eq "Menu" && \ @@ -919,7 +919,7 @@ proc ::tk::MenuFind {w char} { foreach child $windowlist { # Don't descend into other toplevels. - if {[winfo toplevel $w] ne [winfo toplevel $child]} { + if {[winfo toplevel $w] ne [winfo toplevel $child]} { continue } switch -- [winfo class $child] { @@ -941,7 +941,7 @@ proc ::tk::MenuFind {w char} { } } } - return {} + return "" } # ::tk::TraverseToMenu -- @@ -1115,7 +1115,7 @@ proc ::tk::MenuFindName {menu s} { } set last [$menu index last] if {$last eq "none"} { - return + return "" } for {set i 0} {$i <= $last} {incr i} { if {![catch {$menu entrycget $i -label} label]} { @@ -1186,7 +1186,7 @@ if {[tk windowingsystem] eq "aqua"} { # if we go offscreen to the top, show as 'below' if {$y < [winfo vrooty $button]} { set y [expr {[winfo vrooty $button] + [winfo rooty $button]\ - + [winfo reqheight $button]}] + + [winfo reqheight $button]}] } set entry {} } @@ -1340,14 +1340,12 @@ proc ::tk_menuSetFocus {menu} { proc ::tk::GenerateMenuSelect {menu} { variable ::tk::Priv - if {$Priv(activeMenu) eq $menu \ - && $Priv(activeItem) eq [$menu index active]} { - return + if {$Priv(activeMenu) ne $menu \ + || $Priv(activeItem) ne [$menu index active]} { + set Priv(activeMenu) $menu + set Priv(activeItem) [$menu index active] + event generate $menu <<MenuSelect>> } - - set Priv(activeMenu) $menu - set Priv(activeItem) [$menu index active] - event generate $menu <<MenuSelect>> } # ::tk_popup -- @@ -1369,7 +1367,7 @@ proc ::tk_popup {menu x y {entry {}}} { } tk::PostOverPoint $menu $x $y $entry if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} { - tk::SaveGrabInfo $menu + tk::SaveGrabInfo $menu grab -global $menu set Priv(popup) $menu set Priv(window) $menu diff --git a/library/tearoff.tcl b/library/tearoff.tcl index dece4df..96e275f 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -79,11 +79,11 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { } if {[tk windowingsystem] eq "win32"} { - # [Bug 3181181]: Find the toplevel window for the menu - set parent [winfo toplevel $parent] - while {[winfo class $parent] eq "Menu"} { - set parent [winfo toplevel [winfo parent $parent]] - } + # [Bug 3181181]: Find the toplevel window for the menu + set parent [winfo toplevel $parent] + while {[winfo class $parent] eq "Menu"} { + set parent [winfo toplevel [winfo parent $parent]] + } wm transient $menu [winfo toplevel $parent] wm attributes $menu -toolwindow 1 } @@ -135,7 +135,7 @@ proc ::tk::MenuDup {src dst type} { } eval $cmd set last [$src index last] - if {$last eq "none"} { + if {$last eq "none" || $last < 0} { return } for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { diff --git a/library/text.tcl b/library/text.tcl index ec8f3d3..d1f9b86 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -499,7 +499,7 @@ if {[tk windowingsystem] eq "x11"} { # Support for mousewheels on Linux/Unix commonly comes through mapping # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: - # http://linuxreviews.org/howtos/xfree/mouse/ + # https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X bind Text <4> { if {!$tk_strictMotif} { %W yview scroll -50 pixels diff --git a/library/tk.tcl b/library/tk.tcl index 0715489..5bb3be7 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -11,7 +11,7 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.6.11 +package require -exact Tk 8.6.12 # Create a ::tk namespace namespace eval ::tk { @@ -460,7 +460,7 @@ switch -exact -- [tk windowingsystem] { event add <<ContextMenu>> <Button-2> # Official bindings - # See http://support.apple.com/kb/HT1343 + # See https://support.apple.com/en-us/HT201236 event add <<SelectAll>> <Command-Key-a> event add <<Undo>> <Command-Key-z> <Command-Lock-Key-Z> event add <<Redo>> <Shift-Command-Key-z> <Shift-Command-Lock-Key-z> diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index 3ccdd70..876423f 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -42,6 +42,9 @@ namespace eval ttk::theme::aqua { # so we only need to specify !focus.) # Entry + ttk::style configure TEntry \ + -foreground systemTextColor \ + -background systemTextBackgroundColor ttk::style map TEntry \ -foreground { disabled systemDisabledControlTextColor @@ -60,6 +63,9 @@ namespace eval ttk::theme::aqua { } # Spinbox + ttk::style configure TSpinbox \ + -foreground systemTextColor \ + -background systemTextBackgroundColor ttk::style map TSpinbox \ -foreground { disabled systemDisabledControlTextColor diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index a245df8..a0f70c9 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -83,9 +83,8 @@ if {[tk windowingsystem] eq "aqua"} { set mw [winfo reqwidth $menu] set bw [winfo width $mb] set dF [expr {[winfo width $mb] - [winfo reqwidth $menu] - $menuPad}] - set entry "" set entry [::tk::MenuFindName $menu [$mb cget -text]] - if {$entry eq ""} { + if {$entry < 0} { set entry 0 } set x [winfo rootx $mb] @@ -124,25 +123,24 @@ if {[tk windowingsystem] eq "aqua"} { incr mh 6 incr mw 16 } - set entry {} set entry [::tk::MenuFindName $menu [$mb cget -text]] - if {$entry eq {}} { + if {$entry < 0} { set entry 0 } set x [winfo rootx $mb] set y [winfo rooty $mb] switch [$mb cget -direction] { above { - set entry {} + set entry "" incr y -$mh # if we go offscreen to the top, show as 'below' if {$y < [winfo vrooty $mb]} { set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\ - + [winfo reqheight $mb]}] + + [winfo reqheight $mb]}] } } below { - set entry {} + set entry "" incr y $bh # if we go offscreen to the bottom, show as 'above' if {($y + $mh) > ([winfo vrooty $mb] + [winfo vrootheight $mb])} { @@ -196,7 +194,7 @@ proc ttk::menubutton::Pulldown {mb} { $mb state pressed $mb configure -cursor [$menu cget -cursor] foreach {x y entry} [PostPosition $mb $menu] { break } - if {$entry ne {}} { + if {$entry >= 0} { $menu post $x $y $entry } else { $menu post $x $y @@ -228,7 +226,7 @@ proc ttk::menubutton::TransferGrab {mb} { # proc ttk::menubutton::FindMenuEntry {menu s} { set last [$menu index last] - if {$last eq "none" || $last eq ""} { + if {$last eq "none" || $last < 0} { return "" } for {set i 0} {$i <= $last} {incr i} { diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 1213450..8be9887 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -29,8 +29,6 @@ switch [tk windowingsystem] { x11 { lappend eventList <Button-4> <Button-5> \ <Shift-Button-4> <Shift-Button-5> - # For tk 8.7, the event list will be extended by - # <Button-6> <Button-7> } } foreach event $eventList { diff --git a/macosx/Credits.html.in b/macosx/Credits.html.in index cc409b1..1c14367 100644 --- a/macosx/Credits.html.in +++ b/macosx/Credits.html.in @@ -5,8 +5,8 @@ <body style="font-size:120%;font-family:Arial,sans-serif;"> <p> Tcl and Tk are distributed under a modified BSD license:<br> -<a href="https:www.tcl.tk/software/tcltk/license.html"> - https:www.tcl.tk/software/tcltk/license.html +<a href="https://www.tcl-lang.org/software/tcltk/license.html"> + https://www.tcl-lang.org/software/tcltk/license.html </a> </p> <ul style="list-style-type:none;"> diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index ff028b5..dd4c025 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -46,12 +46,6 @@ TK_X11 ?= # Checks and overrides for subframework builds ifeq (${SUBFRAMEWORK}_${TK_X11},1_) -ifeq (${DYLIB_INSTALL_DIR},) - @echo "Cannot install subframework with empty DYLIB_INSTALL_DIR !" && false -endif -ifeq (${DESTDIR},) - @echo "Cannot install subframework with empty DESTDIR !" && false -endif override BUILD_DIR = ${DESTDIR}/build override INSTALL_PATH = /Frameworks endif @@ -145,9 +139,9 @@ wish := ${wish}-X11 override EMBEDDED_BUILD := endif -INSTALL_TARGETS = install-binaries install-libraries +INSTALL_TARGETS = install-binaries install-libraries install-headers ifeq (${EMBEDDED_BUILD},) -INSTALL_TARGETS += install-private-headers install-headers install-demos +INSTALL_TARGETS += install-private-headers install-demos endif ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment) INSTALL_TARGETS += html-tk diff --git a/macosx/README b/macosx/README index 834dea4..4ed334f 100644 --- a/macosx/README +++ b/macosx/README @@ -681,7 +681,7 @@ conditional code which is only used for macOS. The 10.14 release added support for system appearance changes, including a "Dark Mode" that renders all window frames and menus in -dark colors. Tk 8.6.11 provides three virtual events <<LightAqua>>, +dark colors. Tk 8.6 provides three virtual events <<LightAqua>>, <<DarkAqua>> and <<AppearanceChanged>>, to allow you to update your Tk app's appearance when the system appearance changes. These events are generated in [NSView effectiveAppearanceChanged], which is called by diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c index b083531..f8f60f8 100644 --- a/macosx/tkMacOSXButton.c +++ b/macosx/tkMacOSXButton.c @@ -765,10 +765,12 @@ TkMacOSXDrawButton( * Using a ttk::button would be a much better choice, however. */ - if (TkMacOSXInDarkMode(butPtr->tkwin) && - mbPtr->drawinfo.state != kThemeStatePressed && - !(mbPtr->drawinfo.adornment & kThemeAdornmentDefault)) { - hiinfo.state = kThemeStateInactive; + if ([NSApp macOSVersion] < 101500) { + if (TkMacOSXInDarkMode(butPtr->tkwin) && + mbPtr->drawinfo.state != kThemeStatePressed && + !(mbPtr->drawinfo.adornment & kThemeAdornmentDefault)) { + hiinfo.state = kThemeStateInactive; + } } HIThemeDrawButton(&cntrRect, &hiinfo, dc.context, kHIThemeOrientationNormal, &contHIRec); diff --git a/macosx/tkMacOSXColor.c b/macosx/tkMacOSXColor.c index edcd5d3..3951683 100644 --- a/macosx/tkMacOSXColor.c +++ b/macosx/tkMacOSXColor.c @@ -24,6 +24,7 @@ static int numSystemColors; static int rgbColorIndex; static int controlAccentIndex; static int selectedTabTextIndex; +static int pressedButtonTextIndex; static Bool useFakeAccentColor = NO; static SystemColorDatum **systemColorIndex; #if MAC_OS_X_VERSION_MAX_ALLOWED >= 101400 @@ -67,7 +68,8 @@ void initColorTable() if (![NSColor respondsToSelector:colorSelector]) { if ([colorName isEqualToString:@"controlAccentColor"]) { useFakeAccentColor = YES; - } else if (![colorName isEqualToString:@"selectedTabTextColor"]) { + } else if ( ![colorName isEqualToString:@"selectedTabTextColor"] + && ![colorName isEqualToString:@"pressedButtonTextColor"]) { /* Uncomment to print all unsupported colors: */ /* printf("Unsupported color %s\n", colorName.UTF8String); */ continue; @@ -147,6 +149,9 @@ void initColorTable() hPtr = Tcl_FindHashEntry(&systemColors, "SelectedTabTextColor"); entry = (SystemColorDatum *) Tcl_GetHashValue(hPtr); selectedTabTextIndex = entry->index; + hPtr = Tcl_FindHashEntry(&systemColors, "PressedButtonTextColor"); + entry = (SystemColorDatum *) Tcl_GetHashValue(hPtr); + pressedButtonTextIndex = entry->index; [pool drain]; } @@ -278,6 +283,7 @@ GetRGBA( CGFloat *rgba) { NSColor *bgColor, *color = nil; + int OSVersion = [NSApp macOSVersion]; if (!sRGB) { sRGB = [NSColorSpace sRGBColorSpace]; @@ -325,12 +331,17 @@ GetRGBA( colorUsingColorSpace:sRGB]; #endif } else if (entry->index == selectedTabTextIndex) { - int OSVersion = [NSApp macOSVersion]; if (OSVersion > 100600 && OSVersion < 110000) { color = [[NSColor whiteColor] colorUsingColorSpace:sRGB]; } else { color = [[NSColor textColor] colorUsingColorSpace:sRGB]; } + } else if (entry->index == pressedButtonTextIndex) { + if (OSVersion < 120000) { + color = [[NSColor whiteColor] colorUsingColorSpace:sRGB]; + } else { + color = [[NSColor blackColor] colorUsingColorSpace:sRGB]; + } } else { color = [[NSColor valueForKey:entry->selector] colorUsingColorSpace:sRGB]; } diff --git a/macosx/tkMacOSXColor.h b/macosx/tkMacOSXColor.h index deffbbc..bc9d307 100644 --- a/macosx/tkMacOSXColor.h +++ b/macosx/tkMacOSXColor.h @@ -241,8 +241,10 @@ static SystemColorDatum systemColorData[] = { {"WindowBackgroundColor7", ttkBackground, 7, NULL, 0, NULL }, /* Apple's SecondaryLabelColor is the same as their LabelColor so we roll our own. */ {"SecondaryLabelColor", ttkBackground, 14, NULL, 0, NULL }, -/* Color to use for notebook tab labels -- depends on OS version. */ +/* Color to use for notebook tab label text -- depends on OS version. */ {"SelectedTabTextColor", semantic, 0, "textColor", 0, NULL }, +/* Color to use for selected button labels -- depends on OS version. */ +{"PressedButtonTextColor", semantic, 0, "textColor", 0, NULL }, /* Semantic colors that we simulate on older systems which don't supoort them. */ {"ControlAccentColor", semantic, 0, "controlAccentColor", 0, NULL }, {"LabelColor", semantic, 0, "blackColor", 0, NULL }, diff --git a/macosx/tkMacOSXConstants.h b/macosx/tkMacOSXConstants.h index 0b6ae2b..9d4079c 100644 --- a/macosx/tkMacOSXConstants.h +++ b/macosx/tkMacOSXConstants.h @@ -96,6 +96,7 @@ typedef NSInteger NSModalResponse; #define NSMiniaturizableWindowMask NSWindowStyleMaskMiniaturizable #define NSBorderlessWindowMask NSWindowStyleMaskBorderless #define NSFullScreenWindowMask NSWindowStyleMaskFullScreen +#define NSAlphaFirstBitmapFormat NSBitmapFormatAlphaFirst #endif #if MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index af0a06b..5a5ccca 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -55,7 +55,7 @@ #define DEF_BUTTON_ANCHOR "center" #define DEF_BUTTON_ACTIVE_BG_COLOR ACTIVE_BG #define DEF_BUTTON_ACTIVE_BG_MONO BLACK -#define DEF_BUTTON_ACTIVE_FG_COLOR WHITE +#define DEF_BUTTON_ACTIVE_FG_COLOR "systemPressedButtonTextColor" #define DEF_CHKRAD_ACTIVE_FG_COLOR ACTIVE_FG #define DEF_BUTTON_ACTIVE_FG_MONO WHITE #define DEF_BUTTON_BG_COLOR NORMAL_BG @@ -68,13 +68,14 @@ #define DEF_BUTTON_DEFAULT "disabled" #define DEF_BUTTON_DISABLED_FG_COLOR DISABLED #define DEF_BUTTON_DISABLED_FG_MONO "" -#define DEF_BUTTON_FG NORMAL_FG -#define DEF_CHKRAD_FG DEF_BUTTON_FG +#define DEF_BUTTON_FG BLACK +#define DEF_LABEL_FG NORMAL_FG +#define DEF_CHKRAD_FG DEF_LABEL_FG #define DEF_BUTTON_FONT "TkDefaultFont" #define DEF_BUTTON_HEIGHT "0" #define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR #define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO -#define DEF_BUTTON_HIGHLIGHT "systemButtonFrame" +#define DEF_BUTTON_HIGHLIGHT NORMAL_FG #define DEF_LABEL_HIGHLIGHT_WIDTH "0" //#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS //#define DEF_BUTTON_HIGHLIGHT_WIDTH "4" @@ -124,7 +125,7 @@ #define DEF_CANVAS_CURSOR "" #define DEF_CANVAS_HEIGHT "7c" #define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG -#define DEF_CANVAS_HIGHLIGHT BLACK +#define DEF_CANVAS_HIGHLIGHT NORMAL_FG #define DEF_CANVAS_HIGHLIGHT_WIDTH "3" #define DEF_CANVAS_INSERT_BG BLACK #define DEF_CANVAS_INSERT_BD_COLOR "0" @@ -174,7 +175,7 @@ #define DEF_ENTRY_FONT "TkTextFont" #define DEF_ENTRY_FG NORMAL_FG #define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG -#define DEF_ENTRY_HIGHLIGHT BLACK +#define DEF_ENTRY_HIGHLIGHT NORMAL_FG #define DEF_ENTRY_HIGHLIGHT_WIDTH "3" #define DEF_ENTRY_INSERT_BG NORMAL_FG #define DEF_ENTRY_INSERT_BD_COLOR "0" @@ -212,7 +213,7 @@ #define DEF_FRAME_CURSOR "" #define DEF_FRAME_HEIGHT "0" #define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG -#define DEF_FRAME_HIGHLIGHT BLACK +#define DEF_FRAME_HIGHLIGHT NORMAL_FG #define DEF_FRAME_HIGHLIGHT_WIDTH "0" #define DEF_FRAME_PADX "0" #define DEF_FRAME_PADY "0" @@ -248,7 +249,7 @@ #define DEF_LISTBOX_FG NORMAL_FG #define DEF_LISTBOX_HEIGHT "10" #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG -#define DEF_LISTBOX_HIGHLIGHT BLACK +#define DEF_LISTBOX_HIGHLIGHT NORMAL_FG #define DEF_LISTBOX_HIGHLIGHT_WIDTH "0" #define DEF_LISTBOX_JUSTIFY "left" #define DEF_LISTBOX_RELIEF "solid" @@ -343,7 +344,7 @@ #define DEF_MENUBUTTON_HEIGHT "0" #define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR #define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO -#define DEF_MENUBUTTON_HIGHLIGHT BLACK +#define DEF_MENUBUTTON_HIGHLIGHT NORMAL_FG #define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0" #define DEF_MENUBUTTON_IMAGE NULL #define DEF_MENUBUTTON_INDICATOR "1" @@ -373,7 +374,7 @@ #define DEF_MESSAGE_FG NORMAL_FG #define DEF_MESSAGE_FONT "TkDefaultFont" #define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG -#define DEF_MESSAGE_HIGHLIGHT BLACK +#define DEF_MESSAGE_HIGHLIGHT NORMAL_FG #define DEF_MESSAGE_HIGHLIGHT_WIDTH "0" #define DEF_MESSAGE_JUSTIFY "left" #define DEF_MESSAGE_PADX "-1" @@ -439,7 +440,7 @@ #define DEF_SCALE_FROM "0" #define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR #define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO -#define DEF_SCALE_HIGHLIGHT BLACK +#define DEF_SCALE_HIGHLIGHT NORMAL_FG #define DEF_SCALE_HIGHLIGHT_WIDTH "0" #define DEF_SCALE_LABEL "" #define DEF_SCALE_LENGTH "100" @@ -474,7 +475,7 @@ #define DEF_SCROLLBAR_CURSOR "" #define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1" #define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG -#define DEF_SCROLLBAR_HIGHLIGHT BLACK +#define DEF_SCROLLBAR_HIGHLIGHT NORMAL_FG #define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "0" #define DEF_SCROLLBAR_JUMP "0" #define DEF_SCROLLBAR_ORIENT "vertical" @@ -501,7 +502,7 @@ #define DEF_TEXT_FONT "TkFixedFont" #define DEF_TEXT_HEIGHT "24" #define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG -#define DEF_TEXT_HIGHLIGHT BLACK +#define DEF_TEXT_HIGHLIGHT NORMAL_FG #define DEF_TEXT_HIGHLIGHT_WIDTH "3" #define DEF_TEXT_INSERT_BG NORMAL_FG #define DEF_TEXT_INSERT_BD_COLOR "0" diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 4bcaedf..f6b8357 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -350,49 +350,42 @@ static NSInteger showOpenSavePanel( FilePanelCallbackInfo *callbackInfo) { NSInteger modalReturnCode; + int OSVersion = [NSApp macOSVersion]; - if (parent && ![parent attachedSheet]) { - [panel beginSheetModalForWindow:parent - completionHandler:^(NSModalResponse returnCode) { - [NSApp tkFilePanelDidEnd:panel - returnCode:returnCode - contextInfo:callbackInfo ]; - }]; - - /* - * The sheet has been prepared, so now we have to run it as a modal - * window. Using [NSApp runModalForWindow:] on macOS 10.15 or later - * generates warnings on stderr. But using [NSOpenPanel runModal] or - * [NSSavePanel runModal] on 10.14 or earler does not cause the - * completion handler to run when the panel is closed. - */ + /* + * Use a sheet if -parent is specified (unless there is already a sheet). + */ - if ([NSApp macOSVersion] > 101400) { - modalReturnCode = [panel runModal]; - } else { + if (parent && ![parent attachedSheet]) { + if (OSVersion < 101500) { + [panel beginSheetModalForWindow:parent + completionHandler:^(NSModalResponse returnCode) { + [NSApp tkFilePanelDidEnd:panel + returnCode:returnCode + contextInfo:callbackInfo ]; + }]; modalReturnCode = [NSApp runModalForWindow:panel]; - } - } else { - - /* - * For the standalone file dialog, completion handlers do not work - * at all on macOS 10.14 and earlier. - */ - - if ([NSApp macOSVersion] > 101400) { - [panel beginWithCompletionHandler:^(NSModalResponse returnCode) { + } else if (OSVersion < 110000) { + [panel beginSheetModalForWindow:parent + completionHandler:^(NSModalResponse returnCode) { [NSApp tkFilePanelDidEnd:panel - returnCode:returnCode - contextInfo:callbackInfo ]; - }]; + returnCode:returnCode + contextInfo:callbackInfo ]; + }]; modalReturnCode = [panel runModal]; } else { + [parent beginSheet: panel completionHandler:nil]; modalReturnCode = [panel runModal]; [NSApp tkFilePanelDidEnd:panel - returnCode:modalReturnCode - contextInfo:callbackInfo ]; - [panel close]; + returnCode:modalReturnCode + contextInfo:callbackInfo ]; + [parent endSheet:panel]; } + } else { + modalReturnCode = [panel runModal]; + [NSApp tkFilePanelDidEnd:panel + returnCode:modalReturnCode + contextInfo:callbackInfo ]; } return callbackInfo->cmdObj ? modalOther : modalReturnCode; } diff --git a/macosx/tkMacOSXDraw.c b/macosx/tkMacOSXDraw.c index ac5c721..d5396eb 100644 --- a/macosx/tkMacOSXDraw.c +++ b/macosx/tkMacOSXDraw.c @@ -27,6 +27,7 @@ #ifdef TK_MAC_DEBUG #define TK_MAC_DEBUG_DRAWING #define TK_MAC_DEBUG_IMAGE_DRAWING +#define TK_MAC_DEBUG_CG #endif */ @@ -513,7 +514,7 @@ XDrawSegments( * * XFillPolygon -- * - * Draws a filled polygon. + * Draws a filled polygon using the even-odd fill algorithm, * * Results: * None. @@ -531,7 +532,7 @@ XFillPolygon( GC gc, /* Use this GC. */ XPoint *points, /* Array of points. */ int npoints, /* Number of points. */ - TCL_UNUSED(int), /* Shape to draw. */ + TCL_UNUSED(int), /* Shape to draw. */ int mode) /* Drawing mode. */ { MacDrawable *macWin = (MacDrawable *)d; @@ -1265,6 +1266,12 @@ TkMacOSXSetupDrawingContext( Bool canDraw = true; TKContentView *view = nil; TkMacOSXDrawingContext dc = {}; + CGFloat drawingHeight; + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "TkMacOSXSetupDrawingContext: %s\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None"); +#endif /* * If the drawable is not a pixmap, get the associated NSView. @@ -1296,14 +1303,10 @@ TkMacOSXSetupDrawingContext( */ dc.context = TkMacOSXGetCGContextForDrawable(d); - if (dc.context) { - dc.portBounds = CGContextGetClipBoundingBox(dc.context); - } else { + if (!dc.context) { NSRect drawingBounds, currentBounds; - dc.view = view; dc.context = GET_CGCONTEXT; - dc.portBounds = NSRectToCGRect([view bounds]); if (dc.clipRgn) { CGRect clipBounds; CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, @@ -1355,37 +1358,66 @@ TkMacOSXSetupDrawingContext( * Finish configuring the drawing context. */ - { - CGAffineTransform t = { - .a = 1, .b = 0, - .c = 0, .d = -1, - .tx = 0, - .ty = dc.portBounds.size.height - }; + drawingHeight = view ? [view bounds].size.height : + CGContextGetClipBoundingBox(dc.context).size.height; + CGAffineTransform t = { + .a = 1, .b = 0, + .c = 0, .d = -1, + .tx = 0, + .ty = drawingHeight + }; + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "TkMacOSXSetupDrawingContext: pushing GState for %s\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None"); +#endif - dc.portBounds.origin.x += macDraw->xOff; - dc.portBounds.origin.y += macDraw->yOff; - CGContextSaveGState(dc.context); - CGContextSetTextDrawingMode(dc.context, kCGTextFill); - CGContextConcatCTM(dc.context, t); - if (dc.clipRgn) { + CGContextSaveGState(dc.context); + CGContextSetTextDrawingMode(dc.context, kCGTextFill); + CGContextConcatCTM(dc.context, t); + if (dc.clipRgn) { #ifdef TK_MAC_DEBUG_DRAWING - CGContextSaveGState(dc.context); - ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); - CGContextSetRGBFillColor(dc.context, 1.0, 0.0, 0.0, 0.1); - CGContextEOFillPath(dc.context); - CGContextRestoreGState(dc.context); + CGContextSaveGState(dc.context); + ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); + CGContextSetRGBFillColor(dc.context, 1.0, 0.0, 0.0, 0.1); + CGContextEOFillPath(dc.context); + CGContextRestoreGState(dc.context); #endif /* TK_MAC_DEBUG_DRAWING */ + if (!HIShapeIsRectangular(dc.clipRgn)) { + + /* + * We expect the clipping path dc.clipRgn to consist of the + * bounding rectangle of the drawable window, together with + * disjoint smaller rectangles inside of it which bound its + * geometric children. In that case the even-odd rule will + * clip to the region inside the large rectangle and outside + * of the smaller rectangles. + */ + + ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "Setting complex clip for %s to:\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None"); + TkMacOSXPrintRectsInRegion(dc.clipRgn); +#endif + + CGContextEOClip(dc.context); + } else { CGRect r; - CGRect b = CGRectApplyAffineTransform( - CGContextGetClipBoundingBox(dc.context), t); - if (!HIShapeIsRectangular(dc.clipRgn) || - !CGRectContainsRect(*HIShapeGetBounds(dc.clipRgn, &r), b)) { - ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); - CGContextEOClip(dc.context); - } + HIShapeGetBounds(dc.clipRgn, &r); + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "Current clip BBox is %s\n", + NSStringFromRect(CGContextGetClipBoundingBox(GET_CGCONTEXT)).UTF8String); + fprintf(stderr, "Setting clip for %s to rect %s:\n", + macDraw->winPtr ? Tk_PathName(macDraw->winPtr) : "None", + NSStringFromRect(r).UTF8String); +#endif + + CGContextClipToRect(dc.context, r); } } if (gc) { @@ -1405,8 +1437,8 @@ TkMacOSXSetupDrawingContext( TkMacOSXSetColorInContext(gc, gc->foreground, dc.context); if (view) { - CGContextSetPatternPhase(dc.context, CGSizeMake( - dc.portBounds.size.width, dc.portBounds.size.height)); + CGSize size = NSSizeToCGSize([view bounds].size); + CGContextSetPatternPhase(dc.context, size); } if (gc->function != GXcopy) { TkMacOSXDbgMsg("Logical functions other than GXcopy are " @@ -1446,13 +1478,9 @@ TkMacOSXSetupDrawingContext( end: #ifdef TK_MAC_DEBUG_DRAWING - if (!canDraw && win != NULL) { - TkWindow *winPtr = TkMacOSXGetTkWindow(win); - - if (winPtr) { - fprintf(stderr, "Cannot draw in %s - postponing.\n", - Tk_PathName(winPtr)); - } + if (!canDraw && macDraw->winPtr != NULL) { + fprintf(stderr, "Cannot draw in %s - postponing.\n", + Tk_PathName(macDraw->winPtr)); } #endif @@ -1487,13 +1515,21 @@ TkMacOSXRestoreDrawingContext( if (dcPtr->context) { CGContextSynchronize(dcPtr->context); CGContextRestoreGState(dcPtr->context); + +#ifdef TK_MAC_DEBUG_CG + fprintf(stderr, "TkMacOSXRestoreDrawingContext: popped GState\n"); +#endif + } if (dcPtr->clipRgn) { CFRelease(dcPtr->clipRgn); + dcPtr->clipRgn = NULL; } + #ifdef TK_MAC_DEBUG bzero(dcPtr, sizeof(TkMacOSXDrawingContext)); -#endif /* TK_MAC_DEBUG */ +#endif + } /* diff --git a/macosx/tkMacOSXEmbed.c b/macosx/tkMacOSXEmbed.c index 4af2e75..2f04e74 100644 --- a/macosx/tkMacOSXEmbed.c +++ b/macosx/tkMacOSXEmbed.c @@ -1116,6 +1116,9 @@ EmbedWindowDeleted( prevPtr = NULL; containerPtr = firstContainerPtr; while (1) { + if (containerPtr == NULL) { + return; + } if (containerPtr->embeddedPtr == winPtr) { /* * We also have to destroy our parent, to clean up the container. diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index 2a28f73..d9c1c01 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -1208,16 +1208,18 @@ TkpDrawAngledCharsInContext( TkSetMacColor(gc->foreground, &fg); attributes = [fontPtr->nsAttributes mutableCopy]; [attributes setObject:(id)fg forKey:(id)kCTForegroundColorAttributeName]; + CFRelease(fg); nsFont = [attributes objectForKey:NSFontAttributeName]; [nsFont setInContext:GET_NSCONTEXT(context, NO)]; CGContextSetTextMatrix(context, CGAffineTransformIdentity); attributedString = [[NSAttributedString alloc] initWithString:string attributes:attributes]; + [string release]; typesetter = CTTypesetterCreateWithAttributedString( (CFAttributedStringRef)attributedString); textX += (CGFloat) macWin->xOff; textY += (CGFloat) macWin->yOff; - height = drawingContext.portBounds.size.height; + height = [drawingContext.view bounds].size.height; textY = height - textY; t = CGAffineTransformMake(1.0, 0.0, 0.0, -1.0, 0.0, height); if (angle != 0.0) { @@ -1249,7 +1251,6 @@ TkpDrawAngledCharsInContext( CFRelease(line); CFRelease(typesetter); [attributedString release]; - [string release]; [attributes release]; TkMacOSXRestoreDrawingContext(&drawingContext); } diff --git a/macosx/tkMacOSXImage.c b/macosx/tkMacOSXImage.c index 69967af..f256d7a 100644 --- a/macosx/tkMacOSXImage.c +++ b/macosx/tkMacOSXImage.c @@ -4,26 +4,92 @@ * The code in this file provides an interface for XImages, * * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright 2001-2009, Apple Inc. + * Copyright (c) 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net> - * Copyright (c) 2017-2020 Marc Culler. + * Copyright (c) 2017-2021 Marc Culler. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkMacOSXPrivate.h" +#include "tkMacOSXConstants.h" #include "xbytes.h" static CGImageRef CreateCGImageFromPixmap(Drawable pixmap); static CGImageRef CreateCGImageFromDrawableRect( Drawable drawable, int x, int y, unsigned int width, unsigned int height); +/* Pixel formats + * + * Tk uses the XImage structure defined in Xlib.h for storing images. The + * image data in an XImage is a 32-bit aligned array of bytes. Interpretation + * of that data is not specified, but the structure includes parameters which + * provide interpretation hints so that an application can use a family of + * different data structures. + * + * The possible values for the XImage format field are XYBitmap, XYPixmap and + * ZPixmap. The macOS port does not support the XYPixmap format. This means + * that bitmap images are stored as a single bit plane (XYBitmap) and that + * color images are stored as a sequence of pixel values (ZPixmap). + * + * For a ZPixmap, the number of bits allocated to each pixel is specified by + * the bits_per_pixel field of the XImage structure. The functions in this + * module which convert between XImage and native CGImage or NSImage structures + * only support XImages with 32 bits per pixel. The ImageGetPixel and PutPixel + * implementations in this file allow 1, 4, 8, 16 or 32 bits per pixel, however. + * + * In tkImgPhInstance.c the layout used for pixels is determined by the values + * of the red_mask, blue_mask and green_mask fields in the XImage structure. + * The Aqua port always sets red_mask = 0xFF0000, green_mask = 0xFF00, and + * blue_mask = 0xFF. This means that a 32bpp ZPixmap XImage uses ARGB32 pixels, + * with small-endian byte order BGRA. The data array for such an XImage can be + * passed directly to construct a CGBitmapImageRep if one specifies the + * bitmapInfo as kCGBitmapByteOrder32Big | kCGImageAlphaLast. + * + * The structures below describe the bitfields in two common 32 bpp pixel + * layouts. Note that bit field layouts are compiler dependent. The layouts + * shown in the comments are those produced by clang and gcc. Also note + * that kCGBitmapByteOrder32Big is consistently set when creating CGImages or + * CGImageBitmapReps. + */ + +/* RGBA32 0xRRGGBBAA (Byte order is RGBA on big-endian systems.) + * This is used by NSBitmapImageRep when the bitmapFormat property is 0, + * the default value. + */ + +typedef struct RGBA32pixel_t { + unsigned red: 8; + unsigned green: 8; + unsigned blue: 8; + unsigned alpha: 8; +} RGBA32pixel; + +/* + * ARGB32 0xAARRGGBB (Byte order is ARGB on big-endian systems.) + * This is used by Aqua Tk for XImages and by NSBitmapImageReps whose + * bitmapFormat property is NSAlphaFirstBitmapFormat. + */ + +typedef struct ARGB32pixel_t { + unsigned blue: 8; + unsigned green: 8; + unsigned red: 8; + unsigned alpha: 8; +} ARGB32pixel; + +typedef union pixel32_t { + unsigned int uint; + RGBA32pixel rgba; + ARGB32pixel argb; +} pixel32; + #pragma mark XImage handling int _XInitImageFuncPtrs( - XImage *image) + TCL_UNUSED(XImage *)) /* image */ { return 0; } @@ -45,13 +111,18 @@ _XInitImageFuncPtrs( *---------------------------------------------------------------------- */ -static void ReleaseData(void *info, const void *data, size_t size) { +static void ReleaseData( + void *info, + TCL_UNUSED(const void *), /* data */ + TCL_UNUSED(size_t)) /* size */ +{ ckfree(info); } CGImageRef TkMacOSXCreateCGImageWithXImage( - XImage *image) + XImage *image, + uint32_t alphaInfo) { CGImageRef img = NULL; size_t bitsPerComponent, bitsPerPixel; @@ -76,7 +147,7 @@ TkMacOSXCreateCGImageWithXImage( if (image->bitmap_bit_order != MSBFirst) { char *srcPtr = image->data + image->xoffset; char *endPtr = srcPtr + len; - char *destPtr = (data = ckalloc(len)); + char *destPtr = (data = (char *)ckalloc(len)); while (srcPtr < endPtr) { *destPtr++ = xBitReverseTable[(unsigned char)(*(srcPtr++))]; @@ -94,6 +165,7 @@ TkMacOSXCreateCGImageWithXImage( provider, decode, 0); } } else if ((image->format == ZPixmap) && (image->bits_per_pixel == 32)) { + /* * Color image */ @@ -101,6 +173,7 @@ TkMacOSXCreateCGImageWithXImage( CGColorSpaceRef colorspace = CGColorSpaceCreateDeviceRGB(); if (image->width == 0 && image->height == 0) { + /* * CGCreateImage complains on early macOS releases. */ @@ -109,9 +182,7 @@ TkMacOSXCreateCGImageWithXImage( } bitsPerComponent = 8; bitsPerPixel = 32; - bitmapInfo = (image->byte_order == MSBFirst ? - kCGBitmapByteOrder32Little : kCGBitmapByteOrder32Big); - bitmapInfo |= kCGImageAlphaLast; + bitmapInfo = kCGBitmapByteOrder32Big | alphaInfo; data = (char *)memcpy(ckalloc(len), image->data + image->xoffset, len); if (data) { provider = CGDataProviderCreateWithData(data, data, len, @@ -201,14 +272,12 @@ ImageGetPixel( switch (image->bits_per_pixel) { case 32: /* 8 bits per channel */ - r = (*((unsigned int*) srcPtr) >> 16) & 0xff; - g = (*((unsigned int*) srcPtr) >> 8) & 0xff; - b = (*((unsigned int*) srcPtr) ) & 0xff; - /*if (image->byte_order == LSBFirst) { - r = srcPtr[2]; g = srcPtr[1]; b = srcPtr[0]; - } else { - r = srcPtr[1]; g = srcPtr[2]; b = srcPtr[3]; - }*/ + { + ARGB32pixel *pixel = (ARGB32pixel *)srcPtr; + r = pixel->red; + g = pixel->green; + b = pixel->blue; + } break; case 16: /* 5 bits per channel */ r = (*((unsigned short*) srcPtr) >> 7) & 0xf8; @@ -245,7 +314,10 @@ ImageGetPixel( * * ImagePutPixel -- * - * Set a single pixel in an image. + * Set a single pixel in an image. The pixel is provided as an unsigned + * 32-bit integer. The value of that integer is interpreted by assuming + * that its low-order N bits have the format specified by the XImage, + * where N is equal to the bits_per_pixel field of the XImage. * * Results: * None. @@ -271,27 +343,20 @@ ImagePutPixel( if (image->bits_per_pixel == 32) { *((unsigned int*) dstPtr) = pixel; } else { - unsigned char r = ((pixel & image->red_mask) >> 16) & 0xff; - unsigned char g = ((pixel & image->green_mask) >> 8) & 0xff; - unsigned char b = ((pixel & image->blue_mask) ) & 0xff; switch (image->bits_per_pixel) { case 16: - *((unsigned short*) dstPtr) = ((r & 0xf8) << 7) | - ((g & 0xf8) << 2) | ((b & 0xf8) >> 3); + *((unsigned short*) dstPtr) = pixel & 0xffff; break; case 8: - *dstPtr = ((r & 0xc0) >> 2) | ((g & 0xc0) >> 4) | - ((b & 0xc0) >> 6); + *dstPtr = pixel & 0xff; break; case 4: { - unsigned char c = ((r & 0x80) >> 5) | ((g & 0x80) >> 6) | - ((b & 0x80) >> 7); - *dstPtr = (x % 2) ? ((*dstPtr & 0xf0) | (c & 0x0f)) : - ((*dstPtr & 0x0f) | ((c << 4) & 0xf0)); + *dstPtr = (x % 2) ? ((*dstPtr & 0xf0) | (pixel & 0x0f)) : + ((*dstPtr & 0x0f) | ((pixel << 4) & 0xf0)); break; } case 1: - *dstPtr = ((r|g|b) & 0x80) ? (*dstPtr | (0x80 >> (x % 8))) : + *dstPtr = pixel ? (*dstPtr | (0x80 >> (x % 8))) : (*dstPtr & ~(0x80 >> (x % 8))); break; } @@ -319,7 +384,7 @@ ImagePutPixel( XImage * XCreateImage( Display* display, - Visual* visual, + TCL_UNUSED(Visual*), /* visual */ unsigned int depth, int format, int offset, @@ -388,14 +453,25 @@ XCreateImage( /* *---------------------------------------------------------------------- * - * TkPutImage, XPutImage -- + * TkPutImage, XPutImage, TkpPutRGBAImage -- + * + * These functions, which all have the same signature, copy a rectangular + * subimage of an XImage into a drawable. The first two are identical on + * macOS. They assume that the XImage data has the structure of a 32bpp + * ZPixmap in which the image data is an array of 32bit integers packed + * with 8 bit values for the Red Green and Blue channels. They ignore the + * fourth byte. The function TkpPutRGBAImage assumes that the XImage data + * has been extended by using the fourth byte to store an 8-bit Alpha + * value. (The Alpha data is assumed not to pre-multiplied). The image + * is then drawn into the drawable using standard Porter-Duff Source Atop + * Composition (kCGBlendModeSourceAtop in Apple's Core Graphics). * - * Copies a rectangular subimage of an XImage into a drawable. Currently - * this is only called by TkImgPhotoDisplay, using a Window as the - * drawable. + * The TkpPutRGBAImage function is used by TkImgPhotoDisplay to render photo + * images if the compile-time variable TK_CAN_RENDER_RGBA is defined in + * a platform's tkXXXXPort.h header, as is the case for the macOS Aqua port. * * Results: - * None. + * These functions return either BadDrawable or Success. * * Side effects: * Draws the image on the specified drawable. @@ -403,8 +479,12 @@ XCreateImage( *---------------------------------------------------------------------- */ -int -XPutImage( +#define USE_ALPHA kCGImageAlphaLast +#define IGNORE_ALPHA kCGImageAlphaNoneSkipLast + +static int +TkMacOSXPutImage( + uint32_t pixelFormat, Display* display, /* Display. */ Drawable drawable, /* Drawable to place image on. */ GC gc, /* GC to use. */ @@ -418,14 +498,14 @@ XPutImage( { TkMacOSXDrawingContext dc; MacDrawable *macDraw = (MacDrawable *)drawable; - + int result = Success; display->request++; if (!TkMacOSXSetupDrawingContext(drawable, gc, &dc)) { return BadDrawable; } if (dc.context) { CGRect bounds, srcRect, dstRect; - CGImageRef img = TkMacOSXCreateCGImageWithXImage(image); + CGImageRef img = TkMacOSXCreateCGImageWithXImage(image, pixelFormat); /* * The CGContext for a pixmap is RGB only, with A = 0. @@ -435,7 +515,6 @@ XPutImage( CGContextSetBlendMode(dc.context, kCGBlendModeSourceAtop); } if (img) { - bounds = CGRectMake(0, 0, image->width, image->height); srcRect = CGRectMake(src_x, src_y, width, height); dstRect = CGRectMake(dest_x, dest_y, width, height); @@ -445,63 +524,103 @@ XPutImage( CFRelease(img); } else { TkMacOSXDbgMsg("Invalid source drawable"); + result = BadDrawable; } } else { TkMacOSXDbgMsg("Invalid destination drawable"); + result = BadDrawable; } TkMacOSXRestoreDrawingContext(&dc); - return Success; + return result; } -int -TkPutImage( - unsigned long *colors, /* Array of pixel values used by this image. - * May be NULL. */ - int ncolors, /* Number of colors used, or 0. */ - Display *display, - Drawable d, /* Destination drawable. */ +int XPutImage( + Display* display, + Drawable drawable, GC gc, - XImage *image, /* Source image. */ - int src_x, int src_y, /* Offset of subimage. */ - int dest_x, int dest_y, /* Position of subimage origin in drawable. */ - unsigned int width, unsigned int height) - /* Dimensions of subimage. */ -{ - return XPutImage(display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height); + XImage* image, + int src_x, + int src_y, + int dest_x, + int dest_y, + unsigned int width, + unsigned int height) { + return TkMacOSXPutImage(IGNORE_ALPHA, display, drawable, gc, image, + src_x, src_y, dest_x, dest_y, width, height); +} + +int TkPutImage( + TCL_UNUSED(unsigned long *), + TCL_UNUSED(int), + Display* display, + Drawable drawable, + GC gc, + XImage* image, + int src_x, + int src_y, + int dest_x, + int dest_y, + unsigned int width, + unsigned int height) { + return TkMacOSXPutImage(IGNORE_ALPHA, display, drawable, gc, image, + src_x, src_y, dest_x, dest_y, width, height); +} + +int TkpPutRGBAImage( + Display* display, + Drawable drawable, + GC gc, + XImage* image, + int src_x, + int src_y, + int dest_x, + int dest_y, + unsigned int width, + unsigned int height) { + return TkMacOSXPutImage(USE_ALPHA, display, drawable, gc, image, + src_x, src_y, dest_x, dest_y, width, height); } + /* *---------------------------------------------------------------------- * * CreateCGImageFromDrawableRect * - * Extract image data from a MacOSX drawable as a CGImage. + * Extract image data from a MacOSX drawable as a CGImage. The drawable + * may be either a pixmap or a window, but there issues in the case of + * a window. * - * This is only called by XGetImage and XCopyArea. The Tk core uses - * these functions on some platforms, but on macOS the core does not - * call them with a source drawable which is a window. Such calls are - * used only for double-buffered drawing. Since macOS defines the - * macro TK_NO_DOUBLE_BUFFERING, the generic code never calls XGetImage - * or XCopyArea on macOS. Nonetheless, these function are in the stubs - * table and therefore could be used by extensions. + * CreateCGImageFromDrawableRect is called by XGetImage and XCopyArea. + * The Tk core uses these two functions on some platforms in order to + * implement explicit double-buffered drawing -- a pixmap is copied from a + * window, modified using CPU-based graphics composition, and then copied + * back to the window. Platforms, such as macOS, on which the system + * provides double-buffered drawing and GPU-based composition operations + * can avoid calls to XGetImage and XCopyArea from the core by defining + * the compile-time variable TK_NO_DOUBLE_BUFFERING. Nonetheless, these + * two functions are in the stubs table and therefore could be used by + * extensions. * - * This implementation does not work correctly. Originally it relied on + * The implementation here does not always work correctly when the source + * is a window. The original version of this function relied on * [NSBitmapImageRep initWithFocusedViewRect:view_rect] which was * deprecated by Apple in OSX 10.14 and also required the use of other * deprecated functions such as [NSView lockFocus]. Apple's suggested * replacement is [NSView cacheDisplayInRect: toBitmapImageRep:] and that - * is what is being used here. However, that method only works when the - * view has a valid CGContext, and a view is only guaranteed to have a - * valid context during a call to [NSView drawRect]. To further complicate - * matters, cacheDisplayInRect calls [NSView drawRect]. Essentially it is - * asking the view to draw a subrectangle of itself using a special - * graphics context which is linked to the BitmapImageRep. But our - * implementation of [NSView drawRect] does not allow recursive calls. If - * called recursively it returns immediately without doing any drawing. - * So the bottom line is that this function either returns a NULL pointer - * or a black image. To make it useful would require a significant amount - * of rewriting of the drawRect method. Perhaps the next release of OSX - * will include some more helpful ways of doing this. + * is being used here. However, cacheDisplayInRect works by calling + * [NSView drawRect] after setting the current graphics context to be one + * which draws to a bitmap. There are situations in which this can be + * used, e.g. when taking a screenshot of a window. But it cannot be used + * as part of a normal display procedure, using the copy-modify-paste + * paradigm that is the basis of the explicit double-buffering. Since the + * copy operation will call the same display procedure that is calling + * this function via XGetImage or XCopyArea, this would create an infinite + * recursion. + * + * An alternative to the copy-modify-paste paradigm is to use GPU-based + * graphics composition, clipping to the specified rectangle. That is + * the approach that must be followed by display procedures on macOS. * * Results: * Returns an NSBitmapRep representing the image of the given rectangle of @@ -528,51 +647,43 @@ CreateCGImageFromDrawableRect( { MacDrawable *mac_drawable = (MacDrawable *)drawable; CGContextRef cg_context = NULL; + CGRect image_rect = CGRectMake(x, y, width, height); CGImageRef cg_image = NULL, result = NULL; - NSBitmapImageRep *bitmapRep = nil; - NSView *view = nil; + unsigned char *imageData = NULL; if (mac_drawable->flags & TK_IS_PIXMAP) { - /* - * This MacDrawable is a bitmap, so its view is NULL. - */ - - CGRect image_rect = CGRectMake(x, y, width, height); - cg_context = TkMacOSXGetCGContextForDrawable(drawable); - cg_image = CGBitmapContextCreateImage((CGContextRef) cg_context); - if (cg_image) { - result = CGImageCreateWithImageInRect(cg_image, image_rect); - CGImageRelease(cg_image); - } - } else if (TkMacOSXGetNSViewForDrawable(mac_drawable) != nil) { - - /* - * Convert Tk top-left to NSView bottom-left coordinates. - */ - - int view_height = [view bounds].size.height; - NSRect view_rect = NSMakeRect(x + mac_drawable->xOff, - view_height - height - y - mac_drawable->yOff, - width, height); - - /* - * Attempt to copy from the view to a bitmapImageRep. If the view does - * not have a valid CGContext, doing this will silently corrupt memory - * and make a big mess. So, in that case, we just return NULL. - */ - - if (view == [NSView focusView]) { - bitmapRep = [view bitmapImageRepForCachingDisplayInRect: view_rect]; - [view cacheDisplayInRect:view_rect toBitmapImageRep:bitmapRep]; - result = [bitmapRep CGImage]; - CFRelease(bitmapRep); - } else { - TkMacOSXDbgMsg("No CGContext - cannot copy from screen to bitmap."); - result = NULL; + if (cg_context) { + cg_image = CGBitmapContextCreateImage((CGContextRef) cg_context); } } else { - TkMacOSXDbgMsg("Invalid source drawable"); + NSView *view = TkMacOSXGetNSViewForDrawable(mac_drawable); + if (view == nil) { + TkMacOSXDbgMsg("Invalid source drawable"); + return NULL; + } + NSSize size = view.frame.size; + NSUInteger view_width = size.width, view_height = size.height; + NSUInteger bytesPerPixel = 4, + bytesPerRow = bytesPerPixel * view_width, + bitsPerComponent = 8; + imageData = ckalloc(view_height * bytesPerRow); + CGColorSpaceRef colorSpace = CGColorSpaceCreateDeviceRGB(); + cg_context = CGBitmapContextCreate(imageData, view_width, view_height, + bitsPerComponent, bytesPerRow, colorSpace, + kCGImageAlphaPremultipliedLast | + kCGBitmapByteOrder32Big); + CFRelease(colorSpace); + [view.layer renderInContext:cg_context]; + } + if (cg_context) { + cg_image = CGBitmapContextCreateImage(cg_context); + CGContextRelease(cg_context); + } + if (cg_image) { + result = CGImageCreateWithImageInRect(cg_image, image_rect); + CGImageRelease(cg_image); } + ckfree(imageData); return result; } @@ -627,9 +738,6 @@ CreateCGImageFromPixmap( * *---------------------------------------------------------------------- */ -struct pixel_fmt {int r; int g; int b; int a;}; -static struct pixel_fmt bgra = {2, 1, 0, 3}; -static struct pixel_fmt abgr = {3, 2, 1, 0}; XImage * XGetImage( @@ -639,14 +747,13 @@ XGetImage( int y, unsigned int width, unsigned int height, - unsigned long plane_mask, + TCL_UNUSED(unsigned long), /* plane_mask */ int format) { NSBitmapImageRep* bitmapRep = nil; NSUInteger bitmap_fmt = 0; XImage* imagePtr = NULL; char *bitmap = NULL; - char R, G, B, A; int depth = 32, offset = 0, bitmap_pad = 0; unsigned int bytes_per_row, size, row, n, m; @@ -669,48 +776,49 @@ XGetImage( size = [bitmapRep bytesPerPlane]; bytes_per_row = [bitmapRep bytesPerRow]; bitmap = (char *)ckalloc(size); - if (!bitmap - || (bitmap_fmt != 0 && bitmap_fmt != 1) - || [bitmapRep samplesPerPixel] != 4 - || [bitmapRep isPlanar] != 0 - || bytes_per_row < 4 * width - || size != bytes_per_row * height) { + if ((bitmap_fmt != 0 && bitmap_fmt != NSAlphaFirstBitmapFormat) + || [bitmapRep samplesPerPixel] != 4 + || [bitmapRep isPlanar] != 0 + || bytes_per_row < 4 * width + || size != bytes_per_row * height) { TkMacOSXDbgMsg("XGetImage: Unrecognized bitmap format"); - CFRelease(bitmapRep); + [bitmapRep release]; return NULL; } memcpy(bitmap, (char *)[bitmapRep bitmapData], size); - CFRelease(bitmapRep); - - /* - * When Apple extracts a bitmap from an NSView, it may be in either - * BGRA or ABGR format. For an XImage we need RGBA. - */ - - struct pixel_fmt pixel = bitmap_fmt == 0 ? bgra : abgr; + [bitmapRep release]; for (row = 0, n = 0; row < height; row++, n += bytes_per_row) { for (m = n; m < n + 4*width; m += 4) { - R = *(bitmap + m + pixel.r); - G = *(bitmap + m + pixel.g); - B = *(bitmap + m + pixel.b); - A = *(bitmap + m + pixel.a); - - *(bitmap + m) = R; - *(bitmap + m + 1) = G; - *(bitmap + m + 2) = B; - *(bitmap + m + 3) = A; + pixel32 pixel = *((pixel32 *)(bitmap + m)); + if (bitmap_fmt == 0) { // default format + + /* + * This pixel is in ARGB32 format. We need RGBA32. + */ + + pixel32 flipped; + flipped.rgba.red = pixel.argb.red; + flipped.rgba.green = pixel.argb.green; + flipped.rgba.blue = pixel.argb.blue; + flipped.rgba.alpha = pixel.argb.alpha; + *((pixel32 *)(bitmap + m)) = flipped; + } else { // bitmap_fmt = NSAlphaFirstBitmapFormat + *((pixel32 *)(bitmap + m)) = pixel; + } } } imagePtr = XCreateImage(display, NULL, depth, format, offset, (char*) bitmap, width, height, bitmap_pad, bytes_per_row); } else { + /* * There are some calls to XGetImage in the generic Tk code which pass * an XYPixmap rather than a ZPixmap. XYPixmaps should be handled * here. */ + TkMacOSXDbgMsg("XGetImage does not handle XYPixmaps at the moment."); } return imagePtr; diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index 9100d45..53508aa 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -5,7 +5,7 @@ * functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright 2001-2009, Apple Inc. + * Copyright (c) 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net> * Copyright (c) 2017 Marc Culler * @@ -17,6 +17,7 @@ #include <dlfcn.h> #include <objc/objc-auto.h> #include <sys/stat.h> +#include <sys/utsname.h> static char tkLibPath[PATH_MAX + 1] = ""; @@ -103,18 +104,38 @@ static int TkMacOSXGetAppPathCmd(ClientData cd, Tcl_Interp *ip, #endif [self _setupWindowNotifications]; [self _setupApplicationNotifications]; + + if ([NSApp macOSVersion] >= 110000) { + + /* + * Initialize Apple Event processing. Apple's docs (see + * https://developer.apple.com/documentation/appkit/nsapplication) + * recommend doing this here, although historically we have + * done this in applicationWillFinishLaunching. In response to + * bug 7bb246b072. + */ + + TkMacOSXInitAppleEvents(_eventInterp); + + } } -(void)applicationDidFinishLaunching:(NSNotification *)notification { (void)notification; + if ([NSApp macOSVersion] < 110000) { + /* - * Initialize event processing. + * Initialize Apple Event processing on macOS versions + * older than Big Sur (11). */ TkMacOSXInitAppleEvents(_eventInterp); + } + + /* * Initialize the graphics context. */ @@ -168,6 +189,7 @@ static int TkMacOSXGetAppPathCmd(ClientData cd, Tcl_Interp *ip, */ int minorVersion, majorVersion; + #if MAC_OS_X_VERSION_MAX_ALLOWED < 101000 Gestalt(gestaltSystemVersionMinor, (SInt32*)&minorVersion); majorVersion = 10; @@ -177,6 +199,24 @@ static int TkMacOSXGetAppPathCmd(ClientData cd, Tcl_Interp *ip, majorVersion = systemVersion.majorVersion; minorVersion = systemVersion.minorVersion; #endif + + if (majorVersion == 10 && minorVersion == 16) { + + /* + * If a program compiled with a macOS 10.XX SDK is run on macOS 11.0 or + * later then it will report majorVersion 10 and minorVersion 16, no + * matter what the actual OS version of the host may be. And of course + * Apple never released macOS 10.16. To work around this we guess the + * OS version from the kernel release number, as reported by uname. + */ + + struct utsname name; + char *endptr; + if (uname(&name) == 0) { + majorVersion = strtol(name.release, &endptr, 10) - 9; + minorVersion = 0; + } + } [NSApp setMacOSVersion: 10000*majorVersion + 100*minorVersion]; /* diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c index d092749..961072f 100644 --- a/macosx/tkMacOSXKeyEvent.c +++ b/macosx/tkMacOSXKeyEvent.c @@ -72,6 +72,18 @@ static NSUInteger textInputModifiers; } /* + * Discard repeating KeyDown events if the repeat speed has been set to + * "off" in System Preferences. It is unclear why we get these, but we do. + * See ticket [2ecb09d118]. + */ + + if ([theEvent type] == NSKeyDown && + [theEvent isARepeat] && + [NSEvent keyRepeatDelay] < 0) { + return theEvent; + } + + /* * If a local grab is in effect, key events for windows in the * grabber's application are redirected to the grabber. Key events * for other applications are delivered normally. If a global @@ -82,7 +94,10 @@ static NSUInteger textInputModifiers; if (grabWinPtr) { if (winPtr->dispPtr->grabFlags || /* global grab */ grabWinPtr->mainPtr == winPtr->mainPtr){ /* same application */ - winPtr =winPtr->dispPtr->focusPtr; + winPtr = winPtr->dispPtr->focusPtr; + if (!winPtr) { + return theEvent; + } tkwin = (Tk_Window)winPtr; } } @@ -92,26 +107,33 @@ static NSUInteger textInputModifiers; */ if (type == NSKeyUp || type == NSKeyDown) { - if ([[theEvent characters] length] > 0) { - keychar = [[theEvent characters] characterAtIndex:0]; + NSString *characters = [theEvent characters]; + if (characters.length > 0) { + keychar = [characters characterAtIndex:0]; /* * Currently, real keys always send BMP characters, but who knows? */ if (CFStringIsSurrogateHighCharacter(keychar)) { - UniChar lowChar = [[theEvent characters] characterAtIndex:1]; + UniChar lowChar = [characters characterAtIndex:1]; keychar = CFStringGetLongCharacterForSurrogatePair( keychar, lowChar); } } else { /* - * This is a dead key, such as Option-e, so it should go to the - * TextInputClient. + * This is a dead key, such as Option-e, so it usually should get + * passed to the TextInputClient. But if it has a Command modifier + * then it is not functioning as a dead key and should not be + * handled by the TextInputClient. See ticket [1626ed65b8] and the + * method performKeyEquivalent which is implemented in + * tkMacOSXMenu.c. */ - use_text_input = YES; + if (!(modifiers & NSCommandKeyMask)) { + use_text_input = YES; + } } /* @@ -255,7 +277,6 @@ static NSUInteger textInputModifiers; */ if (type == NSKeyDown && [theEvent isARepeat]) { - xEvent.xany.type = KeyRelease; Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); xEvent.xany.type = KeyPress; @@ -692,8 +713,12 @@ XGrabKeyboard( MacDrawable *macWin = (MacDrawable *)grab_window; if (w && macWin->toplevel->winPtr == (TkWindow *) captureWinPtr) { - if (modalSession) { - Tcl_Panic("XGrabKeyboard: already grabbed"); + if (modalSession ) { + if (keyboardGrabNSWindow == w) { + return GrabSuccess; + } else { + Tcl_Panic("XGrabKeyboard: already grabbed"); + } } keyboardGrabNSWindow = w; [w retain]; diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c index 1af18c4..09d91f0 100644 --- a/macosx/tkMacOSXMenu.c +++ b/macosx/tkMacOSXMenu.c @@ -192,6 +192,34 @@ TKBackgroundLoop *backgroundLoop = nil; { return (_tkSpecial == special); } + +/* + * There are cases where a KeyEquivalent (aka menu accelerator) is defined for + * a "dead key", i.e. a key which does not have an associated character but is + * only meant to be the start of a composition sequence. For example, on a + * Spanish keyboard both the ' and the ` keys are dead keys used to place + * accents over letters. But ⌘` is a standard KeyEquivalent which cycles + * through the open windows of an application, changing the focus to the next + * window. + * + * The performKeyEquivalent callback method is being overridden here to work + * around a bug reported in [1626ed65b8]. When a dead key that is also as a + * KeyEquivalent is pressed, a KeyDown event with no characters is passed to + * performKeyEquivalent. The default implementation provided by Apple will + * cause that event to be routed to some private methods of NSMenu which raise + * NSInvalidArgumentException, causing an abort. Returning NO in such a case + * prevents the abort, but does not prevent the KeyEquivalent action from being + * invoked, presumably because the event does get correctly handled higher in + * the responder chain. + */ + +- (BOOL)performKeyEquivalent:(NSEvent *)event +{ + if (event.characters.length == 0) { + return NO; + } + return [super performKeyEquivalent:event]; +} @end @implementation TKMenu(TKMenuPrivate) diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 03d5730..2fcdeb9 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -114,6 +114,17 @@ enum { } case NSLeftMouseUp: case NSLeftMouseDown: + + /* + * Ignore mouse button events which arrive while the app is inactive. + * These events will be resent after activation, causing duplicate + * actions when an app is activated by a bound mouse event. See ticket + * [7bda9882cb]. + */ + + if (! [NSApp isActive]) { + return theEvent; + } case NSMouseMoved: case NSScrollWheel: #if 0 @@ -170,20 +181,18 @@ enum { */ capture = TkMacOSXGetCapture(); - if (capture) { + if (eventWindow) { + winPtr = TkMacOSXGetTkWindow(eventWindow); + } else if (capture) { winPtr = (TkWindow *) capture; eventWindow = TkMacOSXGetNSWindowForDrawable(winPtr->window); if (!eventWindow) { return theEvent; } - } else { - if (eventWindow) { - winPtr = TkMacOSXGetTkWindow(eventWindow); - } - if (!winPtr) { - eventWindow = [NSApp mainWindow]; - winPtr = TkMacOSXGetTkWindow(eventWindow); - } + } + if (!winPtr) { + eventWindow = [NSApp mainWindow]; + winPtr = TkMacOSXGetTkWindow(eventWindow); } if (!winPtr) { diff --git a/macosx/tkMacOSXNotify.c b/macosx/tkMacOSXNotify.c index f32fa76..208d846 100644 --- a/macosx/tkMacOSXNotify.c +++ b/macosx/tkMacOSXNotify.c @@ -340,8 +340,9 @@ TkMacOSXNotifyExitHandler( * for all views that need display before it returns. We call it with * deQueue=NO so that it will not change anything on the AppKit event * queue, because we only want the side effect that it runs drawRect. The - * only time when any NSViews have the needsDisplay property set to YES - * is during execution of this function. + * only times when any NSViews have the needsDisplay property set to YES + * are during execution of this function or in the addDirtyRect method + * of TKContentView. * * The reason for running this function as an idle task is to try to * arrange that all widgets will be fully configured before they are @@ -377,7 +378,8 @@ TkMacOSXDrawAllViews( if (dirtyCount) { continue; } - [view setNeedsDisplayInRect:[view tkDirtyRect]]; + [[view layer] setNeedsDisplayInRect:[view tkDirtyRect]]; + [view setNeedsDisplay:YES]; } } else { [window displayIfNeeded]; diff --git a/macosx/tkMacOSXPort.h b/macosx/tkMacOSXPort.h index 461204e..088d402 100644 --- a/macosx/tkMacOSXPort.h +++ b/macosx/tkMacOSXPort.h @@ -49,6 +49,9 @@ # include <inttypes.h> #endif #include <unistd.h> +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif #include <X11/Xlib.h> #include <X11/cursorfont.h> #include <X11/keysym.h> @@ -75,6 +78,19 @@ #endif /* + * Used to tag functions that are only to be visible within the module being + * built and not outside it (where this is supported by the linker). + */ + +#ifndef MODULE_SCOPE +# ifdef __cplusplus +# define MODULE_SCOPE extern "C" +# else +# define MODULE_SCOPE extern +# endif +#endif + +/* * The following macro defines the number of fd_masks in an fd_set: */ @@ -163,11 +179,16 @@ #define TK_DYNAMIC_COLORMAP 0x0fffffff /* - * Inform tkImgPhInstance.c that our tkPutImage can render an image with an - * alpha channel directly into a window. + * Inform tkImgPhInstance.c that we implement TkpPutRGBAImage to render RGBA + * images directly into a window. */ -#define TKPUTIMAGE_CAN_BLEND +#define TK_CAN_RENDER_RGBA + +MODULE_SCOPE int TkpPutRGBAImage( + Display* display, Drawable drawable, GC gc,XImage* image, + int src_x, int src_y, int dest_x, int dest_y, + unsigned int width, unsigned int height); /* * Used by xcolor.c diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index ed24255..be2264f 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -27,6 +27,7 @@ #define TextStyle MacTextStyle #import <ApplicationServices/ApplicationServices.h> #import <Cocoa/Cocoa.h> +#import <QuartzCore/QuartzCore.h> #ifndef NO_CARBON_H #import <Carbon/Carbon.h> #endif @@ -203,7 +204,6 @@ typedef struct TkMacOSXDrawingContext { CGContextRef context; NSView *view; HIShapeRef clipRgn; - CGRect portBounds; } TkMacOSXDrawingContext; /* @@ -231,7 +231,8 @@ MODULE_SCOPE OSStatus TkMacOSHIShapeUnionWithRect(HIMutableShapeRef inShape, const CGRect *inRect); MODULE_SCOPE OSStatus TkMacOSHIShapeUnion(HIShapeRef inShape1, HIShapeRef inShape2, HIMutableShapeRef outResult); - +MODULE_SCOPE int TkMacOSXCountRectsInRegion(HIShapeRef shape); +MODULE_SCOPE void TkMacOSXPrintRectsInRegion(HIShapeRef shape); /* * Prototypes of TkAqua internal procs. */ diff --git a/macosx/tkMacOSXRegion.c b/macosx/tkMacOSXRegion.c index 6c70a63..fbb41cb 100644 --- a/macosx/tkMacOSXRegion.c +++ b/macosx/tkMacOSXRegion.c @@ -555,6 +555,55 @@ TkMacOSHIShapeUnion( return result; } +static OSStatus +rectCounter( + int msg, + TCL_UNUSED(HIShapeRef), + const CGRect *rect, + void *ref) +{ + int *count = (int *)ref; + (*count)++; + return noErr; +} + +static OSStatus +rectPrinter( + int msg, + TCL_UNUSED(HIShapeRef), + const CGRect *rect, + void *ref) +{ + if (rect) { + fprintf(stderr, " %s\n", NSStringFromRect(*rect).UTF8String); + } + return noErr; +} + +int +TkMacOSXCountRectsInRegion( + HIShapeRef shape) +{ + int rect_count = 0; + if (!HIShapeIsEmpty(shape)) { + ChkErr(HIShapeEnumerate, shape, + kHIShapeParseFromBottom|kHIShapeParseFromLeft, + rectCounter, &rect_count); + } + return rect_count; +} + +void +TkMacOSXPrintRectsInRegion( + HIShapeRef shape) +{ + if (!HIShapeIsEmpty(shape)) { + ChkErr(HIShapeEnumerate, shape, + kHIShapeParseFromBottom|kHIShapeParseFromLeft, + rectPrinter, NULL); + } +} + /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXSubwindows.c b/macosx/tkMacOSXSubwindows.c index 2a6a04c..1093816 100644 --- a/macosx/tkMacOSXSubwindows.c +++ b/macosx/tkMacOSXSubwindows.c @@ -303,12 +303,41 @@ XUnmapWindow( display->request++; if (Tk_IsTopLevel(winPtr)) { if (!Tk_IsEmbedded(winPtr) && - winPtr->wmInfoPtr->hints.initial_state!=IconicState) { - [win orderOut:nil]; + winPtr->wmInfoPtr->hints.initial_state!=IconicState) { [win setExcludedFromWindowsMenu:YES]; + [win orderOut:NSApp]; + if ([win isKeyWindow]) { + + /* + * If we are unmapping the key window then we need to make sure + * that a new key window is assigned, if possible. This is + * supposed to happen when a key window is ordered out, but as + * noted in tkMacOSXWm.c this does not happen, in spite of + * Apple's claims to the contrary. + */ + + for (NSWindow *w in [NSApp orderedWindows]) { + TkWindow *winPtr2 = TkMacOSXGetTkWindow(w); + WmInfo *wmInfoPtr; + + BOOL isOnScreen; + + if (!winPtr2 || !winPtr2->wmInfoPtr) { + continue; + } + wmInfoPtr = winPtr2->wmInfoPtr; + isOnScreen = (wmInfoPtr->hints.initial_state != IconicState && + wmInfoPtr->hints.initial_state != WithdrawnState); + if (w != win && isOnScreen && [w canBecomeKeyWindow]) { + [w makeKeyAndOrderFront:NSApp]; + break; + } + } + } } TkMacOSXInvalClipRgns((Tk_Window)winPtr); } else { + /* * Rebuild the visRgn clip region for the parent so it will be allowed * to draw in the space from which this subwindow was removed and then diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 0075fb8..5d90716 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -162,6 +162,9 @@ extern NSString *NSWindowDidOrderOffScreenNotification; #ifdef TK_MAC_DEBUG_NOTIFICATIONS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); #endif + if (![[notification object] respondsToSelector: @selector (tkLayoutChanged)]) { + return; + } [(TKWindow *)[notification object] tkLayoutChanged]; } @@ -170,6 +173,9 @@ extern NSString *NSWindowDidOrderOffScreenNotification; #ifdef TK_MAC_DEBUG_NOTIFICATIONS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); #endif + if (![[notification object] respondsToSelector: @selector (tkLayoutChanged)]) { + return; + } [(TKWindow *)[notification object] tkLayoutChanged]; } @@ -182,6 +188,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; TkWindow *winPtr = TkMacOSXGetTkWindow(w); if (winPtr) { + winPtr->wmInfoPtr->hints.initial_state = IconicState; Tk_UnmapWindow((Tk_Window)winPtr); } } @@ -291,6 +298,16 @@ extern NSString *NSWindowDidOrderOffScreenNotification; } @end + +/* + * Idle task which forces focus to a particular window. + */ + +static void RefocusGrabWindow(void *data) { + TkWindow *winPtr = (TkWindow *) data; + TkpChangeFocus(winPtr, 1); +} + #pragma mark TKApplication(TKApplicationEvent) @implementation TKApplication(TKApplicationEvent) @@ -308,6 +325,10 @@ extern NSString *NSWindowDidOrderOffScreenNotification; * When the application is activated with Command-Tab it will create a * zombie window for every Tk window which has been withdrawn. So iterate * through the list of windows and order out any withdrawn window. + * If one of the windows is the grab window for its display we focus + * it. This is done as at idle, in case the app was reactivated by + * clicking a different window. In that case we need to wait until the + * mouse event has been processed before focusing the grab window. */ for (NSWindow *win in [NSApp windows]) { @@ -316,7 +337,12 @@ extern NSString *NSWindowDidOrderOffScreenNotification; continue; } if (winPtr->wmInfoPtr->hints.initial_state == WithdrawnState) { - [win orderOut:nil]; + [win orderOut:NSApp]; + } + if (winPtr->dispPtr->grabWinPtr == winPtr) { + Tcl_DoWhenIdle(RefocusGrabWindow, winPtr); + } else { + [[self keyWindow] orderFront: self]; } } } @@ -915,11 +941,59 @@ ConfigureRestrictProc( @implementation TKContentView(TKWindowEvent) +- (id)initWithFrame:(NSRect)frame +{ + self = [super initWithFrame:frame]; + if (self) { + /* + * The layer must exist before we set wantsLayer to YES. + */ + + self.layer = [CALayer layer]; + self.wantsLayer = YES; + self.layerContentsRedrawPolicy = NSViewLayerContentsRedrawOnSetNeedsDisplay; + self.layer.contentsGravity = self.layer.contentsAreFlipped ? + kCAGravityTopLeft : kCAGravityBottomLeft; + + /* + * Nothing gets drawn at all if the layer does not have a delegate. + * Currently, we do not implement any methods of the delegate, however. + */ + + self.layer.delegate = (id) self; + } + return self; +} + +/* + * We will just use drawRect. + */ + +- (BOOL) wantsUpdateLayer +{ + return NO; +} + +- (void) viewDidChangeBackingProperties +{ + + /* + * Make sure that the layer uses a contentScale that matches the + * backing scale factor of the screen. This avoids blurry text whe + * the view is on a Retina display, as well as incorrect size when + * the view is on a normal display. + */ + + self.layer.contentsScale = self.window.screen.backingScaleFactor; +} + - (void) addTkDirtyRect: (NSRect) rect { _tkNeedsDisplay = YES; _tkDirtyRect = NSUnionRect(_tkDirtyRect, rect); [NSApp setNeedsToDraw:YES]; + [self setNeedsDisplay:YES]; + [[self layer] setNeedsDisplay]; } - (void) clearTkDirtyRect diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 3c23308..5a39948 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -1942,6 +1942,8 @@ WmDeiconifyCmd( } } + [[win contentView] setNeedsDisplay:YES]; + Tcl_DoWhenIdle(TkMacOSXDrawAllViews, NULL); return TCL_OK; } @@ -2825,7 +2827,7 @@ WmIconwindowCmd( */ TkpWmSetState(oldIcon, WithdrawnState); - [win orderOut:nil]; + [win orderOut:NSApp]; [win setExcludedFromWindowsMenu:YES]; wmPtr3->iconFor = NULL; } @@ -3734,6 +3736,7 @@ WmTransientCmd( if (TkGetWindowFromObj(interp, tkwin, objv[3], &container) != TCL_OK) { return TCL_ERROR; } + RemoveTransient(winPtr); containerPtr = (TkWindow*) container; while (!Tk_TopWinHierarchy(containerPtr)) { /* @@ -5535,12 +5538,15 @@ Tk_MacOSXGetTkWindow( void *w) { Window window = None; - TkDisplay *dispPtr = TkGetDisplayList(); if ([(NSWindow *)w respondsToSelector: @selector (tkWindow)]) { window = [(TKWindow *)w tkWindow]; } - return (window != None ? - Tk_IdToWindow(dispPtr->display, window) : NULL); + if (window) { + TkDisplay *dispPtr = TkGetDisplayList(); + return Tk_IdToWindow(dispPtr->display, window); + } else { + return NULL; + } } /* @@ -6271,6 +6277,7 @@ TkMacOSXMakeRealWindowExist( Tk_ChangeWindowAttributes((Tk_Window)winPtr, CWOverrideRedirect, &atts); ApplyContainerOverrideChanges(winPtr, NULL); } + [window display]; } /* @@ -6309,8 +6316,7 @@ TkpRedrawWidget(Tk_Window tkwin) { [view bounds].size.height - tkBounds.bottom, tkBounds.right - tkBounds.left, tkBounds.bottom - tkBounds.top); - [view setTkNeedsDisplay:YES]; - [view setTkDirtyRect:bounds]; + [view addTkDirtyRect:bounds]; } } @@ -6443,6 +6449,19 @@ TkpWmSetState( macWin = TkMacOSXGetNSWindowForDrawable(winPtr->window); + /* + * Make sure windows are updated before the state change. As an exception, + * do not process idle tasks before withdrawing a window. The purpose of + * this is to support the common paradigm of immediately withdrawing the + * root window. Processing idle tasks before changing the state causes the + * root to briefly flash on the screen, which users of this paradigm find + * annoying. Not processing the events does not guarantee that the window + * will not appear but makes it more likely. + */ + + if (state != WithdrawnState) { + while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {}; + } if (state == WithdrawnState) { Tk_UnmapWindow((Tk_Window)winPtr); } else if (state == IconicState) { @@ -6463,8 +6482,9 @@ TkpWmSetState( [macWin orderFront:NSApp]; TkMacOSXZoomToplevel(macWin, state == NormalState ? inZoomIn : inZoomOut); } + /* - * Make sure windows are updated after the state change. + * Make sure windows are updated after the state change too. */ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)){} diff --git a/macosx/ttkMacOSXTheme.c b/macosx/ttkMacOSXTheme.c index 92c5156..52880ef 100644 --- a/macosx/ttkMacOSXTheme.c +++ b/macosx/ttkMacOSXTheme.c @@ -36,10 +36,13 @@ * Macros for handling drawing contexts. */ -#define BEGIN_DRAWING(d) { \ - TkMacOSXDrawingContext dc; \ - if (!TkMacOSXSetupDrawingContext((d), NULL, &dc)) {return;} -#define END_DRAWING \ +#define BEGIN_DRAWING(d) { \ + TkMacOSXDrawingContext dc; \ + if (!TkMacOSXSetupDrawingContext((d), NULL, &dc)) { \ + return; \ + } \ + +#define END_DRAWING \ TkMacOSXRestoreDrawingContext(&dc);} #define HIOrientation kHIThemeOrientationNormal @@ -60,7 +63,10 @@ */ static CGFloat darkButtonFace[4] = { - 112.0 / 255, 113.0 / 255, 115.0 / 255, 1.0 + 90.0 / 255, 86.0 / 255, 95.0 / 255, 1.0 +}; +static CGFloat darkPressedButtonFace[4] = { + 114.0 / 255, 110.0 / 255, 118.0 / 255, 1.0 }; static CGFloat darkPressedBevelFace[4] = { 135.0 / 255, 136.0 / 255, 138.0 / 255, 1.0 @@ -74,6 +80,12 @@ static CGFloat darkDisabledButtonFace[4] = { static CGFloat darkInactiveSelectedTab[4] = { 159.0 / 255, 160.0 / 255, 161.0 / 255, 1.0 }; +static CGFloat darkSelectedTab[4] = { + 97.0 / 255, 94.0 / 255, 102.0 / 255, 1.0 +}; +static CGFloat darkTab[4] = { + 44.0 / 255, 41.0 / 255, 50.0 / 255, 1.0 +}; static CGFloat darkFocusRing[4] = { 38.0 / 255, 113.0 / 255, 159.0 / 255, 1.0 }; @@ -717,8 +729,15 @@ static void DrawDarkButton( bounds = CGRectInset(bounds, 1, 1); if (kind == kThemePushButton && (state & TTK_STATE_PRESSED)) { - GradientFillRoundedRectangle(context, bounds, 4, + if ([NSApp macOSVersion] < 120000) { + GradientFillRoundedRectangle(context, bounds, 4, pressedPushButtonGradient, 2); + } else { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkPressedButtonFace + count: 4]; + SolidFillRoundedRectangle(context, bounds, 4, faceColor); + } } else if (kind == kThemePushButton && (state & TTK_STATE_ALTERNATE) && !(state & TTK_STATE_BACKGROUND)) { @@ -993,6 +1012,7 @@ static void DrawDarkTab( NSColorSpace *deviceRGB = [NSColorSpace deviceRGBColorSpace]; NSColor *faceColor, *stroke; CGRect originalBounds = bounds; + int OSVersion = [NSApp macOSVersion]; CGContextSetLineWidth(context, 1.0); CGContextClipToRect(context, bounds); @@ -1002,13 +1022,14 @@ static void DrawDarkTab( * clipped off. */ - if (!(state & TTK_STATE_FIRST_TAB)) { - bounds.origin.x -= 10; - bounds.size.width += 10; - } - - if (!(state & TTK_STATE_LAST_TAB)) { - bounds.size.width += 10; + if (OSVersion < 110000 || !(state & TTK_STATE_SELECTED)) { + if (!(state & TTK_STATE_FIRST_TAB)) { + bounds.origin.x -= 10; + bounds.size.width += 10; + } + if (!(state & TTK_STATE_LAST_TAB)) { + bounds.size.width += 10; + } } /* @@ -1020,13 +1041,25 @@ static void DrawDarkTab( bounds = CGRectInset(bounds, 1, 1); if (!(state & TTK_STATE_SELECTED)) { if (state & TTK_STATE_DISABLED) { - faceColor = [NSColor colorWithColorSpace: deviceRGB - components: darkDisabledButtonFace - count: 4]; + if (OSVersion < 110000) { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkDisabledButtonFace + count: 4]; + } else { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkTab + count: 4]; + } } else { - faceColor = [NSColor colorWithColorSpace: deviceRGB - components: darkButtonFace - count: 4]; + if (OSVersion < 110000) { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkButtonFace + count: 4]; + } else { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkTab + count: 4]; + } } SolidFillRoundedRectangle(context, bounds, 4, faceColor); @@ -1053,21 +1086,34 @@ static void DrawDarkTab( } else { /* - * This is the selected tab; paint it blue. If it is first, cover up - * the separator line drawn by the second one. (The selected tab is - * always drawn last.) + * This is the selected tab. If it is first, cover up the separator + * line drawn by the second one. (The selected tab is always drawn + * last.) */ if ((state & TTK_STATE_FIRST_TAB) && !(state & TTK_STATE_LAST_TAB)) { bounds.size.width += 1; } if (!(state & TTK_STATE_BACKGROUND)) { - GradientFillRoundedRectangle(context, bounds, 4, - darkSelectedGradient, 2); + if (OSVersion < 110000) { + GradientFillRoundedRectangle(context, bounds, 4, + darkSelectedGradient, 2); + } else { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkSelectedTab + count: 4]; + SolidFillRoundedRectangle(context, bounds, 4, faceColor); + } } else { - faceColor = [NSColor colorWithColorSpace: deviceRGB - components: darkInactiveSelectedTab - count: 4]; + if (OSVersion < 110000) { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkInactiveSelectedTab + count: 4]; + } else { + faceColor = [NSColor colorWithColorSpace: deviceRGB + components: darkSelectedTab + count: 4]; + } SolidFillRoundedRectangle(context, bounds, 4, faceColor); } HighlightButtonBorder(context, bounds); diff --git a/tests/arc.tcl b/tests/arc.tcl index 0126c7d..89b9f58 100644 --- a/tests/arc.tcl +++ b/tests/arc.tcl @@ -64,7 +64,7 @@ set outline black } .t.c bind arc <Any-Leave> {.t.c itemconf current -fill $prevFill -outline $prevOutline} -bind .t.c <1> {markarea %x %y} +bind .t.c <Button-1> {markarea %x %y} bind .t.c <B1-Motion> {strokearea %x %y} proc markarea {x y} { @@ -93,7 +93,7 @@ bind .t.c <3> {puts stdout "%x %y"} # The code below allows the circle to be move by shift-dragging. -bind .t.c <Shift-1> { +bind .t.c <Shift-Button-1> { set curx %x set cury %y } diff --git a/tests/bind.test b/tests/bind.test index 6868eba..e1af2ea 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -48,7 +48,7 @@ proc pointerAway {} { # but let's wait more (it depends on computer performance). after 100 ; update event generate .top <Button-1> -warp 1 - update + controlPointerWarpTiming destroy .top } pointerAway @@ -307,9 +307,9 @@ test bind-5.1 {Tk_CreateBindingTable procedure} -body { test bind-6.1 {Tk_DeleteBindTable procedure} -body { canvas .t.c - .t.c bind foo <1> {string 1} + .t.c bind foo <Button-1> {string 1} .t.c create rectangle 0 0 100 100 - .t.c bind 1 <2> {string 2} + .t.c bind 1 <Button-2> {string 2} destroy .t.c } -cleanup { destroy .t.c @@ -322,17 +322,17 @@ test bind-7.1 {Tk_CreateBinding procedure: bad binding} -body { } -returnCodes error -result {no event type or button # or keysym} test bind-7.3 {Tk_CreateBinding procedure: append} -body { canvas .t.c - .t.c bind foo <1> "button 1" - .t.c bind foo <1> "+more button 1" - .t.c bind foo <1> + .t.c bind foo <Button-1> "button 1" + .t.c bind foo <Button-1> "+more button 1" + .t.c bind foo <Button-1> } -cleanup { destroy .t.c } -result {button 1 more button 1} test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} -body { canvas .t.c - .t.c bind foo <1> "+button 1" - .t.c bind foo <1> + .t.c bind foo <Button-1> "+button 1" + .t.c bind foo <Button-1> } -cleanup { destroy .t.c } -result {button 1} @@ -366,10 +366,10 @@ test bind-9.3 {Tk_DeleteBinding procedure} -setup { set result {} } -body { frame .t.f -class Test -width 150 -height 100 - foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} { + foreach i {<Button-1> <Meta-Button-1> <Control-Button-1> <Double-Alt-Button-1>} { bind .t.f $i "binding for $i" } - foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} { + foreach i {<Control-Button-1> <Double-Alt-Button-1> <Button-1> <Meta-Button-1>} { bind .t.f $i {} lappend result [lsort [bind .t.f]] } @@ -403,7 +403,7 @@ test bind-11.1 {Tk_GetAllBindings procedure} -body { } -result {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~} test bind-11.2 {Tk_GetAllBindings procedure} -body { frame .t.f - foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" { + foreach i "<Double-Button-1> <Triple-Button-1> <Meta-Control-a> <Double-Alt-Enter> <Button-1>" { bind .t.f $i Test } lsort [bind .t.f] @@ -412,7 +412,7 @@ test bind-11.2 {Tk_GetAllBindings procedure} -body { } -result {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>} test bind-11.3 {Tk_GetAllBindings procedure} -body { frame .t.f - foreach i "<Double-Triple-1> abcd a<Leave>b" { + foreach i "<Double-Triple-Button-1> abcd a<Leave>b" { bind .t.f $i Test } lsort [bind .t.f] @@ -427,7 +427,7 @@ test bind-12.1 {Tk_DeleteAllBindings procedure} -body { } -result {} test bind-12.2 {Tk_DeleteAllBindings procedure} -body { frame .t.f -class Test -width 150 -height 100 - foreach i "a b c <Meta-1> <Alt-a> <Control-a>" { + foreach i "a b c <Meta-Button-1> <Alt-a> <Control-a>" { bind .t.f $i x } destroy .t.f @@ -440,8 +440,8 @@ test bind-13.1 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind Test <KeyPress> {lappend x "%W %K Test KeyPress"} - bind all <KeyPress> {lappend x "%W %K all KeyPress"} + bind Test <Key> {lappend x "%W %K Test KeyPress"} + bind all <Key> {lappend x "%W %K all KeyPress"} bind Test : {lappend x "%W %K Test :"} bind all _ {lappend x "%W %K all _"} bind .t.f : {lappend x "%W %K .t.f :"} @@ -452,8 +452,8 @@ test bind-13.1 {Tk_BindEvent procedure} -setup { return $x } -cleanup { destroy .t.f - bind all <KeyPress> {} - bind Test <KeyPress> {} + bind all <Key> {} + bind Test <Key> {} bind all _ {} bind Test : {} } -result {{.t.f colon .t.f :} {.t.f colon Test :} {.t.f colon all KeyPress} {.t.f plus Test KeyPress} {.t.f plus all KeyPress} {.t.f underscore Test KeyPress} {.t.f underscore all _}} @@ -465,16 +465,16 @@ test bind-13.2 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind Test <KeyPress> {lappend x "%W %K Test press any"; break} - bind all <KeyPress> {continue; lappend x "%W %K all press any"} + bind Test <Key> {lappend x "%W %K Test press any"; break} + bind all <Key> {continue; lappend x "%W %K all press any"} bind .t.f : {lappend x "%W %K .t.f pressed colon"} event generate .t.f <Key-colon> return $x } -cleanup { destroy .t.f - bind all <KeyPress> {} - bind Test <KeyPress> {} + bind all <Key> {} + bind Test <Key> {} } -result {{.t.f colon .t.f pressed colon} {.t.f colon Test press any}} test bind-13.3 {Tk_BindEvent procedure} -setup { @@ -485,14 +485,14 @@ test bind-13.3 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} + bind Test <Key> {lappend x "%W %K Test press any"; error Test} bind .t.f : {lappend x "%W %K .t.f pressed colon"} event generate .t.f <Key-colon> update list $x $errorInfo } -cleanup { destroy .t.f - bind Test <KeyPress> {} + bind Test <Key> {} rename bgerror {} } -result {{{.t.f colon .t.f pressed colon} {.t.f colon Test press any}} {Test while executing @@ -576,14 +576,14 @@ test bind-13.9 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind .t.f <1> {lappend x "%W z (.t.f <1> binding)"} - bind .t.f <ButtonPress> {lappend x "%W z (.t.f <ButtonPress> binding)"} + bind .t.f <Button-1> {lappend x "%W z (.t.f <Button-1> binding)"} + bind .t.f <Button> {lappend x "%W z (.t.f <Button> binding)"} event generate .t.f <Button-1> event generate .t.f <Button-2> return $x } -cleanup { destroy .t.f -} -result {{.t.f z (.t.f <1> binding)} {.t.f z (.t.f <ButtonPress> binding)}} +} -result {{.t.f z (.t.f <Button-1> binding)} {.t.f z (.t.f <Button> binding)}} test bind-13.10 {Tk_BindEvent procedure: ignore NotifyInferior} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -946,12 +946,12 @@ test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -setup { } -body { bindtags .t.f {a b c d e f g h i j k l m n o p} foreach p [bindtags .t.f] { - bind $p <1> "lappend x $p" + bind $p <Button-1> "lappend x $p" } - event generate .t.f <1> + event generate .t.f <Button-1> return $x } -cleanup { - foreach p [bindtags .t.f] {bind $p <1> {}} + foreach p [bindtags .t.f] {bind $p <Button-1> {}} destroy .t.f } -result {a b c d e f g h i j k l m n o p} test bind-13.34 {Tk_BindEvent procedure: multiple tags} -setup { @@ -976,12 +976,12 @@ test bind-13.35 {Tk_BindEvent procedure: execute binding} -setup { update set x {} } -body { - bind .t.f <1> {lappend x 1} - event generate .t.f <1> + bind .t.f <Button-1> {lappend x 1} + event generate .t.f <Button-1> return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -989,13 +989,13 @@ test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -setup { update set x {} } -body { - bind Test <1> {lappend x Test} - bind .t.f <1> {lappend x .t.f} - event generate .t.f <1> + bind Test <Button-1> {lappend x Test} + bind .t.f <Button-1> {lappend x .t.f} + event generate .t.f <Button-1> return $x } -cleanup { destroy .t.f - bind Test <1> {} + bind Test <Button-1> {} } -result {.t.f Test} test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup { frame .t.f -class Test -width 150 -height 100 @@ -1052,6 +1052,7 @@ test bind-13.45 {Tk_BindEvent procedure: error in script} -setup { test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -1064,10 +1065,11 @@ test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { @@ -1082,7 +1084,7 @@ test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1097,14 +1099,14 @@ test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> @@ -1113,7 +1115,7 @@ test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1129,14 +1131,14 @@ test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> event generate .t.f <Key-a> @@ -1146,14 +1148,14 @@ test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> event generate .t.f <Key-Shift_L> @@ -1163,7 +1165,7 @@ test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1178,7 +1180,7 @@ test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.9 {MatchPatterns procedure, modifier checks} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1191,7 +1193,7 @@ test bind-15.9 {MatchPatterns procedure, modifier checks} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.10 {MatchPatterns procedure, modifier checks} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1204,7 +1206,7 @@ test bind-15.10 {MatchPatterns procedure, modifier checks} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.11 {MatchPatterns procedure, modifier checks} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1217,7 +1219,7 @@ test bind-15.11 {MatchPatterns procedure, modifier checks} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} -constraints { nonPortable } -setup { @@ -1236,7 +1238,7 @@ test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.13 {MatchPatterns procedure, checking detail} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1250,14 +1252,14 @@ test bind-15.13 {MatchPatterns procedure, checking detail} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.14 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1267,14 +1269,14 @@ test bind-15.14 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.15 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1284,14 +1286,14 @@ test bind-15.15 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.16 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1301,14 +1303,14 @@ test bind-15.16 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.17 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1318,14 +1320,14 @@ test bind-15.17 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.18 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1335,14 +1337,14 @@ test bind-15.18 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.19 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1352,14 +1354,14 @@ test bind-15.19 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.20 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1369,14 +1371,14 @@ test bind-15.20 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.21 {MatchPatterns procedure, checking "nearby"} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1386,14 +1388,14 @@ test bind-15.21 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> -time -100 event generate .t.f <Button-1> -time 200 @@ -1401,14 +1403,14 @@ test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update } -body { - bind .t.f <Double-1> {set x 1} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> -time -100 event generate .t.f <Button-1> -time 500 @@ -1416,7 +1418,7 @@ test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.24 {MatchPatterns procedure, virtual event} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1479,38 +1481,41 @@ test bind-15.26 {MatchPatterns procedure, reject a virtual event} -setup { test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { - bind .t.f <KeyPress> {set x 0} + bind .t.f <Key> {set x 0} bind .t.f 1 {set x 1} set x none event generate .t.f <Key-1> return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { - bind .t.f <KeyPress> {set x 0} + bind .t.f <Key> {set x 0} bind .t.f 1 {set x 1} set x none event generate .t.f <Key-2> return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.29 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f + update idletasks focus -force .t.f update } -body { - bind .t.f <KeyPress> {lappend x 0} + bind .t.f <Key> {lappend x 0} bind .t.f 1 {lappend x 1} bind .t.f 21 {lappend x 2} set x none @@ -1527,15 +1532,15 @@ test bind-15.30 {MatchPatterns procedure, conflict resolution} -setup { focus -force .t.f update } -body { - bind .t.f <ButtonPress> {set x 0} - bind .t.f <1> {set x 1} + bind .t.f <Button> {set x 0} + bind .t.f <Button-1> {set x 1} set x none event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1549,7 +1554,7 @@ test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1563,7 +1568,7 @@ test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1571,9 +1576,9 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { update set x {} } -body { - bind .t.f <1> {lappend x single} - bind Test <1> {lappend x single(Test)} - bind Test <Double-1> {lappend x double(Test)} + bind .t.f <Button-1> {lappend x single} + bind Test <Button-1> {lappend x single(Test)} + bind Test <Double-Button-1> {lappend x double(Test)} event generate .t.f <Button-1> event generate .t.f <Button-1> event generate .t.f <Button-1> @@ -1581,8 +1586,8 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { set x } -cleanup { destroy .t.f - bind Test <1> {} - bind Test <Double-1> {} + bind Test <Button-1> {} + bind Test <Double-Button-1> {} } -result {single single(Test) single double(Test) single double(Test)} @@ -1611,7 +1616,7 @@ test bind-16.2 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {1234} +} -result 1234 test bind-16.3 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1638,7 +1643,7 @@ test bind-16.4 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {3} +} -result 3 test bind-16.5 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1651,7 +1656,7 @@ test bind-16.5 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {47} +} -result 47 test bind-16.6 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1755,7 +1760,7 @@ test bind-16.13 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.14 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1794,7 +1799,7 @@ test bind-16.16 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {146} +} -result 146 test bind-16.17 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1860,7 +1865,7 @@ test bind-16.21 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.22 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1873,7 +1878,7 @@ test bind-16.22 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.23 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1886,7 +1891,7 @@ test bind-16.23 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.24 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1919,14 +1924,14 @@ test bind-16.26 {ExpandPercents procedure} -setup { focus -force .t.f update } -body { - bind .t.f <1> {set x "%s"} + bind .t.f <Button-1> {set x "%s"} set x none event generate .t.f <Button-1> -state 1402 event generate .t.f <ButtonRelease-1> set x } -cleanup { destroy .t.f -} -result {1402} +} -result 1402 test bind-16.27 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1939,7 +1944,7 @@ test bind-16.27 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {1023} +} -result 1023 test bind-16.28 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1992,7 +1997,7 @@ test bind-16.31 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {4294} +} -result 4294 test bind-16.32 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2071,7 +2076,7 @@ test bind-16.36 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {24} +} -result 24 test bind-16.37 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2084,7 +2089,7 @@ test bind-16.37 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.38 {ExpandPercents procedure} -constraints { nonPortable } -setup { @@ -2119,7 +2124,7 @@ test bind-16.39 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {32} +} -result 32 test bind-16.40 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2145,7 +2150,7 @@ test bind-16.41 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {2} +} -result 2 test bind-16.42 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2246,7 +2251,7 @@ test bind-17.4 {event command: add 1} -body { event info <<Paste>> } -cleanup { event delete <<Paste>> <Control-v> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-17.5 {event command: add 2} -body { event delete <<Paste>> event add <<Paste>> <Control-v> <Button-2> @@ -2256,13 +2261,13 @@ test bind-17.5 {event command: add 2} -body { } -result {<Button-2> <Control-Key-v>} test bind-17.6 {event command: add with error} -body { - event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1> + event add <<Paste>> <Control-v> <Button-2> abc <xyz> <Button-1> } -cleanup { event delete <<Paste>> } -returnCodes error -result {bad event type or keysym "xyz"} test bind-17.7 {event command: add with error} -body { event delete <<Paste>> - catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} + catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <Button-1>} lsort [event info <<Paste>>] } -cleanup { event delete <<Paste>> @@ -2273,12 +2278,12 @@ test bind-17.8 {event command: delete} -body { } -returnCodes error -result {wrong # args: should be "event delete virtual ?sequence ...?"} test bind-17.9 {event command: delete many} -body { event delete <<Paste>> - event add <<Paste>> <3> <1> <2> t - event delete <<Paste>> <1> <2> + event add <<Paste>> <Button-3> <Button-1> <Button-2> t + event delete <<Paste>> <Button-1> <Button-2> lsort [event info <<Paste>>] } -cleanup { event delete <<Paste>> - event delete <<Paste>> <3> t + event delete <<Paste>> <Button-3> t } -result {<Button-3> t} test bind-17.10 {event command: delete all} -body { event add <<Paste>> a b @@ -2326,12 +2331,12 @@ test bind-17.16 {event command: generate} -setup { update set x {} } -body { - bind .t.f <1> "lappend x 1" - event generate .t.f <1> + bind .t.f <Button-1> "lappend x 1" + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-17.17 {event command: generate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2359,7 +2364,7 @@ test bind-18.3 {CreateVirtualEvent procedure: new physical} -body { event info <<xyz>> } -cleanup { event delete <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body { event delete <<xyz>> event add <<xyz>> <Control-v> @@ -2367,7 +2372,7 @@ test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body { event info <<xyz>> } -cleanup { event delete <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-18.5 {CreateVirtualEvent procedure: existing physical} -body { foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> @@ -2416,7 +2421,7 @@ test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} -setup { event add <<xyz>> <Control-v> event delete <<xyz>> <Button-1> event info <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} -body { event add <<xyz>> <Control-v> event delete <<xyz>> <xyz> @@ -2473,7 +2478,7 @@ test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} -setup { set x } -cleanup { destroy .t.f -} -result {101} +} -result 101 test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2698,7 +2703,7 @@ test bind-20.3 {GetVirtualEvent procedure: owns 1} -setup { event info <<xyz>> } -cleanup { event delete <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-20.4 {GetVirtualEvent procedure: owns many} -setup { event delete <<xyz>> } -body { @@ -2719,7 +2724,7 @@ test bind-21.2 {GetAllVirtualEvents procedure: 1 event} -body { event info } -cleanup { event delete <<xyz>> -} -result {<<xyz>>} +} -result <<xyz>> test bind-21.3 {GetAllVirtualEvents procedure: many events} -body { foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> @@ -2811,7 +2816,7 @@ test bind-22.11 {HandleEventGenerate} -setup { set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.12 {HandleEventGenerate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2824,7 +2829,7 @@ test bind-22.12 {HandleEventGenerate} -setup { set x } -cleanup { destroy .t.f -} -result {4} +} -result 4 test bind-22.13 {HandleEventGenerate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2838,7 +2843,7 @@ test bind-22.13 {HandleEventGenerate} -setup { set x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.14 {HandleEventGenerate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2994,7 +2999,7 @@ test bind-22.25 {HandleEventGenerate: options <Configure> -borderwidth 2i} -setu expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.26 {HandleEventGenerate: options <Key> -borderwidth 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3196,7 +3201,7 @@ test bind-22.39 {HandleEventGenerate: options <Enter> -focus 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.40 {HandleEventGenerate: options <Key> -focus 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3236,7 +3241,7 @@ test bind-22.42 {HandleEventGenerate: options <Expose> -height 2i} -setup { expr {$x eq [winfo pixels .t.f 2i]} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3250,7 +3255,7 @@ test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup { expr {$x eq [winfo pixels .t.f 2i]} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.44 {HandleEventGenerate: options <Key> -height 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3290,7 +3295,7 @@ test bind-22.46 {HandleEventGenerate: options <Key> -keycode 20} -setup { return $x } -cleanup { destroy .t.f -} -result {20} +} -result 20 test bind-22.47 {HandleEventGenerate: options <Button> -keycode 20} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3423,7 +3428,7 @@ test bind-22.56 {HandleEventGenerate: options <Map> -override 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3437,7 +3442,7 @@ test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3451,7 +3456,7 @@ test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.59 {HandleEventGenerate: options <Key> -override 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3531,7 +3536,7 @@ test bind-22.64 {HandleEventGenerate: options <Key> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.65 {HandleEventGenerate: options <Key> -root xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3558,7 +3563,7 @@ test bind-22.66 {HandleEventGenerate: options <Key> -root [winfo id .t]} -setup expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3572,7 +3577,7 @@ test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3586,7 +3591,7 @@ test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3600,7 +3605,7 @@ test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3614,7 +3619,7 @@ test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3628,7 +3633,7 @@ test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.72 {HandleEventGenerate: options <Configure> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3668,7 +3673,7 @@ test bind-22.74 {HandleEventGenerate: options <Key> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3682,7 +3687,7 @@ test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3696,7 +3701,7 @@ test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3710,7 +3715,7 @@ test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3724,7 +3729,7 @@ test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3738,7 +3743,7 @@ test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.80 {HandleEventGenerate: options <Configure> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3778,7 +3783,7 @@ test bind-22.82 {HandleEventGenerate: options <Key> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3792,7 +3797,7 @@ test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3806,7 +3811,7 @@ test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3820,7 +3825,7 @@ test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3834,7 +3839,7 @@ test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3848,7 +3853,7 @@ test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.88 {HandleEventGenerate: options <Configure> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3888,7 +3893,7 @@ test bind-22.90 {HandleEventGenerate: options <Key> -sendevent 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3902,7 +3907,7 @@ test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3916,7 +3921,7 @@ test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.93 {HandleEventGenerate: options <Key> -serial xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3943,7 +3948,7 @@ test bind-22.94 {HandleEventGenerate: options <Key> -serial 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.95 {HandleEventGenerate: options <Key> -state xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3970,7 +3975,7 @@ test bind-22.96 {HandleEventGenerate: options <Key> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3984,7 +3989,7 @@ test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup { return $x } -cleanup { destroy .t.f -} -result {1025} +} -result 1025 test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3998,7 +4003,7 @@ test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setu return $x } -cleanup { destroy .t.f -} -result {1025} +} -result 1025 test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4012,7 +4017,7 @@ test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4026,7 +4031,7 @@ test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4040,7 +4045,7 @@ test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.102 {HandleEventGenerate: options <Visibility> -state xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4107,7 +4112,7 @@ test bind-22.106 {HandleEventGenerate: options <Key> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.107 {HandleEventGenerate: options <Key> -subwindow xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4134,7 +4139,7 @@ test bind-22.108 {HandleEventGenerate: options <Key> -subwindow [winfo id .t]} - expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4148,7 +4153,7 @@ test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4162,7 +4167,7 @@ test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -s expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4176,7 +4181,7 @@ test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4190,7 +4195,7 @@ test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4204,7 +4209,7 @@ test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.114 {HandleEventGenerate: options <Configure> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4244,7 +4249,7 @@ test bind-22.116 {HandleEventGenerate: options <Key> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4258,7 +4263,7 @@ test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4272,7 +4277,7 @@ test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4286,7 +4291,7 @@ test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4300,7 +4305,7 @@ test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4314,7 +4319,7 @@ test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4328,7 +4333,7 @@ test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.123 {HandleEventGenerate: options <Configure> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4368,7 +4373,7 @@ test bind-22.125 {HandleEventGenerate: options <Expose> -width 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4382,7 +4387,7 @@ test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.127 {HandleEventGenerate: options <Key> -width 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4573,7 +4578,7 @@ test bind-22.140 {HandleEventGenerate: options <Key> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4587,7 +4592,7 @@ test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4601,7 +4606,7 @@ test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4615,7 +4620,7 @@ test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4629,7 +4634,7 @@ test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4643,7 +4648,7 @@ test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4657,7 +4662,7 @@ test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4671,7 +4676,7 @@ test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4685,7 +4690,7 @@ test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4699,7 +4704,7 @@ test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.150 {HandleEventGenerate: options <Map> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4739,7 +4744,7 @@ test bind-22.152 {HandleEventGenerate: options <Key> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4753,7 +4758,7 @@ test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4767,7 +4772,7 @@ test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4781,7 +4786,7 @@ test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4795,7 +4800,7 @@ test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4809,7 +4814,7 @@ test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4823,7 +4828,7 @@ test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4837,7 +4842,7 @@ test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4851,7 +4856,7 @@ test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4865,7 +4870,7 @@ test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.162 {HandleEventGenerate: options <Map> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4938,10 +4943,10 @@ test bind-24.5 {FindSequence procedure, multiple bindings} -setup { focus -force .t.f update } -body { - bind .t.f <1> {lappend x single} - bind .t.f <Double-1> {lappend x double} - bind .t.f <Triple-1> {lappend x triple} - bind .t.f <Quadruple-1> {lappend x quadruple} + bind .t.f <Button-1> {lappend x single} + bind .t.f <Double-Button-1> {lappend x double} + bind .t.f <Triple-Button-1> {lappend x triple} + bind .t.f <Quadruple-Button-1> {lappend x quadruple} set x press event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> @@ -5096,7 +5101,7 @@ test bind-25.2 {ParseEventDescription procedure: misinterpreted modifier} -setup button .b } -body { bind .b <Control-M> a - bind .b <M-M> b + bind .b <Meta-M> b lsort [bind .b] } -cleanup { destroy .b @@ -5116,7 +5121,7 @@ test bind-25.4 {ParseEventDescription} -setup { bind .t.f } -cleanup { destroy .t.f -} -result {<<Shift-Paste>>} +} -result <<Shift-Paste>> # Assorted error cases in event sequence parsing test bind-25.5 {ParseEventDescription procedure error cases} -body { @@ -5200,7 +5205,7 @@ test bind-25.21 {modifier names} -setup { test bind-25.22 {modifier names} -setup { frame .t.f -class Test -width 150 -height 100 } -body { - bind .t.f <M-a> foo + bind .t.f <Meta-a> foo bind .t.f } -cleanup { destroy .t.f @@ -5515,9 +5520,9 @@ test bind-26.6 {event names: ButtonPress} -setup { focus -force .t.f update } -body { - bind .t.f <ButtonPress> "set x {event ButtonPress}" + bind .t.f <Button> "set x {event ButtonPress}" set x xyzzy - event generate .t.f <ButtonPress> + event generate .t.f <Button> list $x [bind .t.f] } -cleanup { destroy .t.f @@ -5613,9 +5618,9 @@ test bind-26.13 {event names: KeyPress} -setup { focus -force .t.f update } -body { - bind .t.f <KeyPress> "set x {event KeyPress}" + bind .t.f <Key> "set x {event KeyPress}" set x xyzzy - event generate .t.f <KeyPress> + event generate .t.f <Key> list $x [bind .t.f] } -cleanup { destroy .t.f @@ -5934,28 +5939,28 @@ test bind-28.9 {keysym names, Eth -> ETH} -body { bind .t.f } -cleanup { destroy .t.f -} -result {<Key-ETH>} +} -result <Key-ETH> test bind-28.10 {keysym names, Ooblique -> Oslash} -body { frame .t.f -class Test -width 150 -height 100 bind .t.f <Ooblique> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-Oslash>} +} -result <Key-Oslash> test bind-28.11 {keysym names, gcedilla} -body { frame .t.f -class Test -width 150 -height 100 bind .t.f <gcedilla> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-gcedilla>} +} -result <Key-gcedilla> test bind-28.12 {keysym names, Greek_IOTAdiaeresis -> Greek_IOTAdieresis} -body { frame .t.f -class Test -width 150 -height 100 bind .t.f <Greek_IOTAdiaeresis> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-Greek_IOTAdieresis>} +} -result <Key-Greek_IOTAdieresis> test bind-29.1 {Tcl_BackgroundError procedure} -setup { @@ -6036,7 +6041,7 @@ test bind-30.2 {MouseWheel events} -setup { set x } -cleanup { destroy .t.f -} -result {120} +} -result 120 test bind-30.3 {MouseWheel events} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -6153,6 +6158,7 @@ test bind-32.1 {-warp, window was destroyed before the idle callback DoWarp} -se update } -body { event generate .t.f <Button-1> -warp 1 + controlPointerWarpTiming event generate .t.f <ButtonRelease-1> destroy .t.f update ; # shall simply not crash @@ -6165,7 +6171,7 @@ test bind-32.2 {detection of double click should not fail} -setup { update set x {} } -body { - event generate .t.f <ButtonPress-1> + event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> # Simulate a lot of intervening exposure events. The old implementation # that used an event ring overflowed, and the double click was not detected. @@ -6173,7 +6179,7 @@ test bind-32.2 {detection of double click should not fail} -setup { for {set i 0} {$i < 1000} {incr i} { event generate .t.f <Expose> } - event generate .t.f <ButtonPress-1> + event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> set x } -cleanup { @@ -6199,10 +6205,10 @@ test bind-32.4 {should not trigger Double-1} -setup { update set x {} } -body { - bind .t.f <Double-1> { set x "Double" } - event generate .t.f <1> -time current + bind .t.f <Double-Button-1> { set x "Double" } + event generate .t.f <Button-1> -time current after 1000 - event generate .t.f <1> -time current + event generate .t.f <Button-1> -time current set x } -cleanup { destroy .t.f @@ -6213,10 +6219,10 @@ test bind-32.5 {should trigger Quadruple-1} -setup { update set x {} } -body { - bind .t.f <Quadruple-1> { set x "Quadruple" } - bind .t.f <Triple-1> { set x "Triple" } - bind .t.f <Double-1> { set x "Double" } - bind .t.f <1> { set x "Single" } + bind .t.f <Quadruple-Button-1> { set x "Quadruple" } + bind .t.f <Triple-Button-1> { set x "Triple" } + bind .t.f <Double-Button-1> { set x "Double" } + bind .t.f <Button-1> { set x "Single" } # Old implementation triggered "Double", but new implementation # triggers "Quadruple", the latter behavior conforms to other toolkits. event generate .t.f <Button-1> -time 0 @@ -6246,10 +6252,10 @@ test bind-32.7 {test sequences} -setup { update set x {} } -body { - bind .t.f <Double-1> { lappend x "Double" } - bind .t.f <1><1><a> { lappend x "11" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Double-Button-1> { lappend x "Double" } + bind .t.f <Button-1><Button-1><a> { lappend x "11" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { @@ -6261,12 +6267,12 @@ test bind-32.8 {test sequences} -setup { update set x {} } -body { - bind .t.f <a><1><Double-1><1><a> { lappend x "Double" } + bind .t.f <a><Button-1><Double-Button-1><Button-1><a> { lappend x "Double" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { @@ -6279,7 +6285,7 @@ test bind-32.9 {trigger events for modifier keys} -setup { set x {} } -body { bind .t.f <Any-Key> { set x "Key" } - event generate .t.f <KeyPress> -keysym Caps_Lock + event generate .t.f <Key> -keysym Caps_Lock set x } -cleanup { destroy .t.f @@ -6289,13 +6295,13 @@ test bind-32.10 {reset key state when destroying window} -setup { } -body { pack [frame .t.f]; update; focus -force .t.f bind .t.f <Key-A> { set x "A" } - event generate .t.f <KeyPress-A> - event generate .t.f <KeyPress-A> + event generate .t.f <Key-A> + event generate .t.f <Key-A> destroy .t.f; update pack [frame .t.f]; update; focus -force .t.f bind .t.f <Key-A> { set x "A" } bind .t.f <Double-Key-A> { set x "AA" } - event generate .t.f <KeyPress-A> + event generate .t.f <Key-A> destroy .t.f set x } -result {A} @@ -6309,7 +6315,7 @@ test bind-32.11 {match detailed virtual} -setup { bind Test <<TestControlButton1>> { set x "Control-Button-1" } bind Test <Button-1> { set x "Button-1" } bind .t.f <Button-1> { set x "Button-1" } - event generate .t.f <Control-ButtonPress-1> + event generate .t.f <Control-Button-1> set x } -cleanup { destroy .t.f @@ -6325,14 +6331,14 @@ test bind-32.12 {don't detect repetition when window has changed} -setup { } -body { bind .t.f <Button-1> { set x "1" } bind .t.f <Double-Button-1> { set x "11" } - event generate .t.f <ButtonPress-1> - event generate .t.g <ButtonPress-1> - event generate .t.f <ButtonPress-1> + event generate .t.f <Button-1> + event generate .t.g <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f destroy .t.g -} -result {1} +} -result 1 test bind-32.13 {don't detect repetition when window has changed} -setup { pack [frame .t.f] pack [frame .t.g] @@ -6341,9 +6347,9 @@ test bind-32.13 {don't detect repetition when window has changed} -setup { } -body { bind .t.f <Key-A> { set x "A" } bind .t.f <Double-Key-A> { set x "AA" } - focus -force .t.f; event generate .t.f <KeyPress-A> - focus -force .t.g; event generate .t.g <KeyPress-A> - focus -force .t.f; event generate .t.f <KeyPress-A> + focus -force .t.f; event generate .t.f <Key-A> + focus -force .t.g; event generate .t.g <Key-A> + focus -force .t.f; event generate .t.f <Key-A> set x } -cleanup { destroy .t.f @@ -6355,31 +6361,31 @@ test bind-32.14 {don't detect repetition when window has changed} -setup { update set x {} } -body { - bind .t.f <ButtonPress-1> { set x "1" } - bind .t.f <Double-ButtonPress-1> { set x "11" } - focus -force .t.f; event generate .t.f <ButtonPress-1> - focus -force .t.g; event generate .t.g <ButtonPress-1> - focus -force .t.f; event generate .t.f <ButtonPress-1> + bind .t.f <Button-1> { set x "1" } + bind .t.f <Double-Button-1> { set x "11" } + focus -force .t.f; event generate .t.f <Button-1> + focus -force .t.g; event generate .t.g <Button-1> + focus -force .t.f; event generate .t.f <Button-1> set x } -cleanup { destroy .t.f destroy .t.g -} -result {1} +} -result 1 test bind-32.15 {reset button state when destroying window} -setup { set x {} } -body { pack [frame .t.f]; update; focus -force .t.f - bind .t.f <ButtonPress-1> { set x "1" } - event generate .t.f <ButtonPress-1> - event generate .t.f <ButtonPress-1> + bind .t.f <Button-1> { set x "1" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> destroy .t.f; update pack [frame .t.f]; update; focus -force .t.f - bind .t.f <ButtonPress-1> { set x "1" } - bind .t.f <Double-ButtonPress-1> { set x "11" } - event generate .t.f <ButtonPress-1> + bind .t.f <Button-1> { set x "1" } + bind .t.f <Double-Button-1> { set x "11" } + event generate .t.f <Button-1> destroy .t.f set x -} -result {1} +} -result 1 test bind-33.1 {prefer longest match} -setup { pack [frame .t.f] @@ -6387,179 +6393,179 @@ test bind-33.1 {prefer longest match} -setup { update set x {} } -body { - bind .t.f <a><1><1> { lappend x "a11" } - bind .t.f <Double-1> { lappend x "Double" } + bind .t.f <a><Button-1><Button-1> { lappend x "a11" } + bind .t.f <Double-Button-1> { lappend x "Double" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f } -result {a11} -test bind-33.2 {should prefer most specific event} -setup { +test bind-33.2 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <Double-1> { lappend x "Double" } - bind .t.f <1><1> { lappend x "11" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Double-Button-1> { lappend x "Double" } + bind .t.f <Button-1><Button-1> { lappend x "11" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f # This test case shows that old implementation has an issue, because - # it is expected that <Double-1> is matching, this binding + # it is expected that <Double-Button-1> is matching, this binding # is more specific. But new implementation will be conform to old, # and so "11" is the expected result. -} -result {11} +} -result 11 test bind-33.3 {should prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <a><Double-1><a> { lappend x "Double" } - bind .t.f <a><1><1><a> { lappend x "11" } + bind .t.f <a><Double-Button-1><a> { lappend x "Double" } + bind .t.f <a><Button-1><Button-1><a> { lappend x "11" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f # Also this test case shows that old implementation has an issue, it is - # expected that <a><Double-1><a> is matching, because <Double-1> is more - # specific than <1><1>. But new implementation will be conform to old, + # expected that <a><Double-Button-1><a> is matching, because <Double-Button-1> is more + # specific than <Button-1><Button-1>. But new implementation will be conform to old, # and so "11" is the expected result. -} -result {11} +} -result 11 test bind-33.4 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><1> { lappend x "11" } - bind .t.f <Double-1> { lappend x "Double" } - event generate .t.f <1> -time 0 - event generate .t.f <1> -time 1000 + bind .t.f <Button-1><Button-1> { lappend x "11" } + bind .t.f <Double-Button-1> { lappend x "Double" } + event generate .t.f <Button-1> -time 0 + event generate .t.f <Button-1> -time 1000 set x } -cleanup { destroy .t.f -} -result {11} +} -result 11 test bind-33.5 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><1> { lappend x "11" } - bind .t.f <Double-ButtonPress> { lappend x "Double" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Button-1> { lappend x "11" } + bind .t.f <Double-Button> { lappend x "Double" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {11} +} -result 11 test bind-33.6 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <a><1><1><1><1><a> { lappend x "1111" } - bind .t.f <a><ButtonPress><Double-ButtonPress><ButtonPress><a> { lappend x "Any-Double-Any" } + bind .t.f <a><Button-1><Button-1><Button-1><Button-1><a> { lappend x "1111" } + bind .t.f <a><Button><Double-Button><Button><a> { lappend x "Any-Double-Any" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f -} -result {1111} +} -result 1111 test bind-33.7 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <ButtonPress-1><a> { lappend x "1" } - bind .t.f <ButtonPress><a> { lappend x "Any" } - event generate .t.f <1> + bind .t.f <Button-1><a> { lappend x "1" } + bind .t.f <Button><a> { lappend x "Any" } + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-33.8 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <Double-ButtonPress-1><a> { lappend x "1" } - bind .t.f <ButtonPress><ButtonPress><a> { lappend x "Any" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Double-Button-1><a> { lappend x "1" } + bind .t.f <Button><Button><a> { lappend x "Any" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-33.9 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><2><2><Double-1> { lappend x "first" } - bind .t.f <1><Double-2><1><1> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Button-2><Button-2><Double-Button-1> { lappend x "first" } + bind .t.f <Button-1><Double-Button-2><Button-1><Button-1> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {last} +} -result last test bind-33.10 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><Double-2><1><1> { lappend x "first" } - bind .t.f <1><2><2><Double-1> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Double-Button-2><Button-1><Button-1> { lappend x "first" } + bind .t.f <Button-1><Button-2><Button-2><Double-Button-1> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {last} +} -result last test bind-33.11 {should prefer most specific} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <2><Double-1><Double-2><Double-1><2><2> { lappend x "first" } - bind .t.f <2><1><1><2><2><Double-1><Double-2> { lappend x "last" } - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> + bind .t.f <Button-2><Double-Button-1><Double-Button-2><Double-Button-1><Button-2><Button-2> { lappend x "first" } + bind .t.f <Button-2><Button-1><Button-1><Button-2><Button-2><Double-Button-1><Double-Button-2> { lappend x "last" } + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> set x } -cleanup { destroy .t.f @@ -6567,73 +6573,73 @@ test bind-33.11 {should prefer most specific} -setup { # it is expected that first one is matching, this binding # is more specific. But new implementation will be conform to old, # and so "last" is the expected result. -} -result {last} +} -result last test bind-33.12 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <Control-1><1> { lappend x "first" } - bind .t.f <1><Control-1> { lappend x "last" } - event generate .t.f <Control-1> - event generate .t.f <Control-1> + bind .t.f <Control-Button-1><Button-1> { lappend x "first" } + bind .t.f <Button-1><Control-Button-1> { lappend x "last" } + event generate .t.f <Control-Button-1> + event generate .t.f <Control-Button-1> set x } -cleanup { destroy .t.f -} -result {last} +} -result last test bind-33.13 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><Control-1> { lappend x "first" } - bind .t.f <Control-1><1> { lappend x "last" } - event generate .t.f <Control-1> - event generate .t.f <Control-1> + bind .t.f <Button-1><Control-Button-1> { lappend x "first" } + bind .t.f <Control-Button-1><Button-1> { lappend x "last" } + event generate .t.f <Control-Button-1> + event generate .t.f <Control-Button-1> set x } -cleanup { destroy .t.f # Old implementation failed, and returned "first", but this was wrong, # because both bindings are homogeneous equal, so the most recently defined # must be preferred. -} -result {last} +} -result last test bind-33.14 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><ButtonPress><1><ButtonPress> { lappend x "first" } - bind .t.f <ButtonPress><1><ButtonPress><1> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Button><Button-1><Button> { lappend x "first" } + bind .t.f <Button><Button-1><Button><Button-1> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {last} +} -result last test bind-33.15 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <ButtonPress><1><ButtonPress><1> { lappend x "first" } - bind .t.f <1><ButtonPress><1><ButtonPress> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button><Button-1><Button><Button-1> { lappend x "first" } + bind .t.f <Button-1><Button><Button-1><Button> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f # Old implementation failed, and returned "first", but this was wrong, # because both bindings are homogeneous equal, so the most recently defined # must be preferred. -} -result {last} +} -result last test bind-33.16 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup { pack [frame .t.f] focus -force .t.f @@ -6692,7 +6698,7 @@ test bind-33.19 {simulate use of the keyboard to trigger a pattern sequence with set x {} } -body { bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" } - bind .t.f <Escape><KeyPress><KeyPress><Control-c> { lappend x "Esc_Key(2)_Control-c" } + bind .t.f <Escape><Key><Key><Control-c> { lappend x "Esc_Key(2)_Control-c" } event generate .t.f <Escape> event generate .t.f <Alt_L> event generate .t.f <Control_L> @@ -6736,23 +6742,21 @@ test bind-33.21 {simulate use of the keyboard to trigger a pattern sequence with test bind-34.1 {-warp works relatively to a window} -setup { toplevel .top wm geometry .top +100+100 - update + after 10 ; update } -body { # In order to avoid platform-dependent coordinate results due to # decorations and borders, this test warps the pointer twice # relatively to a window that moved in the meantime, and checks # how much the pointer moved wm geometry .top +200+200 - update + after 10 ; update event generate .top <Motion> -x 20 -y 20 -warp 1 - update idletasks ; # DoWarp is an idle callback - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming set pointerPos1 [winfo pointerxy .top] wm geometry .top +600+600 - update + after 10 ; update event generate .top <Motion> -x 20 -y 20 -warp 1 - update idletasks ; # DoWarp is an idle callback - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming set pointerPos2 [winfo pointerxy .top] # from the first warped position to the second one, the mouse # pointer should have moved the same amount as the window moved @@ -6765,17 +6769,15 @@ test bind-34.1 {-warp works relatively to a window} -setup { set res } -cleanup { destroy .top -} -result {1} +} -result 1 test bind-34.2 {-warp works relatively to the screen} -setup { } -body { # Contrary to bind-34.1, we're directly checking screen coordinates event generate {} <Motion> -x 20 -y 20 -warp 1 - update idletasks ; # DoWarp is an idle callback - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming set res [winfo pointerxy .] event generate {} <Motion> -x 200 -y 200 -warp 1 - update idletasks ; # DoWarp is an idle callback - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming lappend res {*}[winfo pointerxy .] } -cleanup { } -result {20 20 200 200} @@ -6793,8 +6795,7 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup { set res {} } -body { event generate {} <Motion> -x 0 -y 0 -warp 1 - update idletasks ; # DoWarp is an idle callback - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming foreach dim [winfo pointerxy .] { if {$dim <= $halo} { lappend res ok @@ -6803,9 +6804,9 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup { } } event generate {} <Motion> -x 100 -y 100 -warp 1 - update idletasks ; after 50 + controlPointerWarpTiming event generate {} <Motion> -x -1 -y -1 -warp 1 - update idletasks ; after 50 + controlPointerWarpTiming foreach dim [winfo pointerxy .] { if {$dim <= $halo} { lappend res ok @@ -6823,7 +6824,7 @@ proc testKey {window event type mods} { global keyInfo numericKeysym set keyInfo {} set numericKeysym {} - bind $window <KeyPress> { + bind $window <Key> { set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k] set numericKeysym %N } @@ -6897,8 +6898,8 @@ test bind-35.1 {Key events agree for entry widgets} -constraints {aqua} -setup { test bind-35.2 {Can bind to function keys} -constraints {aqua} -body { global keyInfo numericKeysym - bind . <KeyPress> {} - bind . <KeyPress> { + bind . <Key> {} + bind . <Key> { lappend keyInfo %K set numericKeysym %N } @@ -6916,7 +6917,7 @@ test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup { } -body { global keyInfo numericalKeysym set result {} - bind . <KeyPress> { + bind . <Key> { set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k] set numericalKeysym [format "0x%x" %N] } @@ -6967,15 +6968,15 @@ test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup { after 50 update event generate .top.l <Motion> -warp 1 -x 10 -y 10 - update idletasks ; after 50 + controlPointerWarpTiming foreach {x1 y1} [winfo pointerxy .top.l] {} event generate {} <Motion> -warp 1 -x 50 -y 50 - update idletasks ; after 50 + controlPointerWarpTiming grab release .top ; # this will queue events after 50 update event generate .top.l <Motion> -warp 1 -x 10 -y 10 - update idletasks ; after 50 + controlPointerWarpTiming foreach {x2 y2} [winfo pointerxy .top.l] {} # success if the coords are the same with or without the grab, and if they # are at (10,10) inside the label widget as requested by the warping @@ -6984,7 +6985,7 @@ test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup { } -cleanup { destroy .top unset x1 y1 x2 y2 -} -result {1} +} -result 1 # cleanup cleanupTests diff --git a/tests/clrpick.test b/tests/clrpick.test index c15308b..747a1c4 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -10,6 +10,8 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] + if {[testConstraint defaultPseudocolor8]} { # let's soak up a bunch of colors...so that # machines with small color palettes still fail. @@ -172,7 +174,7 @@ test clrpick-2.2 {tk_chooseColor command} -constraints { tk_chooseColor -parent . -title "choose #808040" } -result {#808040} test clrpick-2.3 {tk_chooseColor command} -constraints { - nonUnixUserInteraction colorsLeftover + nonUnixUserInteraction colorsLeftover failsOnXQuarz } -body { ToPressButton . ok tk_chooseColor -parent . -title "Press OK" diff --git a/tests/constraints.tcl b/tests/constraints.tcl index ee073cf..65609d6 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -172,6 +172,67 @@ namespace eval tk { return $r } + # + # CONTROL TIMING ASPECTS OF POINTER WARPING + # + # The proc [controlPointerWarpTiming] takes care of the following timing + # details of pointer warping: + # + # a. Allow pointer warping to happen if it was scheduled for execution at + # idle time. + # - In Tk releases 8.6 and older, pointer warping is scheduled for + # execution at idle time + # - In release 8.7 and newer this happens synchronously and no extra + # control is needed. + # The namespace variable idle_pointer_warping records which of these is + # the case. + # + # b. Work around a race condition associated with OS notification of + # mouse motion on Windows. + # + # When calling [event generate $w $event -warp 1 ...], the following + # sequence occurs: + # - At some point in the processing of this command, either via a + # synchronous execution path, or asynchronously at idle time, Tk calls + # an OS function* to carry out the mouse cursor motion. + # - Tk has previously registered a callback function** with the OS, for + # the OS to call in order to notify Tk when a mouse move is completed. + # - Tk doesn't wait for the callback function to receive the notification + # from the OS, but continues processing. This suits most use cases + # because (usually) the notification comes quickly enough + # (range: a few ms?). However ... + # - A problem arises if Tk performs some processing, immediately following + # up on [event generate $w $event -warp 1 ...], and that processing + # relies on the mouse pointer having actually moved. If such processing + # happens just before the notification from the OS has been received, + # Tk will be using not yet updated info (e.g. mouse coordinates). + # + # Hickup, choke etc ... ! + # + # * the function SendInput() of the Win32 API + # ** the callback function is TkWinChildProc() + # + # This timing issue can be addressed by putting the Tk process on hold + # (do nothing at all) for a somewhat extended amount of time, while + # letting the OS complete its job in the meantime. This is what is + # accomplished by calling [after ms]. + # + # ---- + # For the history of this issue please refer to Tk ticket [69b48f427e], + # specifically the comment on 2019-10-27 14:24:26. + # + variable idle_pointer_warping [expr {![package vsatisfies [package provide Tk] 8.7-]}] + proc controlPointerWarpTiming {{duration 50}} { + variable idle_pointer_warping + if {$idle_pointer_warping} { + update idletasks ;# see a. above + } + if {[tk windowingsystem] eq "win32"} { + after $duration ;# see b. above + } + } + namespace export controlPointerWarpTiming + } } diff --git a/tests/entry.test b/tests/entry.test index ef70a9e..d67980a 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -47,7 +47,7 @@ set cy [font metrics {Courier -12} -linespace] test entry-1.1 {configuration option: "background" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -background #ff0000 @@ -57,7 +57,7 @@ test entry-1.1 {configuration option: "background" for entry} -setup { } -result {#ff0000} test entry-1.2 {configuration option: "background" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -background non-existent @@ -67,7 +67,7 @@ test entry-1.2 {configuration option: "background" for entry} -setup { test entry-1.3 {configuration option: "bd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bd 4 @@ -77,7 +77,7 @@ test entry-1.3 {configuration option: "bd" for entry} -setup { } -result 4 test entry-1.4 {configuration option: "bd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bd badValue @@ -87,7 +87,7 @@ test entry-1.4 {configuration option: "bd" for entry} -setup { test entry-1.5 {configuration option: "bg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bg #ff0000 @@ -97,7 +97,7 @@ test entry-1.5 {configuration option: "bg" for entry} -setup { } -result {#ff0000} test entry-1.6 {configuration option: "bg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -bg non-existent @@ -107,7 +107,7 @@ test entry-1.6 {configuration option: "bg" for entry} -setup { test entry-1.7 {configuration option: "borderwidth" for entry} -setup { entry .e -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -borderwidth 1.3 @@ -117,7 +117,7 @@ test entry-1.7 {configuration option: "borderwidth" for entry} -setup { } -result 1 test entry-1.8 {configuration option: "borderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -borderwidth badValue @@ -127,7 +127,7 @@ test entry-1.8 {configuration option: "borderwidth" for entry} -setup { test entry-1.9 {configuration option: "cursor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -cursor arrow @@ -137,7 +137,7 @@ test entry-1.9 {configuration option: "cursor" for entry} -setup { } -result {arrow} test entry-1.10 {configuration option: "cursor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -cursor badValue @@ -147,7 +147,7 @@ test entry-1.10 {configuration option: "cursor" for entry} -setup { test entry-1.11 {configuration option: "disabledbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledbackground green @@ -157,7 +157,7 @@ test entry-1.11 {configuration option: "disabledbackground" for entry} -setup { } -result {green} test entry-1.12 {configuration option: "disabledbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledbackground non-existent @@ -167,7 +167,7 @@ test entry-1.12 {configuration option: "disabledbackground" for entry} -setup { test entry-1.13 {configuration option: "disabledforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledforeground blue @@ -177,7 +177,7 @@ test entry-1.13 {configuration option: "disabledforeground" for entry} -setup { } -result {blue} test entry-1.14 {configuration option: "disabledforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -disabledforeground non-existent @@ -187,7 +187,7 @@ test entry-1.14 {configuration option: "disabledforeground" for entry} -setup { test entry-1.15 {configuration option: "exportselection" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -exportselection yes @@ -197,7 +197,7 @@ test entry-1.15 {configuration option: "exportselection" for entry} -setup { } -result 1 test entry-1.16 {configuration option: "exportselection" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -exportselection xyzzy @@ -207,7 +207,7 @@ test entry-1.16 {configuration option: "exportselection" for entry} -setup { test entry-1.17 {configuration option: "fg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -fg #110022 @@ -217,7 +217,7 @@ test entry-1.17 {configuration option: "fg" for entry} -setup { } -result {#110022} test entry-1.18 {configuration option: "fg" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -fg non-existent @@ -227,7 +227,7 @@ test entry-1.18 {configuration option: "fg" for entry} -setup { test entry-1.19 {configuration option: "font" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e configure -font {Helvetica -12} @@ -237,7 +237,7 @@ test entry-1.19 {configuration option: "font" for entry} -setup { } -result {Helvetica -12} test entry-1.20 {configuration option: "font" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e configure -font {} @@ -247,7 +247,7 @@ test entry-1.20 {configuration option: "font" for entry} -setup { test entry-1.21 {configuration option: "foreground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -foreground #110022 @@ -257,7 +257,7 @@ test entry-1.21 {configuration option: "foreground" for entry} -setup { } -result {#110022} test entry-1.22 {configuration option: "foreground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -foreground non-existent @@ -267,7 +267,7 @@ test entry-1.22 {configuration option: "foreground" for entry} -setup { test entry-1.23 {configuration option: "highlightbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightbackground #110022 @@ -277,7 +277,7 @@ test entry-1.23 {configuration option: "highlightbackground" for entry} -setup { } -result {#110022} test entry-1.24 {configuration option: "highlightbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightbackground non-existent @@ -287,7 +287,7 @@ test entry-1.24 {configuration option: "highlightbackground" for entry} -setup { test entry-1.25 {configuration option: "highlightcolor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightcolor #110022 @@ -297,7 +297,7 @@ test entry-1.25 {configuration option: "highlightcolor" for entry} -setup { } -result {#110022} test entry-1.26 {configuration option: "highlightcolor" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightcolor non-existent @@ -307,7 +307,7 @@ test entry-1.26 {configuration option: "highlightcolor" for entry} -setup { test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightthickness 6 @@ -317,7 +317,7 @@ test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { } -result 6 test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightthickness -2 @@ -327,7 +327,7 @@ test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { } -result 0 test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -highlightthickness badValue @@ -337,7 +337,7 @@ test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { test entry-1.30 {configuration option: "insertbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertbackground #110022 @@ -347,7 +347,7 @@ test entry-1.30 {configuration option: "insertbackground" for entry} -setup { } -result {#110022} test entry-1.31 {configuration option: "insertbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertbackground non-existent @@ -357,7 +357,7 @@ test entry-1.31 {configuration option: "insertbackground" for entry} -setup { test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { entry .e -borderwidth 2 -insertwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertborderwidth 1.3 @@ -367,7 +367,7 @@ test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { } -result 1 test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertborderwidth 2.6x @@ -377,7 +377,7 @@ test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { test entry-1.34 {configuration option: "insertofftime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertofftime 100 @@ -387,7 +387,7 @@ test entry-1.34 {configuration option: "insertofftime" for entry} -setup { } -result 100 test entry-1.35 {configuration option: "insertofftime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertofftime 3.2 @@ -397,7 +397,7 @@ test entry-1.35 {configuration option: "insertofftime" for entry} -setup { test entry-1.36 {configuration option: "insertontime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertontime 100 @@ -407,7 +407,7 @@ test entry-1.36 {configuration option: "insertontime" for entry} -setup { } -result 100 test entry-1.37 {configuration option: "insertontime" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -insertontime 3.2 @@ -417,7 +417,7 @@ test entry-1.37 {configuration option: "insertontime" for entry} -setup { test entry-1.38 {configuration option: "invalidcommand" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -invalidcommand "any string" @@ -428,7 +428,7 @@ test entry-1.38 {configuration option: "invalidcommand" for entry} -setup { test entry-1.39 {configuration option: "invcmd" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -invcmd "any string" @@ -439,7 +439,7 @@ test entry-1.39 {configuration option: "invcmd" for entry} -setup { test entry-1.40 {configuration option: "justify" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -justify right @@ -449,7 +449,7 @@ test entry-1.40 {configuration option: "justify" for entry} -setup { } -result {right} test entry-1.41 {configuration option: "justify" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -justify bogus @@ -459,7 +459,7 @@ test entry-1.41 {configuration option: "justify" for entry} -setup { test entry-1.42 {configuration option: "readonlybackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -readonlybackground green @@ -469,7 +469,7 @@ test entry-1.42 {configuration option: "readonlybackground" for entry} -setup { } -result {green} test entry-1.43 {configuration option: "readonlybackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -readonlybackground non-existent @@ -479,7 +479,7 @@ test entry-1.43 {configuration option: "readonlybackground" for entry} -setup { test entry-1.44 {configuration option: "relief" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -relief flat @@ -490,7 +490,7 @@ test entry-1.44 {configuration option: "relief" for entry} -setup { test entry-1.45 {configuration option: "selectbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectbackground #110022 @@ -500,7 +500,7 @@ test entry-1.45 {configuration option: "selectbackground" for entry} -setup { } -result {#110022} test entry-1.46 {configuration option: "selectbackground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectbackground non-existent @@ -510,7 +510,7 @@ test entry-1.46 {configuration option: "selectbackground" for entry} -setup { test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectborderwidth 1.3 @@ -520,7 +520,7 @@ test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { } -result 1 test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectborderwidth badValue @@ -530,7 +530,7 @@ test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { test entry-1.49 {configuration option: "selectforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectforeground #110022 @@ -540,7 +540,7 @@ test entry-1.49 {configuration option: "selectforeground" for entry} -setup { } -result {#110022} test entry-1.50 {configuration option: "selectforeground" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -selectforeground non-existent @@ -550,7 +550,7 @@ test entry-1.50 {configuration option: "selectforeground" for entry} -setup { test entry-1.51 {configuration option: "show" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -show * @@ -561,7 +561,7 @@ test entry-1.51 {configuration option: "show" for entry} -setup { test entry-1.52 {configuration option: "state" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -state n @@ -571,7 +571,7 @@ test entry-1.52 {configuration option: "state" for entry} -setup { } -result {normal} test entry-1.53 {configuration option: "state" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -state bogus @@ -581,7 +581,7 @@ test entry-1.53 {configuration option: "state" for entry} -setup { test entry-1.54 {configuration option: "takefocus" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -takefocus "any string" @@ -592,7 +592,7 @@ test entry-1.54 {configuration option: "takefocus" for entry} -setup { test entry-1.55 {configuration option: "textvariable" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -textvariable i @@ -603,7 +603,7 @@ test entry-1.55 {configuration option: "textvariable" for entry} -setup { test entry-1.56 {configuration option: "width" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -width 402 @@ -613,7 +613,7 @@ test entry-1.56 {configuration option: "width" for entry} -setup { } -result 402 test entry-1.57 {configuration option: "width" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -width 3p @@ -623,7 +623,7 @@ test entry-1.57 {configuration option: "width" for entry} -setup { test entry-1.58 {configuration option: "xscrollcommand" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} - pack .e + pack .e ; update idletasks update } -body { .e configure -xscrollcommand {Some command} @@ -642,7 +642,7 @@ test entry-2.2 {Tk_EntryCmd procedure} -body { } -returnCodes error -result {bad window path name "gorp"} test entry-2.3 {Tk_EntryCmd procedure} -body { entry .e - pack .e + pack .e ; update idletasks update list [winfo exists .e] [winfo class .e] [info commands .e] } -cleanup { @@ -668,7 +668,7 @@ test entry-2.5 {Tk_EntryCmd procedure} -body { test entry-3.1 {EntryWidgetCmd procedure} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e @@ -677,7 +677,7 @@ test entry-3.1 {EntryWidgetCmd procedure} -setup { } -returnCodes error -result {wrong # args: should be ".e option ?arg ...?"} test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e bbox @@ -686,7 +686,7 @@ test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e bbox index"} test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e bbox a b @@ -695,7 +695,7 @@ test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e bbox index"} test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e bbox bogus @@ -704,7 +704,7 @@ test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { } -returnCodes error -result {bad entry index "bogus"} test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e bbox 0 @@ -719,7 +719,7 @@ test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): no utf chars @@ -732,7 +732,7 @@ test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): utf at end @@ -745,7 +745,7 @@ test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): utf before index @@ -756,7 +756,7 @@ test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { } -result {31 5 7 13} test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { # Tcl_UtfAtIndex(): no chars @@ -768,7 +768,7 @@ test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { fonts } -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert 0 "abcdefghij\u4e4eklmnop" @@ -807,7 +807,7 @@ test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { } -result 4 test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { llength [.e configure] @@ -860,7 +860,7 @@ test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -returnCodes error -result {bad entry index "bar"} test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -880,7 +880,7 @@ test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result 0123457890 test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update set x {} } -body { @@ -901,7 +901,7 @@ test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -912,7 +912,7 @@ test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result 01234567890 test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -925,7 +925,7 @@ test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -result 01234567890 test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -989,7 +989,7 @@ test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} -setup { } -returnCodes error -result {bad entry index "foo"} test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e index 0 @@ -998,7 +998,7 @@ test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { } -returnCodes {ok} -match glob -result {*} test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { # UTF @@ -1030,7 +1030,7 @@ test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -returnCodes error -result {bad entry index "foo"} test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1041,7 +1041,7 @@ test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -result {012xxx34567890} test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1054,7 +1054,7 @@ test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -result 01234567890 test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "01234567890" @@ -1074,7 +1074,7 @@ test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e insert index text"} test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan a @@ -1083,7 +1083,7 @@ test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan a b c @@ -1092,7 +1092,7 @@ test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan foobar 20 @@ -1101,7 +1101,7 @@ test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { } -returnCodes error -result {bad scan option "foobar": must be mark or dragto} test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e scan mark 20.1 @@ -1114,7 +1114,7 @@ test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} -constraints { fonts } -setup { entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long string, in fact a " @@ -1161,7 +1161,7 @@ test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} -setup } -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} test entry-3.50.1 {EntryWidgetCmd procedure, "select clear" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "0123456789" @@ -1184,7 +1184,7 @@ test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} - } -returnCodes error -result {wrong # args: should be ".e selection present"} test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1196,7 +1196,7 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} - } -result 1 test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1209,7 +1209,7 @@ test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} - } -result 1 test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1236,7 +1236,7 @@ test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} -s } -returnCodes error -result {wrong # args: should be ".e selection adjust index"} test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "0123456789" @@ -1250,7 +1250,7 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} -s } -result 123 test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end "0123456789" @@ -1297,7 +1297,7 @@ test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} -se } -returnCodes error -result {selection isn't in widget .e} test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1310,7 +1310,7 @@ test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -se } -result {2 9 3} test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1324,7 +1324,7 @@ test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} -setup { } -result {0 10} test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e insert end 0123456789 @@ -1338,7 +1338,7 @@ test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} -setup { } -result {2 4} test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} -setup { entry .e - pack .e + pack .e ; update idletasks update .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1350,7 +1350,7 @@ test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} -setu test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1362,7 +1362,7 @@ test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.0537634 0.2688172} test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e xview gorp @@ -1371,7 +1371,7 @@ test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {bad entry index "gorp"} test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1385,7 +1385,7 @@ test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.107527 0.322581} test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e xview moveto foo bar @@ -1394,7 +1394,7 @@ test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e xview moveto fraction"} test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e xview moveto foo @@ -1403,7 +1403,7 @@ test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {expected floating-point number but got "foo"} test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1415,7 +1415,7 @@ test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.505376 0.720430} test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1426,7 +1426,7 @@ test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1437,7 +1437,7 @@ test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {expected integer but got "gorp"} test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1450,7 +1450,7 @@ test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.193548 0.408602} test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1464,7 +1464,7 @@ test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result {0.397849 0.612903} test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1478,7 +1478,7 @@ test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 32 test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1492,7 +1492,7 @@ test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 29 test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1503,7 +1503,7 @@ test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {bad argument "foobars": must be units or pages} test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1514,7 +1514,7 @@ test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -returnCodes error -result {unknown option "eat": must be moveto or scroll} test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e insert end "This is quite a long text string, so long that it " @@ -1528,7 +1528,7 @@ test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 0 test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1540,7 +1540,7 @@ test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { } -result 73 test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." @@ -1562,7 +1562,7 @@ test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { test entry-3.82 {EntryWidgetCmd procedure} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks update } -body { .e gorp @@ -1576,7 +1576,7 @@ test entry-3.82 {EntryWidgetCmd procedure} -setup { test entry-4.1 {DestroyEntry procedure} -body { entry .e -textvariable x -show * - pack .e + pack .e ; update idletasks .e insert end "Sample text" update destroy .e @@ -1631,7 +1631,7 @@ test entry-5.5 {ConfigureEntry procedure} -setup { .e2 insert end "This is some sample text" .e1 configure -exportselection false .e1 insert end "0123456789" - pack .e1 .e2 + pack .e1 .e2 ; update idletasks .e2 select from 0 .e2 select to 10 lappend x [selection get] @@ -1646,7 +1646,7 @@ test entry-5.5 {ConfigureEntry procedure} -setup { } -result {{This is so} {This is so} 1234} test entry-5.6 {ConfigureEntry procedure} -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e insert end "0123456789" .e select from 1 @@ -1658,7 +1658,7 @@ test entry-5.6 {ConfigureEntry procedure} -setup { } -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} test entry-5.6.1 {ConfigureEntry procedure} -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e insert end "0123456789" .e select from 1 @@ -1672,7 +1672,7 @@ test entry-5.6.1 {ConfigureEntry procedure} -setup { test entry-5.7 {ConfigureEntry procedure} -setup { entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -width 4 -xscrollcommand scroll .e insert end "01234567890" @@ -1691,7 +1691,7 @@ test entry-5.8 {ConfigureEntry procedure} -constraints { fonts failsOnXQuarz } -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 0 -font {Helvetica -12} .e insert end "0123" @@ -1706,7 +1706,7 @@ test entry-5.9 {ConfigureEntry procedure} -constraints { fonts } -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised .e insert end "0123" @@ -1719,7 +1719,7 @@ test entry-5.10 {ConfigureEntry procedure} -constraints { fonts } -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief flat .e insert end "0123" @@ -1730,7 +1730,7 @@ test entry-5.10 {ConfigureEntry procedure} -constraints { } -result {0 0 1 1} test entry-5.11 {ConfigureEntry procedure} -setup { entry .e -borderwidth 2 -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { # If "0" in selected font had 0 width, caused divide-by-zero error. .e configure -font {{open look glyph}} @@ -1746,7 +1746,7 @@ test entry-6.1 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ -highlightthickness 3 @@ -1760,7 +1760,7 @@ test entry-6.2 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ -justify center -highlightthickness 3 @@ -1774,7 +1774,7 @@ test entry-6.3 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ -justify right -highlightthickness 3 @@ -1786,7 +1786,7 @@ test entry-6.3 {EntryComputeGeometry procedure} -constraints { } -result {3 4} test entry-6.4 {EntryComputeGeometry procedure} -setup { entry .e - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" @@ -1798,7 +1798,7 @@ test entry-6.4 {EntryComputeGeometry procedure} -setup { } -result 6 test entry-6.5 {EntryComputeGeometry procedure} -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" @@ -1812,7 +1812,7 @@ test entry-6.6 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Courier -12} -bd 2 -relief raised -width 10 .e insert end "01234\t67890" @@ -1826,7 +1826,7 @@ test entry-6.7 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 .e insert end "01234567" @@ -1839,7 +1839,7 @@ test entry-6.8 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 .e insert end "01234567" @@ -1852,7 +1852,7 @@ test entry-6.9 {EntryComputeGeometry procedure} -constraints { fonts } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 update @@ -1864,7 +1864,7 @@ test entry-6.10 {EntryComputeGeometry procedure} -constraints { unix fonts } -setup { entry .e -highlightthickness 2 -font {Helvetica -12} - pack .e + pack .e ; update idletasks } -body { .e configure -bd 1 -relief raised -width 0 -show . .e insert 0 12345 @@ -1881,7 +1881,7 @@ test entry-6.11 {EntryComputeGeometry procedure} -constraints { win } -setup { entry .e -highlightthickness 2 - pack .e + pack .e ; update idletasks } -body { .e configure -bd 1 -relief raised -width 0 -show . -font {helvetica 12} .e insert 0 12345 @@ -1905,7 +1905,7 @@ test entry-6.12 {EntryComputeGeometry procedure} -constraints { } -setup { catch {destroy .e} entry .e -font {Courier -12} -bd 2 -relief raised -width 20 - pack .e + pack .e ; update idletasks } -body { .e insert end "012\t456\t" update @@ -1918,7 +1918,7 @@ test entry-6.12 {EntryComputeGeometry procedure} -constraints { test entry-7.1 {InsertChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -1935,7 +1935,7 @@ test entry-7.1 {InsertChars procedure} -setup { test entry-7.2 {InsertChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -1950,7 +1950,7 @@ test entry-7.2 {InsertChars procedure} -setup { } -result {abcdeXXX abcdeXXX {0.000000 1.000000}} test entry-7.3 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -1964,7 +1964,7 @@ test entry-7.3 {InsertChars procedure} -setup { } -result {5 9 5 8} test entry-7.4 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -1978,7 +1978,7 @@ test entry-7.4 {InsertChars procedure} -setup { } -result {2 9 2 8} test entry-7.5 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -1992,7 +1992,7 @@ test entry-7.5 {InsertChars procedure} -setup { } -result {2 9 2 8} test entry-7.6 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e select from 2 @@ -2006,7 +2006,7 @@ test entry-7.6 {InsertChars procedure} -setup { } -result {2 6 2 5} test entry-7.7 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -xscrollcommand scroll .e insert 0 0123456789 @@ -2018,7 +2018,7 @@ test entry-7.7 {InsertChars procedure} -setup { } -result 7 test entry-7.8 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789 .e icursor 4 @@ -2029,7 +2029,7 @@ test entry-7.8 {InsertChars procedure} -setup { } -result 4 test entry-7.9 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 "This is a very long string" update @@ -2041,7 +2041,7 @@ test entry-7.9 {InsertChars procedure} -setup { } -result 7 test entry-7.10 {InsertChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 "This is a very long string" update @@ -2056,7 +2056,7 @@ test entry-7.11 {InsertChars procedure} -constraints { fonts } -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 "xyzzy" update @@ -2069,7 +2069,7 @@ test entry-7.11 {InsertChars procedure} -constraints { test entry-8.1 {DeleteChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -2085,7 +2085,7 @@ test entry-8.1 {DeleteChars procedure} -setup { test entry-8.2 {DeleteChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -2101,7 +2101,7 @@ test entry-8.2 {DeleteChars procedure} -setup { test entry-8.3 {DeleteChars procedure} -setup { unset -nocomplain contents entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e configure -textvariable contents -xscrollcommand scroll @@ -2116,7 +2116,7 @@ test entry-8.3 {DeleteChars procedure} -setup { } -result {abc abc {0.000000 1.000000}} test entry-8.4 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2132,7 +2132,7 @@ test entry-8.4 {DeleteChars procedure} -setup { } -result {1 6 1 5} test entry-8.5 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2148,7 +2148,7 @@ test entry-8.5 {DeleteChars procedure} -setup { } -result {1 5 1 4} test entry-8.6 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2164,7 +2164,7 @@ test entry-8.6 {DeleteChars procedure} -setup { } -result {1 2 1 5} test entry-8.7 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2178,7 +2178,7 @@ test entry-8.7 {DeleteChars procedure} -setup { } -returnCodes error -result {selection isn't in widget .e} test entry-8.8 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2194,7 +2194,7 @@ test entry-8.8 {DeleteChars procedure} -setup { } -result {3 4 3 8} test entry-8.9 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e insert 0 0123456789abcde .e select from 3 @@ -2207,7 +2207,7 @@ test entry-8.9 {DeleteChars procedure} -setup { } -returnCodes error -result {selection isn't in widget .e} test entry-8.10 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2223,7 +2223,7 @@ test entry-8.10 {DeleteChars procedure} -setup { } -result {3 5 5 8} test entry-8.11 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2239,7 +2239,7 @@ test entry-8.11 {DeleteChars procedure} -setup { } -result {3 8 4 8} test entry-8.12 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2252,7 +2252,7 @@ test entry-8.12 {DeleteChars procedure} -setup { } -result 1 test entry-8.13 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2265,7 +2265,7 @@ test entry-8.13 {DeleteChars procedure} -setup { } -result 1 test entry-8.14 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 0123456789abcde @@ -2278,7 +2278,7 @@ test entry-8.14 {DeleteChars procedure} -setup { } -result 4 test entry-8.15 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "This is a very long string" @@ -2291,7 +2291,7 @@ test entry-8.15 {DeleteChars procedure} -setup { } -result 1 test entry-8.16 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "This is a very long string" @@ -2304,7 +2304,7 @@ test entry-8.16 {DeleteChars procedure} -setup { } -result 1 test entry-8.17 {DeleteChars procedure} -setup { entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "This is a very long string" @@ -2317,7 +2317,7 @@ test entry-8.17 {DeleteChars procedure} -setup { } -result 4 test entry-8.18 {DeleteChars procedure} -constraints failsOnUbuntuNoXft -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks focus .e } -body { .e insert 0 "xyzzy" @@ -2346,7 +2346,7 @@ test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { set x abcde set y ab entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 - pack .e + pack .e ; update idletasks .e configure -textvariable x .e configure -textvariable y update @@ -2357,7 +2357,7 @@ test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { test entry-10.2 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" @@ -2370,7 +2370,7 @@ test entry-10.2 {EntrySetValue procedure, updating selection} -setup { test entry-10.3 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" @@ -2383,7 +2383,7 @@ test entry-10.3 {EntrySetValue procedure, updating selection} -setup { test entry-10.4 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" @@ -2396,7 +2396,7 @@ test entry-10.4 {EntrySetValue procedure, updating selection} -setup { test entry-10.5 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 10 -font {Courier -12} -textvariable x .e insert 0 "abcdefghjklmnopqrstuvwxyz" @@ -2411,10 +2411,10 @@ test entry-10.5 {EntrySetValue procedure, updating display position} -setup { test entry-10.6 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 10 -font {Courier -12} -textvariable x - pack .e + pack .e ; update idletasks .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update @@ -2427,11 +2427,11 @@ test entry-10.6 {EntrySetValue procedure, updating display position} -setup { test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks update } -body { .e configure -width 10 -font {Courier -12} -textvariable x - pack .e + pack .e ; update idletasks .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" @@ -2442,10 +2442,10 @@ test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x entry .e -highlightthickness 2 -bd 2 - pack .e + pack .e ; update idletasks } -body { .e configure -width 10 -font {Courier -12} -textvariable x - pack .e + pack .e ; update idletasks .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" @@ -2456,7 +2456,7 @@ test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { test entry-11.1 {EntryEventProc procedure} -setup { entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} - pack .e + pack .e ; update idletasks } -body { .e insert 0 abcdefg destroy .e @@ -2488,7 +2488,7 @@ test entry-12.1 {EntryCmdDeletedProc procedure} -body { test entry-13.1 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2505,7 +2505,7 @@ test entry-13.2 {GetEntryIndex procedure} -body { } -returnCodes error -result {bad entry index "abogus"} test entry-13.3 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2518,7 +2518,7 @@ test entry-13.3 {GetEntryIndex procedure} -setup { } -result 1 test entry-13.4 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2531,7 +2531,7 @@ test entry-13.4 {GetEntryIndex procedure} -setup { } -result 4 test entry-13.5 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2552,7 +2552,7 @@ test entry-13.6 {GetEntryIndex procedure} -setup { } -returnCodes error -result {bad entry index "ebogus"} test entry-13.7 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2571,7 +2571,7 @@ test entry-13.8 {GetEntryIndex procedure} -setup { } -returnCodes error -result {bad entry index "ibogus"} test entry-13.9 {GetEntryIndex procedure} -setup { entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks } -body { .e insert 0 012345678901234567890 .e xview 4 @@ -2593,7 +2593,7 @@ test entry-13.10 {GetEntryIndex procedure} -constraints x11 -body { # selection range is reset. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2613,7 +2613,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints aquaOrWin32 -body { # entry, the old range will be rehighlighted. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2631,7 +2631,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints aquaOrWin32 -body { test entry-13.12 {GetEntryIndex procedure} -constraints x11 -body { # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2650,7 +2650,7 @@ test entry-13.12 {GetEntryIndex procedure} -constraints x11 -body { test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2667,7 +2667,7 @@ test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { test entry-13.13 {GetEntryIndex procedure} -constraints win -body { # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2687,7 +2687,7 @@ test entry-13.14 {GetEntryIndex procedure} -constraints win -body { # entry, the old range will be rehighlighted. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2707,7 +2707,7 @@ test entry-13.14.1 {GetEntryIndex procedure} -constraints win -body { # entry, the old range will be rehighlighted. # Previous settings: entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2733,7 +2733,7 @@ test entry-13.15 {GetEntryIndex procedure} -body { test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2744,7 +2744,7 @@ test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2755,7 +2755,7 @@ test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2766,7 +2766,7 @@ test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2777,7 +2777,7 @@ test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2788,7 +2788,7 @@ test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { test entry-13.21 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2798,7 +2798,7 @@ test entry-13.21 {GetEntryIndex procedure} -body { } -result 9 test entry-13.22 {GetEntryIndex procedure} -setup { entry .e - pack .e + pack .e ; update idletasks update } -body { .e index 1xyz @@ -2808,7 +2808,7 @@ test entry-13.22 {GetEntryIndex procedure} -setup { test entry-13.23 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2819,7 +2819,7 @@ test entry-13.23 {GetEntryIndex procedure} -body { test entry-13.24 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2830,7 +2830,7 @@ test entry-13.24 {GetEntryIndex procedure} -body { test entry-13.25 {GetEntryIndex procedure} -body { entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ -font {Courier -12} - pack .e + pack .e ; update idletasks .e insert 0 012345678901234567890 .e xview 4 update @@ -2843,7 +2843,7 @@ test entry-13.26 {GetEntryIndex procedure} -constraints fonts -body { selection clear .e .e configure -show . .e insert 0 XXXYZZY - pack .e + pack .e ; update idletasks update list [.e index @7] [.e index @8] } -cleanup { @@ -2903,7 +2903,7 @@ test entry-15.1 {EntryLostSelection} -body { # is scrollcommand needed here?? test entry-16.1 {EntryVisibleRange procedure} -constraints fonts -body { entry .e -width 10 -font {Helvetica -12} - pack .e + pack .e ; update idletasks update .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] @@ -2914,7 +2914,7 @@ test entry-16.2 {EntryVisibleRange procedure} -constraints { unix fonts } -body { entry .e -show X -width 10 -font {Helvetica -12} - pack .e + pack .e ; update idletasks update .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] @@ -2925,7 +2925,7 @@ test entry-16.3 {EntryVisibleRange procedure} -constraints { win } -body { entry .e -show . -width 10 -font {Helvetica -12} - pack .e + pack .e ; update idletasks update .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX format {%.6f %.6f} {*}[.e xview] @@ -2942,7 +2942,7 @@ test entry-16.4 {EntryVisibleRange procedure} -body { test entry-17.1 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} - pack .e + pack .e ; update idletasks update idletasks set timeout [after 500 {set scrollInfo {-1000000 -1000000}}] .e delete 0 end @@ -2955,7 +2955,7 @@ test entry-17.1 {EntryUpdateScrollbar procedure} -body { } -result {0.000000 1.000000} test entry-17.2 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} - pack .e + pack .e ; update idletasks set timeout [after 500 {set scrollInfo {-1000000 -1000000}}] .e insert 0 0123456789abcdef .e xview 3 @@ -2967,7 +2967,8 @@ test entry-17.2 {EntryUpdateScrollbar procedure} -body { } -result {0.187500 0.812500} test entry-17.3 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} - pack .e + pack .e ; update idletasks + update idletasks set timeout [after 500 {set scrollInfo {-1000000 -1000000}}] .e insert 0 abcdefghijklmnopqrs .e xview 6 @@ -2984,7 +2985,7 @@ test entry-17.4 {EntryUpdateScrollbar procedure} -setup { } } -body { entry .e -width 5 - pack .e + pack .e ; update idletasks update idletasks .e configure -xscrollcommand thisisnotacommand vwait x @@ -3027,7 +3028,7 @@ test entry-19.1 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a set ::vVals } -cleanup { @@ -3042,7 +3043,7 @@ test entry-19.2 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a ;# previous settings .e insert 1 b return $::vVals @@ -3058,7 +3059,7 @@ test entry-19.3 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 ab ;# previous settings .e insert end c set ::vVals @@ -3074,7 +3075,7 @@ test entry-19.4 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 abc ;# previous settings .e insert 1 123 list $::vVals $::e @@ -3090,7 +3091,7 @@ test entry-19.5 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a123bc ;# previous settings .e delete 2 set ::vVals @@ -3106,7 +3107,7 @@ test entry-19.6 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 a13bc ;# previous settings .e configure -validate key .e delete 1 3 @@ -3123,7 +3124,7 @@ test entry-19.7 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abc ;# previous settings set ::vVals {} .e insert end d @@ -3140,7 +3141,7 @@ test entry-19.8 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e configure -validate focus ;# previous settings .e insert end abcd ;# previous settings focus -force .e @@ -3159,7 +3160,7 @@ test entry-19.9 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings focus -force .e ;# previous settings update ;# previous settings @@ -3180,7 +3181,7 @@ test entry-19.10 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings focus -force .e # update necessary to process FocusIn event @@ -3198,7 +3199,7 @@ test entry-19.11 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings focus -force .e ;# previous settings # update necessary to process FocusIn event @@ -3219,7 +3220,7 @@ test entry-19.12 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert 0 abcd ;# previous settings focus -force .e # update necessary to process FocusIn event @@ -3237,7 +3238,7 @@ test entry-19.13 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} focus -force . @@ -3256,7 +3257,7 @@ test entry-19.14 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} ;# previous settings focus -force .e @@ -3275,7 +3276,7 @@ test entry-19.15 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} ;# previous settings focus -force .e ;# previous settings @@ -3298,7 +3299,7 @@ test entry-19.16 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::vVals {} ;# previous settings focus -force .e ;# previous settings @@ -3321,7 +3322,7 @@ test entry-19.17 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks .e insert end abcd ;# previous settings set ::e newdata list [.e cget -validate] $::vVals @@ -3339,7 +3340,7 @@ test entry-19.18 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks set ::e newdata ;# previous settings .e configure -validate all set ::e nextdata @@ -3359,7 +3360,7 @@ test entry-19.19 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks set ::e nextdata ;# previous settings .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] @@ -3382,7 +3383,7 @@ test entry-19.20 {entry widget validation} -setup { -invalidcommand bell \ -textvariable ::e \ -background red -foreground white - pack .e + pack .e ; update idletasks set ::e nextdata ;# previous settings .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] ;# prev .e validate ;# previous settings @@ -3405,7 +3406,7 @@ test entry-19.21 {entry widget validation - bug 40e4bf6198} -setup { entry .e -validate key \ -validatecommand [list doval2 %W %d %i %P %s %S %v %V] \ -textvariable ::e - pack .e + pack .e ; update idletasks set ::e origdata .e insert 0 A list [.e cget -validate] [.e get] $::e $::vVals diff --git a/tests/event.test b/tests/event.test index e2ca9f5..f0e2311 100644 --- a/tests/event.test +++ b/tests/event.test @@ -874,9 +874,12 @@ test event-9 {no <Enter> event is generated for the container window when its pack propagate .top 0 bind .top <Enter> {lappend res %W} pack [frame .top.f -bg green -width 50 -height 50] -anchor se -side bottom + tkwait visibility .top.f + after 50 update + focus -force .top.f event generate .top.f <Motion> -warp 1 -x 25 -y 25 ; # <Enter> sent to .top and .top.f - after 50 ; # Win specific - wait for SendInput to be executed + controlPointerWarpTiming update ; # idletasks not enough destroy .top.f ; # no <Enter> event sent update diff --git a/tests/font.test b/tests/font.test index 6995a7b..24816e3 100644 --- a/tests/font.test +++ b/tests/font.test @@ -523,16 +523,16 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { destroy .t.f catch {font delete xyz} pack [label .t.f] - update + update idletasks } -body { font create xyz -family times -size 20 .t.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0 set a1 [font measure xyz "abcd"] - update + update idletasks set b1 [winfo reqwidth .t.f] font configure xyz -family helvetica -size 20 set a2 [font measure xyz "abcd"] - update + update idletasks set b2 [winfo reqwidth .t.f] expr {$a1==$b1 && $a2==$b2} } -cleanup { @@ -2408,6 +2408,147 @@ test font-47.1 {Bug f214b8ad5b} -body { interp delete two } -result {} +test font-47.2 {Bug 3049518,TIP 608 - Canvas} -body { + if {"MyFont" ni [font names]} { + font create MyFont -family "Liberation Sans" -size 13 + } + set text Hello! + destroy .t.c + set c [canvas .t.c] + set textid [$c create text 20 20 -font MyFont -text $text -anchor nw] + set twidth [font measure MyFont $text] + set theight [font metrics MyFont -linespace] + set circid [$c create polygon \ + 15 15 \ + [expr {15 + $twidth}] 15 \ + [expr {15 + $twidth}] [expr {15 + $theight}] \ + 15 [expr {15 + $theight}] \ + -width 1 -joinstyle round -smooth true -fill {} -outline blue] + pack $c -fill both -expand 1 -side top + tkwait visibility $c + + # Lamda test functions + set circle_text {{w user_data text circ} { + if {[winfo class $w] ne "Canvas"} { + puts "Wrong widget type: $w" + return + } + if {$user_data ne "FontChanged"} { + return + } + lappend ::results called-$w + lassign [$w bbox $text] x0 y0 x1 y1 + set offset 5 + set coord [lmap expr { + $x0-5 $y0-5 $x1+5 $y0-5 + $x1+5 $y1+5 $x0-5 $y1+5 + } {expr $expr}] + if {[catch {$w coord $circ $coord} err]} { + puts Error:$err + } + }} + set waitfor {{tag {time 333}} {after $time incr ::wait4; vwait ::wait4}} + set enclosed {{can id} {$can find enclosed {*}[$can bbox $id]}} + + set results {} + apply $circle_text $c FontChanged $textid $circid + bind $c <<TkWorldChanged>> [list apply $circle_text %W %d $textid $circid] + apply $waitfor 1 + + # Begin test: + set results {} + lappend results [apply $enclosed $c $circid] + font configure MyFont -size 26 + apply $waitfor 2 + lappend results [apply $enclosed $c $circid] + font configure MyFont -size 9 + apply $waitfor 3 + lappend results [apply $enclosed $c $circid] + apply $waitfor 4 + font configure MyFont -size 12 + apply $waitfor 5 + lappend results [apply $enclosed $c $circid] +} -cleanup { + destroy $c + unset -nocomplain ::results +} -result {{1 2} called-.t.c {1 2} called-.t.c {1 2} called-.t.c {1 2}} + +test font-47.3 {Bug 3049518, TIP 608 - Label} -body { + if {"MyFont" ni [font names]} { + font create MyFont -family "Liberation Sans" -size 13 + } + set text "Label Test" + destroy .t.l + + set make-img {{size} { + set img [image create photo -width $size -height $size] + $img blank + set max [expr {$size - 1}] + for {set x 0} {$x < $size} {incr x} { + $img put red -to $x $x + $img put black -to 0 $x + $img put black -to $x 0 + $img put black -to $max $x + $img put black -to $x $max + } + return $img + }} + + set testWorldChanged {{w user_data} { + global make-img + if {$user_data ne "FontChanged"} { + return + } + if {![winfo exists $w] || [winfo class $w] ne "Label"} { + return + } + if {[$w cget -image] ne ""} { + image delete [$w cget -image] + } + set size [font metrics [$w cget -font] -linespace] + set img [apply ${make-img} $size] + $w configure -image $img + }} + + set waitfor {{tag {time 500}} { + after $time incr ::wait4 + vwait ::wait4 + }} + + set check {{w} { + global results + set f [$w cget -font] + set i [$w cget -image] + set fs [font metrics $f -linespace] + set ish [image height $i] + set isw [image width $i] + lappend results [list [expr {$fs == $ish ? 1 : [list $fs $ish]}] [expr {$fs == $isw ? 1 : [list $fs $isw]}]] + }} + + set size [font metrics MyFont -linespace] + set img [apply ${make-img} $size] + set l [label .t.l -compound left -image $img -text $text -font MyFont] + pack $l -side top -fill both -expand 1 + bind $l <<TkWorldChanged>> [list apply $testWorldChanged %W %d] + set ::results {} + + apply $waitfor 0 + apply $check $l + font configure MyFont -size 26 + apply $waitfor 1 + apply $check $l + font configure MyFont -size 9 + apply $waitfor 2 + apply $check $l + font configure MyFont -size 13 + apply $waitfor 3 + apply $check $l + set results +} -cleanup { + destroy $l + unset -nocomplain ::results +} -result {{1 1} {1 1} {1 1} {1 1}} + # cleanup cleanupTests return diff --git a/tests/grab.test b/tests/grab.test index 653d756..0be5b61 100644 --- a/tests/grab.test +++ b/tests/grab.test @@ -107,7 +107,7 @@ test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} -body { grab status . } -cleanup { grab release . -} -result {none} +} -result none test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} -body { set curr [grab current .] if { [string length $curr] > 0 } { diff --git a/tests/menu.test b/tests/menu.test index 7589aea..ec78087 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -29,7 +29,7 @@ test menu-1.4 {Tk_MenuCmd procedure} -body { destroy .m1 menu .m1 } -cleanup { - deleteWindows + deleteWindows } -result {.m1} test menu-1.5 {Tk_MenuCmd - creating menubar} -setup { destroy .m1 @@ -38,19 +38,19 @@ test menu-1.5 {Tk_MenuCmd - creating menubar} -setup { .m1 add cascade -label Test -menu "" list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 menu .m1 } -cleanup { - deleteWindows + deleteWindows } -result {.m1} test menu-1.7 {Tk_MenuCmd procedure one clone cascade} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 @@ -58,10 +58,10 @@ test menu-1.7 {Tk_MenuCmd procedure one clone cascade} -setup { .m1 add cascade -menu .m2 menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {.m2} test menu-1.8 {Tk_MenuCmd procedure two clone cascades} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m2 @@ -71,10 +71,10 @@ test menu-1.8 {Tk_MenuCmd procedure two clone cascades} -setup { wm geometry .t3 +0+0 menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {.m2} test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 @@ -84,10 +84,10 @@ test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} -setup { wm geometry .t3 +0+0 list [menu .m2] } -cleanup { - deleteWindows + deleteWindows } -result {.m2} test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 @@ -97,10 +97,10 @@ test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} -setup { .m1 add cascade -menu .m2 list [menu .m2] } -cleanup { - deleteWindows + deleteWindows } -result {.m2} test menu-1.11 {Tk_MenuCmd procedure three clones cascades} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 @@ -112,19 +112,19 @@ test menu-1.11 {Tk_MenuCmd procedure three clones cascades} -setup { .m1 add cascade -menu .m2 list [menu .m2] } -cleanup { - deleteWindows + deleteWindows } -result {.m2} test menu-1.12 {Tk_MenuCmd procedure} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 list [menu .m1] } -cleanup { - deleteWindows + deleteWindows } -result {.m1} test menu-1.13 {Tk_MenuCmd procedure} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 @@ -132,10 +132,10 @@ test menu-1.13 {Tk_MenuCmd procedure} -setup { wm geometry .t3 +0+0 list [menu .m1] } -cleanup { - deleteWindows + deleteWindows } -result {.m1} test menu-1.14 {Tk_MenuCmd procedure} -setup { - deleteWindows + deleteWindows } -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 @@ -145,7 +145,7 @@ test menu-1.14 {Tk_MenuCmd procedure} -setup { wm geometry .t4 +0+0 list [menu .m1] } -cleanup { - deleteWindows + deleteWindows } -result {.m1} # Used for 2.1 - 2.30 tests @@ -262,11 +262,11 @@ test menu-2.27 {configuration options -takefocus {any string}} -body { test menu-2.28 {configuration options -tearoff 0} -body { .m1 configure -tearoff 0 .m1 cget -tearoff -} -result {0} +} -result 0 test menu-2.29 {configuration options -tearoff 1} -body { .m1 configure -tearoff 1 .m1 cget -tearoff -} -result {1} +} -result 1 test menu-2.30 {configuration options -tearoffcommand {any old string}} -body { .m1 configure -tearoffcommand {any old string} .m1 cget -tearoffcommand @@ -537,12 +537,12 @@ test menu-2.85 {entry configuration options 0 -columnbreak 1 tearoff} -body { test menu-2.86 {entry configuration options 1 -columnbreak 1 command} -body { .m1 entryconfigure 1 -columnbreak 1 lindex [.m1 entryconfigure 1 -columnbreak] 4 -} -result {1} +} -result 1 test menu-2.87 {entry configuration options 2 -columnbreak 1 cascade} -body { .m1 entryconfigure 2 -columnbreak 1 lindex [.m1 entryconfigure 2 -columnbreak] 4 -} -result {1} +} -result 1 test menu-2.88 {entry configuration options 3 -columnbreak 1 separator} -body { .m1 entryconfigure 3 -columnbreak 1 @@ -551,12 +551,12 @@ test menu-2.88 {entry configuration options 3 -columnbreak 1 separator} -body { test menu-2.89 {entry configuration options 4 -columnbreak 1 checkbutton} -body { .m1 entryconfigure 4 -columnbreak 1 lindex [.m1 entryconfigure 4 -columnbreak] 4 -} -result {1} +} -result 1 test menu-2.90 {entry configuration options 5 -columnbreak 1 radiobutton} -body { .m1 entryconfigure 5 -columnbreak 1 lindex [.m1 entryconfigure 5 -columnbreak] 4 -} -result {1} +} -result 1 test menu-2.91 {entry configuration options 0 -command beep tearoff} -body { .m1 entryconfigure 0 -command beep @@ -821,12 +821,12 @@ test menu-2.142 {entry configuration options 3 -indicatoron 1 separator} -body { test menu-2.143 {entry configuration options 4 -indicatoron 1 checkbutton} -body { .m1 entryconfigure 4 -indicatoron 1 lindex [.m1 entryconfigure 4 -indicatoron] 4 -} -result {1} +} -result 1 test menu-2.144 {entry configuration options 5 -indicatoron 1 radiobutton} -body { .m1 entryconfigure 5 -indicatoron 1 lindex [.m1 entryconfigure 5 -indicatoron] 4 -} -result {1} +} -result 1 test menu-2.145 {entry configuration options 0 -label test tearoff} -body { .m1 entryconfigure 0 -label test @@ -1164,12 +1164,12 @@ test menu-2.217 {entry configuration options 0 -underline 0 tearoff} -body { test menu-2.218 {entry configuration options 1 -underline 0 command} -body { .m1 entryconfigure 1 -underline 0 lindex [.m1 entryconfigure 1 -underline] 4 -} -result {0} +} -result 0 test menu-2.219 {entry configuration options 2 -underline 0 cascade} -body { .m1 entryconfigure 2 -underline 0 lindex [.m1 entryconfigure 2 -underline] 4 -} -result {0} +} -result 0 test menu-2.220 {entry configuration options 3 -underline 0 separator} -body { .m1 entryconfigure 3 -underline 0 @@ -1178,12 +1178,12 @@ test menu-2.220 {entry configuration options 3 -underline 0 separator} -body { test menu-2.221 {entry configuration options 4 -underline 0 checkbutton} -body { .m1 entryconfigure 4 -underline 0 lindex [.m1 entryconfigure 4 -underline] 4 -} -result {0} +} -result 0 test menu-2.222 {entry configuration options 5 -underline 0 radiobutton} -body { .m1 entryconfigure 5 -underline 0 lindex [.m1 entryconfigure 5 -underline] 4 -} -result {0} +} -result 0 test menu-2.223 {entry configuration options 0 -underline 3p tearoff} -body { .m1 entryconfigure 0 -underline 3p @@ -1359,7 +1359,7 @@ test menu-3.18 {MenuWidgetCmd procedure, "configure" option} -setup { llength [.m1 configure] } -cleanup { destroy .m1 -} -result {20} +} -result 20 test menu-3.19 {MenuWidgetCmd procedure, "configure" option} -setup { destroy .m1 } -body { @@ -1511,7 +1511,7 @@ test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { llength [.m1 entryconfigure 1] } -cleanup { destroy .m1 -} -result {15} +} -result 15 test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { destroy .m1 } -body { @@ -1629,7 +1629,7 @@ test menu-3.50 {MenuWidgetCmd procedure, "post" option} -constraints { destroy .m1 } -body { menu .m1 - .m1 add command -label "menu-3.53: hit Escape" -command "puts hello" + .m1 add command -label "menu-3.50: hit Escape" -command "puts hello" .m1 post 40 40 } -cleanup { destroy .m1 @@ -1656,7 +1656,7 @@ test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} -constraints { destroy .m1 .m2 } -body { menu .m1 - .m1 add command -label "menu-3.56 - hit Escape" + .m1 add command -label "menu-3.53 - hit Escape" menu .m2 .m1 post 40 40 .m1 add cascade -menu .m2 @@ -1758,7 +1758,7 @@ test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} -constraints { destroy .m1 } -body { menu .m1 - .m1 add command -label "menu-3.68 - hit Escape" + .m1 add command -label "menu-3.64 - hit Escape" .m1 post 40 40 .m1 unpost } -cleanup { @@ -1779,7 +1779,7 @@ test menu-3.66a {MenuWidgetCmd procedure, "yposition" option, no tearoff} -setup .m1 yposition 1 } -cleanup { destroy .m1 -} -result {0} +} -result 0 test menu-3.66b {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints { notAqua } -setup { @@ -1791,7 +1791,7 @@ test menu-3.66b {MenuWidgetCmd procedure, "yposition" option, with tearoff} -con .m1 yposition 1 } -cleanup { destroy .m1 -} -result {1} +} -result 1 test menu-3.66c {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints { aqua } -setup { @@ -1803,7 +1803,7 @@ test menu-3.66c {MenuWidgetCmd procedure, "yposition" option, with tearoff} -con .m1 yposition 1 } -cleanup { destroy .m1 -} -result {0} +} -result 0 test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup { destroy .m1 } -body { @@ -1813,7 +1813,7 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup { destroy .m1 } -returnCodes error -result {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition} test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} -setup { - deleteWindows + deleteWindows } -body { set t .t set m1 .t.m1 @@ -1831,7 +1831,7 @@ test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} -setup { $t configure -menu "" list [winfo exists $c1] [winfo exists $c2] } -cleanup { - deleteWindows + deleteWindows } -result {1 1} test menu-3.69 {MenuWidgetCmd procedure, "xposition" option} -setup { destroy .m1 @@ -1869,8 +1869,8 @@ test menu-4.2 {TkInvokeMenu: tearoff} -setup { menu .m1 catch {.m1 invoke 0} } -cleanup { - deleteWindows -} -result {0} + deleteWindows +} -result 0 test menu-4.3 {TkInvokeMenu: checkbutton -on} -setup { destroy .m1 } -body { @@ -2026,7 +2026,7 @@ test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} -setup { list [destroy .m2] [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1] } -returnCodes ok -result {{} .m2 {} {}} test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m2 @@ -2122,7 +2122,7 @@ test menu-6.4 {TkDestroyMenu - reentrancy - clones} -setup { .m1 clone .m1.m3 destroy .m1 } -cleanup { - deleteWindows + deleteWindows } -returnCodes ok test menu-6.5 {TkDestroyMenu} -setup { destroy .m1 .m2 @@ -2131,7 +2131,7 @@ test menu-6.5 {TkDestroyMenu} -setup { .m1 clone .m2 destroy .m1 winfo exists .m2 -} -result {0} +} -result 0 test menu-6.6 {TkDestroyMenu} -setup { destroy .m1 .m2 } -body { @@ -2263,7 +2263,7 @@ test menu-7.4 {UnhookCascadeEntry} -setup { list [destroy .m1] [destroy .m2] } -returnCodes ok -result {{} {}} test menu-7.5 {UnhookCascadeEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -2274,7 +2274,7 @@ test menu-7.5 {UnhookCascadeEntry} -setup { list [destroy .m1] [destroy .m2 .m3] } -returnCodes ok -result {{} {}} test menu-7.6 {UnhookCascadeEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -2285,7 +2285,7 @@ test menu-7.6 {UnhookCascadeEntry} -setup { list [destroy .m2] [destroy .m1 .m3] } -returnCodes ok -result {{} {}} test menu-7.7 {UnhookCascadeEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -2296,7 +2296,7 @@ test menu-7.7 {UnhookCascadeEntry} -setup { list [destroy .m3] [destroy .m1 .m2] } -returnCodes ok -result {{} {}} test menu-7.8 {UnhookCascadeEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -2367,7 +2367,7 @@ test menu-8.6 {DestroyMenuEntry} -setup { list [.m1 delete 1] [.m1 entrycget 1 -label] [destroy .m1] } -result {{} two {}} test menu-8.7 {DestroyMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "one" @@ -2384,7 +2384,7 @@ test menu-9.1 {ConfigureMenu} -setup { menu .m1 list [.m1 configure -postcommand "beep"] [.m1 cget -postcommand] } -cleanup { - deleteWindows + deleteWindows } -result {{} beep} test menu-9.2 {ConfigureMenu} -setup { destroy .m1 @@ -2393,7 +2393,7 @@ test menu-9.2 {ConfigureMenu} -setup { .m1 add command -label "test" list [.m1 configure -tearoff 0] [.m1 entrycget 1 -label] } -cleanup { - deleteWindows + deleteWindows } -result {{} test} test menu-9.3 {ConfigureMenu} -setup { destroy .m1 @@ -2401,7 +2401,7 @@ test menu-9.3 {ConfigureMenu} -setup { menu .m1 list [.m1 configure -postcommand "beep"] [.m1 cget -postcommand] } -cleanup { - deleteWindows + deleteWindows } -result {{} beep} test menu-9.4 {ConfigureMenu} -setup { destroy .m1 @@ -2410,7 +2410,7 @@ test menu-9.4 {ConfigureMenu} -setup { .m1 add command -label "test" .m1 configure -fg red } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-9.5 {ConfigureMenu} -setup { destroy .m1 @@ -2420,7 +2420,7 @@ test menu-9.5 {ConfigureMenu} -setup { .m1 add command -label "two" .m1 configure -fg red } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-9.6 {ConfigureMenu} -setup { destroy .m1 @@ -2431,25 +2431,25 @@ test menu-9.6 {ConfigureMenu} -setup { .m1 add command -label "three" .m1 configure -fg red } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-9.7 {ConfigureMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 tearoff list [.m1 configure -fg red] [.m2 cget -fg] } -cleanup { - deleteWindows + deleteWindows } -result {{} red} test menu-9.8 {ConfigureMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 tearoff list [.m2 configure -fg red] [.m1 cget -fg] } -cleanup { - deleteWindows + deleteWindows } -result {{} red} test menu-9.9 {ConfigureMenu} -setup { destroy .m1 @@ -2457,7 +2457,7 @@ test menu-9.9 {ConfigureMenu} -setup { menu .m1 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} @@ -2470,7 +2470,7 @@ test menu-10.1 {PostProcessEntry: array variable} -setup { .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense" set foo(1) } -cleanup { - deleteWindows + deleteWindows } -result {on} test menu-10.2 {PostProcessEntry: array variable} -setup { destroy .m1 @@ -2480,7 +2480,7 @@ test menu-10.2 {PostProcessEntry: array variable} -setup { .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense" set foo(1) } -cleanup { - deleteWindows + deleteWindows } -result {off} @@ -2492,7 +2492,7 @@ test menu-11.1 {ConfigureMenuEntry} -setup { .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense" list [.m1 entryconfigure 1 -variable bar] [.m1 entrycget 1 -variable] } -cleanup { - deleteWindows + deleteWindows } -result {{} bar} test menu-11.2 {ConfigureMenuEntry} -setup { destroy .m1 @@ -2501,7 +2501,7 @@ test menu-11.2 {ConfigureMenuEntry} -setup { .m1 add command -label "test" list [.m1 entryconfigure 1 -label ""] [.m1 entrycget 1 -label] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-11.3 {ConfigureMenuEntry} -setup { destroy .m1 @@ -2510,83 +2510,83 @@ test menu-11.3 {ConfigureMenuEntry} -setup { .m1 add command list [.m1 entryconfigure 1 -label "test"] [.m1 entrycget 1 -label] } -cleanup { - deleteWindows + deleteWindows } -result {{} test} test menu-11.4 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command list [.m1 entryconfigure 1 -accel "S"] [.m1 entrycget 1 -accel] } -cleanup { - deleteWindows + deleteWindows } -result {{} S} test menu-11.5 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command list [.m1 entryconfigure 1 -label "test"] [.m1 entrycget 1 -label] } -cleanup { - deleteWindows + deleteWindows } -result {{} test} test menu-11.6 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command .m1 entryconfigure 1 -label "test" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.7 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m2 menu .m1 .m1 add cascade .m1 entryconfigure 1 -label "test" -menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.8 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade .m1 entryconfigure 1 -label "test" -menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.9 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m3 .m1 entryconfigure 1 -label "test" -menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.10 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade .m1 entryconfigure 1 -label "test" -menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.11 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m2 .m1 entryconfigure 1 -label "test" -menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.12 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -2599,10 +2599,10 @@ test menu-11.12 {ConfigureMenuEntry} -setup { .m5 add cascade .m5 entryconfigure 1 -label "test" -menu .m1 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.13 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -2613,32 +2613,32 @@ test menu-11.13 {ConfigureMenuEntry} -setup { .m4 add cascade -menu .m1 .m3 entryconfigure 1 -label "test" -menu .m1 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.14 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add checkbutton list [.m1 entryconfigure 1 -variable "test"] [.m1 entrycget 1 -variable] } -cleanup { - deleteWindows + deleteWindows } -result {{} test} test menu-11.15 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 list [.m1 add checkbutton -label "test"] [.m1 entrycget 1 -variable] } -cleanup { - deleteWindows + deleteWindows } -result {{} test} test menu-11.16 {ConfigureMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add radiobutton -label "test" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-11.17 {ConfigureMenuEntry} -setup { deleteWindows @@ -2844,35 +2844,35 @@ test menu-13.8 {TkGetMenuIndex} -setup { .m1 entrycget -1 -label } -returnCodes error -result {bad menu entry index "-1"} test menu-13.9 {TkGetMenuIndex} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test2" .m1 entrycget 999 -label } -cleanup { - deleteWindows + deleteWindows } -result {test2} test menu-13.10 {TkGetMenuIndex} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 insert 999 command -label "test" .m1 entrycget 1 -label } -cleanup { - deleteWindows + deleteWindows } -result {test} test menu-13.11 {TkGetMenuIndex} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "1test" .m1 entrycget 1test -label } -cleanup { - deleteWindows + deleteWindows } -result {1test} test menu-13.12 {TkGetMenuIndex} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" @@ -2880,176 +2880,176 @@ test menu-13.12 {TkGetMenuIndex} -setup { .m1 add command -label "test3" .m1 entrycget test2 -command } -cleanup { - deleteWindows + deleteWindows } -result {beep} test menu-14.1 {MenuCmdDeletedProc} -setup { - deleteWindows + deleteWindows } -body { menu .m1 destroy .m1 } -cleanup { - deleteWindows + deleteWindows } -returnCodes ok test menu-14.2 {MenuCmdDeletedProc} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 destroy .m1 } -cleanup { - deleteWindows + deleteWindows } -returnCodes ok test menu-15.1 {MenuNewEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-15.2 {MenuNewEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test3" .m1 insert 2 command -label "test2" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-15.3 {MenuNewEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test2" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-15.4 {MenuNewEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.1 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 insert foo command -label "test" } -returnCodes error -result {bad menu entry index "foo"} test menu-16.2 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 insert test command -label "foo" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.3 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 insert -1 command -label "test" } -returnCodes error -result {bad menu entry index "-1"} test menu-16.4 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 -tearoff 1 .m1 add command -label "test" .m1 insert 0 command -label "test2" .m1 entrycget 1 -label } -cleanup { - deleteWindows + deleteWindows } -result {test2} test menu-16.5 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.6 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add checkbutton } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.7 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.8 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add radiobutton } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.9 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add separator } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.10 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add blork } -returnCodes error -result {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} test menu-16.11 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-16.12 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 .m2 clone .m3 list [.m2 add command -label "test"] [.m1 entrycget 1 -label] [.m3 entrycget 1 -label] } -cleanup { - deleteWindows + deleteWindows } -result {{} test test} test menu-16.13 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 .m2 clone .m3 list [.m3 add command -label "test"] [.m1 entrycget 1 -label] [.m2 entrycget 1 -label] } -cleanup { - deleteWindows + deleteWindows } -result {{} test test} test menu-16.14 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -blork } -returnCodes error -result {unknown option "-blork"} test menu-16.15 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "File" @@ -3057,20 +3057,20 @@ test menu-16.15 {MenuAddOrInsert} -setup { . configure -menu .container list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-16.16 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 set tearoff [tk::TearOffMenu .m2] list [.m2 add cascade -menu .m1] [$tearoff unpost] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-16.17 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .container @@ -3078,10 +3078,10 @@ test menu-16.17 {MenuAddOrInsert} -setup { set tearoff [tk::TearOffMenu .container] list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-16.18 {MenuAddOrInsert} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .container @@ -3089,10 +3089,10 @@ test menu-16.18 {MenuAddOrInsert} -setup { . configure -menu .container list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} -setup { - deleteWindows + deleteWindows } -body { menu .menubar menu .menubar.test -tearoff 0 @@ -3105,12 +3105,12 @@ test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} -setup { [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \ [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {0 .#menubar.#menubar#test.#menubar#test#cascade {}} test menu-17.1 {MenuVarProc} -setup { - deleteWindows + deleteWindows } -body { catch {unset foo} menu .m1 @@ -3118,21 +3118,21 @@ test menu-17.1 {MenuVarProc} -setup { list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [unset foo] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} # menu-17.2 - Don't know how to generate the flags in the if test menu-17.2 {MenuVarProc} -setup { - deleteWindows + deleteWindows } -body { catch {unset foo} menu .m1 list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [set foo ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-17.3 {MenuVarProc} -setup { - deleteWindows + deleteWindows } -body { catch {unset foo} menu .m1 @@ -3140,30 +3140,30 @@ test menu-17.3 {MenuVarProc} -setup { list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [set foo "hello"] [unset foo] } -cleanup { - deleteWindows + deleteWindows } -result {{} hello {}} test menu-17.4 {MenuVarProc} -setup { - deleteWindows + deleteWindows } -body { menu .m1 set foo "goodbye" list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [set foo "hello"] [unset foo] } -cleanup { - deleteWindows + deleteWindows } -result {{} hello {}} test menu-17.5 {MenuVarProc} -setup { - deleteWindows + deleteWindows } -body { menu .m1 set foo "hello" list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [set foo "goodbye"] [unset foo] } -cleanup { - deleteWindows + deleteWindows } -result {{} goodbye {}} test menu-17.6 {MenuVarProc [5d991b822e]} -setup { - deleteWindows + deleteWindows } -body { # Want this not to crash menu .b @@ -3174,10 +3174,10 @@ test menu-17.6 {MenuVarProc [5d991b822e]} -setup { }}} unset var } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-17.7 {MenuVarProc [5d991b822e]} -setup { - deleteWindows + deleteWindows } -body { # Want this not to duplicate traces menu .b @@ -3188,30 +3188,30 @@ test menu-17.7 {MenuVarProc [5d991b822e]} -setup { }}} unset var } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-18.1 {TkActivateMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 activate 1 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-18.2 {TkActivateMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 activate 0 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-18.3 {TkActivateMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" @@ -3219,10 +3219,10 @@ test menu-18.3 {TkActivateMenuEntry} -setup { .m1 activate 1 .m1 activate 2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-18.4 {TkActivateMenuEntry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" @@ -3230,112 +3230,112 @@ test menu-18.4 {TkActivateMenuEntry} -setup { .m1 activate 1 .m1 activate 1 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-19.1 {TkPostCommand} -constraints nonUnixUserInteraction -setup { - deleteWindows + deleteWindows } -body { menu .m1 -postcommand "set menu_test menu-19.1" .m1 add command -label "menu-19.1 - hit Escape" list [.m1 post 40 40] [.m1 unpost] [set menu_test] } -cleanup { - deleteWindows + deleteWindows } -result {menu-19.1 {} menu-19.1} test menu-19.2 {TkPostCommand} -constraints nonUnixUserInteraction -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "menu-19.2 - hit Escape" list [.m1 post 40 40] [.m1 unpost] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-20.1 {CloneMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2] } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.2 {CloneMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 normal - deleteWindows + deleteWindows } -result {} test menu-20.3 {CloneMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 tearoff } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.4 {CloneMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 menubar } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.5 {CloneMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 foo } -returnCodes error -result {bad menu type "foo": must be normal, tearoff, or menubar} test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 clone .m2 .m1 clone .m3 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.8 {CloneMenu - cascade entries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m2 .m1 clone .foo } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.9 {CloneMenu - cascades entries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m2 menu .m2 .m1 clone .foo } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-20.10 {CloneMenu - tearoff fields} -setup { - deleteWindows + deleteWindows } -body { menu .m1 -tearoff 1 list [.m1 clone .m2 normal] [.m2 cget -tearoff] } -cleanup { - deleteWindows + deleteWindows } -result {{} 1} test menu-20.11 {CloneMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m2 @@ -3343,43 +3343,43 @@ test menu-20.11 {CloneMenu} -setup { } -returnCodes error -result {window name "m2" already exists in parent} test menu-21.1 {MenuDoYPosition} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 yposition glorp } -returnCodes error -result {bad menu entry index "glorp"} test menu-21.2 {MenuDoYPosition} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "Test" .m1 yposition 1 } -cleanup { - deleteWindows + deleteWindows } -returnCodes ok -match glob -result {*} test menu-22.1 {GetIndexFromCoords} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 .m1 index @5 } -cleanup { - deleteWindows -} -result {0} + deleteWindows +} -result 0 test menu-22.2 {GetIndexFromCoords} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 .m1 index @5,5 } -cleanup { - deleteWindows -} -result {0} + deleteWindows +} -result 0 test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup { - deleteWindows + deleteWindows } -constraints {x11} -body { menu .m1 .m1 add command -label "test" @@ -3388,10 +3388,10 @@ test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup { tkwait visibility .m1 .m1 index @5 } -cleanup { - deleteWindows -} -result {0} + deleteWindows +} -result 0 test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup { - deleteWindows + deleteWindows } -constraints {x11} -body { menu .m1 .m1 add command -label "test" @@ -3402,10 +3402,10 @@ test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup { set x [expr {[winfo width .m1] - [.m1 cget -borderwidth] - 1}] .m1 index @$x,5 } -cleanup { - deleteWindows -} -result {0} + deleteWindows +} -result 0 test menu-22.5 {GetIndexFromCoords: mapped wide window} -setup { - deleteWindows + deleteWindows } -constraints {x11} -body { menu .m1 .m1 add command -label "test" @@ -3417,20 +3417,20 @@ test menu-22.5 {GetIndexFromCoords: mapped wide window} -setup { set x [expr {[winfo width .m1] - [.m1 cget -borderwidth] - 1}] .m1 index @$x,5 } -cleanup { - deleteWindows -} -result {0} + deleteWindows +} -result 0 test menu-23.1 {RecursivelyDeleteMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m1 . configure -menu .m1 . configure -menu "" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-23.2 {RecursivelyDeleteMenu} -setup { - deleteWindows + deleteWindows } -body { menu .m2 .m2 add command -label "test2" @@ -3439,28 +3439,28 @@ test menu-23.2 {RecursivelyDeleteMenu} -setup { . configure -menu .m1 . configure -menu "" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-24.1 {TkNewMenuName} -setup { - deleteWindows + deleteWindows } -body { menu .m1 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-24.2 {TkNewMenuName} -setup { - deleteWindows + deleteWindows } -body { menu .m1 menu .m1\#0 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-24.3 {TkNewMenuName} -setup { - deleteWindows + deleteWindows } -body { menu .#m rename .#m hideme @@ -3470,33 +3470,33 @@ test menu-24.3 {TkNewMenuName} -setup { test menu-25.1 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.2 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.3 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" destroy .m1 menu .m1 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.4 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3504,10 +3504,10 @@ test menu-25.4 {TkSetWindowMenuBar} -setup { menu .m2 list [. configure -menu .m2] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.5 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3516,10 +3516,10 @@ test menu-25.5 {TkSetWindowMenuBar} -setup { menu .m3 list [. configure -menu .m3] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.6 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3528,10 +3528,10 @@ test menu-25.6 {TkSetWindowMenuBar} -setup { menu .m3 list [. configure -menu .m3] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.7 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3541,10 +3541,10 @@ test menu-25.7 {TkSetWindowMenuBar} -setup { .t2 configure -menu .m1 list [.t2 configure -menu .m2] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.8 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3555,10 +3555,10 @@ test menu-25.8 {TkSetWindowMenuBar} -setup { .t2 configure -menu .m1 list [. configure -menu .m2] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.9 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3570,10 +3570,10 @@ test menu-25.9 {TkSetWindowMenuBar} -setup { wm geometry .t3 +0+0 list [.t3 configure -menu .m2] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.10 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3585,10 +3585,10 @@ test menu-25.10 {TkSetWindowMenuBar} -setup { wm geometry .t3 +0+0 list [.t2 configure -menu .m2] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.11 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3600,57 +3600,57 @@ test menu-25.11 {TkSetWindowMenuBar} -setup { wm geometry .t3 +0+0 list [. configure -menu .m2] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.12 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.13 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.14 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.15 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-25.16 {TkSetWindowMenuBar} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 . configure -menu .m1 list [toplevel .t2 -menu m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {.t2 {}} test menu-26.1 {DestroyMenuHashTable} -setup { catch {interp delete testinterp} - deleteWindows + deleteWindows } -body { interp create testinterp load {} Tk testinterp @@ -3661,48 +3661,48 @@ test menu-26.1 {DestroyMenuHashTable} -setup { test menu-27.1 {GetMenuHashTable} -setup { catch {interp delete testinterp} - deleteWindows + deleteWindows } -body { interp create testinterp load {} Tk testinterp list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp] } -cleanup { - deleteWindows + deleteWindows } -result {0 .m1 {}} test menu-28.1 {TkCreateMenuReferences - not there before} -setup { - deleteWindows + deleteWindows } -body { menu .m1 } -cleanup { - deleteWindows + deleteWindows } -result {.m1} test menu-28.2 {TkCreateMenuReferences - there already} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m2 menu .m2 } -cleanup { - deleteWindows + deleteWindows } -result {.m2} test menu-29.1 {TkFindMenuReferences - not there} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 .m1 add cascade -menu .m2 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-30.1 {TkFindMenuReferences - there already} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 @@ -3710,38 +3710,38 @@ test menu-30.1 {TkFindMenuReferences - there already} -setup { .m1 add cascade -menu .m2 list [. configure -menu .m1] [. configure -menu ""] } -cleanup { - deleteWindows + deleteWindows } -result {{} {}} test menu-31.1 {TkFreeMenuReferences - menuPtr} -setup { - deleteWindows + deleteWindows } -body { menu .m1 destroy .m1 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-31.2 {TkFreeMenuReferences - cascadePtr} -setup { - deleteWindows + deleteWindows } -body { . configure -menu "" menu .m1 .m1 add cascade -menu .m2 .m1 entryconfigure 1 -menu .m3 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} -setup { - deleteWindows + deleteWindows } -body { . configure -menu .m1 . configure -menu "" } -cleanup { - deleteWindows + deleteWindows } -returnCodes ok -result {} test menu-31.4 {TkFreeMenuReferences - not empty} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add cascade -menu .m3 @@ -3749,22 +3749,22 @@ test menu-31.4 {TkFreeMenuReferences - not empty} -setup { .m2 add cascade -menu .m3 .m2 entryconfigure 1 -menu ".foo" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.1 {DeleteMenuCloneEntries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label foo .m1 clone .m2 .m1 delete 1 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.2 {DeleteMenuCloneEntries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 @@ -3775,10 +3775,10 @@ test menu-32.2 {DeleteMenuCloneEntries} -setup { .m1 clone .m2 .m1 delete 2 3 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.3 {DeleteMenuCloneEntries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 -tearoff 0 .m1 add command -label one @@ -3789,10 +3789,10 @@ test menu-32.3 {DeleteMenuCloneEntries} -setup { .m2 configure -tearoff 1 .m1 delete 1 2 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.4 {DeleteMenuCloneEntries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label one @@ -3803,10 +3803,10 @@ test menu-32.4 {DeleteMenuCloneEntries} -setup { .m2 configure -tearoff 0 .m1 delete 2 3 } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.5 {DeleteMenuCloneEntries} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label one @@ -3815,29 +3815,29 @@ test menu-32.5 {DeleteMenuCloneEntries} -setup { .m1 activate one .m1 delete one } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} -setup { - deleteWindows + deleteWindows } -body { menu .m1 .m1 add command -label test \ -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test" .m1 invoke test } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.7 {DeleteMenuCloneEntries - one entry} -setup { - deleteWindows + deleteWindows } -body { menu .m1 -tearoff 0 .m1 add command -label Hello .m1 delete Hello } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.8 {Ensure all menu clone commands are deleted} -setup { - deleteWindows + deleteWindows } -body { # SF bug #465324 menu .menubar @@ -3851,11 +3851,11 @@ test menu-32.8 {Ensure all menu clone commands are deleted} -setup { info commands .#menubar*test* } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} -setup { set res {} - deleteWindows + deleteWindows } -body { menu .menubar . configure -menu .menubar @@ -3873,12 +3873,12 @@ test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} -setup { lappend res [.#menubar.#menubar#test entrycget 1 -menu] return $res } -cleanup { - deleteWindows + deleteWindows } -result {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade} test menu-33.1 {menu vs command hiding} -setup { - deleteWindows + deleteWindows } -body { set l [interp hidden] menu .m @@ -3896,7 +3896,7 @@ test menu-33.1 {menu vs command hiding} -setup { test menu-34.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} -constraints { altDisplay } -setup { - deleteWindows + deleteWindows } -body { toplevel .one menu .one.m @@ -3916,7 +3916,7 @@ test menu-35.1 {menu -underline string overruns Bug 1599877} -setup { update tk::TraverseToMenu . "e" } -cleanup { - deleteWindows + deleteWindows } -result {} test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup { @@ -3931,7 +3931,7 @@ test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup { } -result {1 {a menubar menu cannot be posted}} test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over it - bug fa32290898} -setup { -} -constraints {userInteraction} -body { +} -constraints {x11} -body { toplevel .top ttk::menubutton .top.mb -text "Some menu"; menu .top.mb.m; @@ -3941,14 +3941,13 @@ test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over pack .top.mb update # simulate mouse click on the menubutton, which posts its menu - event generate .top.mb <ButtonPress-1> -warp 1 - update - after 50 + event generate .top.mb <Button-1> -warp 1 + controlPointerWarpTiming event generate .top.mb <ButtonRelease-1> update # simulate mouse click on the menu again, i.e. without # entering/leaving the posted menu - event generate .top.mb <ButtonPress-1> + event generate .top.mb <Button-1> update after 50 event generate .top.mb <ButtonRelease-1> @@ -3957,7 +3956,7 @@ test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over winfo ismapped .top.mb.m } -cleanup { destroy .top.mb.m .top.m .top -} -result {0} +} -result 0 # cleanup diff --git a/tests/menuDraw.test b/tests/menuDraw.test index 9382974..bf15f25 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -561,7 +561,7 @@ test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} -setup { $tearoff index active } -cleanup { deleteWindows -} -result {none} +} -result none test menuDraw-15.3 {TkPostTearoffMenu - post command} -setup { deleteWindows } -body { diff --git a/tests/menubut.test b/tests/menubut.test index d245fd0..b8a52a9 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -71,7 +71,7 @@ test menubutton-1.9 {configuration options} -body { .mb cget -bd } -cleanup { .mb configure -bd [lindex [.mb configure -bd] 3] -} -result {4} +} -result 4 test menubutton-1.10 {configuration options} -body { .mb configure -bd badValue } -returnCodes error -result {bad screen distance "badValue"} @@ -98,7 +98,7 @@ test menubutton-1.15 {configuration options} -body { .mb cget -borderwidth } -cleanup { .mb configure -borderwidth [lindex [.mb configure -borderwidth] 3] -} -result {1} +} -result 1 test menubutton-1.16 {configuration options} -body { .mb configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} @@ -158,7 +158,7 @@ test menubutton-1.28 {configuration options} -body { .mb cget -height } -cleanup { .mb configure -height [lindex [.mb configure -height] 3] -} -result {18} +} -result 18 test menubutton-1.29 {configuration options} -body { .mb configure -height 20.0 } -returnCodes error -result {expected integer but got "20.0"} @@ -185,7 +185,7 @@ test menubutton-1.34 {configuration options} -body { .mb cget -highlightthickness } -cleanup { .mb configure -highlightthickness [lindex [.mb configure -highlightthickness] 3] -} -result {18} +} -result 18 test menubutton-1.35 {configuration options} -body { .mb configure -highlightthickness badValue } -returnCodes error -result {bad screen distance "badValue"} @@ -213,7 +213,7 @@ test menubutton-1.38 {configuration options} -body { .mb cget -indicatoron } -cleanup { .mb configure -indicatoron [lindex [.mb configure -indicatoron] 3] -} -result {1} +} -result 1 test menubutton-1.39 {configuration options} -body { .mb configure -indicatoron no_way } -returnCodes error -result {expected boolean value but got "no_way"} @@ -237,7 +237,7 @@ test menubutton-1.43 {configuration options} -body { .mb cget -padx } -cleanup { .mb configure -padx [lindex [.mb configure -padx] 3] -} -result {12} +} -result 12 test menubutton-1.44 {configuration options} -body { .mb configure -padx 420x } -returnCodes error -result {bad screen distance "420x"} @@ -246,7 +246,7 @@ test menubutton-1.45 {configuration options} -body { .mb cget -pady } -cleanup { .mb configure -pady [lindex [.mb configure -pady] 3] -} -result {12} +} -result 12 test menubutton-1.46 {configuration options} -body { .mb configure -pady 420x } -returnCodes error -result {bad screen distance "420x"} @@ -291,7 +291,7 @@ test menubutton-1.54 {configuration options} -body { .mb cget -underline } -cleanup { .mb configure -underline [lindex [.mb configure -underline] 3] -} -result {5} +} -result 5 test menubutton-1.55 {configuration options} -body { .mb configure -underline 3p } -returnCodes error -result {expected integer but got "3p"} @@ -300,7 +300,7 @@ test menubutton-1.56 {configuration options} -body { .mb cget -width } -cleanup { .mb configure -width [lindex [.mb configure -width] 3] -} -result {402} +} -result 402 test menubutton-1.57 {configuration options} -body { .mb configure -width 3p } -returnCodes error -result {expected integer but got "3p"} @@ -309,7 +309,7 @@ test menubutton-1.58 {configuration options} -body { .mb cget -wraplength } -cleanup { .mb configure -wraplength [lindex [.mb configure -wraplength] 3] -} -result {100} +} -result 100 test menubutton-1.59 {configuration options} -body { .mb configure -wraplength 6x } -returnCodes error -result {bad screen distance "6x"} @@ -364,10 +364,10 @@ test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} -body { test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} -body { .mb configure -highlightthickness 3 .mb cget -highlightthickness -} -result {3} +} -result 3 test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} -body { llength [.mb configure] -} -result {33} +} -result 33 test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} -body { .mb configure -gorp } -returnCodes error -result {unknown option "-gorp"} diff --git a/tests/scale.test b/tests/scale.test index 34f2cd9..6e62710 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1473,17 +1473,18 @@ test scale-20.3 {Bug [2262543fff] - Scale widget unexpectedly fires command call test scale-20.4 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 4} -setup { catch {destroy .s} set res {} - set commandedVar -1 } -body { scale .s -from 1 -to 50 -command {set commandedVar} - .s set 10 pack .s + update idletasks + .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] + set commandedVar -1 vwait commandedVar ; # -command callback shall fire set res [list [.s get] $commandedVar] } -cleanup { - destroy .s after cancel $timeout + destroy .s } -result {10 10} test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 5} -setup { catch {destroy .s} @@ -1492,6 +1493,7 @@ test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 pack .s + update idletasks .s set 10 .s configure -command {set commandedVar} update ; # -command callback shall NOT fire @@ -1506,6 +1508,7 @@ test scale-20.6 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 pack .s + update idletasks .s configure -command {set commandedVar} .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] @@ -1522,6 +1525,7 @@ test scale-20.7 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 -command {set commandedVar} pack .s + update idletasks .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] vwait commandedVar ; # -command callback shall fire @@ -1538,6 +1542,7 @@ test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command call } -body { scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar} pack .s + update idletasks .s set 10 set timeout [after 500 {set $commandedVar "timeout"}] vwait commandedVar ; # -command callback shall fire diff --git a/tests/send.test b/tests/send.test index c75f428..ccf3eab 100644 --- a/tests/send.test +++ b/tests/send.test @@ -16,6 +16,7 @@ tcltest::loadTestedCommands testConstraint xhost [llength [auto_execok xhost]] testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] # Compute a script that will load Tk into a child interpreter. @@ -297,7 +298,7 @@ test send-8.15 {Tk_SendCmd procedure, local interp, error info} {secureserver te "if 1 {open bogus_file_name}" invoked from within "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}} -test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend failsOnUbuntu} { +test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend failsOnUbuntu failsOnXQuarz} { testsend prop root InterpRegistry "10234 bogus\n" set result [list [catch {send bogus bogus command} msg] $msg] winfo interps diff --git a/tests/text.test b/tests/text.test index 6bd0ae4..9ee0eff 100644 --- a/tests/text.test +++ b/tests/text.test @@ -7419,10 +7419,10 @@ test text-32.3 {peer widget -start, -end and deletion (bug 1630262)} -setup { .pt delete 2.0 3.0 # moreover -startline shall be correct # (was wrong before fixing bug 1630262) - lappend res [.t cget -start] [.pt cget -start] + lappend res [.t cget -start] [.pt cget -start] [.t get @0,0 "@0,0 lineend"] } -cleanup { destroy .pt -} -result {4 3} +} -result {4 3 {Line 5}} test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { destroy .t .pt diff --git a/tests/textDisp.test b/tests/textDisp.test index 3022a54..5dfed82 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -598,7 +598,7 @@ test textDisp-4.4 {UpdateDisplayInfo, wrap-mode "none"} {textfonts} { list [.t bbox 2.0] [.t bbox 2.25] [.t bbox 3.0] $tk_textRelayout } [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] {1.0 2.0 3.0}] test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} { - if {$tcl_platform(platform) == "windows"} { + if {[tk windowingsystem] == "win32"} { wm overrideredirect . 1 } wm geom . 103x$height @@ -609,7 +609,7 @@ test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} { updateText list [.t bbox 2.0] [.t bbox 2.1] [.t bbox 3.0] $tk_textRelayout } [list [list 5 [expr {$fixedDiff + 18}] 1 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 1 $fixedHeight] {1.0 2.0 3.0}] -if {$tcl_platform(platform) == "windows"} { +if {[tk windowingsystem] == "win32"} { wm overrideredirect . 0 } test textDisp-4.6 {UpdateDisplayInfo, tiny window} { @@ -620,7 +620,7 @@ test textDisp-4.6 {UpdateDisplayInfo, tiny window} { # the overrideredirect on "." confuses the window manager and # causes subsequent tests to fail. - if {$tcl_platform(platform) == "windows"} { + if {[tk windowingsystem] == "win32"} { wm overrideredirect . 1 } frame .f2 -width 20 -height 100 @@ -652,7 +652,7 @@ test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} { # the overrideredirect on "." confuses the window manager and # causes subsequent tests to fail. - if {$tcl_platform(platform) == "windows"} { + if {[tk windowingsystem] == "win32"} { wm overrideredirect . 1 } .t delete 1.0 end @@ -1341,11 +1341,11 @@ test textDisp-9.10 {TkTextRedrawTag} { .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 1.0 2.0 updateText - set tk_textRedraw {none} + set tk_textRedraw none .t tag add big 1.3 1.5 updateText set tk_textRedraw -} {none} +} none test textDisp-9.11 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end @@ -1660,6 +1660,21 @@ test textDisp-11.21 {TkTextSetYView, window height smaller than the line height} .top.t see 1.0 .top.t index @0,[expr {$lineheight - 2}] } {1.0} +test textDisp-11.22 {TkTextSetYView, peer has -startline} { + .top.t delete 1.0 end + for {set i 1} {$i <= 50} {incr i} { + .top.t insert end "Line $i\n" + } + pack [.top.t peer create .top.p] -side left + pack [scrollbar .top.sb -command {.top.p yview}] -side left -fill y + .top.p configure -startline 5 -endline 35 -yscrollcommand {.top.sb set} + updateText + .top.p yview moveto 0 + updateText + set res [.top.p get @0,0 "@0,0 lineend"] + destroy .top.p + set res +} {Line 5} .t configure -wrap word .t delete 50.0 51.0 @@ -2352,45 +2367,61 @@ test textDisp-17.5 {TkTextScanCmd procedure} { test textDisp-17.6 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 + updateText .t scan mark 40 60 .t scan dragto 35 55 + updateText .t index @0,0 } {4.7} test textDisp-17.7 {TkTextScanCmd procedure} {textfonts} { .t yview 10.0 .t xview moveto 0 + updateText .t xview scroll 20 units + updateText .t scan mark -10 60 .t scan dragto -5 65 + updateText .t index @0,0 set x [.t index @0,0] .t scan dragto 0 [expr {70 + $fixedDiff}] + updateText list $x [.t index @0,0] } {6.12 2.5} test textDisp-17.8 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 + updateText .t scan mark 0 60 .t scan dragto 30 100 + updateText .t scan dragto 25 95 + updateText .t index @0,0 } {4.7} test textDisp-17.9 {TkTextScanCmd procedure} {textfonts} { .t yview end .t xview moveto 0 + updateText .t xview scroll 100 units + updateText .t scan mark 90 60 .t scan dragto 10 0 + updateText .t scan dragto 14 5 + updateText .t index @0,0 -} {18.44} +} {14.44} .t configure -wrap word test textDisp-17.10 {TkTextScanCmd procedure, word wrapping} {textfonts} { .t yview 10.0 + updateText .t scan mark -10 60 .t scan dragto -5 65 + updateText set x [.t index @0,0] .t scan dragto 0 [expr {70 + $fixedDiff}] + updateText list $x [.t index @0,0] } {9.0 8.0} .t configure -xscrollcommand scroll -yscrollcommand {} @@ -3318,7 +3349,7 @@ test textDisp-24.15 {TkTextCharLayoutProc, -wrap none} {textfonts} { list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 3 $fixedHeight]] test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} { - if {$tcl_platform(platform) == "windows"} { + if {[tk windowingsystem] == "win32"} { wm overrideredirect . 1 } .t configure -wrap char @@ -3328,7 +3359,7 @@ test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} { updateText list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2] } [list [list 3 3 1 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 1 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 1 $fixedHeight]] -if {$tcl_platform(platform) == "windows"} { +if {[tk windowingsystem] == "win32"} { wm overrideredirect . 0 } test textDisp-24.17 {TkTextCharLayoutProc, -wrap word} {textfonts} { @@ -3654,7 +3685,7 @@ test textDisp-27.6 {SizeOfTab procedure, center alignment} {textfonts} { .t tag add x 1.0 end list [.t bbox 1.6] [.t bbox 1.7] } [list [list 32 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 39 [expr {$fixedDiff + 18}] 7 $fixedHeight]] -test textDisp-27.7 {SizeOfTab procedure, center alignment, wrap -none (potential numerical problems)} {textfonts} { +test textDisp-27.7 {SizeOfTab procedure, center alignment, wrap -none (potential numerical problems)} {textfonts failsOnXQuarz} { .t delete 1.0 end set cm [winfo fpixels .t 1c] .t configure -tabs {1c 2c center 3c 4c 5c 6c 7c 8c} -wrap none -width 40 diff --git a/tests/textIndex.test b/tests/textIndex.test index bd4e955..44b4184 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -834,6 +834,18 @@ test textIndex-19.13 {Display lines} { destroy .txt .sbar } {} +test textIndex-19.14 {Display lines with elided lines} { + catch {destroy .t} + pack [text .t] + for {set n 1} {$n <= 1000} {incr n} { + .t insert end "Line $n\n" + } + .t tag configure Elided -elide 1 + .t tag add Elided 6.0 951.0 + update + set res [.t index "951.0 + 1 displaylines"] +} {952.0} + proc text_test_word {startend chars start} { destroy .t text .t @@ -964,6 +976,43 @@ test textIndex-25.1 {IndexCountBytesOrdered, bug [3f1f79abcf]} { destroy .t2 } {} +test textIndex-26.1 {GetIndex restricts the returned index to -starline/-endline in peers, bug [34db75c0ac]} { + set res {} + pack [text .t2] + .t2 insert end "line 1\nline 2\nline 3\nline 4\nline 5\nline 6\n" + pack [.t2 peer create .p2 -startline 2 -endline 3] + lappend res [.p2 index "end"] + lappend res [.p2 index "end lineend"] + lappend res [.p2 index "end display lineend"] + destroy .t2 .p2 + set res +} {2.0 2.0 2.0} +test textIndex-26.2 {GetIndex errors out if mark, image, window, or tag is outside peer -starline/-endline, bug [34db75c0ac]} { + set res {} + pack [text .t2] + .t2 insert end "line 1\nline 2\nline 3\nline 4\nline 5\nline 6\n" + pack [.t2 peer create .p2 -startline 2 -endline 3] + .p2 configure -startline 3 -endline {} + .t2 mark set mymark 1.0 + catch {.p2 index mymark} msg + lappend res [.t2 index mymark] $msg + image create photo redsquare -width 5 -height 5 + redsquare put red -to 0 0 4 4 + .t2 image create 1.0 -image redsquare + catch {.p2 index redsquare} msg + lappend res [.t2 index redsquare] $msg + frame .f -width 10 -height 10 -bg blue + .t2 window create 1.2 -window .f + catch {.p2 index .f} msg + lappend res [.t2 index .f] $msg + .t2 tag add mytag 1.3 + catch {.p2 index mytag.first} msg + lappend res [.t2 index mytag.first] $msg + destroy .t2 .p2 + set res +} {1.0 {bad text index "mymark"} 1.0 {bad text index "redsquare"} 1.2\ + {bad text index ".f"} 1.3 {text doesn't contain any characters tagged with "mytag"}} + # cleanup rename textimage {} catch {destroy .t} diff --git a/tests/textMark.test b/tests/textMark.test index 043ff82..4d2e623 100644 --- a/tests/textMark.test +++ b/tests/textMark.test @@ -182,6 +182,17 @@ test textMark-6.5 {insert and current marks in an empty peer - bug 3487407} -bod } -cleanup { .t configure -startline {} -endline {} } -result {1.0} +test textMark-6.6 {attempt to move the insert mark beyond peer -endline - bug 34db75c0ac} -body { + .t peer create .p -startline 1 -endline 2 + pack .p + update + .p mark set insert 1.2 + focus -force .p + event generate .p <<NextLine>> ; # shall not error out + set res [.p index insert] +} -cleanup { + destroy .p +} -result {1.9} test textMark-7.1 {MarkFindNext - invalid mark name} -body { .t mark next bogus diff --git a/tests/textTag.test b/tests/textTag.test index 825f3b0..9e5ccdc 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -1492,7 +1492,8 @@ set y3 [expr {[lindex $c 1] + [lindex $c 3]/2}] test textTag-15.1 {TkTextBindProc} -constraints haveCourier12 -setup { .t tag delete x y wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { bind .t <ButtonRelease> {lappend x up} .t tag bind x <ButtonRelease> {lappend x x-up} @@ -1518,7 +1519,8 @@ test textTag-15.1 {TkTextBindProc} -constraints haveCourier12 -setup { test textTag-15.2 {TkTextBindProc} -constraints haveCourier12 -setup { .t tag delete x y wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag bind x <Enter> {lappend x x-enter} .t tag bind x <ButtonPress> {lappend x x-down} @@ -1547,7 +1549,8 @@ test textTag-15.2 {TkTextBindProc} -constraints haveCourier12 -setup { test textTag-15.3 {TkTextBindProc} -constraints haveCourier12 -setup { .t tag delete x y wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag bind x <Enter> {lappend x x-enter} .t tag bind x <Any-ButtonPress-1> {lappend x x-down} @@ -1583,7 +1586,8 @@ test textTag-16.1 {TkTextPickCurrent procedure} -constraints { } -setup { .t tag delete {*}[.t tag names] wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1 set x [.t index current] @@ -1606,9 +1610,12 @@ test textTag-16.2 {TkTextPickCurrent procedure} -constraints { } -setup { .t tag delete {*}[.t tag names] wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag configure big -font $bigFont + # update needed here to stabilize the test + update event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1 event gen .t <Motion> -x $x2 -y $y2 set x [.t index current] @@ -1626,7 +1633,8 @@ test textTag-16.3 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { foreach i {a b c d} { .t tag bind $i <Enter> "lappend x enter-$i" @@ -1656,7 +1664,8 @@ test textTag-16.4 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { foreach i {a b c d} { .t tag bind $i <Enter> "lappend x enter-$i" @@ -1685,7 +1694,8 @@ test textTag-16.5 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag configure big -font $bigFont event gen .t <Motion> -x $x1 -y $y1 @@ -1704,7 +1714,8 @@ test textTag-16.6 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag configure big -font $bigFont event gen .t <Motion> -x $x1 -y $y1 @@ -1724,7 +1735,8 @@ test textTag-16.7 {TkTextPickCurrent procedure} -constraints { .t tag remove $i 1.0 end } wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { .t tag configure big -font $bigFont .t tag bind a <Enter> {.t tag add big 3.0 3.2} @@ -1755,7 +1767,8 @@ test textTag-17.1 {insert procedure inserts tags} -setup { test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { destroy .t wm geometry . +200+200 ; update - event generate {} <Motion> -warp 1 -x 5 -y 5 ; update idletasks ; after 50 + event generate {} <Motion> -warp 1 -x 5 -y 5 + controlPointerWarpTiming } -body { text .t -width 30 -height 4 -relief sunken -borderwidth 10 \ -highlightthickness 10 -pady 2 @@ -1772,6 +1785,10 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { set res {} # Bindings must not trigger on the widget border, only over # the actual tagged characters themselves. + # Note that we don't need to call controlPointerWarpTiming + # in the following six calls because we're not checking that + # the mouse pointer has actually moved but rather that the + # tag binding mechanism of the text widget correctly triggers. event gen .t <Motion> -warp 1 -x 0 -y 0 ; update event gen .t <Motion> -warp 1 -x 10 -y 10 ; update event gen .t <Motion> -warp 1 -x 25 -y 25 ; update diff --git a/tests/textWind.test b/tests/textWind.test index a11a418..5b99126 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -1406,7 +1406,7 @@ test textWind-17.1 {peer widgets and embedded windows} -setup { .t window create 1.3 -window .f toplevel .tt pack [.t peer create .tt.t] - update ; update + update destroy .t .tt winfo exists .f } -result {0} @@ -1420,7 +1420,7 @@ test textWind-17.2 {peer widgets and embedded windows} -setup { .t window create 1.4 -window .f toplevel .tt pack [.t peer create .tt.t] - update ; update + update destroy .t .tt.t insert 1.0 "foo" update @@ -1435,7 +1435,7 @@ test textWind-17.3 {peer widget and -create} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - update ; update + update .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} update destroy .t .tt @@ -1451,7 +1451,7 @@ test textWind-17.4 {peer widget deleted one window shouldn't delete others} -set toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} - update ; update + update destroy .tt lappend res [.t get 1.2] update @@ -1469,7 +1469,7 @@ test textWind-17.5 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} - update ; update + update list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] } -cleanup { destroy .tt .t @@ -1484,7 +1484,7 @@ test textWind-17.6 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} - update ; update + update list [.t window configure 1.2 -window] \ [.tt.t window configure 1.2 -window] } -cleanup { @@ -1500,7 +1500,7 @@ test textWind-17.7 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - update ; update + update list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] } -cleanup { destroy .tt .t @@ -1515,7 +1515,7 @@ test textWind-17.8 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - update ; update + update list [.t window configure 1.2 -window] \ [.tt.t window configure 1.2 -window] } -cleanup { @@ -1531,7 +1531,7 @@ test textWind-17.9 {peer widget window configuration} -setup { toplevel .tt pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - update ; update + update .tt.t window configure 1.2 -window [frame .tt.t.f -width 10 -height 20 -bg red] list [.t window configure 1.2 -window] [.tt.t window configure 1.2 -window] } -cleanup { @@ -1541,26 +1541,34 @@ test textWind-17.9 {peer widget window configuration} -setup { test textWind-17.10 {peer widget window configuration} -setup { destroy .t .tt } -body { + set res {} pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] + update idletasks .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] + update idletasks + # There should be a window in the main widget but not in the peer. + lappend res [.t window configure 1.2 -window] + lappend res [.tt.t window configure 1.2 -window] .tt.t window create 1.2 -window [frame .tt.t.f -width 25 -height 20 -bg blue] - update ; update - .t window configure 1.2 -create \ - {destroy %W.f ; frame %W.f -width 50 -height 7 -bg red} - .tt.t window configure 1.2 -window {} + update idletasks + .t window configure 1.2 -create {destroy %W.f ; frame %W.f -width 50 -height 7 -bg red} + update idletasks + # The main widget should not have changed. + lappend res [.t window configure 1.2 -window] .t window configure 1.2 -window {} - set res [list [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window]] + .tt.t window configure 1.2 -window {} update - lappend res [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window] + # Nothing should have changed. + lappend res [.t window configure 1.2 -window] + lappend res [.tt.t window configure 1.2 -window] } -cleanup { destroy .tt .t -} -result {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} +} -result {{-window {} {} {} .t.f} {-window {} {} {} {}} {-window {} {} {} .t.f}\ +{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} test textWind-18.1 {embedded window deletion triggered by a script bound to <Map>} -setup { catch {destroy .t .f .f2} diff --git a/tests/tk.test b/tests/tk.test index 30a36d9..d2e9044 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -157,7 +157,7 @@ test tk-6.5 {tk inactive} -body { update after 100 set i [tk inactive] - expr {$i < 0 || ( $i > 90 && $i < 200 )} + expr {$i < 0 || ( $i > 90 && $i < 300 )} } -result 1 test tk-7.1 {tk inactive in a safe interpreter} -body { diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test index 293bfe1..384f297 100644 --- a/tests/ttk/entry.test +++ b/tests/ttk/entry.test @@ -8,6 +8,7 @@ namespace import -force tcltest::* loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] variable scrollInfo proc scroll args { @@ -77,7 +78,7 @@ test entry-2.1 "Create entry before scrollbar" -body { -expand false -fill x } -cleanup {destroy .te .tsb} -test entry-2.1.1 "Create entry before scrollbar - scrollbar catches up" -constraints failsOnUbuntu -body { +test entry-2.1.1 "Create entry before scrollbar - scrollbar catches up" -constraints {failsOnUbuntu failsOnXQuarz} -body { pack [ttk::entry .te -xscrollcommand [list .tsb set]] \ -expand true -fill both .te insert end [string repeat "abc" 50] diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test index cd3b2ce..9c82cd7 100644 --- a/tests/ttk/spinbox.test +++ b/tests/ttk/spinbox.test @@ -127,7 +127,7 @@ test spinbox-1.8.2 "option -validate" -setup { .sb cget -validate } -cleanup { destroy .sb -} -result {none} +} -result none test spinbox-1.8.3 "option -validate" -setup { ttk::spinbox .sb -from 0 -to 100 @@ -138,14 +138,18 @@ test spinbox-1.8.3 "option -validate" -setup { } -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none} test spinbox-1.8.4 "-validate option: " -setup { - set ::spinbox_test {} ttk::spinbox .sb -from 0 -to 100 + set ::spinbox_test {} } -body { - .sb configure -validate all -validatecommand {lappend ::spinbox_test %P} + .sb configure -validate all -validatecommand {set ::spinbox_test %P} pack .sb + update idletasks .sb set 50 focus -force .sb - after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait + set ::spinbox_wait 0 + set timer [after 100 {set ::spinbox_wait 1}] + vwait ::spinbox_wait + after cancel $timer set ::spinbox_test } -cleanup { destroy .sb diff --git a/tests/ttk/validate.test b/tests/ttk/validate.test index 5430903..61e7c2c 100644 --- a/tests/ttk/validate.test +++ b/tests/ttk/validate.test @@ -78,54 +78,63 @@ test validate-1.7 {entry widget validation - vmode focus} -body { } -result {} test validate-1.8 {entry widget validation - vmode focus} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force .e - # update necessary to process FocusIn event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} focus focusin} test validate-1.9 {entry widget validation - vmode focus} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force . - # update necessary to process FocusOut event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} focus focusout} .e configure -validate all test validate-1.10 {entry widget validation - vmode all} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force .e - # update necessary to process FocusIn event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} all focusin} test validate-1.11 {entry widget validation} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force . - # update necessary to process FocusOut event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} all focusout} .e configure -validate focusin test validate-1.12 {entry widget validation} -body { + set ::vVals {} + set timer [after 300 lappend ::vVals timeout] focus -force .e - # update necessary to process FocusIn event - update + vwait ::vVals + after cancel $timer set ::vVals } -result {.e -1 -1 abcd abcd {} focusin focusin} test validate-1.13 {entry widget validation} -body { set ::vVals {} focus -force . - # update necessary to process FocusOut event update set ::vVals } -result {} .e configure -validate focuso test validate-1.14 {entry widget validation} -body { + set ::vVals {} focus -force .e - # update necessary to process FocusIn event update set ::vVals } -result {} diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test index bb7edc5..d5f6ee3 100644 --- a/tests/unixEmbed.test +++ b/tests/unixEmbed.test @@ -1301,6 +1301,7 @@ test unixEmbed-11.2 {mouse coordinates in embedded toplevels} -constraints { wm geometry .main 200x400+100+100 update idletasks focus -force .main + after 100 set x [expr {[winfo x .main ] + [winfo x .main.b] + 40}] set y [expr {[winfo y .main ] + [winfo y .main.b] + 38}] lappend result [winfo containing $x $y] diff --git a/tests/unixWm.test b/tests/unixWm.test index 209165f..4f94cc1 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -33,24 +33,27 @@ proc makeToplevels {} { } } -# On macOS windows are not allowed to overlap the menubar at the top -# of the screen. So tests which move a window and then check whether -# it got moved to the requested location should use a y coordinate -# larger than the height of the menubar (normally 23 pixels). +# On macOS windows are not allowed to overlap the menubar at the top of the +# screen or the dock. So tests which move a window and then check whether it +# got moved to the requested location should use a y coordinate larger than the +# height of the menubar (normally 23 pixels) and an x coordinate larger than the +# width of the dock, if it happens to be on the left. if {[tk windowingsystem] eq "aqua"} { set mb [expr [menubarheight] + 1] + set X 100 set Y0 $mb set Y2 [expr $mb + 2] set Y5 [expr $mb + 5] } else { + set X 20 set Y0 0 set Y2 2 set Y5 5 } set i 1 -foreach geom "+$Y0+80 +80+$Y0 +0+$Y0" { +foreach geom "+$X+80 +80+$Y0 +$X+$Y0" { destroy .t test unixWm-1.$i {initial window position} unix { toplevel .t -width 200 -height 150 @@ -104,7 +107,7 @@ foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { } set i 1 -foreach geom "+20+80 +100+40 +0+$Y0" { +foreach geom "+$X+80 +$X+40 +$X+$Y0" { test unixWm-4.$i {moving window while withdrawn} unix { wm withdraw .t update idletasks @@ -188,27 +191,27 @@ test unixWm-5.7 {compounded state changes} {unix nonPortable} { destroy .t toplevel .t -width 200 -height 100 -wm geom .t +10+$Y0 +wm geom .t +100+$Y0 wm minsize .t 1 1 update test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update wm geom .t -} 180x150+10+$Y0 +} 180x150+100+$Y0 test unixWm-6.2 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 update wm geom .t -} 250x60+10+$Y0 +} 250x60+100+$Y0 test unixWm-6.3 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 wm geom .t {} update wm geom .t -} 170x140+10+$Y0 +} 170x140+100+$Y0 test unixWm-6.4 {size changes} {unix nonPortable userInteraction} { wm minsize .t 1 1 update @@ -290,7 +293,7 @@ test unixWm-8.3 {icon windows} unix { toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t b c} msg] $msg } {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} -test unixWm-8.4 {icon windows} {unix failsOnUbuntu} { +test unixWm-8.4 {icon windows} {unix failsOnUbuntu failsOnXQuarz} { destroy .t destroy .icon toplevel .t -width 100 -height 30 @@ -635,7 +638,7 @@ test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix { destroy .icon set result } {1 {can't deiconify .icon: it is an icon for .t}} -test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {unix failsOnUbuntu} { +test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {unix failsOnUbuntu failsOnXQuarz} { wm iconify .t set result {} lappend result [winfo ismapped .t] [wm state .t] @@ -854,7 +857,7 @@ test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} unix { destroy .t2 set result } {1 {can't iconify .t2: it is an icon for .t}} -test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu} { +test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu failsOnXQuarz} { destroy .t2 toplevel .t2 wm geom .t2 +0+0 @@ -865,7 +868,7 @@ test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu} { destroy .t2 set result } {0} -test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu} { +test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu failsOnXQuarz} { destroy .t2 toplevel .t2 wm geom .t2 -0+0 @@ -1364,14 +1367,14 @@ test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on gr test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix { destroy .t toplevel .t - wm geometry .t 200x100+0+$Y0 + wm geometry .t 200x100+100+$Y0 listbox .t.l -height 20 -width 20 pack .t.l -fill both -expand 1 update .t.l configure -setgrid 1 update wm geometry .t -} "20x20+0+$Y0" +} "20x20+100+$Y0" test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} unix { destroy .t @@ -1436,7 +1439,7 @@ test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} unix { # No tests for ReparentEvent or ComputeReparentGeometry; I can't figure # out how to exercise these procedures reliably. -test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {unix failsOnUbuntu} { +test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {unix failsOnUbuntu failsOnXQuarz} { destroy .t toplevel .t -width 400 -height 150 wm geometry .t +0+0 @@ -1960,7 +1963,7 @@ test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} unix { [winfo containing [expr $x + 350] $y] \ [winfo containing [expr $x + 450] $y] } {.t .t.f .t.f.f .t {}} -test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {unix failsOnUbuntu} { +test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {unix failsOnUbuntu failsOnXQuarz} { destroy .t destroy .t2 toplevel .t -width 200 -height 200 -bg green diff --git a/tests/winWm.test b/tests/winWm.test index 792a0e4..030d11a 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -14,6 +14,7 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] test winWm-1.1 {TkWmMapWindow} -constraints win -setup { destroy .t @@ -278,12 +279,11 @@ test winWm-6.2 {wm attributes} -constraints win -setup { test winWm-6.3 {wm attributes} -constraints win -setup { destroy .t } -body { - # This isn't quite the correct error message yet, but it works. toplevel .t wm attributes .t -foo } -cleanup { destroy .t -} -returnCodes error -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} +} -returnCodes error -result {bad attribute "-foo": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} test winWm-6.4 {wm attributes -alpha} -constraints win -setup { destroy .t @@ -532,7 +532,7 @@ test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win destroy .tx .t .sd } -result ok -test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -constraints failsOnUbuntu -setup { +test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -constraints {failsOnUbuntu failsOnXQuarz} -setup { destroy .t toplevel .t set winwm92 {} diff --git a/tests/window.test b/tests/window.test index fea695a..c3b507d 100644 --- a/tests/window.test +++ b/tests/window.test @@ -263,6 +263,38 @@ test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} -constra list $error $msg } -result {0 YES} +test window-2.12 {Test for ticket [9b6065d1fd] - restore Tcl [update] command} -constraints { + unixOrWin +} -body { + set code [loadTkCommand] + append code { + after 1000 {set forever 1} + after 100 {destroy .} + after 200 {catch bell msg; puts "ringing the bell -> $msg"} + after 250 {update idletasks} + after 300 {update} + puts "waiting" + vwait forever + puts "done waiting" + catch {bell} msg + puts "bell -> $msg" + catch update msg + puts "update -> $msg" + } + set script [makeFile $code script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} -result {0 {waiting +ringing the bell -> can't invoke "bell" command: application has been destroyed +done waiting +bell -> can't invoke "bell" command: application has been destroyed +update -> }} + test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { unix testmenubar @@ -342,6 +374,7 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -con } -result {} + # cleanup cleanupTests return diff --git a/tests/winfo.test b/tests/winfo.test index 591eb29..750444f 100644 --- a/tests/winfo.test +++ b/tests/winfo.test @@ -294,7 +294,7 @@ test winfo-9.2 {"winfo viewable" command} -body { test winfo-9.3 {"winfo viewable" command} -body { winfo viewable . } -result {1} -test winfo-9.4 {"winfo viewable" command} -constraints failsOnUbuntu -body { +test winfo-9.4 {"winfo viewable" command} -constraints {failsOnUbuntu failsOnXQuarz} -body { wm iconify . winfo viewable . } -cleanup { diff --git a/tests/wm.test b/tests/wm.test index a9e0f10..52a2422 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -128,18 +128,14 @@ test wm-attributes-1.1 {usage} -returnCodes error -body { wm attributes } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-attributes-1.2.1 {usage} -constraints win -returnCodes error -body { - # This is the wrong error to output - unix has it right, but it's - # not critical. wm attributes . _ -} -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} +} -result {bad attribute "_": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} test wm-attributes-1.2.2 {usage} -constraints win -returnCodes error -body { wm attributes . -alpha 1.0 -disabled } -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} test wm-attributes-1.2.3 {usage} -constraints win -returnCodes error -body { - # This is the wrong error to output - unix has it right, but it's - # not critical. wm attributes . -to -} -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} +} -result {bad attribute "-to": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost} test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error -body { wm attributes . _ } -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type} @@ -810,7 +806,7 @@ test wm-iconify-2.4.2 {Misc errors} -constraints !win -setup { destroy .t2 .r.f } -result {can't iconify .t2: it is an embedded window} -test wm-iconify-3.1 {iconify behavior} -constraints failsOnUbuntu -body { +test wm-iconify-3.1 {iconify behavior} -constraints {failsOnUbuntu failsOnXQuarz} -body { toplevel .t2 wm geom .t2 -0+0 update idletasks @@ -1418,7 +1414,7 @@ test wm-stackorder-2.7 {stacking order: no children returns self} -setup { deleteWindows -test wm-stackorder-3.1 {unmapped toplevel} -constraints failsOnUbuntu -body { +test wm-stackorder-3.1 {unmapped toplevel} -constraints {failsOnUbuntu failsOnXQuarz} -body { toplevel .t1 ; update toplevel .t2 ; update wm iconify .t1 @@ -1739,7 +1735,7 @@ test wm-transient-4.1 {transient toplevel is withdrawn deleteWindows } -result {withdrawn 0} test wm-transient-4.2 {already mapped transient toplevel - is withdrawn if toplevel is iconic} -constraints failsOnUbuntu -body { + is withdrawn if toplevel is iconic} -constraints {failsOnUbuntu failsOnXQuarz} -body { toplevel .top raiseDelay wm iconify .top @@ -1753,7 +1749,7 @@ test wm-transient-4.2 {already mapped transient toplevel deleteWindows } -result {withdrawn 0} test wm-transient-4.3 {iconify/deiconify on the toplevel - does a withdraw/deiconify on the transient} -constraints failsOnUbuntu -setup { + does a withdraw/deiconify on the transient} -constraints {failsOnUbuntu failsOnXQuarz} -setup { set results [list] } -body { toplevel .top @@ -2006,7 +2002,7 @@ test wm-state-2.7 {state change before map} -body { } -cleanup { deleteWindows } -result {iconic} -test wm-state-2.8 {state change after map} -constraints failsOnUbuntu -body { +test wm-state-2.8 {state change after map} -constraints {failsOnUbuntu failsOnXQuarz} -body { toplevel .t update wm state .t iconic @@ -2014,7 +2010,7 @@ test wm-state-2.8 {state change after map} -constraints failsOnUbuntu -body { } -cleanup { deleteWindows } -result {iconic} -test wm-state-2.9 {state change after map} -constraints failsOnUbuntu -body { +test wm-state-2.9 {state change after map} -constraints {failsOnUbuntu failsOnXQuarz} -body { toplevel .t update wm iconify .t diff --git a/unix/Makefile.in b/unix/Makefile.in index 3c48bfb..010ba48 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -285,7 +285,7 @@ CC_SEARCH_FLAGS = @CC_SEARCH_FLAGS@ LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@ # support for embedded libraries on Darwin / Mac OS X -DYLIB_INSTALL_DIR = ${LIB_RUNTIME_DIR} +DYLIB_INSTALL_DIR = $(libdir) # support for building the Aqua resource file TK_RSRC_FILE = @TK_RSRC_FILE@ diff --git a/unix/configure b/unix/configure index 45c215e..0df5407 100755 --- a/unix/configure +++ b/unix/configure @@ -308,7 +308,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_VERSION TCL_PATCH_LEVEL TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCLSH_PROG BUILD_TCLSH MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_NOLTO LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT XFT_CFLAGS XFT_LIBS UNIX_FONT_OBJS TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_YEAR TK_LIB_FILE TK_LIB_FLAG TK_LIB_SPEC TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_INCLUDE_SPEC TK_BUILD_STUB_LIB_SPEC TK_BUILD_STUB_LIB_PATH TK_SRC_DIR TK_SHARED_BUILD LD_LIBRARY_PATH_VAR TK_BUILD_LIB_SPEC TCL_STUB_FLAGS XINCLUDES XLIBSW LOCALES TK_WINDOWINGSYSTEM TK_PKG_DIR TK_LIBRARY LIB_RUNTIME_DIR PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_WISH_LIBS CFBUNDLELOCALIZATIONS TK_RSRC_FILE WISH_RSRC_FILE LIB_RSRC_FILE APP_RSRC_FILE REZ REZ_FLAGS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_VERSION TCL_PATCH_LEVEL TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCLSH_PROG BUILD_TCLSH MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS SHARED_BUILD RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_NOLTO LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT XFT_CFLAGS XFT_LIBS UNIX_FONT_OBJS TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_YEAR TK_LIB_FILE TK_LIB_FLAG TK_LIB_SPEC TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_INCLUDE_SPEC TK_BUILD_STUB_LIB_SPEC TK_BUILD_STUB_LIB_PATH TK_SRC_DIR TK_SHARED_BUILD LD_LIBRARY_PATH_VAR TK_BUILD_LIB_SPEC TCL_STUB_FLAGS XINCLUDES XLIBSW LOCALES TK_WINDOWINGSYSTEM TK_PKG_DIR TK_LIBRARY LIB_RUNTIME_DIR PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_WISH_LIBS CFBUNDLELOCALIZATIONS TK_RSRC_FILE WISH_RSRC_FILE LIB_RSRC_FILE APP_RSRC_FILE REZ REZ_FLAGS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -1338,7 +1338,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".11" +TK_PATCH_LEVEL=".12" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -4036,6 +4036,7 @@ _ACEOF fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called @@ -5201,7 +5202,7 @@ fi fi ;; - Linux*|GNU*|NetBSD-Debian) + Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -5215,6 +5216,20 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + + case $system in + DragonFly-*|FreeBSD-*) + if test "${TCL_THREADS}" = "1"; then + + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS" +fi + + ;; + esac + if test $doRpath = yes; then CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' @@ -5403,38 +5418,6 @@ fi fi ;; - DragonFly-*|FreeBSD-*) - # This configuration from FreeBSD Ports. - SHLIB_CFLAGS="-fPIC" - SHLIB_LD="${CC} -shared" - SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" - SHLIB_SUFFIX=".so" - DL_OBJS="tclLoadDl.o" - DL_LIBS="" - if test $doRpath = yes; then - - CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' - LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' -fi - - if test "${TCL_THREADS}" = "1"; then - - # The -pthread needs to go in the LDFLAGS, not LIBS - LIBS=`echo $LIBS | sed s/-pthread//` - CFLAGS="$CFLAGS $PTHREAD_CFLAGS" - LDFLAGS="$LDFLAGS $PTHREAD_LIBS" -fi - - case $system in - FreeBSD-3.*) - # Version numbers are dot-stripped by system policy. - TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' - TCL_LIB_VERSIONS_OK=nodots - ;; - esac - ;; Darwin-*) CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" @@ -6603,9 +6586,11 @@ fi AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*|MSYS_*) ;; - IRIX*) ;; - NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + HP-UX*) ;; Darwin-*) ;; + IRIX*) ;; + NetBSD-*|OpenBSD-*) ;; + OSF1-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac @@ -9385,7 +9370,7 @@ cat >>confdefs.h <<\_ACEOF #define MAC_OSX_TK 1 _ACEOF - LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit" + LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit -framework QuartzCore" EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c' TK_WINDOWINGSYSTEM=AQUA if test -n "${enable_symbols}" -a "${enable_symbols}" != no; then @@ -11871,6 +11856,7 @@ s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@EGREP@,$EGREP,;t t s,@TCL_THREADS@,$TCL_THREADS,;t t +s,@SHARED_BUILD@,$SHARED_BUILD,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t diff --git a/unix/configure.in b/unix/configure.in index 78dd688..ecfc1e5 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".11" +TK_PATCH_LEVEL=".12" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -354,7 +354,7 @@ fi if test $tk_aqua = yes; then AC_DEFINE(MAC_OSX_TK, 1, [Are we building TkAqua?]) - LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit" + LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit -framework QuartzCore" EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c' TK_WINDOWINGSYSTEM=AQUA if test -n "${enable_symbols}" -a "${enable_symbols}" != no; then diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 8139569..6305ef7 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -519,6 +519,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi + AC_SUBST(SHARED_BUILD) ]) #------------------------------------------------------------------------ @@ -1371,7 +1372,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ]) ]) ;; - Linux*|GNU*|NetBSD-Debian) + Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -1385,6 +1386,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + + case $system in + DragonFly-*|FreeBSD-*) + AS_IF([test "${TCL_THREADS}" = "1"], [ + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) + ;; + esac + AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} @@ -1393,7 +1405,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_m64=yes],[tcl_cv_cc_m64=no]) + AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], + [tcl_cv_cc_m64=yes],[tcl_cv_cc_m64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_m64 = yes], [ CFLAGS="$CFLAGS -m64" @@ -1490,32 +1503,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LDFLAGS="$LDFLAGS -pthread" ]) ;; - DragonFly-*|FreeBSD-*) - # This configuration from FreeBSD Ports. - SHLIB_CFLAGS="-fPIC" - SHLIB_LD="${CC} -shared" - SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]" - SHLIB_SUFFIX=".so" - DL_OBJS="tclLoadDl.o" - DL_LIBS="" - AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' - LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) - AS_IF([test "${TCL_THREADS}" = "1"], [ - # The -pthread needs to go in the LDFLAGS, not LIBS - LIBS=`echo $LIBS | sed s/-pthread//` - CFLAGS="$CFLAGS $PTHREAD_CFLAGS" - LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) - case $system in - FreeBSD-3.*) - # Version numbers are dot-stripped by system policy. - TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' - TCL_LIB_VERSIONS_OK=nodots - ;; - esac - ;; Darwin-*) CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" @@ -1536,8 +1523,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], - [tcl_cv_cc_arch_ppc64=yes], - [tcl_cv_cc_arch_ppc64=no]) + [tcl_cv_cc_arch_ppc64=yes],[tcl_cv_cc_arch_ppc64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [ CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" @@ -1549,8 +1535,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], - [tcl_cv_cc_arch_x86_64=yes], - [tcl_cv_cc_arch_x86_64=no]) + [tcl_cv_cc_arch_x86_64=yes],[tcl_cv_cc_arch_x86_64=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [ CFLAGS="$CFLAGS -arch x86_64" @@ -1984,9 +1969,11 @@ dnl # preprocessing tests use only CPPFLAGS. AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*|MSYS_*) ;; - IRIX*) ;; - NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + HP-UX*) ;; Darwin-*) ;; + IRIX*) ;; + NetBSD-*|OpenBSD-*) ;; + OSF1-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac]) @@ -2362,7 +2349,8 @@ AC_DEFUN([SC_TIME_HANDLER], [ # (like convex) have timezone functions, etc. # AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [ - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]], + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h> +#include <stdlib.h>]], [[extern long timezone; timezone += 1; exit (0);]])], @@ -2374,7 +2362,8 @@ AC_DEFUN([SC_TIME_HANDLER], [ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [ - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]], + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h> +#include <stdlib.h>]], [[extern time_t timezone; timezone += 1; exit (0);]])], diff --git a/unix/tk.spec b/unix/tk.spec index efa3b79..91b938d 100644 --- a/unix/tk.spec +++ b/unix/tk.spec @@ -4,7 +4,7 @@ Name: tk Summary: Tk graphical toolkit for the Tcl scripting language. -Version: 8.6.11 +Version: 8.6.12 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tkAppInit.c b/unix/tkAppInit.c index 6cf3d42..1a2421c 100644 --- a/unix/tkAppInit.c +++ b/unix/tkAppInit.c @@ -16,12 +16,16 @@ #undef STATIC_BUILD #include "tk.h" #include "tkPort.h" +#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 +# define Tcl_LibraryInitProc Tcl_PackageInitProc +# define Tcl_StaticLibrary Tcl_StaticPackage +#endif #ifdef TK_TEST #ifdef __cplusplus extern "C" { #endif -extern Tcl_PackageInitProc Tktest_Init; +extern Tcl_LibraryInitProc Tktest_Init; #ifdef __cplusplus } #endif @@ -120,12 +124,11 @@ Tcl_AppInit( if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); + Tcl_StaticLibrary(interp, "Tk", Tk_Init, Tk_SafeInit); #if defined(USE_CUSTOM_EXIT_PROC) if (TkpWantsExitProc()) { - /* The cast below avoids warnings from old gcc compilers. */ - Tcl_SetExitProc((void *)TkpExitProc); + Tcl_SetExitProc(TkpExitProc); } #endif @@ -133,7 +136,7 @@ Tcl_AppInit( if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 0); + Tcl_StaticLibrary(interp, "Tktest", Tktest_Init, 0); #endif /* TK_TEST */ /* diff --git a/unix/tkUnix.c b/unix/tkUnix.c index 2de6e98..ed024d1 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -199,8 +199,12 @@ TkpBuildRegionFromAlphaData( long Tk_GetUserInactiveTime( - Display *dpy) /* The display for which to query the inactive + #ifdef HAVE_XSS + Display *dpy) /* The display for which to query the inactive * time. */ +#else + TCL_UNUSED(Display *)) +#endif /* HAVE_XSS */ { long inactiveTime = -1; #ifdef HAVE_XSS diff --git a/unix/tkUnix3d.c b/unix/tkUnix3d.c index 7ea67a1..2f2475b 100644 --- a/unix/tkUnix3d.c +++ b/unix/tkUnix3d.c @@ -4,7 +4,7 @@ * This file contains the platform specific routines for drawing 3d * borders in the Motif style. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -13,7 +13,9 @@ #include "tkInt.h" #include "tk3d.h" -#if !(defined(_WIN32) || defined(MAC_OSX_TK)) +#if defined(MAC_OSX_TK) +#include "tkMacOSXInt.h" +#else #include "tkUnixInt.h" #endif @@ -46,7 +48,7 @@ typedef struct { TkBorder * TkpGetBorder(void) { - UnixBorder *borderPtr = ckalloc(sizeof(UnixBorder)); + UnixBorder *borderPtr = (UnixBorder *)ckalloc(sizeof(UnixBorder)); borderPtr->solidGC = NULL; return (TkBorder *) borderPtr; diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 3e9ef97..a3d50b6 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -54,6 +54,7 @@ #define DEF_BUTTON_DEFAULT "disabled" #define DEF_BUTTON_DISABLED_FG_COLOR DISABLED #define DEF_BUTTON_DISABLED_FG_MONO "" +#define DEF_LABEL_FG BLACK #define DEF_BUTTON_FG BLACK #define DEF_CHKRAD_FG DEF_BUTTON_FG #define DEF_BUTTON_FONT "TkDefaultFont" diff --git a/unix/tkUnixEmbed.c b/unix/tkUnixEmbed.c index a33a623..ff7860b 100644 --- a/unix/tkUnixEmbed.c +++ b/unix/tkUnixEmbed.c @@ -979,6 +979,7 @@ EmbedWindowDeleted( prevPtr = NULL; containerPtr = tsdPtr->firstContainerPtr; while (1) { + if (containerPtr == NULL) return; if (containerPtr->embeddedPtr == winPtr) { containerPtr->wrapper = None; containerPtr->embeddedPtr = NULL; diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c index 4d0b9be..e424bb7 100644 --- a/unix/tkUnixEvent.c +++ b/unix/tkUnixEvent.c @@ -15,7 +15,7 @@ #ifdef HAVE_XKBKEYCODETOKEYSYM # include <X11/XKBlib.h> #else -# define XkbOpenDisplay(D,V,E,M,m,R) ((V),(E),(M),(m),(R),(NULL)) +# define XkbOpenDisplay(D,V,E,M,m,R) (((void)D),((void)V),((void)E),((void)M),((void)m),((void)R),(NULL)) #endif /* diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index bd83a5e..665b260 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -2763,9 +2763,9 @@ GetScreenFont( FontAttributes *wantPtr, /* Contains desired actual pixel-size if the * best font was scalable. */ char **nameList, /* Array of XLFDs. */ - int bestIdx[2], /* Indices into above array for XLFD of best + int bestIdx[], /* Indices into above array for XLFD of best * bitmapped and best scalable font. */ - unsigned bestScore[2]) /* Scores of best bitmapped and best scalable + unsigned bestScore[]) /* Scores of best bitmapped and best scalable * font. XLFD corresponding to lowest score * will be constructed. */ { diff --git a/unix/tkUnixPort.h b/unix/tkUnixPort.h index 7c6177e..44926a4 100644 --- a/unix/tkUnixPort.h +++ b/unix/tkUnixPort.h @@ -58,6 +58,9 @@ #else # include "../compat/unistd.h" #endif +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif #include <X11/Xlib.h> #include <X11/cursorfont.h> #include <X11/keysym.h> @@ -188,7 +191,7 @@ #ifndef __CYGWIN__ #define TkpPrintWindowId(buf,w) \ - sprintf((buf), "%#08lx", (unsigned long) (w)) + sprintf((buf), "0x%08lx", (unsigned long) (w)) #endif /* diff --git a/unix/tkUnixRFont.c b/unix/tkUnixRFont.c index 226445c..8eb6f53 100644 --- a/unix/tkUnixRFont.c +++ b/unix/tkUnixRFont.c @@ -53,6 +53,10 @@ typedef struct { Region clipRegion; /* The clipping region, or None. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; + +TCL_DECLARE_MUTEX(xftMutex); +#define LOCK Tcl_MutexLock(&xftMutex) +#define UNLOCK Tcl_MutexUnlock(&xftMutex) /* * Package initialization: @@ -122,7 +126,9 @@ GetFont( if (angle != 0.0) { FcPatternAddMatrix(pat, FC_MATRIX, &mat); } + LOCK; ftFont = XftFontOpenPattern(fontPtr->display, pat); + UNLOCK; if (!ftFont) { /* * The previous call to XftFontOpenPattern() should not fail, but @@ -131,11 +137,13 @@ GetFont( * fallback: */ + LOCK; ftFont = XftFontOpen(fontPtr->display, fontPtr->screen, FC_FAMILY, FcTypeString, "sans", FC_SIZE, FcTypeDouble, 12.0, FC_MATRIX, FcTypeMatrix, &mat, NULL); + UNLOCK; } if (!ftFont) { /* @@ -150,7 +158,9 @@ GetFont( fontPtr->faces[i].ft0Font = ftFont; } else { if (fontPtr->faces[i].ftFont) { + LOCK; XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); + UNLOCK; } fontPtr->faces[i].ftFont = ftFont; fontPtr->faces[i].angle = angle; @@ -409,10 +419,14 @@ FinishedWithFont( for (i = 0; i < fontPtr->nfaces; i++) { if (fontPtr->faces[i].ftFont) { + LOCK; XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); + UNLOCK; } if (fontPtr->faces[i].ft0Font) { + LOCK; XftFontClose(fontPtr->display, fontPtr->faces[i].ft0Font); + UNLOCK; } if (fontPtr->faces[i].charset) { FcCharSetDestroy(fontPtr->faces[i].charset); @@ -751,7 +765,9 @@ Tk_MeasureChars( ftFont = GetFont(fontPtr, c, 0.0); if (!errorFlag) { + LOCK; XftTextExtents32(fontPtr->display, ftFont, &c, 1, &extents); + UNLOCK; } else { extents.xOff = 0; errorFlag = 0; @@ -962,8 +978,10 @@ Tk_DrawChars( ftFont = GetFont(fontPtr, c, 0.0); if (ftFont) { specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); + LOCK; XftGlyphExtents(fontPtr->display, ftFont, &specs[nspec].glyph, 1, &metrics); + UNLOCK; /* * Draw glyph only when it fits entirely into 16 bit coords. @@ -976,8 +994,10 @@ Tk_DrawChars( specs[nspec].x = x; specs[nspec].y = y; if (++nspec == NUM_SPEC) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; nspec = 0; } } @@ -986,7 +1006,9 @@ Tk_DrawChars( } } if (nspec) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; } doUnderlineStrikeout: @@ -1113,8 +1135,11 @@ TkDrawAngledChars( * this information... but we'll be ready when it does! */ + LOCK; XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, nglyph, &metrics); + UNLOCK; + /* * Draw glyph only when it fits entirely into 16 bit coords. */ @@ -1137,8 +1162,10 @@ TkDrawAngledChars( * a very small barely readable font) */ + LOCK; XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, originX, originY, glyphs, nglyph); + UNLOCK; } } originX = ROUND16(x); @@ -1148,8 +1175,10 @@ TkDrawAngledChars( glyphs[nglyph++] = XftCharIndex(fontPtr->display, ftFont, c); } if (nglyph) { + LOCK; XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, nglyph, &metrics); + UNLOCK; /* * Draw glyph only when it fits entirely into 16 bit coords. @@ -1158,8 +1187,10 @@ TkDrawAngledChars( if (x >= minCoord && y >= minCoord && x <= maxCoord - metrics.width && y <= maxCoord - metrics.height) { + LOCK; XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, originX, originY, glyphs, nglyph); + UNLOCK; } } #else /* !XFT_HAS_FIXED_ROTATED_PLACEMENT */ @@ -1207,8 +1238,10 @@ TkDrawAngledChars( ft0Font = GetFont(fontPtr, c, 0.0); if (ftFont && ft0Font) { specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); + LOCK; XftGlyphExtents(fontPtr->display, ft0Font, &specs[nspec].glyph, 1, &metrics); + UNLOCK; /* * Draw glyph only when it fits entirely into 16 bit coords. @@ -1221,8 +1254,10 @@ TkDrawAngledChars( specs[nspec].x = ROUND16(x); specs[nspec].y = ROUND16(y); if (++nspec == NUM_SPEC) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; nspec = 0; } } @@ -1231,7 +1266,9 @@ TkDrawAngledChars( } } if (nspec) { + LOCK; XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, specs, nspec); + UNLOCK; } #endif /* XFT_HAS_FIXED_ROTATED_PLACEMENT */ diff --git a/win/configure b/win/configure index fbc5b45..e176fb3 100755 --- a/win/configure +++ b/win/configure @@ -1325,7 +1325,7 @@ SHELL=/bin/sh TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".11" +TK_PATCH_LEVEL=".12" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ @@ -3665,6 +3665,7 @@ echo "${ECHO_T}$ac_cv_municode" >&6 else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" fi + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" echo "$as_me:$LINENO: checking for working -fno-lto" >&5 echo $ECHO_N "checking for working -fno-lto... $ECHO_C" >&6 if test "${ac_cv_nolto+set}" = set; then @@ -3727,6 +3728,66 @@ echo "${ECHO_T}$ac_cv_nolto" >&6 fi fi + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base" + echo "$as_me:$LINENO: checking for working --enable-auto-image-base" >&5 +echo $ECHO_N "checking for working --enable-auto-image-base... $ECHO_C" >&6 +if test "${ac_cv_enable_auto_image_base+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_enable_auto_image_base=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_enable_auto_image_base=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_enable_auto_image_base" >&5 +echo "${ECHO_T}$ac_cv_enable_auto_image_base" >&6 + CFLAGS=$hold_cflags + if test "$ac_cv_enable_auto_image_base" == "yes" ; then + extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base" + fi + echo "$as_me:$LINENO: checking compiler flags" >&5 echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then @@ -5237,7 +5298,7 @@ echo "${ECHO_T}$result" >&6 echo "$as_me:$LINENO: checking for tclsh in Tcl build directory" >&5 echo $ECHO_N "checking for tclsh in Tcl build directory... $ECHO_C" >&6 - BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT} + BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}\${EXESUFFIX} echo "$as_me:$LINENO: result: $BUILD_TCLSH" >&5 echo "${ECHO_T}$BUILD_TCLSH" >&6 diff --git a/win/configure.in b/win/configure.in index 038dc26..d331d8d 100644 --- a/win/configure.in +++ b/win/configure.in @@ -15,7 +15,7 @@ SHELL=/bin/sh TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".11" +TK_PATCH_LEVEL=".12" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/makefile.vc b/win/makefile.vc index 2f30590..ee14935 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -455,7 +455,7 @@ $(TKTEST): $(TKTESTOBJS) $(TKSTUBLIB) $(TKIMPLIB) $(CAT32): $(_TCLDIR)\win\cat.c
$(cc32) $(cflags) $(crt) /D_CRT_NONSTDC_NO_DEPRECATE /DCONSOLE /DUNICODE /D_UNICODE -Fo$(TMP_DIR)\ $?
- $(CONEXECMD) /DCONSOLE -stack:16384 $(TMP_DIR)\cat.obj
+ $(CONEXECMD) -stack:16384 $(TMP_DIR)\cat.obj
$(_VC_MANIFEST_EMBED_EXE)
#---------------------------------------------------------------------
diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 4e3d792..2dc33cc 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -14,13 +14,10 @@ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> -#define NO_SHLWAPI_GDI -#define NO_SHLWAPI_STREAM -#define NO_SHLWAPI_REG -#include <shlwapi.h> +#ifdef _MSC_VER #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") -#pragma comment (lib, "shlwapi.lib") +#endif #include <stdio.h> #include <math.h> @@ -42,7 +39,7 @@ /* protos */ static int CheckForCompilerFeature(const char *option); -static int CheckForLinkerFeature(const char **options, int count); +static int CheckForLinkerFeature(char **options, int count); static int IsIn(const char *string, const char *substring); static int SubstituteFile(const char *substs, const char *filename); static int QualifyPath(const char *path); @@ -59,8 +56,8 @@ typedef struct { char buffer[STATICBUFFERSIZE]; } pipeinfo; -pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; -pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; +pipeinfo Out = {INVALID_HANDLE_VALUE, ""}; +pipeinfo Err = {INVALID_HANDLE_VALUE, ""}; /* * exitcodes: 0 == no, 1 == yes, 2 == error @@ -74,7 +71,7 @@ main( char msg[300]; DWORD dwWritten; int chars; - char *s; + const char *s; /* * Make sure children (cl.exe and link.exe) are kept quiet. @@ -278,7 +275,7 @@ CheckForCompilerFeature( "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| - FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], (300-chars), 0); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; @@ -331,7 +328,7 @@ CheckForCompilerFeature( static int CheckForLinkerFeature( - const char **options, + char **options, int count) { STARTUPINFO si; @@ -412,7 +409,7 @@ CheckForLinkerFeature( "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| - FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], (300-chars), 0); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; @@ -508,7 +505,6 @@ GetVersionFromFile( const char *match, int numdots) { - size_t cbBuffer = 100; static char szBuffer[100]; char *szResult = NULL; FILE *fp = fopen(filename, "rt"); @@ -518,7 +514,7 @@ GetVersionFromFile( * Read data until we see our match string. */ - while (fgets(szBuffer, cbBuffer, fp) != NULL) { + while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { LPSTR p, q; p = strstr(szBuffer, match); @@ -528,7 +524,7 @@ GetVersionFromFile( */ p += strlen(match); - while (*p && !isdigit(*p)) { + while (*p && !isdigit((unsigned char)*p)) { ++p; } @@ -537,14 +533,13 @@ GetVersionFromFile( */ q = p; - while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q) - && (!strchr("ab", q[-1])) || --numdots))) { + while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q) + && !strchr("ab", q[-1])) || --numdots))) { ++q; } - memcpy(szBuffer, p, q - p); - szBuffer[q-p] = 0; - szResult = szBuffer; + *q = 0; + szResult = p; break; } } @@ -567,7 +562,7 @@ typedef struct list_item_t { static list_item_t * list_insert(list_item_t **listPtrPtr, const char *key, const char *value) { - list_item_t *itemPtr = malloc(sizeof(list_item_t)); + list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t)); if (itemPtr) { itemPtr->key = strdup(key); itemPtr->value = strdup(value); @@ -616,9 +611,7 @@ SubstituteFile( const char *substitutions, const char *filename) { - size_t cbBuffer = 1024; static char szBuffer[1024], szCopy[1024]; - char *szResult = NULL; list_item_t *substPtr = NULL; FILE *fp, *sp; @@ -631,7 +624,7 @@ SubstituteFile( sp = fopen(substitutions, "rt"); if (sp != NULL) { - while (fgets(szBuffer, cbBuffer, sp) != NULL) { + while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) { unsigned char *ks, *ke, *vs, *ve; ks = (unsigned char*)szBuffer; while (ks && *ks && isspace(*ks)) ++ks; @@ -648,7 +641,7 @@ SubstituteFile( } /* debug: dump the list */ -#ifdef _DEBUG +#ifndef NDEBUG { int n = 0; list_item_t *p = NULL; @@ -662,7 +655,7 @@ SubstituteFile( * Run the substitutions over each line of the input */ - while (fgets(szBuffer, cbBuffer, fp) != NULL) { + while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { list_item_t *p = NULL; for (p = substPtr; p != NULL; p = p->nextPtr) { char *m = strstr(szBuffer, p->key); @@ -679,7 +672,7 @@ SubstituteFile( memcpy(szBuffer, szCopy, sizeof(szCopy)); } } - printf(szBuffer); + printf("%s", szBuffer); } list_free(&substPtr); @@ -688,6 +681,17 @@ SubstituteFile( return 0; } +BOOL FileExists(LPCTSTR szPath) +{ +#ifndef INVALID_FILE_ATTRIBUTES + #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) +#endif + DWORD pathAttr = GetFileAttributes(szPath); + return (pathAttr != INVALID_FILE_ATTRIBUTES && + !(pathAttr & FILE_ATTRIBUTE_DIRECTORY)); +} + + /* * QualifyPath -- * @@ -701,13 +705,8 @@ 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); + + GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); printf("%s\n", szCwd); return 0; } @@ -724,7 +723,8 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) { HANDLE hSearch; char path[MAX_PATH+1]; - int dirlen, keylen, ret; + size_t dirlen; + int keylen, ret; WIN32_FIND_DATA finfo; if (dir == NULL || keypath == NULL) @@ -765,7 +765,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) strncpy(path+dirlen+1, finfo.cFileName, sublen); path[dirlen+1+sublen] = '\\'; strncpy(path+dirlen+1+sublen+1, keypath, keylen+1); - if (PathFileExists(path)) { + if (FileExists(path)) { /* Found a match, print to stdout */ path[dirlen+1+sublen] = '\0'; QualifyPath(path); @@ -791,8 +791,9 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) */ static int LocateDependency(const char *keypath) { - int i, ret; - static char *paths[] = {"..", "..\\..", "..\\..\\.."}; + size_t i; + int ret; + static const char *paths[] = {"..", "..\\..", "..\\..\\.."}; for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { ret = LocateDependencyHelper(paths[i], keypath); diff --git a/win/rules.vc b/win/rules.vc index 2ec5292..c24fce3 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1123,7 +1123,7 @@ STUBPREFIX = $(PROJECT)stub # TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc
TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip
-TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip
+TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip
!if $(DOING_TCL)
TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
@@ -1203,9 +1203,16 @@ TCLSH_NATIVE = $(TCLSH) !if $(DOING_TK) || $(NEED_TK)
WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
-TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
-TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
+TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT)
+TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
+!if $(TCL_MAJOR_VERSION) == 8
+TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
+!else
+TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
+TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib
+!endif
+TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
!if $(DOING_TK)
WISH = $(OUT_DIR)\$(WISHNAME)
@@ -1253,7 +1260,13 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" # Various output paths
PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
+!if $(TCL_MAJOR_VERSION) == 8
+PRJLIBNAME = $(PRJLIBNAME8)
+!else
+PRJLIBNAME = $(PRJLIBNAME9)
+!endif
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
@@ -1583,12 +1596,22 @@ default-target: $(DEFAULT_BUILD_TARGET) !if $(MULTIPLATFORM_INSTALL)
default-pkgindex:
+ @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } >> $(OUT_DIR)\pkgIndex.tcl
!else
default-pkgindex:
+ @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+ [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } >> $(OUT_DIR)\pkgIndex.tcl
!endif
default-pkgindex-tea:
@@ -1597,6 +1620,8 @@ default-pkgindex-tea: @PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME)
@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME)
@PKG_LIB_FILE@ $(PRJLIBNAME)
+@PKG_LIB_FILE8@ $(PRJLIBNAME8)
+@PKG_LIB_FILE9@ $(PRJLIBNAME9)
<<
default-install: default-install-binaries default-install-libraries
@@ -659,6 +659,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" fi + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" AC_CACHE_CHECK(for working -fno-lto, ac_cv_nolto, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], @@ -673,6 +674,18 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi fi + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base" + AC_CACHE_CHECK(for working --enable-auto-image-base, + ac_cv_enable_auto_image_base, + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], + [ac_cv_enable_auto_image_base=yes], + [ac_cv_enable_auto_image_base=no]) + ) + CFLAGS=$hold_cflags + if test "$ac_cv_enable_auto_image_base" == "yes" ; then + extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base" + fi + AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then SHLIB_LD="" @@ -1204,7 +1217,7 @@ AC_DEFUN([SC_PROG_TCLSH], [ AC_DEFUN([SC_BUILD_TCLSH], [ AC_MSG_CHECKING([for tclsh in Tcl build directory]) - BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT} + BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}\${EXESUFFIX} AC_MSG_RESULT($BUILD_TCLSH) AC_SUBST(BUILD_TCLSH) ]) diff --git a/win/tkWin32Dll.c b/win/tkWin32Dll.c index 8cfddee..802b1f3 100644 --- a/win/tkWin32Dll.c +++ b/win/tkWin32Dll.c @@ -119,11 +119,11 @@ DllMain( case DLL_PROCESS_DETACH: /* * Protect the call to TkFinalize in an SEH block. We can't be - * guarenteed Tk is always being unloaded from a stable condition. + * guaranteed Tk is always being unloaded from a stable condition. */ #ifdef HAVE_NO_SEH -# ifdef __WIN64 +# ifdef _WIN64 __asm__ __volatile__ ( /* diff --git a/win/tkWinButton.c b/win/tkWinButton.c index 7332c93..4e965c2 100644 --- a/win/tkWinButton.c +++ b/win/tkWinButton.c @@ -149,7 +149,7 @@ InitBoxes(void) size = tsdPtr->boxesPtr->biSize + (sizeof(RGBQUAD) << tsdPtr->boxesPtr->biBitCount) + tsdPtr->boxesPtr->biSizeImage; - newBitmap = ckalloc(size); + newBitmap = (LPBITMAPINFOHEADER)ckalloc(size); memcpy(newBitmap, tsdPtr->boxesPtr, size); tsdPtr->boxesPtr = newBitmap; tsdPtr->boxWidth = tsdPtr->boxesPtr->biWidth / 4; @@ -182,7 +182,7 @@ InitBoxes(void) */ void -TkpButtonSetDefaults() +TkpButtonSetDefaults(void) { int width = GetSystemMetrics(SM_CXEDGE); if (width > 0) { @@ -208,11 +208,11 @@ TkpButtonSetDefaults() TkButton * TkpCreateButton( - Tk_Window tkwin) + TCL_UNUSED(Tk_Window)) { WinButton *butPtr; - butPtr = ckalloc(sizeof(WinButton)); + butPtr = (WinButton *)ckalloc(sizeof(WinButton)); butPtr->hwnd = NULL; return (TkButton *) butPtr; } @@ -316,14 +316,14 @@ TkpDisplayButton( { TkWinDCState state; HDC dc; - register TkButton *butPtr = (TkButton *) clientData; + TkButton *butPtr = (TkButton *)clientData; GC gc; Tk_3DBorder border; Pixmap pixmap; int x = 0; /* Initialization only needed to stop compiler * warning. */ int y, relief; - register Tk_Window tkwin = butPtr->tkwin; + Tk_Window tkwin = butPtr->tkwin; int width = 0, height = 0, haveImage = 0, haveText = 0, drawRing = 0; RECT rect; int defaultWidth; /* Width of default ring. */ @@ -818,7 +818,7 @@ TkpDisplayButton( void TkpComputeButtonGeometry( - register TkButton *butPtr) /* Button whose geometry may have changed. */ + TkButton *butPtr) /* Button whose geometry may have changed. */ { int txtWidth, txtHeight; /* Width and height of text */ int imgWidth, imgHeight; /* Width and height of image */ @@ -1264,7 +1264,7 @@ ButtonProc( PAINTSTRUCT ps; BeginPaint(hwnd, &ps); EndPaint(hwnd, &ps); - TkpDisplayButton((ClientData)butPtr); + TkpDisplayButton(butPtr); /* * Special note: must cancel any existing idle handler for @@ -1272,7 +1272,7 @@ ButtonProc( * cleared the REDRAW_PENDING flag. */ - Tcl_CancelIdleCall(TkpDisplayButton, (ClientData)butPtr); + Tcl_CancelIdleCall(TkpDisplayButton, butPtr); return 0; } case BN_CLICKED: { @@ -1287,14 +1287,14 @@ ButtonProc( Tcl_Interp *interp = butPtr->info.interp; if (butPtr->info.state != STATE_DISABLED) { - Tcl_Preserve((ClientData)interp); + Tcl_Preserve(interp); code = TkInvokeButton((TkButton*)butPtr); if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (button invoke)"); Tcl_BackgroundException(interp, code); } - Tcl_Release((ClientData)interp); + Tcl_Release(interp); } Tcl_ServiceAll(); return 0; diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c index 774eddc..8c9399a 100644 --- a/win/tkWinCursor.c +++ b/win/tkWinCursor.c @@ -39,7 +39,7 @@ typedef struct { * resource identifier. */ -static struct CursorName { +static const struct CursorName { const char *name; LPCTSTR id; } cursorNames[] = { @@ -96,7 +96,7 @@ TkGetCursorByName( Tk_Uid string) /* Description of cursor. See manual entry for * details on legal syntax. */ { - struct CursorName *namePtr; + const struct CursorName *namePtr; TkWinCursor *cursorPtr; int argc; const char **argv = NULL; diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 852de02..b03cbd7 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -59,6 +59,7 @@ #define DEF_BUTTON_DEFAULT "disabled" #define DEF_BUTTON_DISABLED_FG_COLOR DISABLED #define DEF_BUTTON_DISABLED_FG_MONO "" +#define DEF_LABEL_FG NORMAL_FG #define DEF_BUTTON_FG NORMAL_FG #define DEF_CHKRAD_FG TEXT_FG #define DEF_BUTTON_FONT "TkDefaultFont" diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index cdfdafa..176ba88 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -782,7 +782,7 @@ Tk_ChooseColorObjCmd( } parent = tkwin; - chooseColor.lStructSize = sizeof(CHOOSECOLOR); + chooseColor.lStructSize = sizeof(CHOOSECOLORW); chooseColor.hwndOwner = NULL; chooseColor.hInstance = NULL; chooseColor.rgbResult = oldColor; @@ -908,7 +908,7 @@ ColorDlgHookProc( ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); const char *title; - CHOOSECOLOR *ccPtr; + CHOOSECOLORW *ccPtr; (void)wParam; if (WM_INITDIALOG == uMsg) { @@ -917,7 +917,7 @@ ColorDlgHookProc( * Set the title string of the dialog. */ - ccPtr = (CHOOSECOLOR *) lParam; + ccPtr = (CHOOSECOLORW *) lParam; title = (const char *) ccPtr->lCustData; if ((title != NULL) && (title[0] != '\0')) { @@ -3151,7 +3151,7 @@ HookProc( WPARAM wParam, LPARAM lParam) { - CHOOSEFONT *pcf = (CHOOSEFONT *) lParam; + CHOOSEFONTW *pcf = (CHOOSEFONTW *) lParam; HWND hwndCtrl; static HookData *phd = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) @@ -3463,10 +3463,10 @@ FontchooserShowCmd( Tk_MakeWindowExist(parent); - ZeroMemory(&cf, sizeof(CHOOSEFONT)); - ZeroMemory(&lf, sizeof(LOGFONT)); + ZeroMemory(&cf, sizeof(CHOOSEFONTW)); + ZeroMemory(&lf, sizeof(LOGFONTW)); lf.lfCharSet = DEFAULT_CHARSET; - cf.lStructSize = sizeof(CHOOSEFONT); + cf.lStructSize = sizeof(CHOOSEFONTW); cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent)); cf.lpLogFont = &lf; cf.nFontType = SCREEN_FONTTYPE; diff --git a/win/tkWinDraw.c b/win/tkWinDraw.c index 042d1b1..4ed8ab2 100644 --- a/win/tkWinDraw.c +++ b/win/tkWinDraw.c @@ -587,9 +587,6 @@ TkPutImage( } if (!bitmap) { Tcl_Panic("Fail to allocate bitmap"); - DeleteDC(dcMem); - TkWinReleaseDrawableDC(d, dc, &state); - return BadValue; } bitmap = SelectObject(dcMem, bitmap); BitBlt(dc, dest_x, dest_y, (int) width, (int) height, dcMem, src_x, src_y, diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c index 1c6ba6c..36c6047 100644 --- a/win/tkWinEmbed.c +++ b/win/tkWinEmbed.c @@ -1088,8 +1088,8 @@ EmbedWindowDeleted( prevPtr = NULL; containerPtr = tsdPtr->firstContainerPtr; - if (containerPtr == NULL) return; while (1) { + if (containerPtr == NULL) return; if (containerPtr->embeddedPtr == winPtr) { containerPtr->embeddedHWnd = NULL; containerPtr->embeddedPtr = NULL; diff --git a/win/tkWinFont.c b/win/tkWinFont.c index 5eed32c..c24cd5f 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -2748,7 +2748,7 @@ LoadFontRanges( * range information. */ int *symbolPtr) { - int n, i, swapped, offset, cbData, segCount; + int n, i, j, k, swapped, offset, cbData, segCount; DWORD cmapKey; USHORT *startCount, *endCount; CMAPTABLE cmapTable; @@ -2824,9 +2824,9 @@ LoadFontRanges( offset += cbData + sizeof(USHORT); GetFontData(hdc, cmapKey, (DWORD) offset, startCount, cbData); if (swapped) { - for (i = 0; i < segCount; i++) { - SwapShort(&endCount[i]); - SwapShort(&startCount[i]); + for (j = 0; j < segCount; j++) { + SwapShort(&endCount[j]); + SwapShort(&startCount[j]); } } if (*symbolPtr != 0) { @@ -2842,11 +2842,11 @@ LoadFontRanges( * 8-bit characters [note Bug: 2406] */ - for (i = 0; i < segCount; i++) { - if (((startCount[i] & 0xff00) == 0xf000) - && ((endCount[i] & 0xff00) == 0xf000)) { - startCount[i] &= 0xff; - endCount[i] &= 0xff; + for (k = 0; k < segCount; k++) { + if (((startCount[k] & 0xff00) == 0xf000) + && ((endCount[k] & 0xff00) == 0xf000)) { + startCount[k] &= 0xff; + endCount[k] &= 0xff; } } } diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 67894c7..22e84cb 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -511,7 +511,7 @@ GetEntryText( : Tcl_GetString(mePtr->accelPtr); const char *p, *next; Tcl_DString itemString; - int ch; + Tcl_UniChar ch = 0; /* * We have to construct the string with an ampersand preceeding the @@ -528,16 +528,17 @@ GetEntryText( if (*p == '&') { Tcl_DStringAppend(&itemString, "&", 1); } - next = p + TkUtfToUniChar(p, &ch); + next = p + Tcl_UtfToUniChar(p, &ch); Tcl_DStringAppend(&itemString, p, (int) (next - p)); } + ch = 0; if (mePtr->accelLength > 0) { Tcl_DStringAppend(&itemString, "\t", 1); for (p = accel, i = 0; *p != '\0'; i++, p = next) { if (*p == '&') { Tcl_DStringAppend(&itemString, "&", 1); } - next = p + TkUtfToUniChar(p, &ch); + next = p + Tcl_UtfToUniChar(p, &ch); Tcl_DStringAppend(&itemString, p, (int) (next - p)); } } diff --git a/win/tkWinPort.h b/win/tkWinPort.h index 337a866..0118608 100644 --- a/win/tkWinPort.h +++ b/win/tkWinPort.h @@ -21,6 +21,7 @@ *--------------------------------------------------------------------------- */ +#include <stdio.h> #include <wchar.h> #include <io.h> #include <stdlib.h> @@ -64,6 +65,9 @@ typedef _TCHAR TCHAR; #endif +#if defined(__GNUC__) && !defined(__cplusplus) +# pragma GCC diagnostic ignored "-Wc++-compat" +#endif #include <X11/Xlib.h> #include <X11/cursorfont.h> #include <X11/keysym.h> diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index a633dc2..409a6db 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -4,7 +4,7 @@ * This file implements the Windows specific portion of the scrollbar * widget. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -82,7 +82,7 @@ const Tk_ClassProcs tkpScrollbarProcs = { static void WinScrollbarEventProc(ClientData clientData, XEvent *eventPtr) { - WinScrollbar *scrollPtr = clientData; + WinScrollbar *scrollPtr = (WinScrollbar *)clientData; if (eventPtr->type == ButtonPress) { ModalLoop(scrollPtr, eventPtr); @@ -121,7 +121,7 @@ TkpCreateScrollbar( Tcl_MutexUnlock(&winScrlbrMutex); } - scrollPtr = ckalloc(sizeof(WinScrollbar)); + scrollPtr = (WinScrollbar *)ckalloc(sizeof(WinScrollbar)); scrollPtr->winFlags = 0; scrollPtr->hwnd = NULL; @@ -275,7 +275,7 @@ void TkpDisplayScrollbar( ClientData clientData) /* Information about window. */ { - WinScrollbar *scrollPtr = (WinScrollbar *) clientData; + WinScrollbar *scrollPtr = (WinScrollbar *)clientData; Tk_Window tkwin = scrollPtr->info.tkwin; scrollPtr->info.flags &= ~REDRAW_PENDING; @@ -295,7 +295,7 @@ TkpDisplayScrollbar( DestroyWindow(hwnd); CreateProc(tkwin, Tk_WindowId(Tk_Parent(tkwin)), - (ClientData) scrollPtr); + scrollPtr); } else { UpdateScrollbar(scrollPtr); } @@ -383,7 +383,7 @@ UpdateScrollbarMetrics(void) void TkpComputeScrollbarGeometry( - register TkScrollbar *scrollPtr) + TkScrollbar *scrollPtr) /* Scrollbar whose geometry may have * changed. */ { @@ -591,7 +591,7 @@ ScrollbarProc( void TkpConfigureScrollbar( - register TkScrollbar *scrollPtr) + TCL_UNUSED(TkScrollbar *)) /* Information about widget; may or may not * already have values for some fields. */ { @@ -617,7 +617,7 @@ ModalLoop( int oldMode; if (scrollPtr->hwnd) { - Tcl_Preserve((ClientData)scrollPtr); + Tcl_Preserve(scrollPtr); scrollPtr->winFlags |= IN_MODAL_LOOP; oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); TkWinResendEvent(scrollPtr->oldProc, scrollPtr->hwnd, eventPtr); @@ -626,7 +626,7 @@ ModalLoop( if (scrollPtr->hwnd && scrollPtr->winFlags & ALREADY_DEAD) { DestroyWindow(scrollPtr->hwnd); } - Tcl_Release((ClientData)scrollPtr); + Tcl_Release(scrollPtr); } } @@ -650,7 +650,7 @@ ModalLoop( int TkpScrollbarPosition( - register TkScrollbar *scrollPtr, + TkScrollbar *scrollPtr, /* Scrollbar widget record. */ int x, int y) /* Coordinates within scrollPtr's window. */ { diff --git a/win/tkWinWm.c b/win/tkWinWm.c index ff83ad2..d2602f7 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -358,7 +358,7 @@ typedef struct TkWmInfo { * of top-level windows. */ -static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); +static void TopLevelReqProc(void *, Tk_Window); static void RemapWindows(TkWindow *winPtr, HWND parentHWND); static const Tk_GeomMgr wmMgrType = { @@ -436,9 +436,9 @@ static BlockOfIconImagesPtr ReadIconOrCursorFromFile(Tcl_Interp *interp, Tcl_Obj* fileName, BOOL isIcon); static WinIconPtr ReadIconFromFile(Tcl_Interp *interp, Tcl_Obj *fileName); +static BOOL AdjustIconImagePointers(LPICONIMAGE lpImage); static WinIconPtr GetIconFromPixmap(Display *dsPtr, Pixmap pixmap); static int ReadICOHeader(Tcl_Channel channel); -static BOOL AdjustIconImagePointers(LPICONIMAGE lpImage); static HICON MakeIconOrCursorFromResource(LPICONIMAGE lpIcon, BOOL isIcon); static HICON GetIcon(WinIconPtr titlebaricon, int icon_size); @@ -2740,10 +2740,8 @@ TkWmDeadWindow( void TkWmSetClass( - TkWindow *winPtr) /* Newly-created top-level window. */ + TCL_UNUSED(TkWindow *)) /* Newly-created top-level window. */ { - (void)winPtr; - /* Do nothing */ return; } @@ -2946,7 +2944,7 @@ Tk_WmObjCmd( static int WmAspectCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2954,7 +2952,6 @@ WmAspectCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int numer1, denom1, numer2, denom2; - (void)tkwin; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -3075,9 +3072,6 @@ WmAttributesCmd( } for (i = 3; i < objc; i += 2) { string = Tcl_GetStringFromObj(objv[i], &length); - if ((length < 2) || (string[0] != '-')) { - goto configArgs; - } if (strncmp(string, "-disabled", length) == 0) { stylePtr = &style; styleBit = WS_DISABLED; @@ -3110,6 +3104,12 @@ WmAttributesCmd( Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "TOPMOST", NULL); return TCL_ERROR; } + } else if (i == 3) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad attribute \"%s\": must be -alpha, -transparentcolor, -disabled, -fullscreen, -toolwindow, or -topmost", + string)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "UNRECOGNIZED", NULL); + return TCL_ERROR; } else { goto configArgs; } @@ -3313,7 +3313,7 @@ WmAttributesCmd( static int WmClientCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3322,7 +3322,6 @@ WmClientCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; const char *argv3; int length; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name?"); @@ -3478,7 +3477,7 @@ WmColormapwindowsCmd( static int WmCommandCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3488,7 +3487,6 @@ WmCommandCmd( const char *argv3; int cmdArgc; const char **cmdArgv; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); @@ -3548,14 +3546,13 @@ WmCommandCmd( static int WmDeiconifyCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -3601,7 +3598,7 @@ WmDeiconifyCmd( static int WmFocusmodelCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3615,7 +3612,6 @@ WmFocusmodelCmd( OPT_ACTIVE, OPT_PASSIVE }; int index; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?"); @@ -3658,17 +3654,13 @@ WmFocusmodelCmd( static int WmForgetCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel or Frame to work with */ - Tcl_Interp *dummy, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(int), /* Number of arguments. */ + TCL_UNUSED(Tcl_Obj *const *)) /* Argument objects. */ { Tk_Window frameWin = (Tk_Window) winPtr; - (void)tkwin; - (void)dummy; - (void)objc; - (void)objv; if (Tk_IsTopLevel(frameWin)) { Tk_UnmapWindow(frameWin); @@ -3676,10 +3668,10 @@ WmForgetCmd( Tk_MakeWindowExist((Tk_Window)winPtr->parentPtr); RemapWindows(winPtr, Tk_GetHWND(winPtr->parentPtr->window)); - /* - * Make sure wm no longer manages this window - */ - Tk_ManageGeometry(frameWin, NULL, NULL); + /* + * Make sure wm no longer manages this window + */ + Tk_ManageGeometry(frameWin, NULL, NULL); TkWmDeadWindow(winPtr); /* flags (above) must be cleared before calling */ @@ -3710,7 +3702,7 @@ WmForgetCmd( static int WmFrameCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3719,7 +3711,6 @@ WmFrameCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; HWND hwnd; char buf[TCL_INTEGER_SPACE]; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -3756,7 +3747,7 @@ WmFrameCmd( static int WmGeometryCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3766,7 +3757,6 @@ WmGeometryCmd( char xSign, ySign; int width, height; const char *argv3; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); @@ -3825,7 +3815,7 @@ WmGeometryCmd( static int WmGridCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3833,7 +3823,6 @@ WmGridCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; - (void)tkwin; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -3987,7 +3976,7 @@ WmGroupCmd( static int WmIconbitmapCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -3996,7 +3985,6 @@ WmIconbitmapCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */ const char *string; - (void)tkwin; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? ?image?"); @@ -4124,14 +4112,13 @@ WmIconbitmapCmd( static int WmIconifyCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -4249,7 +4236,7 @@ WmIconmaskCmd( static int WmIconnameCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4258,7 +4245,6 @@ WmIconnameCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; const char *argv3; int length; - (void)tkwin; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?"); @@ -4301,7 +4287,7 @@ WmIconnameCmd( static int WmIconphotoCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4319,7 +4305,6 @@ WmIconphotoCmd( unsigned size; BITMAPINFO bmInfo; ICONINFO iconInfo; - (void)tkwin; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, @@ -4495,7 +4480,7 @@ WmIconphotoCmd( static int WmIconpositionCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4503,7 +4488,6 @@ WmIconpositionCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); @@ -4662,17 +4646,14 @@ WmIconwindowCmd( static int WmManageCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel or Frame to work with */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + TCL_UNUSED(int), /* Number of arguments. */ + TCL_UNUSED(Tcl_Obj *const *)) /* Argument objects. */ { Tk_Window frameWin = (Tk_Window) winPtr; WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; - (void)objc; - (void)objv; if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { @@ -4719,7 +4700,7 @@ WmManageCmd( static int WmMaxsizeCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4727,7 +4708,6 @@ WmMaxsizeCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); @@ -4771,7 +4751,7 @@ WmMaxsizeCmd( static int WmMinsizeCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4779,7 +4759,6 @@ WmMinsizeCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); @@ -4823,7 +4802,7 @@ WmMinsizeCmd( static int WmOverrideredirectCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4832,7 +4811,6 @@ WmOverrideredirectCmd( WmInfo *wmPtr = winPtr->wmInfoPtr; int boolean, curValue; XSetWindowAttributes atts; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); @@ -4896,7 +4874,7 @@ WmOverrideredirectCmd( static int WmPositionfromCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4910,7 +4888,6 @@ WmPositionfromCmd( OPT_PROGRAM, OPT_USER }; int index; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); @@ -4965,7 +4942,7 @@ WmPositionfromCmd( static int WmProtocolCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -4977,7 +4954,6 @@ WmProtocolCmd( const char *cmd; int cmdLength; Tcl_Obj *resultObj; - (void)tkwin; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -5062,7 +5038,7 @@ WmProtocolCmd( static int WmResizableCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5070,7 +5046,6 @@ WmResizableCmd( { WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; - (void)tkwin; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); @@ -5125,7 +5100,7 @@ WmResizableCmd( static int WmSizefromCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5139,7 +5114,6 @@ WmSizefromCmd( OPT_PROGRAM, OPT_USER }; int index; - (void)tkwin; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); @@ -5323,7 +5297,7 @@ WmStackorderCmd( static int WmStateCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5337,7 +5311,6 @@ WmStateCmd( OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN, OPT_ZOOMED }; int index; - (void)tkwin; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); @@ -5464,7 +5437,7 @@ WmStateCmd( static int WmTitleCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -5474,7 +5447,6 @@ WmTitleCmd( const char *argv3; int length; HWND wrapper; - (void)tkwin; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); @@ -5670,14 +5642,13 @@ WmTransientCmd( static int WmWithdrawCmd( - Tk_Window tkwin, /* Main window of the application. */ + TCL_UNUSED(Tk_Window), /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - (void)tkwin; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -5986,12 +5957,11 @@ TopLevelEventProc( static void TopLevelReqProc( - ClientData dummy, /* Not used. */ + TCL_UNUSED(void *), Tk_Window tkwin) /* Information about window. */ { TkWindow *winPtr = (TkWindow *) tkwin; WmInfo *wmPtr; - (void)dummy; wmPtr = winPtr->wmInfoPtr; if (wmPtr) { @@ -6538,15 +6508,13 @@ Tk_CoordsToWindow( void Tk_GetVRootGeometry( - Tk_Window tkwin, /* Window whose virtual root is to be + TCL_UNUSED(Tk_Window), /* Window whose virtual root is to be * queried. */ int *xPtr, int *yPtr, /* Store x and y offsets of virtual root * here. */ int *widthPtr, int *heightPtr) /* Store dimensions of virtual root here. */ { - (void)tkwin; - *xPtr = GetSystemMetrics(SM_XVIRTUALSCREEN); *yPtr = GetSystemMetrics(SM_YVIRTUALSCREEN); *widthPtr = GetSystemMetrics(SM_CXVIRTUALSCREEN); diff --git a/win/winMain.c b/win/winMain.c index f072f78..14eb718 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -19,6 +19,10 @@ #include <locale.h> #include <stdlib.h> #include <tchar.h> +#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 +# define Tcl_LibraryInitProc Tcl_PackageInitProc +# define Tcl_StaticLibrary Tcl_StaticPackage +#endif #if defined(__GNUC__) int _CRT_glob = 0; @@ -28,7 +32,7 @@ int _CRT_glob = 0; #ifdef __cplusplus extern "C" { #endif -extern Tcl_PackageInitProc Tktest_Init; +extern Tcl_LibraryInitProc Tktest_Init; #endif /* TK_TEST */ #if !defined(TCL_USE_STATIC_PACKAGES) @@ -40,9 +44,9 @@ extern Tcl_PackageInitProc Tktest_Init; #endif #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES -extern Tcl_PackageInitProc Registry_Init; -extern Tcl_PackageInitProc Dde_Init; -extern Tcl_PackageInitProc Dde_SafeInit; +extern Tcl_LibraryInitProc Registry_Init; +extern Tcl_LibraryInitProc Dde_Init; +extern Tcl_LibraryInitProc Dde_SafeInit; #endif #ifdef __cplusplus @@ -199,10 +203,21 @@ Tcl_AppInit( if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } +#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES + if (Registry_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticLibrary(interp, "Registry", Registry_Init, 0); + + if (Dde_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticLibrary(interp, "Dde", Dde_Init, Dde_SafeInit); +#endif if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); + Tcl_StaticLibrary(interp, "Tk", Tk_Init, Tk_SafeInit); /* * Initialize the console only if we are running as an interactive @@ -214,23 +229,11 @@ Tcl_AppInit( return TCL_ERROR; } } -#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES - if (Registry_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "Registry", Registry_Init, 0); - - if (Dde_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit); -#endif - #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 0); + Tcl_StaticLibrary(interp, "Tktest", Tktest_Init, 0); #endif /* TK_TEST */ /* diff --git a/xlib/X11/Xlib.h b/xlib/X11/Xlib.h index 1977939..56d049c 100644 --- a/xlib/X11/Xlib.h +++ b/xlib/X11/Xlib.h @@ -330,9 +330,6 @@ typedef struct _XImage { unsigned long green_mask; unsigned long blue_mask; XPointer obdata; /* hook for the object routines to hang on */ -#if defined(MAC_OSX_TK) - int pixelpower; /* No longer used. */ -#endif struct funcs { /* image manipulation routines */ struct _XImage *(*create_image)(); #if NeedFunctionPrototypes diff --git a/xlib/ximage.c b/xlib/ximage.c index aaab946..b3a8f20 100644 --- a/xlib/ximage.c +++ b/xlib/ximage.c @@ -51,11 +51,13 @@ XCreateBitmapFromData( } ximage = XCreateImage(display, NULL, 1, XYBitmap, 0, (char*) data, width, height, 8, (width + 7) / 8); - ximage->bitmap_bit_order = LSBFirst; - _XInitImageFuncPtrs(ximage); - TkPutImage(NULL, 0, display, pix, gc, ximage, 0, 0, 0, 0, width, height); - ximage->data = NULL; - XDestroyImage(ximage); + if (ximage) { + ximage->bitmap_bit_order = LSBFirst; + _XInitImageFuncPtrs(ximage); + TkPutImage(NULL, 0, display, pix, gc, ximage, 0, 0, 0, 0, width, height); + ximage->data = NULL; + XDestroyImage(ximage); + } XFreeGC(display, gc); return pix; } |