tk9.1.0/0000755003604700454610000000000015256474664010500 5ustar dgp771divtk9.1.0/.github/0000755003604700454610000000000015256474664012040 5ustar dgp771divtk9.1.0/.github/workflows/0000755003604700454610000000000015256474664014075 5ustar dgp771divtk9.1.0/.github/workflows/win-build.yml0000644003604700454610000001230615255022635016476 0ustar dgp771divname: Windows on: push: branches: - "main" - "core-9-1-branch" tags: - "core-*" permissions: contents: read env: ERROR_ON_FAILURES: 1 jobs: msvc: runs-on: windows-2025-vs2026 defaults: run: shell: powershell working-directory: tk/win # Using powershell means we need to explicitly stop on failure strategy: matrix: config: - "" - "OPTS=symbols" - "OPTS=static" steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Checkout Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: manifest-in-rc-only path: tcl - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 - name: Make Install Location working-directory: tcl run: | echo "TCLDIR=`pwd`" >> $GITHUB_ENV cd .. mkdir install cd install echo "INSTALLDIR=`pwd`" >> $GITHUB_ENV - name: Build Tcl (${{ matrix.config }}) run: | &nmake -f makefile.vc release install ${{ matrix.config }} if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } working-directory: tcl/win - name: Build Tk (${{ matrix.config }}) run: | &nmake -f makefile.vc all ${{ matrix.config }} if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - name: Build Test Harness (${{ matrix.config }}) run: | &nmake -f makefile.vc tktest ${{ matrix.config }} if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - name: Run Tk Tests (${{ matrix.config }}) run: | nmake -f makefile.vc test-classic ${{ matrix.config }} | tee out-classic.txt || { echo "::error::Failure during Test" exit 1 } nmake -f makefile.vc test-ttk ${{ matrix.config }} | tee out-ttk.txt || { echo "::error::Failure during Test" exit 1 } grep -q "Failed 0" out-classic.txt || { echo "::error::Failure during Test" exit 1 } grep -q "Failed 0" out-ttk.txt || { echo "::error::Failure during Test" exit 1 } env: CI_BUILD_WITH_MSVC: 1 shell: bash timeout-minutes: 10 - name: Build Help (${{ matrix.config }}) run: | &nmake -f makefile.vc htmlhelp ${{ matrix.config }} if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - name: Install (${{ matrix.config }}) run: | &nmake -f makefile.vc install ${{ matrix.config }} if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } gcc: runs-on: windows-2025-vs2026 defaults: run: shell: msys2 {0} working-directory: win strategy: matrix: config: - "" - "--enable-symbols=mem" - "--enable-symbols=all" - "--disable-shared" steps: - name: Install MSYS2 uses: msys2/setup-msys2@v2 with: msystem: MINGW64 install: git mingw-w64-x86_64-toolchain make zip - name: Checkout Tk uses: actions/checkout@v7 - name: Checkout Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: manifest-in-rc-only path: tcl - name: Prepare run: | touch tkStubInit.c touch "${HOME}/forWinDialog-5.12.7" mkdir "${HOME}/install_dir" echo "INSTALL_DIR=${HOME}/install_dir" >> $GITHUB_ENV working-directory: generic - name: Configure and Build Tcl (${{ matrix.config }}) run: | ./configure $CFGOPT "--prefix=$INSTALL_DIR" || { cat config.log echo "::warning::Failure during Tcl Configure" exit 1 } make all install || { echo "::warning::Failure during Tcl Build" exit 1 } echo "TCL_CONFIG_PATH=`pwd`" >> $GITHUB_ENV env: CFGOPT: --enable-64bit ${{ matrix.config }} working-directory: tcl/win - name: Configure Tk (${{ matrix.config }}) run: | ./configure $CFGOPT "--prefix=$HOME/INSTALL_DIR" "--with-tcl=$TCL_CONFIG_PATH" || { cat config.log echo "::error::Failure during Configure" exit 1 } env: CFGOPT: --enable-64bit ${{ matrix.config }} - name: Build Tk run: | make all install tktest || { echo "::error::Failure during Build" exit 1 } - name: Run Tk Tests run: | make test-classic | tee out-classic.txt make test-ttk | tee out-ttk.txt grep -q "Failed 0" out-classic.txt || { echo "::error::Failure during Test" exit 1 } grep -q "Failed 0" out-ttk.txt || { echo "::error::Failure during Test" exit 1 } timeout-minutes: 10 tk9.1.0/.github/workflows/onefiledist.yml0000644003604700454610000001664615255022635017124 0ustar dgp771divname: Build Binaries on: push: branches: - "main" - "core-9-1-branch" tags: - "core-*" permissions: contents: read jobs: linux: name: Linux runs-on: ubuntu-26.04 defaults: run: shell: bash env: CC: gcc CFGOPT: --disable-symbols --disable-shared steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Checkout Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: main path: tcl - name: Prepare run: | sudo apt-get update sudo apt-get install libtommath-dev libxss-dev libxft-dev libcups2-dev libatk1.0-dev libatk-bridge2.0-dev libharfbuzz-dev touch tcl/generic/tclStubInit.c tcl/generic/tclOOStubInit.c touch tk/generic/tkStubInit.c echo "INST_DIR=$(cd install;pwd)" >> $GITHUB_ENV echo "VER_PATH=$(cd tcl/tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV working-directory: "." - name: Configure Tcl run: | ./configure $CFGOPT --prefix=$INST_DIR working-directory: tcl/unix - name: Build & Install Tcl run: | make binaries libraries install make shell SCRIPT="$VER_PATH $GITHUB_ENV" working-directory: tcl/unix - name: Configure Tk run: | ./configure $CFGOPT --with-tcl=$INST_DIR/lib --prefix=$INST_DIR working-directory: tk/unix - name: Build & Install Tk run: | make binaries libraries install working-directory: tk/unix # TODO: need the Tk version separately for distro naming below - name: Package run: | cp bin/wish9.1 ${BUILD_NAME} chmod +x ${BUILD_NAME} tar -cf ${BUILD_NAME}.tar ${BUILD_NAME} working-directory: ${{ env.INST_DIR }} env: BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_snapshot - name: Upload uses: actions/upload-artifact@v7 with: name: Wish ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot) path: ${{ env.INST_DIR }}/*.tar - name: Describe Installation Zip Contents if: ${{ always() }} run: | unzip -l wish${{ env.TCL_PATCHLEVEL }}_snapshot || true working-directory: ${{ env.INST_DIR }} macos: name: macOS runs-on: macos-15 defaults: run: shell: bash env: CC: gcc CFGOPT: --disable-symbols --disable-shared steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Checkout Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: main path: tcl - name: Checkout create-dmg uses: actions/checkout@v7 with: repository: create-dmg/create-dmg ref: v1.2.2 path: create-dmg - name: Prepare run: | mkdir -p install/contents touch tcl/generic/tclStubInit.c tcl/generic/tclOOStubInit.c || true touch tk/generic/tkStubInit.c || true wget https://github.com/culler/macher/releases/download/v1.8/macher sudo cp macher /usr/local/bin sudo chmod a+x /usr/local/bin/macher echo "INST_DIR=$(cd install;pwd)" >> $GITHUB_ENV echo "VER_PATH=$(cd tcl/tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV echo "CFLAGS=-arch x86_64 -arch arm64" >> $GITHUB_ENV working-directory: "." - name: Configure Tcl run: | ./configure $CFGOPT --prefix=$INST_DIR working-directory: tcl/unix - name: Build & Install Tcl run: | make binaries libraries install make shell SCRIPT="$VER_PATH $GITHUB_ENV" working-directory: tcl/unix - name: Configure Tk run: | ./configure $CFGOPT --with-tcl=$INST_DIR/lib --prefix=$INST_DIR \ --enable-aqua working-directory: tk/unix - name: Build & Install Tk run: | make binaries libraries install working-directory: tk/unix # TODO: need the Tk version separately for distro naming below - name: Package run: | cp ../tk/unix/wish contents/${BUILD_NAME} chmod +x contents/${BUILD_NAME} cat > contents/README.txt <> $GITHUB_ENV echo "VER_PATH=$(cd tcl/tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV working-directory: "." - name: Configure Tcl run: | ./configure $CFGOPT --prefix=$INST_DIR working-directory: tcl/win - name: Build & Install Tcl run: | make binaries libraries install $INST_DIR/bin/tclsh* $VER_PATH $GITHUB_ENV working-directory: tcl/win - name: Configure Tk run: | ./configure $CFGOPT --with-tcl=$INST_DIR/lib --prefix=$INST_DIR working-directory: tk/win - name: Build & Install Tk run: | make all install echo "TK_BIN=`pwd`/`echo wish*.exe`" >> $GITHUB_ENV working-directory: tk/win # TODO: need the Tk version separately for distro naming below - name: Package run: | cp ${TK_BIN} combined/${BUILD_NAME}.exe working-directory: install env: BUILD_NAME: wish${{ env.TCL_PATCHLEVEL }}_snapshot - name: Upload uses: actions/upload-artifact@v7 with: name: Wish ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot) path: install/combined/wish${{ env.TCL_PATCHLEVEL }}_snapshot.exe tk9.1.0/.github/workflows/mac-build.yml0000644003604700454610000001146315255022635016444 0ustar dgp771divname: macOS on: push: branches: - "main" - "core-9-1-branch" tags: - "core-*" permissions: contents: read env: ERROR_ON_FAILURES: 1 jobs: framework: runs-on: macos-26 defaults: run: shell: bash working-directory: tk/macosx steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Check out Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: main path: tcl - name: Prepare checked out repositories run: | touch tk/generic/tkStubInit.c mkdir build echo "BUILD_DIR=`cd build && pwd`" >> $GITHUB_ENV echo "DESTDIR=`cd build && pwd`" >> $GITHUB_ENV working-directory: . - name: Build Tcl run: | make all working-directory: tcl/macosx - name: Build run: | make all install || { echo "::error::Failure during Build" exit 1 } - name: Run Tests run: | make TK_NO_STDERR=1 test | tee out.txt nmatches=$( grep -c "Failed 0" out.txt ) if [ $nmatches -lt 4 ] then echo "::error::Failure during Test" exit 1 fi timeout-minutes: 30 prefix: runs-on: macos-26 strategy: matrix: symbols: - 'no' - 'mem' options: - '--enable-aqua' - '--disable-aqua --disable-bidi' defaults: run: shell: bash working-directory: tk/unix steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Check out Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: main path: tcl - name: Prepare checked out repositories env: SET_DISPLAY: ${{ contains(matrix.options, '--disable-aqua') }} run: | touch tkStubInit.c mkdir "$HOME/install dir" echo "USE_XVFB=$SET_DISPLAY" >> $GITHUB_ENV working-directory: tk/generic - name: Add X11 (if required) if: ${{ env.USE_XVFB == 'true' }} run: | brew install --cask xquartz sudo /opt/X11/libexec/privileged_startx || true working-directory: . - name: Build Tcl run: | ./configure $CFGOPT --disable-zipfs "--prefix=$HOME/install dir" || { cat config.log echo "::error::Failure during Tcl Configure" exit 1 } make all || { echo "::error::Failure during Tcl Build" exit 1 } make install || { echo "::error::Failure during Tcl Install" exit 1 } working-directory: tcl/unix env: CFGOPT: --enable-symbols=${{ matrix.symbols }} - name: Configure (symbols=${{ matrix.symbols }} ${{matrix.options }}) run: | ./configure $CFGOPT --disable-zipfs "--prefix=$HOME/install dir" --disable-xft || { cat config.log echo "::error::Failure during Configure" exit 1 } env: CFGOPT: --enable-symbols=${{ matrix.symbols }} ${{matrix.options }} - name: Build run: | make all tktest || { echo "::error::Failure during Build" exit 1 } - name: Run Tests run: | if [ $USE_XVFB == true ]; then function runXvfb { PATH=$PATH:/opt/X11/bin Xvfb $1 & XVFB_PID=$! echo Launched Xvfb $1 as process $XVFB_PID >&2 trap "echo killing process $XVFB_PID... >&2; kill $XVFB_PID" 0 export DISPLAY=$1 sleep 2 } else function runXvfb { echo Xvfb not used, this is a --enable-aqua build export TK_NO_STDERR=1 } fi ( runXvfb :0; make test-classic; exit $? ) | tee out-classic.txt || { echo "::error::Failure during Test (classic)" exit 1 } ( runXvfb :0; make test-ttk; exit $? ) | tee out-ttk.txt || { echo "::error::Failure during Test (ttk)" exit 1 } 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 } timeout-minutes: 20 - name: Carry out trial installation run: | make install || { cat config.log echo "::error::Failure during Install" exit 1 } tk9.1.0/.github/workflows/linux-with-tcl9-build.yml0000644003604700454610000001000215255022635020651 0ustar dgp771divname: Linux (with Tcl 9.0) on: push: branches: - "main" - "core-9-1-branch" tags: - "core-*" permissions: contents: read defaults: run: shell: bash working-directory: unix env: ERROR_ON_FAILURES: 1 jobs: build: runs-on: ubuntu-26.04 strategy: matrix: compiler: - "gcc" - "clang" config: - "" - "CFLAGS=-DTK_NO_DEPRECATED=1" - "--enable-symbols" steps: - name: Checkout uses: actions/checkout@v7 with: path: "." - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | sudo apt-get update sudo apt-get install xvfb tcl9.0-dev libtommath-dev libx11-dev libxss-dev libxft-dev libicu-dev xfonts-75dpi xfonts-100dpi xfonts-scalable libxfont2 unifont libharfbuzz-dev mkdir "$HOME/install dir" touch doc/man.macros generic/tkStubInit.c echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV echo "CC=$COMPILER" >> $GITHUB_ENV echo "BUILD_CONFIG_ID=$OPTS" >> $GITHUB_ENV working-directory: "." env: CFGOPT: ${{ matrix.config }} COMPILER: ${{ matrix.compiler }} OPTS: ${{ matrix.compiler }}${{ matrix.config }} - name: Configure (opts=${{ matrix.config }}) run: | ./configure $CFGOPT --with-tcl=/usr/lib/tcl9.0 "--prefix=$HOME/install dir" || { cat config.log echo "::error::Failure during Configure" exit 1 } - name: Build run: | make binaries libraries || { echo "::error::Failure during Build" exit 1 } - name: Build Test Harness run: | make tktest || { echo "::error::Failure during Build" exit 1 } - name: Test-Drive Installation run: | make install || { echo "::error::Failure during Install" exit 1 } - name: Create Distribution Package run: | make dist || { echo "::error::Failure during Distribute" exit 1 } test: runs-on: ubuntu-26.04 strategy: matrix: compiler: - "gcc" config: - "" - "--enable-symbols" steps: - name: Checkout uses: actions/checkout@v7 with: path: "." - name: Checkout Tcl 9.0 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: core-9-0-branch path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | sudo apt-get update sudo apt-get install tcl9.0-dev libtommath-dev xvfb libx11-dev libxss-dev libxft-dev libicu-dev xfonts-75dpi xfonts-100dpi xfonts-scalable libxfont2 unifont libharfbuzz-dev mkdir "$HOME/install dir" touch doc/man.macros generic/tkStubInit.c echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV echo "CC=$COMPILER" >> $GITHUB_ENV working-directory: "." env: CFGOPT: ${{ matrix.config }} COMPILER: ${{ matrix.compiler }} - name: Configure ${{ matrix.config }} run: | ./configure $CFGOPT --with-tcl=/usr/lib/tcl9.0 "--prefix=$HOME/install dir" || { cat config.log echo "::error::Failure during Configure" exit 1 } - name: Build run: | make binaries libraries tktest || { echo "::error::Failure during Build" exit 1 } - name: Run Tests run: | xvfb-run --auto-servernum make test-classic | tee out-classic.txt xvfb-run --auto-servernum make test-ttk | tee out-ttk.txt grep -q "Failed 0" out-classic.txt || { echo "::error::Failure during Test" exit 1 } grep -q "Failed 0" out-ttk.txt || { echo "::error::Failure during Test" exit 1 } timeout-minutes: 15 tk9.1.0/.github/workflows/linux-build.yml0000644003604700454610000001370615255022635017045 0ustar dgp771divname: Linux on: push: branches: - "main" - "core-9-1-branch" tags: - "core-*" permissions: contents: read defaults: run: shell: bash working-directory: tk/unix env: ERROR_ON_FAILURES: 1 jobs: build: runs-on: ubuntu-26.04 strategy: matrix: compiler: - "gcc" - "clang" config: - "" - "CFLAGS=-DTK_NO_DEPRECATED=1" - "--disable-shared" - "--enable-symbols" steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Checkout Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: main path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | sudo apt-get update sudo apt-get install libtommath-dev libxss-dev libxft-dev libcups2-dev libatk1.0-dev libatk-bridge2.0-dev libharfbuzz-dev mkdir "$HOME/install dir" touch tk/doc/man.macros tk/generic/tkStubInit.c echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV echo "CC=$COMPILER" >> $GITHUB_ENV echo "TOOL_DIR=$(cd tcl/tools;pwd)" >> $GITHUB_ENV echo "BUILD_CONFIG_ID=$OPTS" >> $GITHUB_ENV working-directory: "." env: CFGOPT: ${{ matrix.config }} COMPILER: ${{ matrix.compiler }} OPTS: ${{ matrix.compiler }}${{ matrix.config }} - name: Configure and Build Tcl run: | ./configure $CFGOPT "--prefix=$HOME/install dir" || { cat config.log echo "::warning::Failure during Tcl Configure" exit 1 } make all install || { echo "::warning::Failure during Tcl Build" exit 1 } echo "TCL_CONFIG_PATH=`pwd`" >> $GITHUB_ENV working-directory: tcl/unix - name: Configure (opts=${{ matrix.config }}) run: | ./configure $CFGOPT --with-tcl=$TCL_CONFIG_PATH "--prefix=$HOME/install dir" || { cat config.log echo "::error::Failure during Configure" exit 1 } - name: Build run: | make binaries libraries || { echo "::error::Failure during Build" exit 1 } - name: Build Test Harness run: | make tktest || { echo "::error::Failure during Build" exit 1 } - name: Test-Drive Installation run: | make install || { echo "::error::Failure during Install" exit 1 } - name: Create Distribution Package run: | make dist || { echo "::error::Failure during Distribute" exit 1 } - name: Convert Documentation to HTML run: | make html-tk TOOL_DIR=$TOOL_DIR || { echo "::error::Failure during Distribute" exit 1 } - name: Discover Version ID if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} run: | cd /tmp/dist echo "VERSION=`ls -d tk* | sed 's/tk//'`" >> $GITHUB_ENV - name: Upload Source Distribution if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} uses: actions/upload-artifact@v7 with: name: Tk ${{ env.VERSION }} Source distribution (snapshot) path: | /tmp/dist/tk* !/tmp/dist/tk*/html/** - name: Upload Documentation Distribution if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} uses: actions/upload-artifact@v7 with: name: Tk ${{ env.VERSION }} HTML documentation (snapshot) path: /tmp/dist/tk*/html test: runs-on: ubuntu-26.04 strategy: matrix: compiler: - "gcc" config: - "" - "--enable-symbols" steps: - name: Checkout Tk uses: actions/checkout@v7 with: path: tk - name: Checkout Tcl 9.1 uses: actions/checkout@v7 with: repository: tcltk/tcl ref: main path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | sudo apt-get update sudo apt-get install libtommath-dev libxss-dev libxft-dev libcups2-dev xvfb libicu-dev xfonts-75dpi xfonts-100dpi xfonts-scalable libxfont2 unifont libharfbuzz-dev mkdir "$HOME/install dir" touch tk/doc/man.macros tk/generic/tkStubInit.c echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV echo "CC=$COMPILER" >> $GITHUB_ENV working-directory: "." env: CFGOPT: ${{ matrix.config }} COMPILER: ${{ matrix.compiler }} - name: Configure and Build Tcl run: | ./configure $CFGOPT "--prefix=$HOME/install dir" || { cat config.log echo "::warning::Failure during Tcl Configure" exit 1 } make all install || { echo "::warning::Failure during Tcl Build" exit 1 } echo "TCL_CONFIG_PATH=`pwd`" >> $GITHUB_ENV working-directory: tcl/unix - name: Configure ${{ matrix.config }} run: | ./configure $CFGOPT --with-tcl=$TCL_CONFIG_PATH "--prefix=$HOME/install dir" || { cat config.log echo "::error::Failure during Configure" exit 1 } - name: Build run: | make binaries libraries tktest || { echo "::error::Failure during Build" exit 1 } - name: Run Tests run: | xvfb-run --auto-servernum make test-classic | tee out-classic.txt xvfb-run --auto-servernum make test-ttk | tee out-ttk.txt grep -q "Failed 0" out-classic.txt || { echo "::error::Failure during Test" exit 1 } grep -q "Failed 0" out-ttk.txt || { echo "::error::Failure during Test" exit 1 } timeout-minutes: 10 tk9.1.0/tests/0000755003604700454610000000000015256474664011642 5ustar dgp771divtk9.1.0/tests/ttk/0000755003604700454610000000000015256474664012444 5ustar dgp771divtk9.1.0/tests/ttk/all.tcl0000644003604700454610000000342415255022635013705 0ustar dgp771div# all.tcl -- # # This file contains a top-level script to run all of the ttk # tests. Execute it by invoking "source all.tcl" when running tktest # in this directory. # # Copyright © 2007 the Tk developers. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # REQUIREMENTS # package require tk ;# This is the Tk test suite; fail early if no Tk! package require tcltest 2.2 # # TCLTEST CONFIGURATION # # Set defaults for the Tk test suite tcltest::configure -singleproc 1 # Handle command line parameters if {[llength $argv] & 1} { puts stderr "error: the number of command line parameters must be even (name - value pairs)." exit 1 } set ignoredOptions [list -testdir] set ignoredIndices [list ] set index 0 foreach {key value} $argv { if {$key in $ignoredOptions} { lappend ignoredIndices $index puts stderr "warning: the Tk test suite ignores the option \"$key\" on the command line." } incr index 2 } set tcltestOptions $argv foreach index [lreverse $ignoredIndices] { set tcltestOptions [lreplace $tcltestOptions $index [expr {$index + 1}]] } tcltest::configure {*}$tcltestOptions unset ignoredIndices ignoredOptions index tcltestOptions # Set tcltest options that are not user-configurable for the Tk test suite tcltest::configure -testdir [file normalize [file dirname [info script]]] # Determine test files to skip set skipFiles [tcltest::configure -notfile] if {"vista" ni [ttk::style theme names]} { lappend skipFiles vsapi.test tcltest::configure -notfile [lsort -unique $skipFiles] } unset skipFiles # # RUN ALL TESTS # # Note: the environment variable ERROR_ON_FAILURES is set by Github CI if {[tcltest::runAllTests] && [info exists env(ERROR_ON_FAILURES)]} { exit 1 } tk9.1.0/tests/ttk/vsapi.test0000644003604700454610000000424615255022635014457 0ustar dgp771div# # Tests exercising Microsoft Visual Styles elements, defined through # the command "ttk::style element create XXX vsapi" # # # TESTFILE INITIALIZATION # package require tcltest 2.2; # needed in mode -singleproc 0 # Load the main script main.tcl, which takes care of: # - setup for the application and the root window # - importing commands from the tcltest namespace # - loading of the testutils mechanism along with its utility procs # - loading of Tk specific test constraints (additionally to constraints # provided by the package tcltest) source [file join [file dirname [tcltest::configure -testdir]] main.tcl] # Ensure a pristine initial window state resetWindows # # LOCAL TEST CONSTRAINTS # testConstraint vista \ [expr {"vista" in [ttk::style theme names]}] # # TESTS # test vsapi-1.1 "WINDOW WP_SMALLCLOSEBUTTON" -constraints vista -body { ttk::style element create smallclose vsapi \ WINDOW 19 {disabled 4 pressed 3 active 2 {} 1} ttk::style layout CloseButton {CloseButton.smallclose -sticky news} ttk::button .b -style CloseButton pack .b -expand true -fill both list [winfo reqwidth .b] [winfo reqheight .b] } -cleanup { destroy .b } -result [list 13 13] test vsapi-1.2 "EXPLORERBAR EBP_HEADERPIN" -constraints vista -body { ttk::style element create pin vsapi \ EXPLORERBAR 3 { {pressed !selected} 3 {active !selected} 2 {pressed selected} 6 {active selected} 5 {selected} 4 {} 1 } ttk::style layout Explorer.Pin {Explorer.Pin.pin -sticky news} ttk::checkbutton .pin -style Explorer.Pin pack .pin -expand true -fill both list [winfo reqwidth .pin] [winfo reqheight .pin] } -cleanup { destroy .pin } -result [list 16 16] test vsapi-1.3 "EXPLORERBAR EBP_HEADERCLOSE" -constraints vista -body { ttk::style element create headerclose vsapi \ EXPLORERBAR 2 {pressed 3 active 2 {} 1} ttk::style layout Explorer.CloseButton { Explorer.CloseButton.headerclose -sticky news } ttk::button .b -style Explorer.CloseButton pack .b -expand true -fill both list [winfo reqwidth .b] [winfo reqheight .b] } -cleanup { destroy .b } -result [list 16 16] # # TESTFILE CLEANUP # tcltest::cleanupTests tk9.1.0/tests/ttk/validate.test0000644003604700454610000002244215255022635015124 0ustar dgp771div# # Entry widget validation tests # Derived from core test suite entry-19.1 through entry-19.20 # # NOTES # # * Many tests in this test file build upon a previous one. This occurs # systematically for groups of contiguous tests sharing the same major # test number. All test files for ttk widgets exhibit this practice. # # As a consequence, attempts to run tests selectively/individually using the # tcltest options "-match", "-skip" or "-limitconstraints 1" lead to # unexpected failures. Therefore, invocations using these options should be # considered as "de facto invalid" for the ttk test suite. # # As an exception, using "-match" or "-skip" to select or deselect entire # groups of contiguous tests does not seem to raise problems. # # # TESTFILE INITIALIZATION # package require tcltest 2.2; # needed in mode -singleproc 0 # Load the main script main.tcl, which takes care of: # - setup for the application and the root window # - importing commands from the tcltest namespace # - loading of the testutils mechanism along with its utility procs # - loading of Tk specific test constraints (additionally to constraints # provided by the package tcltest) source [file join [file dirname [tcltest::configure -testdir]] main.tcl] # Ensure a pristine initial window state resetWindows # Import utility procs for specific functional areas testutils import entry # # LOCAL TEST CONSTRAINTS # testConstraint ttkEntry 1 testConstraint coreEntry [expr {![testConstraint ttkEntry]}] testConstraint NA 0 # # COMMON TEST SETUP # foreach i {1 2 3 4} { set validateCmd$i [list validateCommand$i %W %d %i %P %s %S %v %V] } # # TESTS # test validate-0.0 "Setup" -constraints ttkEntry -body { rename entry {} interp alias {} entry {} ttk::entry return; } test validate-0.1 "More setup" -body { destroy .e catch {unset textVar} unset -nocomplain validationData; # not necessary entry .e -validate all \ -validatecommand $validateCmd1 \ -invalidcommand bell \ -textvariable textVar \ ; pack .e } test validate-1.1 {entry widget validation - insert} -body { .e insert 0 a set validationData } -result {.e 1 0 a {} a all key} test validate-1.2 {entry widget validation - insert} -body { .e insert 1 b set validationData } -result {.e 1 1 ab a b all key} test validate-1.3 {entry widget validation - insert} -body { .e insert end c set validationData } -result {.e 1 2 abc ab c all key} test validate-1.4 {entry widget validation - insert} -body { .e insert 1 123 list $validationData $textVar } -result {{.e 1 1 a123bc abc 123 all key} a123bc} test validate-1.5 {entry widget validation - delete} -body { .e delete 2 set validationData } -result {.e 0 2 a13bc a123bc 2 all key} test validate-1.6 {entry widget validation - delete} -body { .e configure -validate key .e delete 1 3 set validationData } -result {.e 0 1 abc a13bc 13 key key} test validate-1.7 {entry widget validation - vmode focus} -body { set validationData {} .e configure -validate focus .e insert end d set validationData } -result {} test validate-1.8 {entry widget validation - vmode focus} -body { set validationData {} set timer [after 300 validationData lappend timeout] focus -force .e vwait validationData after cancel $timer set validationData } -result {.e -1 -1 abcd abcd {} focus focusin} test validate-1.9 {entry widget validation - vmode focus} -body { set validationData {} set timer [after 300 validationData lappend timeout] focus -force . vwait validationData after cancel $timer set validationData } -result {.e -1 -1 abcd abcd {} focus focusout} # # COMMON TEST SETUP # .e configure -validate all test validate-1.10 {entry widget validation - vmode all} -body { set validationData {} set timer [after 300 validationData lappend timeout] focus -force .e vwait validationData after cancel $timer set validationData } -result {.e -1 -1 abcd abcd {} all focusin} test validate-1.11 {entry widget validation} -body { set validationData {} set timer [after 300 validationData lappend timeout] focus -force . vwait validationData after cancel $timer set validationData } -result {.e -1 -1 abcd abcd {} all focusout} # # COMMON TEST SETUP # .e configure -validate focusin test validate-1.12 {entry widget validation} -body { set validationData {} set timer [after 300 validationData lappend timeout] focus -force .e vwait validationData after cancel $timer set validationData } -result {.e -1 -1 abcd abcd {} focusin focusin} test validate-1.13 {entry widget validation} -body { set validationData {} focus -force . update set validationData } -result {} # # COMMON TEST SETUP # .e configure -validate focuso test validate-1.14 {entry widget validation} -body { set validationData {} focus -force .e update set validationData } -result {} test validate-1.15 {entry widget validation} -body { focus -force . # update necessary to process FocusOut event update set validationData } -result {.e -1 -1 abcd abcd {} focusout focusout} # DIFFERENCE: core entry temporarily sets "-validate all", ttk::entry doesn't. test validate-1.16 {entry widget validation} -body { .e configure -validate all list [.e validate] $validationData } -result {1 {.e -1 -1 abcd abcd {} all forced}} # DIFFERENCE: ttk::entry does not perform validation when setting the -variable test validate-1.17 {entry widget validation} -constraints coreEntry -body { .e configure -validate all set textVar newdata list [.e cget -validate] $validationData } -result {all {.e -1 -1 newdata abcd {} all forced}} test validate-1.18 {entry widget validation} -constraints coreEntry -body { .e configure -validate all -validatecommand $validateCmd3 set textVar nextdata list [.e cget -validate] $validationData } -result {none {.e -1 -1 nextdata newdata {} all forced}} # DIFFERENCE: ttk::entry doesn't validate when setting linked -variable # DIFFERENCE: ttk::entry doesn't disable validation ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the entry textvar is also set test validate-1.19 {entry widget validation} -constraints coreEntry -body { .e configure -validate all -validatecommand $validateCmd2 .e validate list [.e cget -validate] [.e get] $validationData } -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}} ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the entry widget shown as is in the textvar. # DIFFERENCE: ttk entry doesn't get out of sync w/textvar test validate-1.20 {entry widget validation} -constraints coreEntry -body { .e configure -validate all -validatecommand $validateCmd2 set textVar testdata list [.e cget -validate] [.e get] $textVar $validationData } -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} test validate-2.1 "Validation script changes value" -body { .e configure -validate none -validatecommand $validateCmd4 set textVar testdata .e configure -validate all .e validate list [.e get] $textVar $validationData } -result {dovaldata dovaldata {.e -1 -1 testdata testdata {} all forced}} # DIFFERENCE: core entry disables validation, ttk entry does not. # # COMMON TEST CLEANUP # destroy .e catch {unset textVar} # See bug #1236979 test validate-2.2 "configure in -validatecommand" -body { proc validate-2.2 {win str} { $win configure -foreground black return 1 } ttk::entry .e -textvariable var -validatecommand {validate-2.2 %W %P} .e validate } -result 1 -cleanup { destroy .e } ### invalid state behavior # test validate-3.0 "Setup" -body { set ::E "123" ttk::entry .e \ -validatecommand {string is integer -strict %P} \ -validate all \ -textvariable ::E \ ; return [list [.e get] [.e state]] } -result [list 123 {}] test validate-3.1 "insert - valid" -body { .e insert end "4" return [list [.e get] [.e state]] } -result [list 1234 {}] test validate-3.2 "insert - invalid" -body { .e insert end "X" return [list [.e get] [.e state]] } -result [list 1234 {}] test validate-3.3 "force invalid value" -body { append ::E "XY" return [list [.e get] [.e state]] } -result [list 1234XY {}] test validate-3.4 "revalidate" -body { return [list [.e validate] [.e get] [.e state]] } -result [list 0 1234XY {invalid}] # the next two tests (used to) exercise validation lockout protection -- # if the widget is currently invalid, all edits are allowed. # This behavior is currently disabled. # test validate-3.5 "all edits allowed while invalid" -constraints NA -body { .e delete 4 return [list [.e get] [.e state]] } -result [list 1234Y {invalid}] test validate-3.6 "...until the value becomes valid" -constraints NA -body { .e delete 4 return [list [.e get] [.e state]] } -result [list 1234 {}] test validate-3.last "Cleanup" -body { destroy .e } # # TESTFILE CLEANUP # foreach i {1 2 3 4} { unset validateCmd$i } unset i testutils forget entry tcltest::cleanupTests tk9.1.0/tests/ttk/ttk.test0000644003604700454610000005401515255022635014136 0ustar dgp771div# # Diverse tests for ttk # # NOTES # # * Many tests in this test file build upon a previous one. This occurs # systematically for groups of contiguous tests sharing the same major # test number. All test files for ttk widgets exhibit this practice. # # As a consequence, attempts to run tests selectively/individually using the # tcltest options "-match", "-skip" or "-limitconstraints 1" lead to # unexpected failures. Therefore, invocations using these options should be # considered as "de facto invalid" for the ttk test suite. # # As an exception, using "-match" or "-skip" to select or deselect entire # groups of contiguous tests does not seem to raise problems. # # # TESTFILE INITIALIZATION # package require tcltest 2.2; # needed in mode -singleproc 0 # Load the main script main.tcl, which takes care of: # - setup for the application and the root window # - importing commands from the tcltest namespace # - loading of the testutils mechanism along with its utility procs # - loading of Tk specific test constraints (additionally to constraints # provided by the package tcltest) source [file join [file dirname [tcltest::configure -testdir]] main.tcl] # Ensure a pristine initial window state resetWindows # # LOCAL UTILITY PROCS # proc bgerror {error} { variable bgerror $error variable bgerrorInfo $::errorInfo variable bgerrorCode $::errorCode } # Tests using this will fail if the top-level window contains the cursor proc checkstate {w} { foreach statespec { {!active !disabled} {!active disabled} {active !disabled} {active disabled} active disabled } { lappend result [$w instate $statespec] } set result } proc selfdestruct {w args} { destroy $w } proc wrong#args {args} { return "wrong # args: should be \"$args\"" } proc wrong#varargs {varpart args} { set usage $args append usage " ?$varpart ...?" return "wrong # args: should be \"$usage\"" } # # COMMON TEST SETUP # variable widgetClasses { button checkbutton radiobutton menubutton label entry frame labelframe scrollbar notebook progressbar combobox separator panedwindow treeview sizegrip scale } # # TESTS # # # Self-destruct tests. # Do these early, so any memory corruption has a longer time to cause a crash. # test ttk-6.1 "Self-destructing checkbutton" -body { pack [ttk::checkbutton .sd -text "Self-destruction" -variable ::sd] trace add variable sd write [list selfdestruct .sd] update .sd invoke } -returnCodes error test ttk-6.2 "Checkbutton self-destructed" -body { winfo exists .sd } -result 0 # test ttk-6.3 not applicable [see #2175411] test ttk-6.4 "Destroy widget in configure" -setup { set OUCH ouch trace add variable OUCH read { kill.b } proc kill.b {args} { destroy .b } } -cleanup { unset OUCH } -body { pack [ttk::checkbutton .b] set rc [catch { .b configure -variable OUCH } msg] list $rc $msg [winfo exists .b] [info commands .b] } -result [list 1 "widget has been destroyed" 0 {}] test ttk-6.5 "Clean up -textvariable traces" -body { foreach class {ttk::button ttk::checkbutton ttk::radiobutton} { $class .b1 -textvariable V set V "asdf" destroy .b1 set V "" } } test ttk-6.6 "Bad color spec in styles" -body { pack [ttk::button .b1 -text Hi!] ttk::style configure TButton -foreground badColor event generate .b1 update ttk::style configure TButton -foreground black destroy .b1 set ::bgerror } -result {unknown color name "badColor"} test ttk-6.7 "Basic destruction test" -body { foreach widget $widgetClasses { ttk::$widget .w pack .w destroy .w } } test ttk-6.8 "Button command removes itself" -body { ttk::button .b -command ".b configure -command {}; set ::A {it worked}" .b invoke destroy .b set ::A } -result {it worked} test ttk-6.9 "Bad font spec in styles" -setup { ttk::style theme create badfont -settings { ttk::style configure . -font {Helvetica 12 Bogus} } ttk::style theme use badfont } -cleanup { ttk::style theme use default } -body { pack [ttk::label .l -text Hi! -font {}] event generate .l update destroy .l set ::bgerror } -result {unknown font style "Bogus"} test ttk-construction-failure-1 "Excercise construction failure path" -setup { option add *TLabel.cursor badCursor 1 } -cleanup { option add *TLabel.cursor {} 1 } -body { catch {ttk::label .l} errmsg list $errmsg [info commands .l] [winfo exists .l] } -result [list {bad cursor spec "badCursor"} {} 0] test ttk-construction-failure-2 "Destroy widget in constructor" -setup { set OUCH ouch trace add variable OUCH read { kill.b } proc kill.b {args} { destroy .b } } -cleanup { unset OUCH } -body { list \ [catch { ttk::checkbutton .b -variable OUCH } msg] \ $msg \ [winfo exists .b] \ [info commands .b] \ ; } -result [list 1 "widget has been destroyed" 0 {}] test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body { # see #2298720 toplevel .t ttk::button .t.b -command [list destroy .t] .t.b invoke list [winfo exists .t] [winfo exists .t.b] } -result [list 0 0] # # Basic tests. # test ttk-1.1 "Create multiline button showing justified text" -body { wm geometry . +100+100 event generate . -warp 1 -x 600 -y 600 pack [ttk::button .t -text "Hello\nWorld!!" -justify center] -expand true -fill both update } test ttk-1.2 "Check style" -body { .t cget -style } -result {} test ttk-1.3 "Set bad style" -body { .t configure -style "nosuchstyle" } -returnCodes error -result {Layout nosuchstyle not found} test ttk-1.4 "Original style preserved" -body { .t cget -style } -result "" test ttk-2.0 "Check state" -body { checkstate .t } -result [list 1 0 0 0 0 0] test ttk-2.1 "Change state" -body { .t state active } -result !active test ttk-2.2 "Check state again" -body { checkstate .t } -result [list 0 0 1 0 1 0] test ttk-2.3 "Change state again" -body { .t state {!active disabled} } -result {active !disabled} test ttk-2.4 "Check state again" -body { checkstate .t } -result [list 0 1 0 0 0 1] test ttk-2.5 "Change state again" -body { .t state !disabled } -result {disabled} test ttk-2.6 "instate scripts, false" -body { set x 0 .t instate disabled { set x 1 } set x } -result 0 test ttk-2.7 "instate scripts, true" -body { set x 0 .t instate !disabled { set x 1 } set x } -result 1 test ttk-2.8 {Bug [3223850]: Button remains stuck when disabled as depressed on XP} -setup { destroy .b set ttk28 {} pack [ttk::button .b -command {set ::ttk28 failed}] update } -body { bind .b {after 0 {.b configure -state disabled}} after 1 {event generate .b } after 50 {event generate .b } set aid [after 100 {set ::ttk28 [.b instate {disabled !pressed}]}] vwait ::ttk28 after cancel $aid set ttk28 } -cleanup { destroy .b unset -nocomplain ttk28 aid } -result 1 test ttk-2.9 {Bug [7231bf99]: Setting ttk state may change the variable passed by value} -body { pack [ttk::button .b1 -text Hi!] set state [list invalid disabled] .b1 state $state set state } -cleanup { unset state destroy .b1 } -result [list invalid disabled] foreach wc $widgetClasses { test ttk-coreoptions-$wc "$wc has all core options" -body { ttk::$wc .w foreach option {-class -style -cursor -takefocus} { .w cget $option } } -cleanup { catch {destroy .w} } } # misc. error detection test ttk-3.0 "Bad option" -body { ttk::button .bad -badoption foo } -returnCodes error -result {unknown option "-badoption"} -match glob test ttk-3.1 "Make sure widget command not created" -body { .bad state disabled } -returnCodes error -result {invalid command name ".bad"} -match glob test ttk-3.2 "Propagate errors from variable traces" -body { set A 0 trace add variable A write {error "failure" ;# } ttk::checkbutton .cb -variable A .cb invoke } -cleanup { unset ::A ; destroy .cb } -returnCodes error -result {can't set "A": failure} test ttk-3.3 "Constructor failure with cursor" -body { ttk::button .b -cursor bottom_right_corner -style BadStyle } -returnCodes error -result "Layout BadStyle not found" test ttk-3.4 {Bug [2009213]: Segfault after setting bad -sliderrelief and packing scale} -body { ttk::style configure TScale -sliderrelief {} pack [ttk::scale .s] update } -cleanup { ttk::style configure TScale -sliderrelief raised destroy .s } # Test resource allocation # (@@@ "-font" is a compatibility option now, so tests 4.1-4.3 # don't really test anything useful at the moment.) # test ttk-4.0 "Setup" -body { catch { destroy .t } pack [ttk::label .t -text "Button 1"] testConstraint fontOption [expr {![catch { set prevFont [.t cget -font] }]}] return -code ok } test ttk-4.1 "Change font" -constraints fontOption -body { .t configure -font "Helvetica 18 bold" } test ttk-4.2 "Check font" -constraints fontOption -body { .t cget -font } -result "Helvetica 18 bold" test ttk-4.3 "Restore font" -constraints fontOption -body { .t configure -font $prevFont } test ttk-4.4 "Bad resource specifications" -body { ttk::style theme settings alt { ttk::style configure TButton -font {Bad font} # @@@ it would be best to raise an error at this point, # @@@ but that's not really feasible in the current framework. } pack [ttk::button .tb1 -text "Ouch"] ttk::style theme use alt update; # As long as we haven't crashed, everything's OK ttk::style theme settings alt { ttk::style configure TButton -font TkDefaultFont } ttk::style theme use default destroy .tb1 } # # COMMON TEST SETUP # # For tests ttk-8.* # # # -compound tests: # variable iconData \ {R0lGODlhIAAgAKIAANnZ2YQAAP8AAISEhP///////////////yH5BAEAAAAALAAAAAAgACAA AAP/CLoMGLqKoMvtGIqiqxEYCLrcioGiyxwIusyBgaLLLRiBoMsQKLrcjYGgu4Giy+2CAkFX A0WX2wXFIOgGii7trkCEohsDCACBoktEKLpKhISiGwAIECiqSKooukiqKKoxgACBooukKiIo SKooujGDECi6iqQqsopEV2MQAkV3kXQZRXdjEAJFl5F0FUWXY3ACRZcFSRdFlyVwJlB0WZB0 UXRZAmcCRZeRdBVFl2NwAkV3kXQZRXdjcAJFV5FURVaR6GoMDgSKLpKqiKAgqaLoxgwOBIoq kiqKLpIqimrM4ECg6BIRiq4SIaHoxgyCBoou7a5AhKIbMzgAAIGiy+2CTWJmBhAAAkWX2wXF zCDoBooud2PMDIKuRqDocgtGzMwg6O4Eii5z4Kgi6DIMhqLoagQGjiqCLvPgYOgqji6CLrfi 6DIj6HI7jq4i6DIkADs=} variable compoundStrings {text image center top bottom left right none} test ttk-8.0 "Setup for 8.X" -body { ttk::button .ctb image create photo icon -data $::iconData; pack .ctb } test ttk-8.1 "Test -compound options" -body { # Exhaustively test each combination. # Main goal is to make sure no code paths crash. foreach image {icon ""} { foreach text {"Hi!" ""} { foreach compound $::compoundStrings { .ctb configure -image $image -text $text -compound $compound update } } } } test ttk-8.2 "Test -compound options with regular button" -body { button .rtb pack .rtb foreach image {"" icon} { foreach text {"Hi!" ""} { foreach compound [lrange $::compoundStrings 2 end] { .rtb configure -image $image -text $text -compound $compound update } } } } test ttk-8.3 "Rerun test 8.1" -body { foreach image {icon ""} { foreach text {"Hi!" ""} { foreach compound $::compoundStrings { .ctb configure -image $image -text $text -compound $compound update } } } } test ttk-8.4 "ImageChanged" -body { ttk::button .b -image icon icon blank } -cleanup { destroy .b } test ttk-9.1 "Traces on nonexistant namespaces" -body { ttk::checkbutton .tcb -variable foo::bar } -returnCodes error -result {can't trace "foo::bar": parent namespace doesn't exist} test ttk-9.2 "Traces on nonexistant namespaces II" -body { ttk::checkbutton .tcb -variable X .tcb configure -variable foo::bar } -returnCodes error -result {can't trace "foo::bar": parent namespace doesn't exist} test ttk-9.3 "Restore saved options on configure error" -body { .tcb cget -variable } -result X test ttk-9.4 "Textvariable tests" -body { set tcbLabel "Testing..." .tcb configure -textvariable tcbLabel .tcb cget -text } -result "Testing..." # Changing -text has no effect if there is a linked -textvariable. # Compatible with core widget. test ttk-9.5 "Change -text" -body { .tcb configure -text "Changed -text" .tcb cget -text } -result "Testing..." # Unset -textvariable clears the text. # NOTE: this is different from core widgets, which automagically reinitalize # the -textvariable to the last value of -text. # test ttk-9.6 "Unset -textvariable" -body { unset tcbLabel list [info exists tcbLabel] [.tcb cget -text] } -result [list 0 ""] test ttk-9.7 "Unset textvariable, comparison" -body { # # NB: ttk::label behaves differently from the standard label here; # NB: this is on purpose: I believe the standard behaviour is the Wrong Thing # unset -nocomplain V1 V2 label .l -text Foo ; ttk::label .tl -text Foo .l configure -textvariable V1 ; .tl configure -textvariable V2 list [set V1] [info exists V2] } -cleanup { destroy .l .tl } -result [list Foo 0] test ttk-9.8 "-textvariable overrides -text" -body { ttk::label .tl -textvariable TV set TV Foo .tl configure -text Bar .tl cget -text } -cleanup { destroy .tl } -result "Foo" test ttk-9.9 "default for -justify" -body { ttk::label .tl .tl cget -justify } -cleanup { destroy .tl } -result "" test ttk-9.10 "default for -anchor" -body { ttk::label .tl .tl cget -anchor } -cleanup { destroy .tl } -result "" # # Frame widget tests: # test ttk-10.1 "ttk::frame -class resource" -body { ttk::frame .f -class Foo } -result .f test ttk-10.2 "Check widget class" -body { winfo class .f } -result Foo test ttk-10.3 "Check class resource" -body { .f cget -class } -result Foo test ttk-10.4 "Try to modify class resource" -body { .f configure -class Bar } -returnCodes error -match glob -result "*read-only option*" test ttk-10.5 "Check class resource again" -body { .f cget -class } -result Foo test ttk-11.1 "-state test, setup" -body { ttk::button .b .b instate disabled } -result 0 test ttk-11.2 "-state test, disable" -body { .b configure -state disabled .b instate disabled } -result 1 test ttk-11.3 "-state test, reenable" -body { .b configure -state normal .b instate disabled } -result 0 test ttk-11.4 "-state test, unrecognized -state value" -body { .b configure -state bogus .b state } -result [list] test ttk-11.5 "-state test, 'active'" -body { .b configure -state active .b state } -result [list active] -cleanup { .b state !active } test ttk-11.6 "-state test, 'readonly'" -body { .b configure -state readonly .b state } -result [list readonly] -cleanup { .b state !readonly } test ttk-11.7 "-state test, cleanup" -body { destroy .b } test ttk-12.1 "-cursor option" -body { ttk::button .b .b cget -cursor } -result {} test ttk-12.2 "-cursor option" -body { .b configure -cursor arrow .b cget -cursor } -result arrow test ttk-12.2.1 "-cursor option, widget doesn't overwrite it" -setup { ttk::treeview .tr pack .tr update } -body { .tr configure -cursor X_cursor event generate .tr update .tr cget -cursor } -cleanup { destroy .tr } -result {X_cursor} test ttk-12.3 "-borderwidth frame option" -body { destroy .t toplevel .t raise .t pack [set t [ttk::frame .t.f]] -expand true -fill x ; pack [ttk::label $t.l -text "ASDF QWERTY"] -expand true -fill both foreach theme {default alt} { ttk::style theme use $theme foreach relief {flat raised sunken ridge groove solid} { $t configure -relief $relief for {set i 5} {$i >= 0} {incr i -1} { $t configure -borderwidth $i update } } } } test ttk-12.4 "-borderwidth frame option" -body { .t.f configure -relief raised .t.f configure -borderwidth 1 ttk::style theme use alt update } test ttk-13.1 "Custom styles -- bad -style option" -body { ttk::button .tb1 -style badstyle } -returnCodes error -result "*badstyle not found*" -match glob test ttk-13.4 "Custom styles -- bad -style option" -body { ttk::button .tb1 .tb1 configure -style badstyle } -cleanup { destroy .tb1 } -returnCodes error -result "*badstyle not found*" -match glob test ttk-13.5 "Custom layouts -- missing element definition" -body { ttk::style layout badstyle { NoSuchElement } ttk::button .tb1 -style badstyle } -cleanup { destroy .tb1 } -result .tb1 # @@@ Should: signal an error, possibly a background error. # # See #793909 # test ttk-14.1 "-variable in nonexistant namespace" -body { ttk::checkbutton .tw -variable ::nsn::foo } -returnCodes error -result {can't trace *: parent namespace doesn't exist} \ -match glob -cleanup { destroy .tw } test ttk-14.2 "-textvariable in nonexistant namespace" -body { ttk::label .tw -textvariable ::nsn::foo } -returnCodes error -result {can't trace *: parent namespace doesn't exist} \ -match glob -cleanup { destroy .tw } test ttk-14.3 "-textvariable in nonexistant namespace" -body { ttk::entry .tw -textvariable ::nsn::foo } -returnCodes error -result {can't trace *: parent namespace doesn't exist} \ -match glob -cleanup { destroy .tw } test ttk-15.1 {Tcl bug [3062331]: segfault in variable traces with ttk::* widgets} -setup { destroy .b } -body { set Y {} ttk::button .b -textvariable Y trace add variable Y unset "destroy .b; #" unset Y } -cleanup { destroy .b } -result {} test ttk-15.2 {Bug [3341056]: Usage of recreated ttk::checkbutton causes crash} -setup { proc foo {} { destroy .lf ttk::labelframe .lf ttk::checkbutton .lf.cb -text xxx } } -body { ttk::button .b -text xxx -command foo .b invoke .b invoke .lf.cb invoke destroy .b } -cleanup { rename foo {} destroy .lf } -result {} ## Test ensemble processing: # # (See also: SF#2021443) # test ttk-ensemble-0 "style element create: insufficient args" -body { ttk::style } -returnCodes error -result \ [wrong#varargs arg ttk::style option] test ttk-ensemble-1 "style element create: insufficient args" -body { ttk::style element } -returnCodes error -result \ [wrong#varargs arg ttk::style element option] test ttk-ensemble-2 "style element create: insufficient args" -body { ttk::style element create } -returnCodes error -result \ [wrong#varargs {-option value} ttk::style element create name type] test ttk-ensemble-3 "style element create: insufficient args" -body { ttk::style element create plain.background } -returnCodes error -result \ [wrong#varargs {-option value} ttk::style element create name type] test ttk-ensemble-4 "style element create: insufficient args" -body { ttk::style element create plain.background from } -returnCodes error -result [wrong#args theme ?element?] test ttk-ensemble-5 "style element create: valid" -body { ttk::style element create plain.background from default } -returnCodes 0 -result "" test ttk-16.1 {ttk::style theme styles - no such theme} -body { ttk::style theme styles noSuchTheme } -returnCodes 1 -result {theme "noSuchTheme" does not exist} test ttk-16.2 {ttk::style theme styles - theme exists} -body { # simply check this produces a list with some style names, # without checking exact content (not needed, and may vary # depending on platform, versions, improvements...) expr {[llength [ttk::style theme styles alt]] > 0} } -result 1 # test for ttk::label # test for "-textangle" option for ttk::labels test ttk::label-1.1 {configuration option: "textangle" for ttk::label} -setup { ttk::label .l -borderwidth 2 -font {Helvetica -12 bold} pack .l update } -body { .l configure -textangle 10.5 .l cget -textangle } -cleanup { destroy .l } -result {10.5} test ttk::label-1.2 {configuration option: "textangle" for ttk::label} -setup { ttk::label .l -borderwidth 2 -font {Helvetica -12 bold} pack .l update } -body { .l configure -textangle 0 -text "Hello World" update set w [winfo reqwidth .l] set h [winfo reqheight .l] .l configure -textangle 90 update expr {[winfo reqwidth .l] == $h && [winfo reqheight .l] == $w} } -cleanup { destroy .l unset w h } -result {1} test ttk::label-1.3 {configuration option: "textangle" for ttk::label} -setup { ttk::label .l -borderwidth 2 -font {Helvetica -12 bold} pack .l update } -body { .l configure -textangle 45 -text "Hello World" update expr {[winfo reqwidth .l] == [winfo reqheight .l]} } -cleanup { destroy .l } -result {1} test ttk::label-1.4 {configuration option: "textangle" for ttk::label: no value} -body { ttk::label .l -textangle } -returnCodes error -result {wrong # args: should be "ttk::label pathName ?-option value ...?"} test ttk::label-1.5 {configuration option: "textangle" for ttk::label: invalid value} -body { ttk::label .l -textangle A } -returnCodes error -result {expected floating-point number or "" but got "A"} test ttk::label-1.6 {configuration option: "textangle" for ttk::label: out of range value} -body { ttk::label .l -textangle -1 .l cget -textangle } -cleanup { destroy .l } -result {-1} test ttk::label-1.7 {configuration option: "textangle" for ttk::label: wrap around} -setup { ttk::label .l -borderwidth 2 -font {Helvetica -12 bold} -text "Hello World" pack .l update } -body { set w [winfo reqwidth .l] set h [winfo reqheight .l] .l configure -textangle 360 update expr {[winfo reqwidth .l] == $w && [winfo reqheight .l] == $h} } -cleanup { destroy .l unset w h } -result {1} test ttk::label-1.8 {configuration option: "textangle" for ttk::label: minimum value} -body { ttk::label .l -textangle 0 .l cget -textangle } -cleanup { destroy .l } -result {0} test ttk::label-1.9 {configuration option: "textangle" for ttk::label: maximum value} -body { ttk::label .l -textangle 359.9 .l cget -textangle } -cleanup { destroy .l } -result {359.9} test ttk::label-1.10 {configuration option: "textangle" for ttk::label: default value} -body { ttk::label .l .l cget -textangle } -cleanup { destroy .l } -result {} # # TESTFILE CLEANUP # destroy {*}[winfo children .] tcltest::cleanupTests tk9.1.0/tests/ttk/treeview.test0000644003604700454610000070610315255022635015170 0ustar dgp771div# # Tests for the ttk::treeview widget # # NOTES # # * The ttk test suite holds many tests that build upon a previous one. This # is not incidental; it occurs systematically for groups of contiguous tests # in most ttk test files. # # A consequence of this practice is that attempts to run tests selectively/ # individually using the tcltest options "-match", "-skip" or "-limitconstraints 1" # lead to unintended failures. Therefore, invocations using these options # may be considered invalid for the ttk test suite (but not for the # corresponding core Tk tests). # # # TESTFILE INITIALIZATION # package require tcltest 2.2; # needed in mode -singleproc 0 # Load the main script main.tcl, which takes care of: # - setup for the application and the root window # - importing commands from the tcltest namespace # - loading of the testutils mechanism along with its utility procs # - loading of Tk specific test constraints (additionally to constraints # provided by the package tcltest) source [file join [file dirname [tcltest::configure -testdir]] main.tcl] # Ensure a pristine initial window state resetWindows # # COMMON TEST SETUP # set dtheme [ttk::style theme use] ttk::style theme use default set dfont [font configure TkDefaultFont] set hfont [font configure TkHeadingFont] set size [expr {[tk windowingsystem] ne "aqua" ? 9 : 10}] font configure TkDefaultFont -family Arial -size $size font configure TkHeadingFont -family Arial -size $size set colors [list red {pink maroon darkred magenta} green {chartreuse lime olive teal} \ blue {cyan turquoise mediumblue darkblue navy} orange {coral} yellow {gold} purple \ {} brown {wheat khaki} black {} white {beige} gray {silver}] set columns [list Color Hex Decimal Float] # # LOCAL UTILITY PROCS # proc insert {w parent color} { lassign [winfo rgb . $color] r g b set num [expr {($r>>8) << 16 | ($g>>8) << 8 | ($b>>8)}] $w insert $parent end -id $color -text [string totitle $color] -values [list [format "#%06X" $num] $num [expr {$num*1.1111}]] } proc create {w} { ttk::style configure Treeview -rowheight 20 -headingheight 20 ttk::treeview .tv -columns [lrange $::columns 1 end] -show {tree headings} \ -height 10 -rowheight 20 -headingheight 20 \ -xscrollcommand [list .sx set] -yscrollcommand [list .sy set] ttk::scrollbar .sx -orient horizontal -command [list .tv xview] ttk::scrollbar .sy -orient vertical -command [list .tv yview] grid .tv .sy -sticky nsew grid .sx -sticky nsew grid columnconfigure . 0 -weight 1 grid rowconfigure . 0 -weight 1 set i -1 foreach col $::columns { .tv heading [format "#%d" [incr i]] -text $col } foreach {color children} $::colors { set id [insert .tv {} $color] foreach child $children { insert .tv $id $child } } .tv expand -recurse {} tkwait visibility .tv wm geometry . 800x250 update focus .tv return .tv } proc fixed_table {w} { ttk::style configure Treeview -font {Arial 10} -rowheight 20 -headingheight 0 ttk::style configure Heading -font {Arial 10} $w configure -height 10 -rowheight 20 -headingheight 20 update } proc columns_no_stretch {w} { set columns [concat #0 [$w cget -columns]] $w configure -columns [lrange $columns 1 end] foreach column $columns { $w column $column -width 200 -stretch 0 } update } proc columns_stretch {w} { set columns [concat #0 [$w cget -columns]] $w configure -columns [lrange $columns 1 end] foreach column $columns { $w column $column -width 200 -stretch 1 } update } proc lcompare {list1 list2} { foreach e1 $list1 e2 $list2 { if {$e1 ne $e2} { return 0 } } return 1 } proc checkorder {item} { set index 0 foreach child [.tv children $item] { if {[.tv index $child] != $index} { return 0 } else { incr index } } return 1 } proc ButtonPress {w item {column {#0}} {offset 0}} { focus -force $w $w see $item $column pause 25 lassign [$w bbox $item $column] x y wd h if {$offset > 0} { incr x $offset } else { incr x $wd incr x -10 } incr y 5 event generate $w -x $x -y $y pause 25 event generate $w -x $x -y $y update } proc KeyPress {w item column keysym {modifier {}} {mac_mod {}}} { focus -force $w if {$column eq {}} { $w focus $item } else { $w cellfocus [list $item $column] } update if {$mac_mod ne "" && [tk windowingsystem] eq "aqua"} { set modifier $mac_mod } if {$modifier ne "" && [tk windowingsystem] eq "aqua"} { switch -- $modifier { "Alt" {set modifier "Option"} "Control" {set modifier "Command"} } } set mod [expr {$modifier ne "" ? [format "%s-" $modifier] : ""}] event generate $w [format "<%sKeyPress-%s>" $mod $keysym] pause 25 event generate $w [format "<%sKeyRelease-%s>" $mod $keysym] update } proc MouseMove {w item column} { lassign [$w bbox $item $column] x y width height event generate $w -warp 1 -when now -x $x -y $y } # # TESTS # # Widget Functions test Init-1.1 {Create} -body { ttk::treeview .tv } -result {.tv} test Init-1.2 {Root node properly initialized bug #1541739} -body { .tv insert {} end -id a .tv see a } test Init-1.3 {Cleanup} -body { destroy .tv } # Cget test Cget-2.1 {Create} -body { ::ttk::treeview .tv } -result {.tv} test Cget-2.2 {Get columns} -body { .tv cget -columns } test Cget-2.3 {Get cursor} -body { .tv cget -cursor } test Cget-2.4 {Get display columns defaults} -body { .tv cget -displaycolumns } -result {#all} test Cget-2.5 {Heading Height} -body { .tv cget -headingheight } -match {glob} -result {*} test Cget-2.6 {Height} -body { .tv cget -height } -result {10} test Cget-2.7 {Padding} -body { .tv cget -padding } -result "" test Cget-2.8 {Row Height} -body { .tv cget -rowheight } -match {glob} -result {*} test Cget-2.9 {Select Mode} -body { .tv cget -selectmode } -result {extended} test Cget-2.10 {Select type} -body { .tv cget -selecttype } -result {item} test Cget-2.11 {Show} -body { .tv cget -show } -result {tree headings} test Cget-2.12 {Striped} -body { .tv cget -striped } -result {0} test Cget-2.13 {Style} -body { .tv cget -style } test Cget-2.14 {Takefocus} -body { .tv cget -takefocus } -result {ttk::takefocus} test Cget-2.15 {Titlecolumns} -body { .tv cget -titlecolumns } -result {0} test Cget-2.16 {Titleitems} -body { .tv cget -titleitems } -result {0} test Cget-2.17 {Xscrollcommand} -body { .tv cget -xscrollcommand } test Cget-2.18 {Yscrollcommand} -body { .tv cget -yscrollcommand } test Cget-2.19 {Cleanup} -body { destroy .tv } # Configure test Configure-3.1 {Create} -body { ::ttk::treeview .tv } -result {.tv} test Configure-3.2 {Get Columns} -body { .tv configure -columns } -result {-columns columns Columns {} {}} test Configure-3.3 {Set Columns} -body { .tv configure -columns $::columns lindex [.tv configure -columns] end } -result $::columns test Configure-3.4 {Invalid Column Id} -body { .tv configure -columns {illegal "list"value} } -match {glob} -result {list element in quotes followed by*} -returnCodes {1} test Configure-3.5 {Get Cursor} -body { .tv configure -cursor } -result {-cursor cursor Cursor {} {}} test Configure-3.6 {Set Cursor} -body { .tv configure -cursor arrow .tv cget -cursor } -result {arrow} test Configure-3.7 {Get Display columns} -body { .tv configure -displaycolumns } -result {-displaycolumns displayColumns DisplayColumns #all #all} test Configure-3.8 {Set Display Columns} -body { .tv configure -displaycolumns [lsort $::columns] .tv cget -columns } -result {Color Hex Decimal Float} test Configure-3.9 {Inavlid Display Column Id} -body { .tv configure -displaycolumns {Color Decimal Bogus} } -result {Invalid column index "Bogus"} -returnCodes {1} test Configure-3.10 {Invalid Display Column Index} -body { .tv configure -displaycolumns {0 1 2 3 4} } -result {Column index "4" out of bounds} -returnCodes {1} test Configure-3.11 {Negative Display Column Index} -body { .tv configure -displaycolumns {-1 1 2 3 4} } -result {Column index "-1" out of bounds} -returnCodes {1} test Configure-3.12 {Invalid Display Column Name} -body { .tv configure -displaycolumns {Color Hex Decimal Float Bogus} } -result {Invalid column index "Bogus"} -returnCodes {1} test Configure-3.13 {No Display Column} -body { .tv configure -displaycolumns {Color {} Decimal} } -result {Column index "" out of bounds} -returnCodes {1} test Configure-3.14 {Reset to Default} -body { .tv configure -displaycolumns #all .tv cget -displaycolumns } -result {#all} test Configure-3.15 {Get Heading Height} -body { .tv configure -headingheight } -match {glob} -result {-headingheight headingHeight Height 0 *} test Configure-3.16 {Set Heading Height} -body { .tv configure -headingheight 30 .tv cget -headingheight } -result {30} test Configure-3.17 {Get Height} -body { .tv configure -height } -result {-height height Height 10 10} test Configure-3.18 {Set Height} -body { .tv configure -height 15 .tv cget -height } -result {15} test Configure-3.19 {Get Padding} -body { .tv configure -padding } -result {-padding padding Pad {} {}} test Configure-3.20 {Set Padding} -body { .tv configure -padding 1 .tv cget -padding } -result {1} test Configure-3.21 {Set Multiple Padding} -body { .tv configure -padding {2 4 6 8} .tv cget -padding } -result {2 4 6 8} test Configure-3.22 {Get Row Height} -body { .tv configure -rowheight } -match {glob} -result {-rowheight rowHeight Height 0 *} test Configure-3.23 {Set Row Height} -body { .tv configure -rowheight 30 .tv cget -rowheight } -result {30} test Configure-3.24 {Get Select Mode} -body { .tv configure -selectmode } -result {-selectmode selectMode SelectMode extended extended} test Configure-3.25 {Set Select Mode} -body { .tv configure -selectmode multiple .tv cget -selectmode } -result {multiple} test Configure-3.26 {Invalid Select Mode} -body { .tv configure -selectmode bogus } -result {bad selectmode "bogus": must be none, single, browse, extended, or multiple} -returnCodes {1} test Configure-3.27 {Get Select Type} -body { .tv configure -selecttype } -result {-selecttype selectType SelectType item item} test Configure-3.28 {Set Select Type} -body { .tv configure -selecttype cell .tv cget -selecttype } -result {cell} test Configure-3.29 {Invalid Select Type} -body { .tv configure -selecttype bogus } -result {bad selecttype "bogus": must be item or cell} -returnCodes {1} test Configure-3.30 {Get Show Components} -body { .tv configure -show } -result {-show show Show {tree headings} {tree headings}} test Configure-3.31 {Set Show Components} -body { .tv configure -show tree .tv cget -show } -result {tree} test Configure-3.32 {Invalid Show Components} -body { .tv configure -show bogus } -result {bad value "bogus": must be tree or headings} -returnCodes {1} test Configure-3.33 {Get Striped} -body { .tv configure -striped } -result {-striped striped Striped 0 0} test Configure-3.34 {Set Striped} -body { .tv configure -striped 1 .tv cget -striped } -result {1} test Configure-3.35 {Invalid Striped} -body { .tv configure -striped bogus } -result {expected boolean value but got "bogus"} -returnCodes {1} test Configure-3.36 {Get Style} -body { .tv configure -style } -result {-style style Style {} {}} test Configure-3.37 {Set Style} -body { .tv configure -style CheckTreeview .tv cget -style } -result {CheckTreeview} test Configure-3.38 {Invalid Style} -body { .tv configure -style bogus } -result {Layout bogus not found} -returnCodes {1} test Configure-3.39 {Get Takefocus} -body { .tv configure -takefocus } -result {-takefocus takeFocus TakeFocus ttk::takefocus ttk::takefocus} test Configure-3.40 {Set Takefocus} -body { .tv configure -takefocus 1 .tv cget -takefocus } -result {1} test Configure-3.41 {Get Title Columns} -body { .tv configure -titlecolumns } -result {-titlecolumns titlecolumns Titlecolumns 0 0} test Configure-3.42 {Set Title Columns} -body { .tv configure -titlecolumns 1 .tv cget -titlecolumns } -result {1} test Configure-3.43 {Invalid Title Columns} -body { .tv configure -titlecolumns -1 } -result {"#-1" is out of range} -returnCodes {1} test Configure-3.44 {Get Title Items} -body { .tv configure -titleitems } -result {-titleitems titleitems Titleitems 0 0} test Configure-3.45 {Set Title Items} -body { .tv configure -titleitems 2 .tv cget -titleitems } -result {2} test Configure-3.46 {Invalid Title Items} -body { .tv configure -titleitems -1 } -result {"-1" is out of range} -returnCodes {1} test Configure-3.47 {Get Xscrollcommand} -body { .tv configure -xscrollcommand } -result {-xscrollcommand xScrollCommand ScrollCommand {} {}} test Configure-3.48 {Set Xscrollcommand} -body { .tv configure -xscrollcommand new_command lindex [.tv configure -xscrollcommand] end } -result {new_command} test Configure-3.49 {Get Yscrollcommand} -body { .tv configure -yscrollcommand } -result {-yscrollcommand yScrollCommand ScrollCommand {} {}} test Configure-3.50 {Set Yscrollcommand} -body { .tv configure -xscrollcommand new_command lindex [.tv configure -xscrollcommand] end } -result {new_command} test Configure-3.51 {Cleanup} -body { destroy .tv } # State and instate test State-4.1 {Create} -body { set w [create .tv] } -result {.tv} test State-4.2 {Too many args} -body { .tv state active bogus } -result {wrong # args: should be ".tv state state-spec"} -returnCodes {1} test State-4.3 {Invalid state} -body { .tv state bogus } -result {Invalid state name bogus} -returnCodes {1} test State-4.4 {Set state} -body { .tv state disabled } -result {!disabled} test State-4.5 {Get state} -body { lsearch -all -inline [.tv state] disabled } -result {disabled} test State-4.6 {In state} -body { .tv instate disabled } -result {1} test State-4.7 {Clear state} -body { .tv state !disabled lsearch -all -inline [.tv state] disabled } test State-4.8 {Not in state} -body { .tv instate disabled } -result {0} test State-4.9 {Cleanup} -body { destroy .tv .sx .sy } # Style test Style-5.1 {Create} -body { set w [create .tv] } -result {.tv} test Style-5.2 {Too many args} -body { .tv style bogus } -result {wrong # args: should be ".tv style "} -returnCodes {1} test Style-5.3 {Default} -body { .tv style } -result {Treeview} test Style-5.4 {Class} -body { winfo class .tv } -result {Treeview} test Style-5.5 {Set CheckTreeview Style} -body { .tv configure -style CheckTreeview .tv style } -result {CheckTreeview} test Style-5.6 {Restore} -body { .tv configure -style Treeview .tv style } -result {Treeview} test Style-5.7 {Cleanup} -body { destroy .tv .sx .sy } test Style-5.8 {Custom style} -setup { ttk::style configure customStyle.Treeview } -body { ttk::treeview .tv -style customStyle.Treeview .tv cget -style } -result {customStyle.Treeview} test Style-5.9 {Cleanup} -body { destroy .tv .sx .sy } test Style-5.10 {Treeview with custom theme doesn't resize bug bc602049ab} -setup { image create photo tvbg -data { iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAACNiR0NAAAACXBIWXMAAAnXAAAJ1wG xbhe3AAAAGXRFWHRTb2Z0d2FyZQB3d3cuaW5rc2NhcGUub3Jnm+48GgAAACJJREFUOI 1jPLF9+38GKgImaho2auCogaMGjho4auBQMhAAyR0DXUEyypsAAAAASUVORK5CYII= } ttk::style theme create bar-bc602049ab -parent clam -settings { ttk::style element create Treeview.field image tvbg -width 0 -height 0 } ttk::style theme use bar-bc602049ab } -body { pack [ttk::treeview .tv] update idletasks set g1 [winfo geometry .tv] ttk::style theme use bar-bc602049ab update idletasks set g2 [winfo geometry .tv] expr {$g1 eq $g2 ? 1 : "$g1 --> $g2"} } -cleanup { image delete tvbg } -result {1} test Style-5.11 {Cleanup} -body { destroy .tv } # Focus Ring test Focus_Ring-6.1 {Create} -body { set w [ttk::treeview .tv -columns {Data}] grid $w $w insert {} end -id red -text "Test" -values Data $w heading #0 -text Tree $w heading #1 -text Data set w } -result {.tv} test Focus_Ring-6.2 {Thick focus ring} -body { set h [lindex [.tv bbox red] 3] ttk::style configure Row -focuscolor green -focussolid 1 -focusthickness 3 $w focus red expr {$h == [lindex [.tv bbox red] 3]} } -result {1} test Focus_Ring-6.3 {Dotted focus ring} -body { set h [lindex [.tv bbox red] 3] ttk::style configure Row -focuscolor black -focussolid 0 -focusthickness 1 $w focus red expr {$h == [lindex [.tv bbox red] 3]} } -result {1} test Focus_Ring-6.4 {Row padding} -body { set h [lindex [.tv bbox red] 3] ttk::style configure Row -focuscolor black -focussolid 1 -focusthickness 1 -padding {2 3 2 3} $w focus red expr {$h == [lindex [.tv bbox red] 3]} } -cleanup { ttk::style configure Row -padding 0 $w focus {} } -result {1} test Focus_Ring-6.5 {Cell focus} -body { set h [lindex [.tv bbox red #1] 3] ttk::style configure Row -focuscolor green -focussolid 1 -focusthickness 3 $w cellfocus [list red #1] expr {$h == [lindex [.tv bbox red] 3]} } -result {1} test Focus_Ring-6.6 {Cell dotted focus} -body { set h [lindex [.tv bbox red #1] 3] ttk::style configure Row -focuscolor black -focussolid 0 -focusthickness 1 $w cellfocus [list red #1] expr {$h == [lindex [.tv bbox red] 3]} } -cleanup { ttk::style configure Row -focuscolor black -focussolid 1 -focusthickness 1 } -result {1} test Focus_Ring-6.7 {Cell padding} -body { set h [lindex [.tv bbox red #1] 3] ttk::style configure Cell -padding {2 3 2 3} $w cellfocus {red #1} update expr {[lindex [.tv bbox red] 3] > $h} } -cleanup { ttk::style configure Cell -padding 0 } -result {1} test Focus_Ring-6.8 {Cleanup} -body { destroy $w } # Heading Height test Heading_Height-7.1 {Create} -setup { ::ttk::style configure Treeview -headingheight 0 } -body { set w [ttk::treeview .tv -columns {Data}] grid $w $w insert {} end -id red -text "Test" -values Data $w heading #0 -text Tree $w heading #1 -text Data set w } -result {.tv} test Heading_Height-7.2 {Set font changes height} -body { set h [$w cget -headingheight] ttk::style configure Heading -font "Courier 20" update expr {[$w cget -headingheight] > $h} } -result {1} test Heading_Height-7.3 {Change font changes height} -setup { font create TestFont -family Courier -size 24 } -body { set h [$w cget -headingheight] ttk::style configure Heading -font TestFont update expr {[$w cget -headingheight] > $h} } -result {1} test Heading_Height-7.4 {Update font size changes height} -body { set h [$w cget -headingheight] font configure TestFont -size 32 update expr {[$w cget -headingheight] > $h} } -result {1} test Heading_Height-7.5 {Reset to default font} -body { set h [$w cget -headingheight] ttk::style configure Heading -font TkHeadingFont update expr {[$w cget -headingheight] > $h} } -result {0} test Heading_Height-7.6 {Set Item padding changes height} -body { set h [$w cget -headingheight] ttk::style configure Heading -padding "2 5 2 7" update expr {[$w cget -headingheight] > $h} } -result {1} test Heading_Height-7.7 {Change Item padding changes height} -body { set h [$w cget -headingheight] ttk::style configure Heading -padding "2 8 2 6" update expr {[$w cget -headingheight] > $h} } -cleanup { ttk::style configure Heading -padding {} } -result {1} test Heading_Height-7.8 {Manual set heading height} -body { set h [$w cget -headingheight] $w configure -headingheight 35 update expr {[$w cget -headingheight] > $h} } -result {0} test Heading_Height-7.9 {Restore auto set heading height and heading height 0} -body { set h [$w cget -headingheight] $w configure -headingheight 0 update expr {[$w cget -headingheight] > $h} } -result {0} test Heading_Height-7.10 {Override heading height set} -body { set h [$w cget -headingheight] ttk::style configure Treeview -headingheight 73 update expr {[$w cget -headingheight] > $h} } -result {1} test Heading_Height-7.11 {Override heading height reset} -body { set h [$w cget -headingheight] ttk::style configure Treeview -headingheight 25 update expr {[$w cget -headingheight] > $h} } -result {0} test Heading_Height-7.12 {Override heading height clear} -body { set h [$w cget -headingheight] ttk::style configure Treeview -headingheight 0 update expr {[$w cget -headingheight] > $h} } -result {0} test Heading_Height-7.13 {Cleanup} -body { destroy $w font delete TestFont } -cleanup { ttk::style configure Treeview -headingheight 0 } # Row test Row-8.1 {Create} -setup { ::ttk::style configure Treeview -rowheight 0 } -body { set w [ttk::treeview .tv -columns {Data}] grid $w $w insert {} end -id red -text "Test" -values Data $w heading #0 -text Tree $w heading #1 -text Data set w } -result {.tv} test Row-8.2 {Set font changes height} -body { set h [$w cget -rowheight] ttk::style configure Treeview -font "Courier 20" update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {1} test Row-8.3 {Change font changes height} -setup { font create TestFont -family Courier -size 24 } -body { set h [$w cget -rowheight] ttk::style configure Treeview -font TestFont update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {1} test Row-8.4 {Update font size changes height} -body { set h [$w cget -rowheight] font configure TestFont -size 32 update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {1} test Row-8.5 {Reset to default font} -body { set h [$w cget -rowheight] ttk::style configure Treeview -font TkDefaultFont update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {0} test Row-8.6 {Set Item padding changes height} -body { set h [$w cget -rowheight] ttk::style configure Item -padding "2 2 2 2" update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {1} test Row-8.7 {Change Item padding changes height} -body { set h [$w cget -rowheight] ttk::style configure Item -padding "2 3 2 5" update expr {[lindex [.tv bbox red #1] 3] > $h} } -cleanup { ttk::style configure Item -padding {} } -result {1} test Row-8.8 {Set Cell padding changes height} -body { set h [$w cget -rowheight] ttk::style configure Cell -padding "2 7 2 5" update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {1} test Row-8.9 {Change Cell padding changes height} -body { set h [$w cget -rowheight] ttk::style configure Cell -padding "2 9 2 9" update expr {[lindex [.tv bbox red #1] 3] > $h} } -cleanup { ttk::style configure Cell -padding {} } -result {1} test Row-8.10 {Manual set row height} -body { set h [$w cget -rowheight] $w configure -rowheight 30 update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {0} test Row-8.11 {Set row height to 0 Bug #6ee162c3d9} -body { set h [$w cget -rowheight] $w configure -rowheight 0 update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {0} test Row-8.12 {Override row height set} -body { set h [$w cget -rowheight] ttk::style configure Treeview -rowheight 73 update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {1} test Row-8.13 {Override row height reset} -body { set h [$w cget -rowheight] ttk::style configure Treeview -rowheight 25 update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {0} test Row-8.14 {Override row height clear} -body { set h [$w cget -rowheight] ttk::style configure Treeview -rowheight 0 update expr {[lindex [.tv bbox red #1] 3] > $h} } -result {0} test Row-8.15 {Cleanup} -body { destroy $w font delete TestFont } -cleanup { ttk::style configure Treeview -rowheight 0 } proc scrollcallback {args} { set ::scrolldata $args } # Xview test Xview-9.1 {Create} -body { set w [create .tv] fixed_table $w wm geometry . 400x300 set w } -result {.tv} test Xview-9.2 {Invalid function} -body { .tv xview bogus } -result {expected integer but got "bogus"} -returnCodes {1} test Xview-9.3 {Moveto too many args} -body { .tv xview moveto x y z } -result {wrong # args: should be ".tv xview moveto fraction"} -returnCodes {1} test Xview-9.4 {Moveto invalid} -body { .tv xview moveto bogus } -result {expected floating-point number but got "bogus"} -returnCodes {1} test Xview-9.5 {Get current} -setup { columns_no_stretch .tv .tv xview 200 update } -body { .tv xview } -match {glob} -result {0.25 0.7*} test Xview-9.6 {Moveto min} -body { .tv xview moveto 0.0 update .tv xview } -match {glob} -result {0.0 0.4*} test Xview-9.7 {Moveto mid} -body { .tv xview moveto 0.25 update .tv xview } -match {glob} -result {0.25 0.7*} test Xview-9.8 {Moveto max} -body { .tv xview moveto 1.0 update .tv xview } -match {glob} -result {0.5* 1.0} test Xview-9.9 {Moveto before first} -body { .tv xview moveto -1.0 update .tv xview } -match {glob} -result {0.0 0.4*} test Xview-9.10 {Moveto after last} -body { .tv xview moveto 2.0 update .tv xview } -match {glob} -result {0.5* 1.0} test Xview-9.11 {Scroll too many args} -body { .tv xview scroll x y z } -result {wrong # args: should be ".tv xview scroll number pages|units"} -returnCodes {1} test Xview-9.12 {Scroll invalid units} -body { .tv xview scroll bogus units } -result {expected floating-point number but got "bogus"} -returnCodes {1} test Xview-9.13 {Scroll invalid type} -body { .tv xview scroll 1.0 bogus } -result {bad argument "bogus": must be pages or units} -returnCodes {1} test Xview-9.14 {Scroll pages} -body { .tv xview scroll 1 pages update .tv xview } -match {glob} -result {0.5* 1.0} test Xview-9.15 {Scroll units} -body { .tv xview scroll -1 units update .tv xview } -match {glob} -result {0.5* 0.9*} test Xview-9.16 {Xscrollcommand} -setup { .tv configure -xscrollcommand scrollcallback } -body { .tv delete [.tv children {}] update set ::scrolldata } -match {glob} -result {0.5* 0.9*} test Xview-9.17 {Cleanup} -body { destroy .tv .sx .sy } # Yview test Yview-10.1 {Create} -body { set w [create .tv] fixed_table $w wm geometry . 400x300 } test Yview-10.2 {Invalid function} -body { .tv yview bogus } -result {expected integer but got "bogus"} -returnCodes {1} test Yview-10.3 {Moveto too many args} -body { .tv yview moveto x y z } -result {wrong # args: should be ".tv yview moveto fraction"} -returnCodes {1} test Yview-10.4 {Get current} -body { .tv yview } -match {glob} -result {0.0 0.34*} test Yview-10.5 {Moveto invalid} -body { .tv yview moveto bogus } -result {expected floating-point number but got "bogus"} -returnCodes {1} test Yview-10.6 {Moveto min} -body { .tv yview moveto 0.0 update .tv yview } -match {glob} -result {0.0 0.44*} test Yview-10.7 {Moveto mid} -body { .tv yview moveto 0.5 update .tv yview } -match {glob} -result {0.51* 0.96*} test Yview-10.8 {Moveto max} -body { .tv yview moveto 1.0 update .tv yview } -match {glob} -result {0.55* 1.0} test Yview-10.9 {Moveto before first} -body { .tv yview moveto -1.0 update .tv yview } -match {glob} -result {0.0 0.44*} test Yview-10.10 {Moveto after last} -body { .tv yview moveto 2.0 update .tv yview } -match {glob} -result {0.55* 1.0} test Yview-10.11 {Scroll too many args} -body { .tv yview scroll x y z } -result {wrong # args: should be ".tv yview scroll number pages|units"} -returnCodes {1} test Yview-10.12 {Scroll invalid units} -body { .tv yview scroll bogus units } -result {expected floating-point number but got "bogus"} -returnCodes {1} test Yview-10.13 {Scroll invalid type} -body { .tv yview scroll 1.0 bogus } -result {bad argument "bogus": must be pages or units} -returnCodes {1} test Yview-10.14 {Scroll pages} -body { .tv yview scroll 1 pages update .tv yview } -match {glob} -result {0.55* 1.0} test Yview-10.15 {Scroll units} -body { .tv yview scroll -1 units update .tv yview } -match {glob} -result {0.51* 0.96*} test Yview-10.16 {Yscrollcommand} -setup { .tv configure -yscrollcommand scrollcallback } -body { .tv delete [.tv children {}] update set ::scrolldata } -result {0.0 1.0} test Yview-10.17 {Cleanup} -body { destroy .tv .sx .sy } # Column functions # Column test Column-11.1 {Create} -body { set w [create .tv] } -result {.tv} test Column-11.2 {Too few args} -body { .tv column } -result {wrong # args: should be ".tv column column ?-option? ?value? ?-option value ...?"} -returnCodes {1} test Column-11.3 {Invalid column} -body { .tv column bogus } -result {Invalid column index "bogus"} -returnCodes {1} test Column-11.4 {Out of range column} -body { .tv column 5 } -result {Column index "5" out of bounds} -returnCodes {1} test Column-11.5 {Get anchor} -body { .tv column 0 -anchor } -result {w} test Column-11.6 {Set anchor} -body { .tv column 0 -anchor e .tv column 0 -anchor } -result {e} test Column-11.7 {Set anchor invalid} -body { .tv column 0 -anchor bogus } -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} -returnCodes {1} test Column-11.8 {Get id} -body { .tv column 0 -id } -result {Hex} test Column-11.9 {Set id} -body { .tv column 0 -id new } -result {Attempt to change read-only option} -returnCodes {1} test Column-11.10 {Get minwidth} -body { .tv column 0 -minwidth } -result {20} test Column-11.11 {Set minwidth} -body { .tv column 0 -minwidth 25 .tv column 0 -minwidth } -result {25} test Column-11.12 {Set minwidth invalid} -body { .tv column 0 -minwidth -50 .tv column 0 -minwidth } -result {-50} test Column-11.13 {Get separator} -body { .tv column 0 -separator } -result {0} test Column-11.14 {Set separator} -body { .tv column 0 -separator 1 .tv column 0 -separator } -result {1} test Column-11.15 {Set separator invalid} -body { .tv column 0 -separator bogus } -result {expected boolean value but got "bogus"} -returnCodes {1} test Column-11.16 {Get stretch} -body { .tv column 0 -stretch } -result {1} test Column-11.17 {Set stretch} -body { .tv column 0 -stretch 1 .tv column 0 -stretch } -result {1} test Column-11.18 {Set stretch invalid} -body { .tv column 0 -stretch bogus } -result {expected boolean value but got "bogus"} -returnCodes {1} test Column-11.19 {Get width} -body { .tv column 0 -width } -result {200} test Column-11.20 {Set width} -body { .tv column 0 -width 25 .tv column 0 -width } -result {25} test Column-11.21 {Set width invalid} -body { .tv column 0 -width -50 .tv column 0 -width } -result {-50} test Column-11.22 {Cleanup} -body { destroy .tv .sx .sy } # Column Ids test Column_Ids-12.1 {Create} -body { set w [create .tv] } -result {.tv} test Column_Ids-12.2 {Tree column} -body { .tv column #0 } -match {glob} -result {*} test Column_Ids-12.3 {Symbolic Index} -body { .tv column Hex -id } -result {Hex} test Column_Ids-12.4 {Data Column Index} -body { .tv column 2 -id } -result {Float} test Column_Ids-12.5 {Display Column Index} -body { .tv column #2 -id } -result {Decimal} test Column_Ids-12.6 {Out of Bounds Index} -body { .tv column 4 -id } -result {Column index "4" out of bounds} -returnCodes {1} test Column_Ids-12.7 {Out of Bounds Display Index} -body { .tv column #4 -id } -result {Column #4 out of range} -returnCodes {1} test Column_Ids-12.8 {Invalid Index} -body { .tv column bogus -id } -result {Invalid column index "bogus"} -returnCodes {1} test Column_Ids-12.9 {Set New Order} -body { .tv configure -displaycolumns [list Float Decimal Hex] } test Column_Ids-12.10 {Get Order} -body { list [.tv column #1 -id] [.tv column #2 -id] [.tv column #3 -id] } -result {Float Decimal Hex} test Column_Ids-12.11 {Cleanup} -body { destroy .tv .sx .sy } # Heading test Heading-13.1 {Create} -body { set w [create .tv] } -result {.tv} test Heading-13.2 {Too few args} -body { .tv heading } -result {wrong # args: should be ".tv heading column ?-option? ?value? ?-option value ...?"} -returnCodes {1} test Heading-13.3 {Invalid column} -body { .tv heading bogus } -result {Invalid column index "bogus"} -returnCodes {1} test Heading-13.4 {Invalid option} -body { .tv heading 0 -bogus } -result {unknown option "-bogus"} -returnCodes {1} test Heading-13.5 {Get anchor} -body { .tv heading 0 -anchor } -result {center} test Heading-13.6 {Set anchor} -body { .tv heading 0 -anchor e .tv heading 0 -anchor } -result {e} test Heading-13.7 {Set anchor invalid} -body { .tv heading 0 -anchor bogus } -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} -returnCodes {1} test Heading-13.8 {Get command} -body { .tv heading 0 -command } test Heading-13.9 {Set command} -body { .tv heading 0 -command new_command .tv heading 0 -command } -result {new_command} test Heading-13.10 {Get image} -body { .tv heading 0 -image } test Heading-13.11 {Set image} -body { .tv heading 0 -image ::tk::icons::question .tv heading 0 -image } -result {::tk::icons::question} test Heading-13.12 {Set image invalid} -body { .tv heading 0 -image bogus } test Heading-13.13 {Get state} -body { .tv heading 0 state } test Heading-13.14 {Set state} -body { .tv heading 0 state disabled .tv heading 0 state } -result {disabled} test Heading-13.15 {Set state invalid} -body { .tv heading 0 state bogus } -result {Invalid state name bogus} -returnCodes {1} test Heading-13.16 {Get text} -body { .tv heading 0 -text } -result {Hex} test Heading-13.17 {Set text} -body { .tv heading 0 -text "New Text" .tv heading 0 -text } -result {New Text} test Heading-13.18 {Leak test} -setup { set heading [string range _Hej_ 1 3] } -body { for {set t 0} {$t < 3} {incr t} { ttk::treeview .tapa -columns "hej hopp" .tapa heading #0 -text $heading destroy .tapa } tcl::unsupported::representation $heading } -match {glob} -result {*refcount of 3,*} test Heading-13.19 {Cleanup} -body { destroy .tv .sx .sy } # Column Resize test Drag_and_Drop-14.1 {Create} -body { set w [create .tv] wm geometry . 400x300 set w } -result {.tv} test Drag_and_Drop-14.2 {Too few drag args} -body { .tv drag } -result {wrong # args: should be ".tv drag column xposition"} -returnCodes {1} test Drag_and_Drop-14.3 {Too many drag args} -body { .tv drag column pos bogus } -result {wrong # args: should be ".tv drag column xposition"} -returnCodes {1} test Drag_and_Drop-14.4 {Too many drop args} -body { .tv drop bogus } -result {wrong # args: should be ".tv drop"} -returnCodes {1} test Drag_and_Drop-14.5 {Invalid Column} -body { .tv drag bogus 100 } -result {Invalid column index "bogus"} -returnCodes {1} test Drag_and_Drop-14.6 {Resize by display column} -body { .tv drag #0 75 .tv drop .tv column #0 -width } -result {75} test Drag_and_Drop-14.7 {Resize by column number} -body { .tv drag 0 125 .tv drop .tv column #1 -width } -result {50} test Drag_and_Drop-14.8 {Resize by column name} -body { .tv drag Decimal 190 .tv drop .tv column #2 -width } -result {65} test Drag_and_Drop-14.9 {Resize to hide column} -setup { .tv column #3 -minwidth 0 } -body { .tv drag #3 190 .tv drop .tv column #3 -width } -result {0} test Drag_and_Drop-14.10 {Out of range column} -body { .tv drag #4 500 } -result {Column #4 out of range} -returnCodes {1} test Drag_and_Drop-14.11 {Out of bounds column} -body { .tv drag 4 500 } -result {Column index "4" out of bounds} -returnCodes {1} test Drag_and_Drop-14.12 {Not displayed column} -setup { .tv configure -columns [list Decimal Float] } -body { .tv drag Hex 150 } -result {Invalid column index "Hex"} -returnCodes {1} test Drag_and_Drop-14.13 {Cleanup} -body { destroy .tv .sx .sy } test Drag_and_Drop-14.14 {Create} -body { set w [create .tv] } -result {.tv} test Drag_and_Drop-14.15 {Drag beyond right edge is allowed} -setup { columns_stretch .tv } -body { set res [list [.tv column #0 -width]] .tv drag #0 1000 update lappend res [.tv column #0 -width] set res } -result {200 1000} test Drag_and_Drop-14.16 {Drag beyond left edge is not allowed} -setup { columns_stretch .tv } -body { set res [list [.tv column #0 -width]] .tv drag #1 -100 update lappend res [.tv column #0 -width] set res } -result {200 20} test Drag_and_Drop-14.17 {Drag First Column} -setup { columns_stretch .tv } -body { set res [list [.tv column #0 -width]] .tv drag #0 -100 update lappend res [.tv column #0 -width] set res } -result {196 20} test Drag_and_Drop-14.18 {Drag Last Column} -setup { columns_stretch .tv } -body { set res [list [.tv column #3 -width]] .tv drag #3 1000 update lappend res [.tv column #3 -width] set res } -result {197 412} test Drag_and_Drop-14.19 {Shrink Column In Stretch Mode Adds Space to Next Column} -setup { columns_stretch .tv } -body { set res [list [.tv column #2 -width]] .tv drag #1 300 update lappend res [.tv column #2 -width] set res } -result {200 285} test Drag_and_Drop-14.20 {Expand Column In Stretch Mode Reduces Space in Next Column} -body { set res [list [.tv column #2 -width]] .tv drag #1 500 update lappend res [.tv column #2 -width] set res } -result {285 85} test Drag_and_Drop-14.21 {Shrink Column Not In Stretch Mode Does Not Change Next Column} -setup { columns_no_stretch .tv } -body { set res [list [.tv column #2 -width]] .tv drag #1 300 update lappend res [.tv column #2 -width] set res } -result {200 200} test Drag_and_Drop-14.22 {Expand Column Not In Stretch Mode Does Not Change Next Column} -setup { columns_no_stretch .tv } -body { set res [list [.tv column #2 -width]] .tv drag #1 500 update lappend res [.tv column #2 -width] set res } -result {200 200} test Drag_and_Drop-14.23 {Cleanup} -body { destroy .tv .sx .sy } # Item functions # Bbox proc cell_bbox {w item} { set res [list] foreach col [concat #0 [$w cget -columns]] { lappend res [.tv bbox $item $col] } return $res } test Bbox-15.1 {Create} -body { set w [create .tv] fixed_table $w . configure -width 600 set w } -result {.tv} test Bbox-15.2 {Too few args} -body { .tv bbox } -result {wrong # args: should be ".tv bbox item ?column?"} -returnCodes {1} test Bbox-15.3 {Too many args} -body { .tv bbox item column bogus } -result {wrong # args: should be ".tv bbox item ?column?"} -returnCodes {1} test Bbox-15.4 {Invalid item} -body { .tv bbox bogus } -result {Item bogus not found} -returnCodes {1} test Bbox-15.5 {Invalid column} -body { .tv bbox red bogus } -result {Invalid column index "bogus"} -returnCodes {1} test Bbox-15.6 {Get Item Coords} -body { .tv bbox red } -match {glob} -result {0 2? 800 20} test Bbox-15.7 {Get Item and Column Coords} -body { .tv bbox red #0 } -match {glob} -result {0 2? 200 20} test Bbox-15.8 {Get Cell Coords} -body { .tv bbox {*}[list pink #0] } -match {glob} -result {20 4? 180 20} test Bbox-15.9 {Root} -body { .tv bbox {} } test Bbox-15.10 {Detached Item} -setup { .tv detach white } -body { .tv bbox white } test Bbox-15.11 {Item in Y view} -setup { columns_no_stretch .tv wm geometry . 400x300 update } -body { .tv bbox red } -match {glob} -result {0 2? 800 20} test Bbox-15.12 {Y view scroll item out of view} -body { .tv yview 0 update set res [list [.tv bbox red #0]] .tv yview 400 update lappend res [.tv bbox red #0] set res } -cleanup { .tv yview 0 } -match {glob} -result {{0 2? 200 20} {}} test Bbox-15.13 {Y view scroll item into view} -body { .tv yview 400 update set res [list [.tv bbox red #0]] .tv yview 0 update lappend res [.tv bbox red #0] set res } -cleanup { .tv yview 0 } -match {glob} -result {{} {0 2? 200 20}} test Bbox-15.14 {Column in X view} -setup { columns_no_stretch .tv wm geometry . 400x300 update } -body { .tv bbox red #0 } -match {glob} -result {0 2? 200 20} test Bbox-15.15 {X view scroll cell out of view Bug #2381555} -body { .tv xview 0 update set res [list [.tv bbox red #0]] .tv xview 200 update lappend res [.tv bbox red #0] set res } -cleanup { .tv xview 0 } -match {glob} -result {{0 2? 200 20} {-200 2? 200 20}} test Bbox-15.16 {X view scroll cell into view Bug #2381555} -body { .tv xview 400 update set res [list [.tv bbox red #0]] .tv xview 0 update lappend res [.tv bbox red #0] set res } -cleanup { .tv xview 0 } -match {glob} -result {{-400 2? 200 20} {0 2? 200 20}} test Bbox-15.17 {Title Columns No Scroll} -setup { .tv configure -titlecolumns 1 .tv xview 0 update } -body { set res [list [cell_bbox .tv red]] .tv xview 400 update lappend res [cell_bbox .tv red] return $res } -match {glob} -result {{{0 2? 200 20} {200 2? 200 20} {400 2? 200 20} {600 2? 200 20}} {{0 2? 200 20} {-200 2? 200 20} {0 2? 200 20} {200 2? 200 20}}} test Bbox-15.18 {Title Columns Scroll} -setup { .tv configure -titlecolumns 1 .tv xview 0 update } -body { set res [list [cell_bbox .tv blue]] .tv xview 400 update lappend res [cell_bbox .tv blue] return $res } -match {glob} -result {{{0 22? 200 20} {200 22? 200 20} {400 22? 200 20} {600 22? 200 20}} {{0 22? 200 20} {-200 22? 200 20} {0 22? 200 20} {200 22? 200 20}}} test Bbox-15.19 {Title Rows No Scroll} -setup { .tv configure -titleitems 1 .tv yview 0 update } -body { set res [list [cell_bbox .tv red]] .tv yview 400 update lappend res [cell_bbox .tv red] return $res } -match {glob} -result {{{0 2? 200 20} {-200 2? 200 20} {0 2? 200 20} {200 2? 200 20}} {{0 2? 200 20} {-200 2? 200 20} {0 2? 200 20} {200 2? 200 20}}} test Bbox-15.20 {Title Rows Scroll} -setup { .tv configure -titleitems 1 .tv yview 0 update } -body { set res [list [cell_bbox .tv blue]] .tv yview 400 update lappend res [cell_bbox .tv blue] return $res } -match {glob} -result {{{0 22? 200 20} {-200 22? 200 20} {0 22? 200 20} {200 22? 200 20}} {{} {} {} {}}} test Bbox-15.21 {Title Columns > Number of Columns} -setup { .tv configure -titlecolumns 5 .tv yview 0 update } -body { set res [list [.tv yview]] .tv yview 250 lappend res [.tv yview] return $res } -match {glob} -result {{0.0 0.46*} {0.53* 1.0}} test Bbox-15.22 {Title Rows > Number of Items} -setup { .tv configure -titleitems 50 .tv xview 0 update } -body { set res [list [.tv xview]] .tv xview 250 lappend res [.tv xview] return $res } -result {{0.0 1.0} {0.0 1.0}} test Bbox-15.23 {Cleanup} -body { destroy .tv .sx .sy } # Children test Children-17.1 {Create} -body { set w [create .tv] } -result {.tv} test Children-17.2 {Too few args} -body { .tv children } -result {wrong # args: should be ".tv children item ?newchildren?"} -returnCodes {1} test Children-17.3 {Too many args} -body { .tv children item list bogus } -result {wrong # args: should be ".tv children item ?newchildren?"} -returnCodes {1} test Children-17.4 {Invalid item} -body { .tv children bogus } -result {Item bogus not found} -returnCodes {1} test Children-17.5 {Invalid children} -body { .tv children {} bogus } -result {Item bogus not found} -returnCodes {1} test Children-17.6 {Get children} -body { set children [.tv children {}] } -result {red green blue orange yellow purple brown black white gray} test Children-17.7 {Get Root} -body { llength [.tv children {}] } -result {10} test Children-17.8 {Set Root} -body { set l [lreverse [.tv children {}]] .tv children {} $l lcompare $l [.tv children {}] } -result {1} test Children-17.9 {Get Children} -body { .tv children red } -result [lindex $::colors 1] test Children-17.10 {Set Children} -body { set l [lreverse [.tv children red]] .tv children red $l lcompare $l [.tv children red] } -result {1} test Children-17.11 {Replace Children} -body { .tv children blue green } test Children-17.12 {Check Children} -body { expr {"green" in [.tv children blue]} } -result {1} test Children-17.13 {Get Grand Children} -body { .tv children green } -result [lindex $::colors 3] test Children-17.14 {Does not have} -body { .tv children green [list lime olive] .tv detached teal } -result {1} test Children-17.15 {Replace Detached Children} -body { .tv children blue [lindex $::colors 5] .tv children blue } -result [lindex $::colors 5] test Children-17.16 {Replace children with parent} -body { .tv children cyan [list blue] } -result {Cannot insert blue as descendant of cyan} -returnCodes {1} test Children-17.17 {Replace with self} -body { .tv children blue [list blue] } -result {Cannot insert blue as descendant of blue} -returnCodes {1} test Children-17.18 {Check Order} -body { checkorder {} } -result {1} test Children-17.19 {Insert root item} -body { .tv children blue [list cyan {} darkblue] } -result {Cannot insert root as child item} -returnCodes {1} test Children-17.20 {Selected item} -setup { .tv selection set yellow set children [.tv children {}] } -body { set r [.tv selection] .tv children {} [list red green blue] lappend r [.tv selection] } -cleanup { .tv children {} $children } -result {yellow {}} test Children-17.21 {Focus item} -setup { .tv focus yellow set children [.tv children {}] } -body { set r [.tv focus] .tv children {} [list red green blue] lappend r [.tv focus] } -cleanup { .tv children {} $children } -result {yellow {}} test Children-17.22 {Selection anchor} -setup { .tv selection anchor yellow set children [.tv children {}] } -body { set r [.tv selection anchor] .tv children {} [list red green blue] lappend r [.tv selection anchor] } -cleanup { .tv children {} $children } -result {yellow {}} test Children-17.23 {Detached Item} -setup { .tv detach white } -body { llength [.tv children white] } -result {1} test Children-17.24 {Duplicate Items} -setup { .tv children {} $children } -body { .tv children {} [list red green blue yellow black gray white red green blue] llength [.tv children {}] } -result {7} test Children-17.25 {Duplicate Detached Items} -setup { .tv children {} $children .tv detach [list black white] } -body { .tv children {} [concat [.tv children {}] [.tv detached] [.tv detached]] llength [.tv children {}] } -result {12} test Children-17.26 {Duplicate Sequential Items} -setup { .tv children {} $children } -body { .tv children {} [list red red green green blue blue yellow black black gray gray white] llength [.tv children {}] } -result {7} test Children-17.27 {Cleanup} -body { destroy .tv .sx .sy } # Collapse set ::changed_item "" test Collapse-18.1 {Create} -body { set w [create .tv] } -result {.tv} test Collapse-18.2 {Too few args} -body { .tv collapse } -result {wrong # args: should be ".tv collapse ?-recurse? items"} -returnCodes {1} test Collapse-18.3 {Too many args} -body { .tv collapse -recurse {} bogus } -result {wrong # args: should be ".tv collapse ?-recurse? items"} -returnCodes {1} test Collapse-18.4 {Invalid item} -body { .tv collapse bogus } -result {Item bogus not found} -returnCodes {1} test Collapse-18.5 {Invalid arg} -body { .tv collapse -bogus {} } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Collapse-18.6 {Root} -setup { .tv expand -recurse {} } -body { .tv collapse {} } test Collapse-18.7 {Child} -body { .tv collapse red .tv item red -open } -result {0} test Collapse-18.8 {Grandchild} -body { .tv collapse maroon .tv item maroon -open } -result {0} test Collapse-18.9 {Great Grandchild} -setup { .tv move green blue 0 } -body { .tv collapse lime .tv item lime -open } -result {0} test Collapse-18.10 {Multiple} -body { .tv collapse [list red green blue] .tv item green -open } -result {0} test Collapse-18.11 {Recurse} -body { .tv collapse -recurse red .tv item maroon -open } -result {0} test Collapse-18.12 {All} -body { .tv collapse -recurse {} .tv item green -open } -result {0} test Collapse-18.13 {Detached Item} -setup { .tv detach white } -body { .tv collapse white .tv item white -open } -result {0} test Collapse-18.14 {Trigger virtual event} -setup { .tv item green -open 1 bind .tv "<>" {set ::changed_item green} } -body { ::ttk::treeview::ToggleOpenState .tv green update return $::changed_item } -result {green} test Collapse-18.15 {Vritual Event with detail} -setup { .tv item blue -open 1 bind .tv "<>" {set ::changed_item "%d"} } -body { ::ttk::treeview::ToggleOpenState .tv blue update return $::changed_item } -result {blue} test Collapse-18.16 {Cleanup} -body { destroy .tv .sx .sy } # Current test Current-19.1 {Create} -body { set w [create .tv] } -result {.tv} test Current-19.2 {Too many args} -body { .tv current bogus } -result {wrong # args: should be ".tv current"} -returnCodes {1} test Current-19.3 {Default current} -body { .tv current } test Current-19.4 {Set current item} -setup { lassign [.tv bbox red] x y w h event generate .tv -warp 1 -x $x -y $y } -body { .tv current } -result {red #0} test Current-19.5 {Set current item and column} -setup { lassign [.tv bbox red #1] x y w h incr x 10 event generate .tv -warp 1 -x $x -y $y } -body { .tv current } -result {red Hex} test Current-19.6 {Cleanup} -body { destroy .tv .sx .sy } # Delete test Delete-20.1 {Create} -body { set w [create .tv] } -result {.tv} test Delete-20.2 {Too few args} -body { .tv delete } -result {wrong # args: should be ".tv delete items"} -returnCodes {1} test Delete-20.3 {Too many args} -body { .tv delete {} bogus } -result {wrong # args: should be ".tv delete items"} -returnCodes {1} test Delete-20.4 {Invalid item} -body { .tv delete [list bogus] } -result {Item bogus not found} -returnCodes {1} test Delete-20.5 {Root} -body { .tv delete {{}} } -result {Cannot delete root item} -returnCodes {1} test Delete-20.6 {Single} -body { .tv delete white expr {"white" in [.tv children {}]} } -result {0} test Delete-20.7 {Multiple} -body { .tv delete [list black gray] expr {"black" in [.tv children {}]} } -result {0} test Delete-20.8 {Descendants of Deleted} -body { .tv delete [list yellow purple brown] expr {[.tv exists gold] || [.tv exists wheat]} } -result {0} test Delete-20.9 {Selected Item} -setup { .tv selection set turquoise } -body { set r [.tv selection] .tv delete turquoise lappend r [.tv selection] } -result {turquoise {}} test Delete-20.10 {Focus item} -setup { .tv focus teal } -body { set r [.tv focus] .tv delete teal lappend r [.tv focus] } -result {teal {}} test Delete-20.11 {Selection anchor} -setup { .tv selection anchor olive } -body { set r [.tv selection anchor] .tv delete olive lappend r [.tv selection anchor] } -result {olive {}} test Delete-20.12 {Child} -body { .tv delete orange expr {"orange" in [.tv children {}]} } -result {0} test Delete-20.13 {Grandchild} -body { .tv delete navy expr {"navy" in [.tv children blue]} } -result {0} test Delete-20.14 {Great Grandchild} -setup { .tv move blue green 0 } -body { .tv delete cyan expr {"cyan" in [.tv children blue]} } -result {0} test Delete-20.15 {Descendants and Parents} -body { expr {[.tv exists yellow] || [.tv exists orange] || [.tv exists coral]} } -result {0} test Delete-20.16 {Empty list} -body { .tv delete {} } test Delete-20.17 {Detached Item} -body { .tv move blue {} end .tv detach green .tv delete green .tv exists green } -result {0} test Delete-20.18 {Duplicate items} -body { .tv delete [list mediumblue darkblue] .tv delete darkblue } -result {Item darkblue not found} -returnCodes {1} test Delete-20.19 {Check Order} -body { checkorder {} } -result {1} test Delete-20.20 {Cleanup} -body { destroy .tv .sx .sy } # Depth test Depth-21.1 {Create} -body { set w [create .tv] } -result {.tv} test Depth-21.2 {Too few args} -body { .tv depth } -result {wrong # args: should be ".tv depth item"} -returnCodes {1} test Depth-21.3 {Too many args} -body { .tv depth {} bogus } -result {wrong # args: should be ".tv depth item"} -returnCodes {1} test Depth-21.4 {Invalid item} -body { .tv depth bogus } -result {Item bogus not found} -returnCodes {1} test Depth-21.5 {Root item} -body { .tv depth {} } -result {0} test Depth-21.6 {Child item} -body { .tv depth red } -result {1} test Depth-21.7 {Grandchild item} -body { .tv depth maroon } -result {2} test Depth-21.8 {Great Grandchild item} -setup { .tv move orange yellow 0 } -body { .tv depth coral } -result {3} test Depth-21.9 {Detached Item} -setup { .tv detach white } -body { .tv depth white } -result {0} test Depth-21.10 {Hidden Item} -setup { .tv item gray -hidden 1 } -body { .tv depth silver } -result {2} test Depth-21.11 {Cleanup} -body { destroy .tv .sx .sy } # Detach test Detach-22.1 {Create} -body { set w [create .tv] } -result {.tv} test Detach-22.2 {Too few args} -body { .tv detach } -result {wrong # args: should be ".tv detach items"} -returnCodes {1} test Detach-22.3 {Too many args} -body { .tv detach {} bogus } -result {wrong # args: should be ".tv detach items"} -returnCodes {1} test Detach-22.4 {Invalid item} -body { .tv detach [list bogus] } -result {Item bogus not found} -returnCodes {1} test Detach-22.5 {Detach Single} -setup { set children [.tv children {}] } -body { .tv detach red expr {"red" in [.tv children {}]} } -cleanup { .tv children {} $children } -result {0} test Detach-22.6 {Detach Multiple} -setup { set children [.tv children {}] } -body { .tv detach [list green blue] expr {"blue" in [.tv children {}]} } -cleanup { .tv children {} $children } -result {0} test Detach-22.7 {Check Order} -body { checkorder {} } -result {1} test Detach-22.8 {Detach Root} -body { .tv detach {} } test Detach-22.9 {Selected item} -setup { .tv selection set yellow set children [.tv children {}] } -body { set r [.tv selection] .tv detach yellow lappend r [.tv selection] } -cleanup { .tv children {} $children } -result {yellow {}} test Detach-22.10 {Focus item} -setup { .tv focus yellow set children [.tv children {}] } -body { set r [.tv focus] .tv detach yellow lappend r [.tv focus] } -cleanup { .tv children {} $children } -result {yellow {}} test Detach-22.11 {Selection anchor} -setup { .tv selection anchor yellow set children [.tv children {}] } -body { set r [.tv selection anchor] .tv detach yellow lappend r [.tv selection anchor] } -cleanup { .tv children {} $children } -result {yellow {}} test Detach-22.12 {Detach Child} -setup { set children [.tv children {}] } -body { .tv detach white expr {"white" in [.tv children {}]} } -cleanup { .tv children {} $children } -result {0} test Detach-22.13 {Detach Grandchild} -setup { set children [.tv children {}] } -body { .tv detach gold expr {"gold" in [.tv children yellow]} } -cleanup { .tv children {} $children } -result {0} test Detach-22.14 {Detach Great Grandchild} -setup { .tv move orange yellow 0 set children [.tv children {}] } -body { .tv detach coral expr {"coral" in [.tv children orange]} } -cleanup { .tv children {} $children } -result {0} test Detach-22.15 {Detach Detached Item} -setup { set children [.tv children {}] } -body { .tv detach white expr {"white" in [.tv children {}]} } -cleanup { .tv children {} $children } -result {0} test Detach-22.16 {Reattach} -setup { set children [.tv children {}] } -body { .tv move white {} end lindex [.tv children {}] end } -cleanup { .tv children {} $children } -result {white} test Detach-22.17 {Cleanup} -body { destroy .tv .sx .sy } # Detached test Detached-23.1 {Create} -body { set w [create .tv] } -result {.tv} test Detached-23.2 {Too many args} -body { .tv detached {} bogus } -result {wrong # args: should be ".tv detached ?-all|item?"} -returnCodes {1} test Detached-23.3 {Invalid item} -body { .tv detached bogus } -result {Item bogus not found} -returnCodes {1} test Detached-23.4 {Not Detached} -body { .tv detached red } -result {0} test Detached-23.5 {Detach Single} -body { .tv detach red .tv detached red } -result {1} test Detached-23.6 {Detach Multiple} -body { .tv detach [list green blue] .tv detached blue } -result {1} test Detached-23.7 {Get All Detached} -body { lsort [.tv detached] } -result {blue green red} test Detached-23.8 {Child of Detached} -body { .tv detached cyan } -result {1} test Detached-23.9 {Grandchild of Detached} -setup { .tv move orange blue 0 } -body { .tv detached coral } -result {1} test Detached-23.10 {Detach Child} -body { .tv detach white .tv detached white } -result {1} test Detached-23.11 {Detach Grandchild} -body { .tv detach gold .tv detached gold } -result {1} test Detached-23.12 {Detach Great Grandchild} -body { .tv detach coral .tv detached coral } -result {1} test Detached-23.13 {Reattach} -body { .tv move red {} 0 .tv detached red } -result {0} test Detached-23.14 {Reattach Granchild} -setup { .tv move orange {} end } -body { .tv move coral orange end .tv detached coral } -result {0} test Detached-23.15 {Get Detached} -body { lsort [.tv detached] } -result {blue gold green white} test Detached-23.16 {Get All Detached} -body { lsort [.tv detached -all] } -result {beige blue chartreuse cyan darkblue gold green lime mediumblue navy olive teal turquoise white} test Detached-23.17 {Detach Root} -body { .tv detach {} .tv detached {} } -result {0} test Detached-23.18 {Cleanup} -body { destroy .tv .sx .sy } # Exists test Exists-24.1 {Create} -body { set w [create .tv] } -result {.tv} test Exists-24.2 {Too few args} -body { .tv exists } -result {wrong # args: should be ".tv exists item"} -returnCodes {1} test Exists-24.3 {Too many args} -body { .tv exists {} bogus } -result {wrong # args: should be ".tv exists item"} -returnCodes {1} test Exists-24.4 {Invalid item} -body { .tv exists bogus } -result {0} test Exists-24.5 {Deleted} -body { .tv delete red .tv exists red } -result {0} test Exists-24.6 {Descendants of Deleted} -body { expr {[.tv exists maroon] || [.tv exists pink] || [.tv exists darkred] || [.tv exists magenta]} } -result {0} test Exists-24.7 {Root} -body { .tv exists {} } -result {1} test Exists-24.8 {Child} -body { .tv exists blue } -result {1} test Exists-24.9 {Grandchild} -body { .tv exists cyan } -result {1} test Exists-24.10 {Great Grandchild} -setup { .tv move orange yellow 0 } -body { .tv exists coral } -result {1} test Exists-24.11 {Deleted Great Grandchild} -setup { .tv delete yellow } -body { .tv exists coral } -result {0} test Exists-24.12 {Detached item} -setup { .tv detach white } -body { .tv exists white } -result {1} test Exists-24.13 {Deleted item} -setup { .tv delete black } -body { .tv exists black } -result {0} test Exists-24.14 {Cleanup} -body { destroy .tv .sx .sy } # Expand set ::changed_item "" test Expand-25.1 {Create} -body { set w [create .tv] } -result {.tv} test Expand-25.2 {Too few args} -body { .tv expand } -result {wrong # args: should be ".tv expand ?-recurse? items"} -returnCodes {1} test Expand-25.3 {Too many args} -body { .tv expand -recurse {} bogus } -result {wrong # args: should be ".tv expand ?-recurse? items"} -returnCodes {1} test Expand-25.4 {Invalid item} -body { .tv expand bogus } -result {Item bogus not found} -returnCodes {1} test Expand-25.5 {Invalid arg} -body { .tv expand -bogus {} } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Expand-25.6 {Root} -setup { .tv collapse -recurse {} } -body { .tv expand {} } test Expand-25.7 {Child} -body { .tv expand red .tv item red -open } -result {1} test Expand-25.8 {Grandchild} -setup { .tv move yellow maroon end } -body { .tv expand maroon .tv item maroon -open } -result {1} test Expand-25.9 {Multiple} -body { .tv expand [list green blue] .tv item blue -open } -result {1} test Expand-25.10 {Recurse} -setup { .tv collapse -recurse red } -body { .tv expand -recurse red .tv item maroon -open } -result {1} test Expand-25.11 {All} -setup { .tv collapse -recurse {} } -body { .tv expand -recurse {} .tv item red -open } -result {1} test Expand-25.12 {Detached item} -setup { .tv detach white } -body { .tv expand white .tv item white -open } -result {1} test Expand-25.13 {Trigger virtual event} -setup { .tv item green -open 0 bind .tv "<>" {set ::changed_item green} } -body { ::ttk::treeview::ToggleOpenState .tv green update return $::changed_item } -result {green} test Expand-25.14 {Vritual Event with detail} -setup { .tv item blue -open 0 bind .tv "<>" {set ::changed_item "%d"} } -body { ::ttk::treeview::ToggleOpenState .tv blue update return $::changed_item } -result {blue} test Expand-25.15 {Cleanup} -body { destroy .tv .sx .sy } # Focus set ::focus "" test Focus-26.1 {Create} -body { set w [create .tv] } -result {.tv} test Focus-26.2 {Too many args} -body { .tv focus {} bogus } -result {wrong # args: should be ".tv focus ?item?"} -returnCodes {1} test Focus-26.3 {Invalid item} -body { .tv focus bogus } -result {Item bogus not found} -returnCodes {1} test Focus-26.4 {No focus} -body { .tv focus {} .tv focus } test Focus-26.5 {Set item focus} -body { .tv focus red .tv focus } -result {red} test Focus-26.6 {Set focus grandchild} -body { .tv focus maroon .tv focus } -result {maroon} test Focus-26.7 {Clear focus} -body { .tv focus {} .tv focus } test Focus-26.8 {Focus on hidden item} -setup { .tv hide green } -body { .tv focus green .tv focus } -result {green} test Focus-26.9 {Delete focus item} -body { .tv focus blue .tv delete blue .tv focus } test Focus-26.10 {Detached item} -setup { .tv detach white } -body { .tv focus white .tv focus } -result {detached item} -returnCodes {1} test Focus-26.11 {Trigger virtual event} -setup { bind .tv "<>" {set ::focus [%W focus]} } -body { .tv focus red update return $::focus } -result {red} test Focus-26.12 {Clear virtial event} -body { .tv focus {} update return $::focus } test Focus-26.13 {Vritual Event with detail} -setup { bind .tv "<>" {set ::focus "%d"} } -body { .tv focus black update return $::focus } -result {black} test Focus-26.14 {Cleanup} -body { destroy .tv .sx .sy } # Cell Focus test Cell_Focus-27.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Focus-27.2 {Too many args} -body { .tv cellfocus {} bogus } -result {wrong # args: should be ".tv cellfocus ?cell?"} -returnCodes {1} test Cell_Focus-27.3 {Invalid cell} -body { .tv cellfocus bogus } -result {Cell id must be a list of two elements} -returnCodes {1} test Cell_Focus-27.4 {Invalid item} -body { .tv cellfocus {bogus #0} } -result {Item bogus not found} -returnCodes {1} test Cell_Focus-27.5 {Invalid column} -body { .tv cellfocus {red bogus} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Focus-27.6 {Clear focus} -body { .tv cellfocus {} .tv cellfocus } test Cell_Focus-27.7 {Clear focus with null cell} -body { .tv cellfocus {{} #0} .tv cellfocus } test Cell_Focus-27.8 {Set cell focus} -body { .tv cellfocus {blue #2} .tv cellfocus } -result {blue Decimal} test Cell_Focus-27.9 {Clear cell focus} -body { .tv focus {} .tv cellfocus } test Cell_Focus-27.10 {Set cell focus} -body { .tv cellfocus {red 0} .tv cellfocus } -result {red Hex} test Cell_Focus-27.11 {Set focus clears cell focus} -body { .tv focus blue .tv cellfocus } test Cell_Focus-27.12 {Focus on hidden item} -body { .tv hide green .tv cellfocus {green #1} .tv cellfocus } -result {green Hex} test Cell_Focus-27.13 {Delete focus item} -body { .tv cellfocus {blue #2} .tv delete blue .tv cellfocus } test Cell_Focus-27.14 {Detached item} -setup { .tv detach white } -body { .tv cellfocus {white #3} .tv cellfocus } -result {detached item} -returnCodes {1} test Cell_Focus-27.15 {Trigger virtual event} -setup { bind .tv "<>" {set ::focus [%W cellfocus]} } -body { .tv cellfocus [list red Hex] update return $::focus } -result {red Hex} test Cell_Focus-27.16 {Clear virtial event} -body { .tv cellfocus {} update return $::focus } test Cell_Focus-27.17 {Vritual Event with detail} -setup { bind .tv "<>" {set ::focus "%d"} } -body { .tv cellfocus {black #0} update return $::focus } -result {black #0} test Cell_Focus-27.18 {Cleanup} -body { destroy .tv .sx .sy } # Has Children test Has_Children-28.1 {Create} -body { set w [create .tv] } -result {.tv} test Has_Children-28.2 {Too few args} -body { .tv haschildren } -result {wrong # args: should be ".tv haschildren item"} -returnCodes {1} test Has_Children-28.3 {Too many args} -body { .tv haschildren {} bogus } -result {wrong # args: should be ".tv haschildren item"} -returnCodes {1} test Has_Children-28.4 {Invalid item} -body { .tv haschildren bogus } -result {Item bogus not found} -returnCodes {1} test Has_Children-28.5 {Has children} -body { .tv haschildren red } -result {1} test Has_Children-28.6 {Does not have children} -body { .tv haschildren black } -result {0} test Has_Children-28.7 {Root} -body { .tv haschildren {} } -result {1} test Has_Children-28.8 {Detached item} -setup { .tv detach white } -body { .tv haschildren white } -result {1} test Has_Children-28.9 {Hidden item} -setup { .tv item gray -hidden 1 } -body { .tv haschildren gray } -result {1} test Has_Children-28.10 {Empty tree} -setup { .tv children {} {} } -body { .tv haschildren {} } -result {0} test Has_Children-28.11 {Cleanup} -body { destroy .tv .sx .sy } # Hide test Hide-29.1 {Create} -body { set w [create .tv] } -result {.tv} test Hide-29.2 {Too few args} -body { .tv hide } -result {wrong # args: should be ".tv hide ?-recurse? items"} -returnCodes {1} test Hide-29.3 {Too many args} -body { .tv hide -recurse {} bogus } -result {wrong # args: should be ".tv hide ?-recurse? items"} -returnCodes {1} test Hide-29.4 {Invalid item} -body { .tv hide bogus } -result {Item bogus not found} -returnCodes {1} test Hide-29.5 {Invalid arg} -body { .tv hide -bogus {} } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Hide-29.6 {Root} -setup { .tv unhide -recurse {} } -body { .tv hide {} } test Hide-29.7 {Child} -body { .tv hide red .tv item red -hidden } -result {1} test Hide-29.8 {Grandchild} -body { .tv hide maroon .tv item maroon -hidden } -result {1} test Hide-29.9 {Multiple} -body { .tv hide [list green blue] .tv item blue -hidden } -result {1} test Hide-29.10 {Recurse} -body { .tv hide -recurse red .tv item maroon -hidden } -result {1} test Hide-29.11 {All} -body { .tv hide -recurse {} .tv item green -hidden } -result {1} test Hide-29.12 {Detached item} -setup { .tv detach white } -body { .tv hide white .tv item white -hidden } -result {1} test Hide-29.13 {Cleanup} -body { destroy .tv .sx .sy } # Identifier - Get Item at Index within an Item test Identifier-30.1 {Create} -body { set w [create .tv] } -result {.tv} test Identifier-30.2 {Too few args} -body { .tv identifier } -result {wrong # args: should be ".tv identifier item index"} -returnCodes {1} test Identifier-30.3 {Too many args} -body { .tv identifier {} 0 bogus } -result {wrong # args: should be ".tv identifier item index"} -returnCodes {1} test Identifier-30.4 {Invalid item} -body { .tv identifier bogus 0 } -result {Item bogus not found} -returnCodes {1} test Identifier-30.5 {Invalid index} -body { .tv identifier {} bogus } -result {bad index "bogus": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Identifier-30.6 {First Child} -body { .tv identifier {} first } -result {red} test Identifier-30.7 {Last Child} -body { .tv identifier {} last } -result {gray} test Identifier-30.8 {End Index} -body { .tv identifier {} end } -result {gray} test Identifier-30.9 {Partial index} -body { .tv identifier {} en } -result {bad index "en": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Identifier-30.10 {0th child} -body { .tv identifier {} 0 } -result {red} test Identifier-30.11 {8th Child} -body { .tv identifier {} 8 } -result {white} test Identifier-30.12 {Size Index} -body { .tv identifier {} [.tv size {}] } -result {gray} test Identifier-30.13 {Negative index} -body { .tv identifier {} -1 } -result {red} test Identifier-30.14 {Out of range index} -body { .tv identifier {} 100 } -result {gray} test Identifier-30.15 {End+10} -body { .tv identifier {} end+10 } -result {gray} test Identifier-30.16 {End-1} -body { .tv identifier {} end-1 } -result {white} test Identifier-30.17 {End-10} -body { .tv identifier {} end-10 } -result {red} test Identifier-30.18 {End-100} -body { .tv identifier {} end-100 } -result {red} test Identifier-30.19 {M+N Index} -body { .tv identifier {} 1+4 } -result {purple} test Identifier-30.20 {M-N Index} -body { .tv identifier {} 6-3 } -result {orange} test Identifier-30.21 {M-N Negative index} -body { .tv identifier {} 6-20 } -result {red} test Identifier-30.22 {M+N Out of range index} -body { .tv identifier {} 5+10 } -result {gray} test Identifier-30.23 {First Grandchild} -body { .tv identifier red first } -result {pink} test Identifier-30.24 {2nd Grandchild} -body { .tv identifier red 1 } -result {maroon} test Identifier-30.25 {Last Grandchild} -body { .tv identifier red last } -result {magenta} test Identifier-30.26 {Detached item} -setup { .tv detach white } -body { .tv identifier white 0 } -result {beige} test Identifier-30.27 {Cleanup} -body { destroy .tv .sx .sy } # Index - Get index of an item within it's parent test Index-31.1 {Create} -body { set w [create .tv] } -result {.tv} test Index-31.2 {Too few args} -body { .tv index } -result {wrong # args: should be ".tv index item ?index?"} -returnCodes {1} test Index-31.3 {Too many args} -body { .tv index {} 0 bogus } -result {wrong # args: should be ".tv index item ?index?"} -returnCodes {1} test Index-31.4 {Invalid item} -body { .tv index bogus } -result {Item bogus not found} -returnCodes {1} test Index-31.5 {Invalid index} -body { .tv index {} bogus } -result {bad index "bogus": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Index-31.6 {Root} -body { .tv index {} } -result {0} test Index-31.7 {Index First} -body { .tv index red } -result {0} test Index-31.8 {Index Middle} -body { .tv index orange } -result {3} test Index-31.9 {Index End} -body { .tv index gray } -result {9} test Index-31.10 {First Grandchild} -body { .tv index red first } -result {0} test Index-31.11 {2nd Grandchild} -body { .tv index red 1 } -result {1} test Index-31.12 {Last Grandchild} -body { .tv index red last } -result {3} test Index-31.13 {Detached item} -setup { .tv detach white } -body { .tv index white } -result {0} test Index-31.14 {Cleanup} -body { destroy .tv .sx .sy } # Index Id test Index_Id-32.1 {Create} -body { set w [create .tv] } -result {.tv} test Index_Id-32.2 {Invalid index} -body { .tv index {} bogus } -result {bad index "bogus": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Index_Id-32.3 {First} -body { .tv index {} first } -result {0} test Index_Id-32.4 {Last} -body { .tv index {} last } -result {9} test Index_Id-32.5 {End} -body { .tv index {} end } -result {10} test Index_Id-32.6 {Partial index} -body { .tv index {} en } -result {bad index "en": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Index_Id-32.7 {0th Child} -body { .tv index {} 0 } -result {0} test Index_Id-32.8 {8th Child} -body { .tv index {} 8 } -result {8} test Index_Id-32.9 {Negative index} -body { .tv index {} -1 } test Index_Id-32.10 {Out of range index} -body { .tv index {} 100 } -result {100} test Index_Id-32.11 {End+10} -body { .tv index {} end+10 } test Index_Id-32.12 {End-1} -body { .tv index {} end-1 } -result {9} test Index_Id-32.13 {End-100} -body { .tv index {} end-100 } test Index_Id-32.14 {M+N Index} -body { .tv index {} 1+4 } -result {5} test Index_Id-32.15 {M-N Index} -body { .tv index {} 6-3 } -result {3} test Index_Id-32.16 {M-N Negative index} -body { .tv index {} 6-20 } test Index_Id-32.17 {M+N Out of range index} -body { .tv index {} 5+10 } -result {15} test Index_Id-32.18 {Cleanup} -body { destroy .tv .sx .sy } # Insert test Insert-33.1 {Create} -body { set w [create .tv] } -result {.tv} test Insert-33.2 {Too few args} -body { .tv insert } -match {glob} -result {wrong # args: should be ".tv insert ?parent index?|?before|after item? ?-id id? ?-option value ...?"} -returnCodes {1} test Insert-33.3 {Invalid item} -body { .tv insert bogus end } -result {Item bogus not found} -returnCodes {1} test Insert-33.4 {Insert invalid index} -body { .tv insert {} bogus } -result {bad index "bogus": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Insert-33.5 {Insert invalid before item} -body { .tv insert before bogus } -result {Item bogus not found} -returnCodes {1} test Insert-33.6 {Insert invalid after item} -body { .tv insert after bogus } -result {Item bogus not found} -returnCodes {1} test Insert-33.7 {Partial name} -body { .tv insert aft end } -result {Item aft not found} -returnCodes {1} test Insert-33.8 {Insert with defaults} -body { .tv insert {} end } -match {glob} -result {I00*} test Insert-33.9 {Insert at 0} -body { .tv insert {} 0 -id zero lindex [.tv children {}] 0 } -result {zero} test Insert-33.10 {Insert at index} -body { .tv insert {} 5 -id middle lindex [.tv children {}] 5 } -result {middle} test Insert-33.11 {Insert at end} -body { .tv insert {} end -id end lindex [.tv children {}] end } -result {end} test Insert-33.12 {Insert before beginning} -body { .tv insert {} -1 -id before lindex [.tv children {}] 0 } -result {before} test Insert-33.13 {Insert beyond end} -body { .tv insert {} 100 -id beyond lindex [.tv children {}] end } -result {beyond} test Insert-33.14 {Insert at first} -body { .tv insert {} first -id first lindex [.tv children {}] 0 } -result {first} test Insert-33.15 {Insert at last} -body { .tv insert {} last -id last lindex [.tv children {}] end-1 } -result {last} test Insert-33.16 {Insert with id} -body { .tv insert {} end -id new .tv exists new } -cleanup { .tv delete new } -result {1} test Insert-33.17 {Insert duplicate id} -body { .tv insert {} end -id new .tv insert {} end -id new } -cleanup { .tv delete new } -result {Item new already exists} -returnCodes {1} test Insert-33.18 {Insert with height} -body { .tv insert {} end -id new -height 5 .tv item new -height } -cleanup { .tv delete new } -result {5} test Insert-33.19 {Insert with hidden} -body { .tv insert {} end -id new -hidden 1 .tv item new -hidden } -cleanup { .tv delete new } -result {1} test Insert-33.20 {Insert with image} -body { .tv insert {} end -id new -image ::tk::icons::error .tv item new -image } -cleanup { .tv delete new } -result {::tk::icons::error} test Insert-33.21 {Insert with image anchor} -body { .tv insert {} end -id new -imageanchor sw .tv item new -imageanchor } -cleanup { .tv delete new } -result {sw} test Insert-33.22 {Insert with open} -body { .tv insert {} end -id new -open 1 .tv item new -open } -cleanup { .tv delete new } -result {1} test Insert-33.23 {Insert with tags} -body { .tv insert {} end -id new -tags new_tag .tv item new -tags } -cleanup { .tv delete new } -result {new_tag} test Insert-33.24 {Insert with text} -body { .tv insert {} end -id new -text "Some text" .tv item new -text } -cleanup { .tv delete new } -result {Some text} test Insert-33.25 {Insert with values} -body { .tv insert {} end -id new -values [list #FF 255 0.1] .tv item new -values } -cleanup { .tv delete new } -match {glob} -result {*} test Insert-33.26 {Insert child} -body { .tv insert {} end -id child lindex [.tv children {}] end } -result {child} test Insert-33.27 {Insert grandchild} -body { .tv insert child end -id grandchild lindex [.tv children child] end } -result {grandchild} test Insert-33.28 {Insert greatgrandchild} -body { .tv insert grandchild end -id greatgrandchild lindex [.tv children grandchild] end } -cleanup { .tv delete child } -result {greatgrandchild} test Insert-33.29 {Check Order} -body { checkorder {} } -result {1} test Insert-33.30 {Cleanup} -body { destroy .tv .sx .sy } test Insert-33.31 {Create} -body { set w [create .tv] } -result {.tv} test Insert-33.32 {Insert before first item} -body { .tv insert before red -id new lindex [.tv children {}] 0 } -cleanup { .tv delete new } -result {new} test Insert-33.33 {Insert after first item} -body { .tv insert after red -id new lindex [.tv children {}] 1 } -cleanup { .tv delete new } -result {new} test Insert-33.34 {Insert before end item} -body { .tv insert before gray -id new lindex [.tv children {}] end-1 } -cleanup { .tv delete new } -result {new} test Insert-33.35 {Insert after end item} -body { .tv insert after gray -id new lindex [.tv children {}] end } -cleanup { .tv delete new } -result {new} test Insert-33.36 {Insert before detached item} -setup { .tv detach black } -body { .tv insert before black } -result {cannot insert before detached item} -returnCodes {1} test Insert-33.37 {Insert after detached item} -body { .tv insert after black } -result {cannot insert after detached item} -returnCodes {1} test Insert-33.38 {Cleanup} -body { destroy .tv .sx .sy } # Item test Item-34.1 {Create} -body { set w [create .tv] } -result {.tv} test Item-34.2 {Too few args} -body { .tv item } -result {wrong # args: should be ".tv item item ?-option? ?value? ?-option value ...?"} -returnCodes {1} test Item-34.3 {Invalid item} -body { .tv item bogus } -result {Item bogus not found} -returnCodes {1} test Item-34.4 {Invalid option} -body { .tv item testitem -bogus value } -result {Item testitem not found} -returnCodes {1} test Item-34.5 {Setup item} -body { .tv insert {} end -id testitem } -result {testitem} test Item-34.6 {item get all} -body { .tv item testitem } -result {-text {} -height 1 -hidden 0 -id testitem -image {} -imageanchor {} -values {} -open 0 -tags {} state {}} test Item-34.7 {item get height} -body { .tv item testitem -height } -result {1} test Item-34.8 {item get hidden} -body { .tv item testitem -hidden } -result {0} test Item-34.9 {item get id} -body { .tv item testitem -id } -result {testitem} test Item-34.10 {item get image} -body { .tv item testitem -image } test Item-34.11 {item get image anchor} -body { .tv item testitem -imageanchor } test Item-34.12 {item get open} -body { .tv item testitem -open } -result {0} test Item-34.13 {item get tags} -body { .tv item testitem -tags } test Item-34.14 {item get text} -body { .tv item testitem -text } test Item-34.15 {item get values} -body { .tv item testitem -values } test Item-34.16 {Item set height} -body { .tv item testitem -height 5 .tv item testitem -height } -result {5} test Item-34.17 {Item set hidden} -body { .tv item testitem -hidden 1 .tv item testitem -hidden } -result {1} test Item-34.18 {Item set image} -body { .tv item testitem -image ::tk::icons::error .tv item testitem -image } -result {::tk::icons::error} test Item-34.19 {Item set image anchor} -body { .tv item testitem -imageanchor sw .tv item testitem -imageanchor } -result {sw} test Item-34.20 {Item set open} -body { .tv item testitem -open 1 .tv item testitem -open } -result {1} test Item-34.21 {Item set tags} -body { .tv item testitem -tags testitem_tag .tv item testitem -tags } -result {testitem_tag} test Item-34.22 {Item set text} -body { .tv item testitem -text "Some text" .tv item testitem -text } -result {Some text} test Item-34.23 {Item set values} -body { .tv item testitem -values [list #FF 255 0.1] .tv item testitem -values } -result [list #FF 255 0.1] test Item-34.24 {Item reset height} -body { .tv item testitem -height 1 .tv item testitem -height } -result {1} test Item-34.25 {Item reset hidden} -body { .tv item testitem -hidden 0 .tv item testitem -hidden } -result {0} test Item-34.26 {Item reset image} -body { .tv item testitem -image "" .tv item testitem -image } test Item-34.27 {Item reset image anchor} -body { .tv item testitem -imageanchor "" .tv item testitem -imageanchor } test Item-34.28 {Item reset open} -body { .tv item testitem -open 0 .tv item testitem -open } -result {0} test Item-34.29 {Item reset tags} -body { .tv item testitem -tags "" .tv item testitem -tags } test Item-34.30 {Item reset text} -body { .tv item testitem -text "" .tv item testitem -text } test Item-34.31 {Item reset values} -body { .tv item testitem -values "" .tv item testitem -values } test Item-34.32 {Item invalid height} -body { .tv item testitem -height -15 .tv item testitem -height } -result {Invalid item height -15} -returnCodes {1} test Item-34.33 {Item set invalid height} -body { .tv item testitem -height 1.5 } -result {expected integer but got "1.5"} -returnCodes {1} test Item-34.34 {Item set 0 height} -body { .tv item testitem -height 0 } -result {Invalid item height 0} -returnCodes {1} test Item-34.35 {Item set invalid hidden} -body { .tv item testitem -hidden bogus } -result {expected boolean value but got "bogus"} -returnCodes {1} test Item-34.36 {Item set invalid image} -body { .tv item testitem -image bogus } -result {image "bogus" does not exist} -returnCodes {1} test Item-34.37 {Item set invalid image anchor} -body { .tv item testitem -imageanchor bogus } -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, center, or ""} -returnCodes {1} test Item-34.38 {Item set invalid values} -body { .tv item testitem -values "{bad}list" } -match {glob} -result {list element in braces followed by*} -returnCodes {1} test Item-34.39 {Root item} -body { .tv item {} } -result {-text {} -height 1 -hidden 0 -id {} -image {} -imageanchor {} -values {} -open 1 -tags {} state {}} test Item-34.40 {Root get} -body { .tv item {} -text } test Item-34.41 {Root set} -body { .tv item {} -text "root" .tv item {} -text } -result {root} test Item-34.42 {Cleanup} -body { destroy .tv .sx .sy } # Move test Move-35.1 {Create} -body { set w [create .tv] } -result {.tv} test Move-35.2 {Too few args} -body { .tv move } -result {wrong # args: should be ".tv move item ?parent index?|?before|after otherItem?"} -returnCodes {1} test Move-35.3 {Too many args} -body { .tv move {} {} 0 bogus } -result {wrong # args: should be ".tv move item ?parent index?|?before|after otherItem?"} -returnCodes {1} test Move-35.4 {Invalid item} -body { .tv move bogus {} end } -result {Item bogus not found} -returnCodes {1} test Move-35.5 {Invalid parent} -body { .tv move red bogus end } -result {Item bogus not found} -returnCodes {1} test Move-35.6 {Invalid index} -body { .tv move red {} bogus } -result {bad index "bogus": must be first, last, end, end-n, m+n, m-n, or an index number >= 0} -returnCodes {1} test Move-35.7 {Move invalid before item} -body { .tv move red before bogus } -result {Item bogus not found} -returnCodes {1} test Move-35.8 {Move invalid after item} -body { .tv move red after bogus } -result {Item bogus not found} -returnCodes {1} test Move-35.9 {Partial name} -body { .tv move red aft end } -result {Item aft not found} -returnCodes {1} test Move-35.10 {No change Check} -body { lindex [.tv children {}] 0 } -result {red} test Move-35.11 {Move root} -body { .tv move {} {} 0 } -result {cannot move root item} -returnCodes {1} test Move-35.12 {Move under self} -body { .tv move red red 0 } -result {Cannot insert red as descendant of red} -returnCodes {1} test Move-35.13 {Move after self} -body { .tv move red {} 0 lindex [.tv children {}] 0 } -result {red} test Move-35.14 {Move under child} -body { .tv move red maroon 0 } -result {Cannot insert red as descendant of maroon} -returnCodes {1} test Move-35.15 {Move under grandchild} -setup { .tv move green maroon 0 } -body { .tv move red lime 0 } -result {Cannot insert red as descendant of lime} -returnCodes {1} test Move-35.16 {Move first to last} -body { .tv move red {} last .tv identifier {} last } -result {gray} test Move-35.17 {Move end to first} -body { .tv move red {} first .tv identifier {} first } -result {red} test Move-35.18 {Move first to end} -body { .tv move red {} end .tv identifier {} end } -result {red} test Move-35.19 {Move item to index 0} -body { .tv move red {} 0 .tv identifier {} 0 } -result {red} test Move-35.20 {Move item after end} -body { .tv move red {} 50 .tv identifier {} 50 } -result {red} test Move-35.21 {Move item before start} -body { .tv move red {} -5 .tv identifier {} -5 } -result {red} test Move-35.22 {Move item to size index} -body { set size [.tv size {}] .tv move red {} $size .tv identifier {} $size } -result {red} test Move-35.23 {Move item to -10} -body { .tv move red {} -10 .tv identifier {} -10 } -result {red} test Move-35.24 {Move item to size index + 1} -body { set size [.tv size {}] incr size .tv move red {} $size .tv identifier {} $size } -result {red} test Move-35.25 {Move item under item} -body { .tv move blue green 0 lindex [.tv children green] 0 } -result {blue} test Move-35.26 {Remaining Order} -body { checkorder {} } -result {1} test Move-35.27 {Move item to new parent} -body { .tv move red {} 0 .tv identifier {} 0 } -result {red} test Move-35.28 {Move detached item} -setup { .tv detach white } -body { .tv move white green 0 .tv identifier green 0 } -result {white} test Move-35.29 {Move child after self} -body { .tv move red {} 1 .tv index red } -result {0} test Move-35.30 {Move child before self} -body { .tv move red {} 0 .tv index red } -result {0} test Move-35.31 {Check Order} -body { checkorder {} } -result {1} test Move-35.32 {Move before first item} -body { .tv move blue before red lindex [.tv children {}] 0 } -result {blue} test Move-35.33 {Move after first item} -body { .tv move blue after red lindex [.tv children {}] 1 } -result {blue} test Move-35.34 {Move before end item} -body { .tv move blue before gray lindex [.tv children {}] end-1 } -result {blue} test Move-35.35 {Move after end item} -body { .tv move blue after gray lindex [.tv children {}] end } -result {blue} test Move-35.36 {Move before detached item} -setup { .tv detach white } -body { .tv move blue before white } -result {cannot move before detached item} -returnCodes {1} test Move-35.37 {Move after detached item} -body { .tv move blue after white } -result {cannot move after detached item} -returnCodes {1} test Move-35.38 {Selected item} -setup { .tv selection set yellow set children [.tv children {}] } -body { set r [.tv selection] .tv move yellow before orange lappend r [.tv selection] } -cleanup { .tv children {} $children } -result {yellow yellow} test Move-35.39 {Focus item} -setup { .tv focus yellow set children [.tv children {}] } -body { set r [.tv focus] .tv move yellow before orange lappend r [.tv focus] } -cleanup { .tv children {} $children } -result {yellow yellow} test Move-35.40 {Selection anchor} -setup { .tv selection anchor yellow set children [.tv children {}] } -body { set r [.tv selection anchor] .tv move yellow before orange lappend r [.tv selection anchor] } -cleanup { .tv children {} $children } -result {yellow yellow} test Move-35.41 {Cleanup} -body { destroy .tv .sx .sy } # Parent test Parent-36.1 {Create} -body { set w [create .tv] } -result {.tv} test Parent-36.2 {Too few args} -body { .tv parent } -result {wrong # args: should be ".tv parent item"} -returnCodes {1} test Parent-36.3 {Too many args} -body { .tv parent {} bogus } -result {wrong # args: should be ".tv parent item"} -returnCodes {1} test Parent-36.4 {Invalid item} -body { .tv parent bogus } -result {Item bogus not found} -returnCodes {1} test Parent-36.5 {Root item} -body { .tv parent {} } -result {} test Parent-36.6 {Item} -body { .tv parent red } -result {} test Parent-36.7 {Child Item} -body { .tv parent pink } -result {red} test Parent-36.8 {Grandchild Item} -setup { .tv move green red end } -body { .tv parent lime } -result {green} test Parent-36.9 {Detached Item} -setup { .tv detach white } -body { .tv parent white } test Parent-36.10 {Cleanup} -body { destroy .tv .sx .sy } # Set test Set-37.1 {Create} -body { set w [create .tv] } -result {.tv} test Set-37.2 {Too few args} -body { .tv set } -result {wrong # args: should be ".tv set item ?column? ?value? ?column value ...?"} -returnCodes {1} test Set-37.3 {Invalid item} -body { .tv set bogus } -result {Item bogus not found} -returnCodes {1} test Set-37.4 {Invalid column name} -body { .tv set {} bogus } -result {Invalid column index "bogus"} -returnCodes {1} test Set-37.5 {Invalid column number} -body { .tv set red 3 } -result {Column index "3" out of bounds} -returnCodes {1} test Set-37.6 {Invalid display column} -body { .tv set red #4 } -result {Column #4 out of range} -returnCodes {1} test Set-37.7 {Invalid argc} -body { .tv set red Hex #FF0000 Decimal } -result {wrong # args: should be ".tv set item ?column? ?value? ?column value ...?"} -returnCodes {1} test Set-37.8 {Get All} -body { .tv set red } -result {{#0} Red Hex #FF0000 Decimal 16711680 Float 18568347.648} test Set-37.9 {Get tree column} -body { .tv set red #0 } -result {Red} test Set-37.10 {Set tree column} -body { .tv set red #0 Rojo .tv set red #0 } -result {Rojo} test Set-37.11 {Check tree column} -body { .tv item red -text } -result {Rojo} test Set-37.12 {Get by column name} -body { .tv set red Hex } -result {#FF0000} test Set-37.13 {Set by column name} -body { .tv set red Hex #012345 .tv set red Hex } -result {#012345} test Set-37.14 {Check by column name} -body { lindex [.tv item red -values] 0 } -result {#012345} test Set-37.15 {Get by column number} -body { .tv set red 1 } -result {16711680} test Set-37.16 {Set by column number} -body { .tv set red 1 123 .tv set red 1 } -result {123} test Set-37.17 {Check by column number} -body { lindex [.tv item red -values] 1 } -result {123} test Set-37.18 {Get by display column number} -body { .tv set red #3 } -result {18568347.648} test Set-37.19 {Set by display column number} -body { .tv set red #3 1234.5678 .tv set red #3 } -result {1234.5678} test Set-37.20 {Check by display column number} -body { lindex [.tv item red -values] 2 } -result {1234.5678} test Set-37.21 {Set multiple} -body { .tv set blue #0 Azul Hex #987654 1 987654321 #3 9876.543210 .tv set blue } -result {{#0} Azul Hex #987654 Decimal 987654321 Float 9876.543210} test Set-37.22 {Set tree column} -body { .tv set green #0 new .tv set green #0 } -result {new} test Set-37.23 {Get with no tree column} -setup { .tv insert {} end -id test } -body { .tv set test #0 } test Set-37.24 {Set with no tree column} -body { .tv set test #0 Test .tv set test #0 } -result {Test} test Set-37.25 {Get with no values} -body { .tv set test 0 } test Set-37.26 {Set with no values} -body { .tv set test 2 345.678 .tv set test 2 } -result {345.678} test Set-37.27 {Detached Item} -setup { .tv detach white } -body { .tv set white #0 new .tv set white #0 } -result {new} test Set-37.28 {Root item} -body { .tv set {} } -result {{#0} {} Hex {} Decimal {} Float {}} test Set-37.29 {Root get} -body { .tv set {} #0 } test Set-37.30 {Root set} -body { .tv set {} #0 Rainbow .tv set {} #0 } -result {Rainbow} test Set-37.31 {Cleanup} -body { destroy .tv .sx .sy } # Size test Size-38.1 {Create} -body { set w [create .tv] } -result {.tv} test Size-38.2 {Too few args} -body { .tv size } -result {wrong # args: should be ".tv size ?-hidden? ?-recurse? item"} -returnCodes {1} test Size-38.3 {Too many args} -body { .tv size -hidden -recurse -recursive {} } -result {wrong # args: should be ".tv size ?-hidden? ?-recurse? item"} -returnCodes {1} test Size-38.4 {Invalid item} -body { .tv size bogus } -result {Item bogus not found} -returnCodes {1} test Size-38.5 {Invalid arg} -body { .tv size -bogus {} } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Size-38.6 {Root items} -body { .tv size {} } -result [llength [.tv children {}]] test Size-38.7 {Child items} -body { .tv size red } -result [llength [.tv children red]] test Size-38.8 {All recurse items} -body { .tv size -recurse {} } -result [llength [concat {*}$::colors]] test Size-38.9 {All recurse items under child} -setup { .tv move green red end } -body { .tv size -recurse red } -result {9} test Size-38.10 {Detached Item} -setup { .tv detach white } -body { .tv size white } -result [llength [.tv children white]] test Size-38.11 {Not hidden items} -setup { .tv hide black } -body { .tv size {} } -result {7} test Size-38.12 {Hidden items} -setup { .tv hide black } -body { .tv size -hidden {} } -result {8} test Size-38.13 {Cleanup} -body { destroy .tv .sx .sy } # Unhide test Unhide-39.1 {Create} -body { set w [create .tv] } -result {.tv} test Unhide-39.2 {Too few args} -body { .tv unhide } -result {wrong # args: should be ".tv unhide ?-recurse? items"} -returnCodes {1} test Unhide-39.3 {Too many args} -body { .tv unhide -recurse {} bogus } -result {wrong # args: should be ".tv unhide ?-recurse? items"} -returnCodes {1} test Unhide-39.4 {Invalid item} -body { .tv unhide bogus } -result {Item bogus not found} -returnCodes {1} test Unhide-39.5 {Invalid arg} -body { .tv unhide -bogus red } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Unhide-39.6 {Root} -setup { .tv hide -recurse {} } -body { .tv unhide {} } test Unhide-39.7 {Child} -body { .tv unhide red .tv item red -hidden } -result {0} test Unhide-39.8 {Grandchild} -body { .tv unhide maroon .tv item maroon -hidden } -result {0} test Unhide-39.9 {Multiple} -body { .tv unhide [list green blue] .tv item blue -hidden } -result {0} test Unhide-39.10 {Recurse} -body { .tv unhide -recurse red .tv item maroon -hidden } -result {0} test Unhide-39.11 {All} -body { .tv unhide -recurse {} .tv item green -hidden } -result {0} test Unhide-39.12 {Detached item} -setup { .tv detach white } -body { .tv unhide white .tv item white -hidden } -result {0} test Unhide-39.13 {Cleanup} -body { destroy .tv .sx .sy } # Visible test Visible-40.1 {Create} -body { set w [create .tv] } -result {.tv} test Visible-40.2 {Too few args} -body { .tv visible } -result {wrong # args: should be ".tv visible item"} -returnCodes {1} test Visible-40.3 {Too many args} -body { .tv visible {} bogus } -result {wrong # args: should be ".tv visible item"} -returnCodes {1} test Visible-40.4 {Invalid item} -body { .tv visible bogus } -result {Item bogus not found} -returnCodes {1} test Visible-40.5 {Root} -body { .tv visible {} } -result {1} test Visible-40.6 {Child} -body { .tv visible red } -result {1} test Visible-40.7 {Grandchild} -body { .tv visible maroon } -result {1} test Visible-40.8 {Great grandchild} -setup { .tv move green red end } -body { .tv visible lime } -result {1} test Visible-40.9 {Hidden Item} -setup { .tv item blue -hidden 1 } -body { .tv visible blue } -result {0} test Visible-40.10 {Hidden child Item} -body { .tv visible cyan } -result {0} test Visible-40.11 {Detached item} -setup { .tv detach white } -body { .tv visible white } -result {0} test Visible-40.12 {Detached child item} -body { .tv visible beige } -result {0} test Visible-40.13 {Parent Closed} -setup { .tv item blue -hidden 0 -open 0 } -body { .tv visible cyan } -result {0} test Visible-40.14 {Cleanup} -body { destroy .tv .sx .sy } proc get_all {w fn item args} { set list [list] while {$item ne ""} { lappend list $item set item [$w $fn {*}$args $item] } return $list } # Binding functions # After test After-41.1 {Create} -body { set w [create .tv] } -result {.tv} test After-41.2 {Too few args} -body { .tv after } -result {wrong # args: should be ".tv after ?-hidden? ?-norecurse? item"} -returnCodes {1} test After-41.3 {Too many args} -body { .tv after -hidden -norecurse -bogus red } -result {wrong # args: should be ".tv after ?-hidden? ?-norecurse? item"} -returnCodes {1} test After-41.4 {Invalid item} -body { .tv after bogus } -result {Item bogus not found} -returnCodes {1} test After-41.5 {Invald option} -body { .tv after -bogus red } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test After-41.6 {Get all} -body { get_all .tv after red -norecurse } -result {red green blue orange yellow purple brown black white gray} test After-41.7 {Get all recurse} -body { get_all .tv after red } -result [concat {*}$::colors] test After-41.8 {Move} -body { .tv move brown red end } test After-41.9 {Get visible item after first item collapsed} -setup { .tv collapse -recurse {} } -body { .tv after red } -result {green} test After-41.10 {Get visible item after last item collapsed} -body { .tv after gray } test After-41.11 {Get visible item after child collapsed} -body { .tv after maroon } -result {darkred} test After-41.12 {Get visible item after last child collapsed} -body { .tv after magenta } -result {brown} test After-41.13 {Get visible item after grandchild collapsed} -body { .tv after lime } -result {olive} test After-41.14 {Get visible item after last grandchild collapsed} -body { .tv after teal } -result {blue} test After-41.15 {Get visible item after last item in tree collapsed} -body { .tv after silver } test After-41.16 {After root} -body { .tv after {} } test After-41.17 {Get visible item after first item expanded} -setup { .tv expand -recurse {} } -body { .tv after red } -result {pink} test After-41.18 {Get visible item after last item expanded} -body { .tv after gray } -result {silver} test After-41.19 {Get visible item after child expanded} -body { .tv after maroon } -result {darkred} test After-41.20 {Get visible item after last child expanded} -body { .tv after magenta } -result {brown} test After-41.21 {Get visible item after grandchild expanded} -body { .tv after lime } -result {olive} test After-41.22 {Get visible item after last grandchild expanded} -body { .tv after teal } -result {blue} test After-41.23 {Get visible item after last item in tree} -body { .tv after silver } test After-41.24 {Get visible item after detached item} -setup { .tv detach white } -body { .tv after white } test After-41.25 {After root} -body { .tv after {} } test After-41.26 {Get visible item after hidden item} -setup { .tv item orange -hidden 1 } -body { .tv after -norecurse orange } -result {yellow} test After-41.27 {Get visible item after item no recurse no hidden} -body { .tv after -norecurse blue } -result {yellow} test After-41.28 {Get visible item after item no recurse include hidden} -body { .tv after -norecurse -hidden blue } -result {orange} test After-41.29 {Get visible after last child without recurse} -body { .tv after -norecurse teal } test After-41.30 {Cleanup} -body { destroy .tv .sx .sy } # Before test Before-42.1 {Create} -body { set w [create .tv] } -result {.tv} test Before-42.2 {Too few args} -body { .tv before } -result {wrong # args: should be ".tv before ?-hidden? ?-norecurse? item"} -returnCodes {1} test Before-42.3 {Too many args} -body { .tv before -hidden -norecurse -bogus red } -result {wrong # args: should be ".tv before ?-hidden? ?-norecurse? item"} -returnCodes {1} test Before-42.4 {Invalid item} -body { .tv before bogus } -result {Item bogus not found} -returnCodes {1} test Before-42.5 {Invald option} -body { .tv before -bogus red } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Before-42.6 {Get all} -body { get_all .tv before gray -norecurse } -result {gray white black brown purple yellow orange blue green red} test Before-42.7 {Get all recurse} -body { get_all .tv before silver } -result [lreverse [concat {*}$::colors]] test Before-42.8 {Move} -body { .tv move brown red 0 } test Before-42.9 {Get visible item before first item collapsed} -setup { .tv collapse -recurse {} } -body { .tv before red } test Before-42.10 {Get visible item before last item collapsed} -body { .tv before gray } -result {white} test Before-42.11 {Get visible item before child collapsed} -body { .tv before maroon } -result {pink} test Before-42.12 {Get visible item before first child collapsed} -body { .tv before pink } -result {brown} test Before-42.13 {Get visible item before grandchild collapsed} -body { .tv before lime } -result {chartreuse} test Before-42.14 {Get visible item before first grandchild collapsed} -body { .tv before chartreuse } -result {green} test Before-42.15 {before root} -body { .tv before {} } test Before-42.16 {Get visible item before first item expanded} -setup { .tv expand -recurse {} } -body { .tv before red } test Before-42.17 {Get visible item before last item expanded} -body { .tv before gray } -result {beige} test Before-42.18 {Get visible item before child expanded} -body { .tv before maroon } -result {pink} test Before-42.19 {Get visible item before first child expanded} -body { .tv before pink } -result {khaki} test Before-42.20 {Get visible item before grandchild expanded} -body { .tv before olive } -result {lime} test Before-42.21 {Get visible item before first grandchild expanded} -body { .tv before chartreuse } -result {green} test Before-42.22 {Get visible item before detached item} -setup { .tv detach white } -body { .tv before white } test Before-42.23 {before root} -body { .tv before {} } test Before-42.24 {Get visible item before hidden item} -setup { .tv item orange -hidden 1 } -body { .tv before -norecurse orange } -result {blue} test Before-42.25 {Get visible item before item no recurse no hidden} -body { .tv before -norecurse yellow } -result {blue} test Before-42.26 {Get visible item before item no recurse include hidden} -body { .tv before -norecurse -hidden yellow } -result {orange} test Before-42.27 {Get visible before first child without recurse} -body { .tv before -norecurse chartreuse } test Before-42.28 {Cleanup} -body { destroy .tv .sx .sy } # Range test Range-43.1 {Create} -body { set w [create .tv] } -result {.tv} test Range-43.2 {Too few args} -body { .tv range } -result {wrong # args: should be ".tv range ?-hidden? ?-norecurse? first last"} -returnCodes {1} test Range-43.3 {Too many args} -body { .tv range -hidden -norecurse -bogus first last } -result {wrong # args: should be ".tv range ?-hidden? ?-norecurse? first last"} -returnCodes {1} test Range-43.4 {Invalid option} -body { .tv range -bogus red blue } -result {bad option "-bogus": must be -hidden, -nohidden, -recurse, -recursive, or -norecurse} -returnCodes {1} test Range-43.5 {Invalid from item} -body { .tv range bogus red } -result {Item bogus not found} -returnCodes {1} test Range-43.6 {Invalid to item} -body { .tv range red bogus } -result {Item bogus not found} -returnCodes {1} test Range-43.7 {Root item} -body { .tv range {} red } test Range-43.8 {Root items} -body { .tv range {} {} } test Range-43.9 {Skip hidden} -setup { .tv hide purple } -body { .tv range red gray } -cleanup { .tv unhide purple } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue cyan turquoise mediumblue darkblue navy orange coral yellow gold brown wheat khaki black white beige gray} test Range-43.10 {Skip collapsed} -setup { .tv item blue -open 0 } -body { .tv range red gray } -cleanup { .tv item blue -open 1 } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue orange coral yellow gold purple brown wheat khaki black white beige gray} test Range-43.11 {All children collapsed} -setup { .tv collapse -recurse {} } -body { .tv range red gray } -result {red green blue orange yellow purple brown black white gray} test Range-43.12 {Subset of children} -body { .tv range blue black } -result {blue orange yellow purple brown black} test Range-43.13 {Subset of children reversed} -body { .tv range white blue } -result {white black brown purple yellow orange blue} test Range-43.14 {All children expanded} -setup { .tv expand {} } -body { .tv range red gray } -result {red green blue orange yellow purple brown black white gray} test Range-43.15 {Multi-level} -setup { .tv expand -recurse {} } -body { .tv range blue yellow } -result [concat blue [.tv children blue] orange [.tv children orange] yellow] test Range-43.16 {3 levels} -body { .tv range red blue } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Range-43.17 {Between Detached and Attached Item} -setup { .tv detach white } -body { .tv range black gray } -result {black gray} test Range-43.18 {Root item} -body { .tv range {} red } test Range-43.19 {Get items no recurse no hidden} -setup { .tv item orange -hidden 1 } -body { .tv range -norecurse blue yellow } -result {blue yellow} test Range-43.20 {Get items include no recurse include hidden} -body { .tv range -norecurse -hidden blue yellow } -result {blue orange yellow} test Range-43.21 {Get items with different parents and no recurse} -setup { .tv unhide -recurse {} } -body { .tv range -norecurse pink cyan } -result {pink maroon darkred magenta} test Range-43.22 {Get items includes detached item} -setup { .tv detach white } -body { .tv range white gray } test Range-43.23 {Cleanup} -body { destroy .tv .sx .sy } # Next test Next-44.1 {Create} -body { set w [create .tv] } -result {.tv} test Next-44.2 {Too few args} -body { .tv next } -result {wrong # args: should be ".tv next item"} -returnCodes {1} test Next-44.3 {Too many args} -body { .tv next red {} } -result {wrong # args: should be ".tv next item"} -returnCodes {1} test Next-44.4 {Invalid item} -body { .tv next bogus } -result {Item bogus not found} -returnCodes {1} test Next-44.5 {Get all} -body { get_all .tv next red } -result {red green blue orange yellow purple brown black white gray} test Next-44.6 {Root} -body { .tv next {} } test Next-44.7 {Get next item after first item} -body { .tv next red } -result {green} test Next-44.8 {Get next item after last item} -body { .tv next gray } test Next-44.9 {Get next item after child} -body { .tv next maroon } -result {darkred} test Next-44.10 {Get next item after last child} -body { .tv next magenta } test Next-44.11 {Get next item after grandchild} -setup { .tv move green red end } -body { .tv next lime } -result {olive} test Next-44.12 {Get next item after last grandchild} -body { .tv next teal } test Next-44.13 {Get next for detached item} -setup { .tv detach white } -body { .tv next white } test Next-44.14 {Get next item after hidden item} -setup { .tv item orange -hidden 1 } -body { .tv next orange } -result {yellow} test Next-44.15 {Get next item skip hidden item} -body { .tv next blue } -result {orange} test Next-44.16 {Cleanup} -body { destroy .tv .sx .sy } # Previous test Previous-45.1 {Create} -body { set w [create .tv] } -result {.tv} test Previous-45.2 {Too few args} -body { .tv prev } -result {wrong # args: should be ".tv prev item"} -returnCodes {1} test Previous-45.3 {Too many args} -body { .tv prev red {} } -result {wrong # args: should be ".tv prev item"} -returnCodes {1} test Previous-45.4 {Invalid item} -body { .tv prev bogus } -result {Item bogus not found} -returnCodes {1} test Previous-45.5 {Get all} -body { get_all .tv prev gray } -result {gray white black brown purple yellow orange blue green red} test Previous-45.6 {Root} -body { .tv prev {} } test Previous-45.7 {Get prev item before first item} -body { .tv prev red } test Previous-45.8 {Get prev item before last item} -body { .tv prev gray } -result {white} test Previous-45.9 {Get prev item before child} -body { .tv prev maroon } -result {pink} test Previous-45.10 {Get prev item before first child} -body { .tv prev pink } test Previous-45.11 {Get prev item before grandchild} -setup { .tv move green red end .tv parent green } -body { .tv prev lime } -result {chartreuse} test Previous-45.12 {Get prev item before first grandchild} -body { .tv prev chartreuse } test Previous-45.13 {Get prev for detached item} -setup { .tv detach white } -body { .tv prev white } test Previous-45.14 {Get prev item before hidden item} -setup { .tv item orange -hidden 1 } -body { .tv prev orange } -result {blue} test Previous-45.15 {Get prev item skip hidden item} -body { .tv prev yellow } -result {orange} test Previous-45.16 {Cleanup} -body { destroy .tv .sx .sy } # See proc xdelta {w item column} { set x [lindex [$w xview] 0] $w see $item $column set delta [expr {[lindex [$w xview] 0] - $x}] expr {$delta > 0 ? 1 : ($delta < 0 ? -1 : 0)} } proc ydelta {w item} { set y [lindex [$w yview] 0] $w see $item set delta [expr {[lindex [$w yview] 0] - $y}] expr {$delta > 0 ? 1 : ($delta < 0 ? -1 : 0)} } test See-46.1 {Create} -body { set w [create .tv] columns_no_stretch $w wm geometry . 400x300 set w } -result {.tv} test See-46.2 {Too few args} -body { .tv see } -result {wrong # args: should be ".tv see item ?column?"} -returnCodes {1} test See-46.3 {Too many args} -body { .tv see red 0 {} } -result {wrong # args: should be ".tv see item ?column?"} -returnCodes {1} test See-46.4 {Invalid item} -body { .tv see bogus } -result {Item bogus not found} -returnCodes {1} test See-46.5 {Invalid column} -body { .tv see red bogus } -result {Invalid column index "bogus"} -returnCodes {1} test See-46.6 {Invalid display column} -body { .tv see red #4 } -result {Column #4 out of range} -returnCodes {1} test See-46.7 {Move} -body { .tv move green red end update } test See-46.8 {Root item} -body { .tv see {} } test See-46.9 {First Item} -setup { .tv configure -titleitems 0 -titlecolumns 0 .tv xview moveto 1.0 .tv yview moveto 1.0 update } -body { ydelta .tv red } -result {-1} test See-46.10 {Last Item} -body { ydelta .tv gray } -result {1} test See-46.11 {Grandchild} -body { ydelta .tv darkblue } -result {-1} test See-46.12 {Great Grandchild} -body { ydelta .tv lime } -result {-1} test See-46.13 {First Item One Titlerow} -setup { .tv configure -titleitems 1 -titlecolumns 0 .tv xview moveto 1.0 .tv yview moveto 1.0 update } -body { ydelta .tv red } -result {0} test See-46.14 {Second Item One Titlerow} -body { ydelta .tv pink } -result {-1} test See-46.15 {Last Item One Titlerow} -body { ydelta .tv gray } -result {1} test See-46.16 {First Item Five Titlerows} -setup { .tv configure -titleitems 5 -titlecolumns 0 .tv xview moveto 1.0 .tv yview moveto 1.0 update } -body { ydelta .tv red } -result {0} test See-46.17 {Middle Item Five Titlerow} -body { ydelta .tv green } -result {-1} test See-46.18 {Last Item Five Titlerows} -body { ydelta .tv gray } -result {1} test See-46.19 {First column Scroll Left} -setup { .tv configure -titleitems 0 -titlecolumns 0 .tv xview moveto 1.0 .tv yview moveto 1.0 update } -body { xdelta .tv red #0 } -result {-1} test See-46.20 {Second column Scroll Right} -body { xdelta .tv orange #1 } -result {1} test See-46.21 {Third column Scroll Right} -body { xdelta .tv yellow #2 } -result {1} test See-46.22 {Forth column Scroll Right} -body { xdelta .tv gray #3 } -result {1} test See-46.23 {Third column Scroll Left} -body { xdelta .tv yellow #2 } -result {-1} test See-46.24 {Second column Scroll Left} -body { xdelta .tv orange #1 } -result {-1} test See-46.25 {First column Scroll Left} -body { xdelta .tv red #0 } -result {-1} test See-46.26 {First column Scroll Left 1 Titlecolumn} -setup { .tv configure -titleitems 0 -titlecolumns 1 .tv xview moveto 1.0 .tv yview moveto 1.0 update } -body { xdelta .tv red #0 } -result {0} test See-46.27 {Second column Scroll Right 1 Titlecolumn} -body { xdelta .tv orange #1 } -result {-1} test See-46.28 {Third column Scroll Right 1 Titlecolumn} -body { xdelta .tv yellow #2 } -result {1} test See-46.29 {Forth column Scroll Right 1 Titlecolumn} -body { xdelta .tv gray #3 } -result {1} test See-46.30 {Third column Scroll Left 1 Titlecolumn} -body { xdelta .tv yellow #2 } -result {-1} test See-46.31 {Second column Scroll Left 1 Titlecolumn} -body { xdelta .tv orange #1 } -result {-1} test See-46.32 {First column Scroll Left 1 Titlecolumn} -body { xdelta .tv red #0 } -result {0} test See-46.33 {Closed item} -setup { .tv item blue -open 0 } -body { .tv see darkblue .tv item blue -open } -result {1} test See-46.34 {Hidden item} -setup { .tv item blue -hidden 1 } -body { .tv see darkblue .tv item blue -hidden } -result {1} test See-46.35 {Detached item} -setup { .tv detach white } -body { ydelta .tv white } -result {0} test See-46.36 {Detached cell} -body { xdelta .tv white #3 } -result {0} test See-46.37 {Cleanup} -body { destroy .tv .sx .sy } test See-46.38 {Create} -body { set w [create .tv] .tv expand -recurse {} } test See-46.39 {Init} -setup { .tv xview moveto 0.0 .tv yview moveto 0.0 } -body { .tv item blue -height 5 .tv item yellow -height 10 .tv item orange -height 15 update } test See-46.40 {Height Scrolled} -body { ydelta .tv orange } -result {1} test See-46.41 {Height Reverse Scroll} -body { ydelta .tv green } -result {-1} test See-46.42 {Height Partial View} -body { ydelta .tv blue } -result {0} test See-46.43 {Rowheight} -setup { ttk::style configure Treeview -rowheight 50 .tv xview moveto 0.0 .tv yview moveto 1.0 } -body { ydelta .tv white } -cleanup { ttk::style configure Treeview -rowheight 20 } -result {0} test See-46.44 {Cleanup} -body { destroy .tv .sx .sy } # Events test Button_Events-47.1 {Create} -body { set w [create .tv] fixed_table $w set w } -result {.tv} test Button_Events-47.2 {Click on Open} -setup { .tv item red -open 0 } -body { set state [.tv item red -open] ButtonPress .tv red #0 10 list $state [expr {[.tv item red -open] ? 1 : 0}] } -result {0 1} test Button_Events-47.3 {Click on Close} -setup { .tv item red -open 1 } -body { set state [.tv item red -open] ButtonPress .tv red #0 10 list $state [expr {[.tv item red -open] ? 1 : 0}] } -result {1 0} test Button_Events-47.4 {Click on Padding} -setup { .tv item red -open 0 } -body { set state [.tv item red -open] ButtonPress .tv red #0 0 list $state [expr {[.tv item red -open] ? 1 : 0}] } -result {0 0} test Button_Events-47.5 {Click on Text} -setup { .tv item red -open 1 } -body { set state [.tv item pink -open] ButtonPress .tv pink #0 40 list $state [expr {[.tv item pink -open] ? 1 : 0}] } -result {0 0} test Button_Events-47.6 {Click on Cell} -setup { .tv item red -open 1 } -body { set state [.tv item pink -open] ButtonPress .tv pink Hex list $state [expr {[.tv item pink -open] ? 1 : 0}] } -result {0 0} test Button_Events-47.7 {Cleanup} -body { destroy .tv .sx .sy } test Item_Events-48.1 {Create} -body { set w [create .tv] fixed_table $w .tv configure -selecttype item set w } -result {.tv} test Item_Events-48.2 {Select Item Focus} -body { set focus [.tv focus] ButtonPress .tv pink #1 list $focus [.tv focus] } -result {{} pink} test Item_Events-48.3 {Select Item} -body { ButtonPress .tv blue #1 list [.tv focus] [lsort [.tv selection]] } -result {blue blue} test Item_Events-48.4 {Item Key Up} -body { KeyPress .tv blue {} Up list [.tv focus] [.tv selection] } -result {teal teal} test Item_Events-48.5 {Item Key Down} -body { KeyPress .tv blue {} Down .tv focus } -result {cyan} test Item_Events-48.6 {Item Key Page Top} -body { KeyPress .tv blue {} Up Control Option .tv focus } -result {maroon} test Item_Events-48.7 {Item Key Page Bottom} -body { KeyPress .tv blue {} Down Control Option .tv focus } -result {cyan} test Item_Events-48.8 {Item Key Left} -body { KeyPress .tv blue {} Left .tv item blue -open } -result {0} test Item_Events-48.9 {Item Key Right} -body { KeyPress .tv blue {} Right .tv item blue -open } -result {1} test Item_Events-48.10 {Item Key Left Grandchild} -body { KeyPress .tv darkblue {} Left .tv focus } -result {blue} test Item_Events-48.11 {Item Key First} -body { KeyPress .tv mediumblue {} Home .tv focus } -result {cyan} test Item_Events-48.12 {Item Key Last} -body { KeyPress .tv mediumblue {} End .tv focus } -result {navy} test Item_Events-48.13 {Item Key Top} -body { KeyPress .tv yellow {} Home Control .tv focus } -result {red} test Item_Events-48.14 {Item Key Bottom} -body { KeyPress .tv yellow {} End Control .tv focus } -result {silver} test Item_Events-48.15 {Select Up} -setup { ButtonPress .tv blue #1 } -body { KeyPress .tv blue {} Up Shift list [.tv focus] [lsort [.tv selection]] } -cleanup { .tv selection set {} } -result {blue {blue teal}} test Item_Events-48.16 {Select Down} -setup { ButtonPress .tv blue #1 } -body { KeyPress .tv blue {} Down Shift list [.tv focus] [lsort [.tv selection]] } -cleanup { .tv selection set {} } -result {blue {blue cyan}} test Item_Events-48.17 {Select First} -setup { ButtonPress .tv blue #1 } -body { KeyPress .tv mediumblue {} Home Shift list [.tv focus] [lsort [.tv selection]] } -cleanup { .tv selection set {} } -result {mediumblue {blue chartreuse darkred green lime magenta maroon olive pink red teal}} test Item_Events-48.18 {Select Last} -setup { ButtonPress .tv blue #1 } -body { KeyPress .tv mediumblue {} End Shift list [.tv focus] [lsort [.tv selection]] } -cleanup { .tv selection set {} } -result {mediumblue {beige black blue brown coral cyan darkblue gold gray khaki mediumblue navy orange purple turquoise wheat white yellow}} test Item_Events-48.19 {Cleanup} -body { destroy .tv .sx .sy } test Cell_Events-49.1 {Create} -body { set w [create .tv] fixed_table $w .tv configure -selecttype cell set w } -result {.tv} test Cell_Events-49.2 {Select Cell Focus} -body { set focus [.tv cellfocus] ButtonPress .tv maroon Hex list $focus [.tv cellfocus] } -cleanup { .tv cellselection set {} } -result {{} {maroon Hex}} test Cell_Events-49.3 {Select Cell} -setup { .tv item blue -open 1 } -body { ButtonPress .tv blue Hex list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Hex} {{blue Hex}}} test Cell_Events-49.4 {Cell Up} -setup { ButtonPress .tv blue Hex } -body { KeyPress .tv blue Hex Up list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{teal Hex} {{teal Hex}}} test Cell_Events-49.5 {Cell Down} -setup { ButtonPress .tv blue Hex .tv item blue -open 1 } -body { KeyPress .tv blue Hex Down list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{cyan Hex} {{cyan Hex}}} test Cell_Events-49.6 {Cell Left} -setup { ButtonPress .tv blue Float } -body { KeyPress .tv blue Float Left list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Decimal} {{blue Decimal}}} test Cell_Events-49.7 {Cell Right} -setup { ButtonPress .tv blue Decimal } -body { KeyPress .tv blue Decimal Right list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Float} {{blue Float}}} test Cell_Events-49.8 {Cell First} -setup { ButtonPress .tv blue Decimal } -body { KeyPress .tv blue Decimal Home list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue #0} {{blue #0}}} test Cell_Events-49.9 {Cell Last} -setup { ButtonPress .tv blue Hex } -body { KeyPress .tv blue Hex End list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Float} {{blue Float}}} test Cell_Events-49.10 {Cell Topleft} -setup { ButtonPress .tv blue Hex } -body { KeyPress .tv blue Hex Home Control list [.tv cellfocus] [lsort [.tv cellselection]] } -result {{red #0} {{red #0}}} test Cell_Events-49.11 {Cell Bottomright} -setup { ButtonPress .tv blue Hex } -body { KeyPress .tv blue Hex End Control list [.tv cellfocus] [lsort [.tv cellselection]] } -result {{silver Float} {{silver Float}}} test Cell_Events-49.12 {Select Cell Up} -setup { ButtonPress .tv blue Hex } -body { KeyPress .tv blue Hex Up Shift list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Hex} {{blue Hex} {teal Hex}}} test Cell_Events-49.13 {Select Cell Down} -setup { ButtonPress .tv blue Hex .tv item blue -open 1 } -body { KeyPress .tv blue Hex Down Shift list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Hex} {{blue Hex} {cyan Hex}}} test Cell_Events-49.14 {Select Cell Left} -setup { ButtonPress .tv blue Float } -body { KeyPress .tv blue Float Left Shift list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Float} {{blue Decimal} {blue Float}}} test Cell_Events-49.15 {Select Cell Right} -setup { ButtonPress .tv blue Decimal } -body { KeyPress .tv blue Decimal Right Shift list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Decimal} {{blue Decimal} {blue Float}}} test Cell_Events-49.16 {Select Cell First} -setup { ButtonPress .tv blue Decimal } -body { KeyPress .tv blue Decimal Home Shift list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Decimal} {{blue #0} {blue Decimal} {blue Hex}}} test Cell_Events-49.17 {Select Cell Last} -setup { ButtonPress .tv blue Hex } -body { KeyPress .tv blue Hex End Shift list [.tv cellfocus] [lsort [.tv cellselection]] } -cleanup { .tv cellselection set {} } -result {{blue Hex} {{blue Decimal} {blue Float} {blue Hex}}} test Cell_Events-49.18 {Cleanup} -body { destroy .tv .sx .sy } # Selection Functions # Selection test Selection-50.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection-50.2 {Invalid operation} -body { .tv selection bogus } -result {bad operation "bogus": must be add, anchor, has, includes, present, remove, set, size, or toggle} -returnCodes {1} test Selection-50.3 {Cleanup} -body { destroy .tv .sx .sy } # Selection Add test Selection_Add-51.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Add-51.2 {Too few args} -body { .tv selection add } -result {wrong # args: should be ".tv selection add ?items?|?options first last?"} -returnCodes {1} test Selection_Add-51.3 {Too many args} -body { .tv selection add -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv selection add ?items?|?options first last?"} -returnCodes {1} test Selection_Add-51.4 {Invalid item} -body { .tv selection add bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Add-51.5 {Invalid range} -body { .tv selection add red bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Add-51.6 {Root item} -body { .tv selection add {} } test Selection_Add-51.7 {Root range} -body { .tv selection add {} {} } -result {cannot select root item} -returnCodes {1} test Selection_Add-51.8 {Single item} -body { .tv selection add red .tv selection } -result {red} test Selection_Add-51.9 {Multiple items} -setup { .tv selection set red } -body { .tv selection add [list maroon green blue] .tv selection } -result {red maroon green blue} test Selection_Add-51.10 {Range of items} -setup { .tv selection set red } -body { .tv selection add green orange .tv selection } -result {red green chartreuse lime olive teal blue cyan turquoise mediumblue darkblue navy orange} test Selection_Add-51.11 {Range reverse order} -setup { .tv selection set red } -body { .tv selection add orange green .tv selection } -result {red green chartreuse lime olive teal blue cyan turquoise mediumblue darkblue navy orange} test Selection_Add-51.12 {Duplicate item} -setup { .tv selection set red } -body { .tv selection add red .tv selection } -result {red} test Selection_Add-51.13 {Duplicate Items} -setup { .tv selection set [list red green blue orange yellow] } -body { .tv selection add [list red green blue orange yellow] .tv selection } -result {red green blue orange yellow} test Selection_Add-51.14 {Empty List} -setup { .tv selection set red } -body { .tv selection add [list] .tv selection } -result {red} test Selection_Add-51.15 {No Closed items} -setup { .tv item green -open 0 } -body { .tv selection add -nohidden red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green blue} test Selection_Add-51.16 {Include Closed items} -setup { .tv item green -open 0 } -body { .tv selection add -hidden magenta cyan .tv selection } -cleanup { .tv selection set red } -result {red magenta green chartreuse lime olive teal blue cyan} test Selection_Add-51.17 {No Hidden items} -setup { .tv item green -open 1 -hidden 1 } -body { .tv selection add -nohidden magenta cyan .tv selection } -cleanup { .tv selection set red } -result {red magenta blue cyan} test Selection_Add-51.18 {Include Hidden items} -setup { .tv item green -open 1 -hidden 1 } -body { .tv selection add -hidden magenta cyan .tv selection } -cleanup { .tv selection set red } -result {red magenta green chartreuse lime olive teal blue cyan} test Selection_Add-51.19 {No Recurse} -body { .tv selection add -norecurse green blue .tv selection } -cleanup { .tv selection set red } -result {red green blue} test Selection_Add-51.20 {Recurse} -setup { .tv item green -open 1 -hidden 0 } -body { .tv selection add -recurse green blue .tv selection } -cleanup { .tv selection set red } -result {red green chartreuse lime olive teal blue} test Selection_Add-51.21 {Cleanup} -body { destroy .tv .sx .sy } # Selection Anchor test Selection_Anchor-52.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Anchor-52.2 {Too many args} -body { .tv selection anchor first last bogus } -result {wrong # args: should be ".tv selection anchor ?item?"} -returnCodes {1} test Selection_Anchor-52.3 {Invalid item} -body { .tv selection anchor bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Anchor-52.4 {Get} -body { .tv selection anchor } test Selection_Anchor-52.5 {Set} -body { .tv selection anchor red .tv selection anchor } -result {red} test Selection_Anchor-52.6 {Clear} -body { .tv selection anchor {} .tv selection anchor } test Selection_Anchor-52.7 {Cleanup} -body { destroy .tv .sx .sy } # Selection Clear test Selection_Clear-53.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Clear-53.2 {Single item} -setup { .tv selection set red } -body { .tv selection set {} .tv selection } test Selection_Clear-53.3 {Multiple items} -setup { .tv selection set [list red green blue] } -body { .tv selection set {} .tv selection } test Selection_Clear-53.4 {Multiple levels} -setup { .tv selection set [list red magenta green blue cyan] } -body { .tv selection set {} .tv selection } test Selection_Clear-53.5 {Cleanup} -body { destroy .tv .sx .sy } # Selection Get test Selection_Get-54.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Get-54.2 {Default selection} -body { .tv selection } test Selection_Get-54.3 {Selection single} -setup { .tv selection set red } -body { .tv selection } -cleanup { .tv selection set {} } -result {red} test Selection_Get-54.4 {Selection multiple} -setup { .tv selection set [list red green blue] } -body { .tv selection } -cleanup { .tv selection set {} } -result {red green blue} test Selection_Get-54.5 {Selection range} -setup { .tv selection set red blue } -body { .tv selection } -cleanup { .tv selection set {} } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Get-54.6 {Multiple levels} -setup { .tv selection set [list red magenta blue cyan gold] } -body { .tv selection } -cleanup { .tv selection set {} } -result {red magenta blue cyan gold} test Selection_Get-54.7 {Cleanup} -body { destroy .tv .sx .sy } # Selection Has test Selection_Has-55.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Has-55.2 {Too few args} -body { .tv selection has } -result {wrong # args: should be ".tv selection has items"} -returnCodes {1} test Selection_Has-55.3 {Too many args} -body { .tv selection has -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv selection has items"} -returnCodes {1} test Selection_Has-55.4 {Invalid item} -body { .tv selection has bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Has-55.5 {No items} -body { .tv selection has {} } -result {0} test Selection_Has-55.6 {Single item} -setup { .tv selection set red } -body { .tv selection has red } -cleanup { .tv selection set {} } -result {1} test Selection_Has-55.7 {Multiple items} -setup { .tv selection set [list red green blue] } -body { .tv selection has [list red green blue] } -cleanup { .tv selection set {} } -result {1} test Selection_Has-55.8 {Some selected items} -setup { .tv selection set [list red green blue] } -body { .tv selection has [list red blue] } -cleanup { .tv selection set {} } -result {1} test Selection_Has-55.9 {More than selected items} -setup { .tv selection set [list red blue] } -body { .tv selection has [list red green blue] } -cleanup { .tv selection set {} } -result {0} test Selection_Has-55.10 {Unselected item} -body { .tv selection has red } -result {0} test Selection_Has-55.11 {Duplicate Items} -setup { .tv selection set [list red green blue orange yellow] } -body { .tv selection has [list red red red] } -cleanup { .tv selection set {} } -result {1} test Selection_Has-55.12 {Empty List} -body { .tv selection has [list] } -result {0} test Selection_Has-55.13 {Cleanup} -body { destroy .tv .sx .sy } # Selection Includes test Selection_Includes-56.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Includes-56.2 {Too few args} -body { .tv selection includes } -result {wrong # args: should be ".tv selection includes items"} -returnCodes {1} test Selection_Includes-56.3 {Too many args} -body { .tv selection includes items bogus } -result {wrong # args: should be ".tv selection includes items"} -returnCodes {1} test Selection_Includes-56.4 {Invalid item} -body { .tv selection includes bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Includes-56.5 {Root item} -body { .tv selection includes {} } -result {0} test Selection_Includes-56.6 {Single item} -setup { .tv selection set red } -body { .tv selection includes red } -cleanup { .tv selection set {} } -result {1} test Selection_Includes-56.7 {Multiple items} -setup { .tv selection set [list red green blue] } -body { .tv selection includes [list red green blue] } -cleanup { .tv selection set {} } -result {1} test Selection_Includes-56.8 {Some selected items} -setup { .tv selection set [list red green blue] } -body { .tv selection includes [list red blue] } -cleanup { .tv selection set {} } -result {1} test Selection_Includes-56.9 {More than selected items} -setup { .tv selection set [list red blue] } -body { .tv selection includes [list red green blue] } -cleanup { .tv selection set {} } -result {0} test Selection_Includes-56.10 {Unselected item} -body { .tv selection includes red } -result {0} test Selection_Includes-56.11 {Unselected items} -body { .tv selection includes [list red green blue] } -result {0} test Selection_Includes-56.12 {Duplicate Items} -setup { .tv selection set [list red green blue orange yellow] } -body { .tv selection includes [list red red red] } -cleanup { .tv selection set {} } -result {1} test Selection_Includes-56.13 {Cleanup} -body { destroy .tv .sx .sy } # Selection Present test Selection_Present-57.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Present-57.2 {Too many args} -body { .tv selection present bogus } -result {wrong # args: should be ".tv selection present"} -returnCodes {1} test Selection_Present-57.3 {No items} -body { .tv selection present } -result {0} test Selection_Present-57.4 {Single item} -setup { .tv selection set red } -body { .tv selection present } -cleanup { .tv selection set {} } -result {1} test Selection_Present-57.5 {Multiple items} -setup { .tv selection set [list red green blue] } -body { .tv selection present } -cleanup { .tv selection set {} } -result {1} test Selection_Present-57.6 {Multiple levels} -setup { .tv selection set [list red green blue maroon cyan] } -body { .tv selection present } -cleanup { .tv selection set {} } -result {1} test Selection_Present-57.7 {Range of items} -setup { .tv selection set red blue } -body { .tv selection present } -cleanup { .tv selection set {} } -result {1} test Selection_Present-57.8 {Duplicate Selection} -setup { .tv selection set [list red green blue] } -body { .tv selection set [list red green blue] .tv selection present } -cleanup { .tv selection set {} } -result {1} test Selection_Present-57.9 {Cleanup} -body { destroy .tv .sx .sy } # Selection Remove test Selection_Remove-58.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Remove-58.2 {Too few args} -body { .tv selection remove } -result {wrong # args: should be ".tv selection remove ?items?|?options first last?"} -returnCodes {1} test Selection_Remove-58.3 {Too many args} -body { .tv selection remove -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv selection remove ?items?|?options first last?"} -returnCodes {1} test Selection_Remove-58.4 {Invalid item} -body { .tv selection remove bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Remove-58.5 {Root item} -body { .tv selection remove {} } test Selection_Remove-58.6 {Single item} -setup { .tv selection set red } -body { .tv selection remove red .tv selection } test Selection_Remove-58.7 {Empty List} -setup { .tv selection set blue } -body { .tv selection remove [list] .tv selection } -cleanup { .tv selection set {} } -result {blue} test Selection_Remove-58.8 {Multiple items} -setup { .tv selection set [list red green blue black white] } -body { .tv selection remove [list red green blue black white] .tv selection } test Selection_Remove-58.9 {Multiple levels} -setup { .tv selection set [list red green blue maroon cyan] } -body { .tv selection remove [list red green blue maroon cyan] .tv selection } test Selection_Remove-58.10 {Some selected items} -setup { .tv selection set [list red green blue] } -body { .tv selection remove [list red blue] .tv selection } -cleanup { .tv selection set {} } -result {green} test Selection_Remove-58.11 {More than selected items} -setup { .tv selection set [list red green blue] } -body { .tv selection remove [list red green blue orange yellow] .tv selection } test Selection_Remove-58.12 {Unselected item} -body { .tv selection remove red .tv selection } test Selection_Remove-58.13 {Range of items} -setup { .tv selection set [list red green blue orange yellow] } -body { .tv selection remove red orange .tv selection } -result {yellow} test Selection_Remove-58.14 {Range reverse order} -setup { .tv selection set [list red green blue orange yellow] } -body { .tv selection remove orange red .tv selection } -result {yellow} test Selection_Remove-58.15 {Duplicate Items} -setup { .tv selection set [list red green blue orange yellow] } -body { .tv selection remove [list red green blue orange yellow red green blue orange yellow] .tv selection } test Selection_Remove-58.16 {No Closed items} -setup { .tv item green -open 0 -hidden 0 .tv selection set [list green lime teal] } -body { .tv selection remove -nohidden -recurse red blue .tv selection } -result {lime teal} test Selection_Remove-58.17 {Include Closed items} -setup { .tv item green -open 0 -hidden 0 .tv selection set [list green lime teal] } -body { .tv selection remove -hidden -recurse red blue .tv selection } test Selection_Remove-58.18 {No Hidden items} -setup { .tv item green -open 1 -hidden 1 .tv selection set [list green lime teal] } -body { .tv selection remove -nohidden -recurse red blue .tv selection } -result {green lime teal} test Selection_Remove-58.19 {Include Hidden items} -setup { .tv item green -open 1 -hidden 1 .tv selection set [list green lime teal] } -body { .tv selection remove -hidden -recurse red blue .tv selection } test Selection_Remove-58.20 {No Recurse} -setup { .tv item green -open 1 -hidden 1 .tv selection set [list green lime teal] } -body { .tv selection remove -nohidden -norecurse red blue .tv selection } -result {green lime teal} test Selection_Remove-58.21 {Include Recurse items} -setup { .tv item green -open 1 -hidden 1 .tv selection set [list green lime teal] } -body { .tv selection remove -hidden -norecurse red blue .tv selection } -result {lime teal} test Selection_Remove-58.22 {Cleanup} -body { destroy .tv .sx .sy } # Selection Set test Selection_Set-59.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Set-59.2 {Too few args} -body { .tv selection set } -result {wrong # args: should be ".tv selection set ?items?|?options first last?"} -returnCodes {1} test Selection_Set-59.3 {Too many args} -body { .tv selection set -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv selection set ?items?|?options first last?"} -returnCodes {1} test Selection_Set-59.4 {Invalid item} -body { .tv selection set bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Set-59.5 {Clear selection} -body { .tv selection set {} .tv cellselection } -cleanup { .tv selection set red } test Selection_Set-59.6 {Single item} -body { .tv selection set red .tv selection } -cleanup { .tv selection set red } -result {red} test Selection_Set-59.7 {Multiple items} -body { .tv selection set [list red green blue] .tv selection } -cleanup { .tv selection set red } -result {red green blue} test Selection_Set-59.8 {Multiple levels} -body { .tv selection set [list red magenta green blue cyan] .tv selection } -cleanup { .tv selection set red } -result {red magenta green blue cyan} test Selection_Set-59.9 {Range of items} -body { .tv selection set red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Set-59.10 {Range reverse order} -body { .tv selection set blue red .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Set-59.11 {Duplicate Selection} -setup { .tv selection set [list red green blue] } -body { .tv selection set [list red green blue] .tv selection } -cleanup { .tv selection set red } -result {red green blue} test Selection_Set-59.12 {No Closed items} -setup { .tv item green -open 0 -hidden 0 } -body { .tv selection set -nohidden -recurse red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green blue} test Selection_Set-59.13 {Include Closed items} -setup { .tv item green -open 0 -hidden 0 } -body { .tv selection set -hidden -recurse red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Set-59.14 {No Hidden items} -setup { .tv item green -open 1 -hidden 1 } -body { .tv selection set -nohidden -recurse red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta blue} test Selection_Set-59.15 {Include Hidden items} -setup { .tv item green -open 1 -hidden 1 } -body { .tv selection set -hidden -recurse red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Set-59.16 {No Recurse items} -setup { .tv item green -open 1 -hidden 0 } -body { .tv selection set -nohidden -norecurse red blue .tv selection } -cleanup { .tv selection set red } -result {red green blue} test Selection_Set-59.17 {Include Recurse items} -setup { .tv item green -open 1 -hidden 0 } -body { .tv selection set -nohidden -recurse red blue .tv selection } -cleanup { .tv selection set red } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Set-59.18 {Cleanup} -body { destroy .tv .sx .sy } # Selection Size test Selection_Size-60.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Size-60.2 {Too many args} -body { .tv selection size bogus } -result {wrong # args: should be ".tv selection size"} -returnCodes {1} test Selection_Size-60.3 {No items} -body { .tv selection size } -result {0} test Selection_Size-60.4 {Single item} -setup { .tv selection set red } -body { .tv selection size } -cleanup { .tv selection set {} } -result {1} test Selection_Size-60.5 {Multiple items} -setup { .tv selection set [list red green blue] } -body { .tv selection size } -cleanup { .tv selection set {} } -result {3} test Selection_Size-60.6 {Multiple levels} -setup { .tv selection set [list red green blue maroon cyan] } -body { .tv selection size } -cleanup { .tv selection set {} } -result {5} test Selection_Size-60.7 {Range of items} -setup { .tv selection set red blue } -body { .tv selection size } -cleanup { .tv selection set {} } -result {11} test Selection_Size-60.8 {Duplicate Selection} -setup { .tv selection set [list red green blue] } -body { .tv selection set [list red green blue] .tv selection size } -cleanup { .tv selection set {} } -result {3} test Selection_Size-60.9 {Cleanup} -body { destroy .tv .sx .sy } # Selection Toggle test Selection_Toggle-61.1 {Create} -body { set w [create .tv] } -result {.tv} test Selection_Toggle-61.2 {Too few args} -body { .tv selection toggle } -result {wrong # args: should be ".tv selection toggle ?items?|?options first last?"} -returnCodes {1} test Selection_Toggle-61.3 {Too many args} -body { .tv selection toggle -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv selection toggle ?items?|?options first last?"} -returnCodes {1} test Selection_Toggle-61.4 {Invalid item} -body { .tv selection toggle bogus } -result {Item bogus not found} -returnCodes {1} test Selection_Toggle-61.5 {Root item} -body { .tv selection toggle {} } test Selection_Toggle-61.6 {Single unselected item} -setup { .tv selection set {} } -body { .tv selection toggle red .tv selection } -result {red} test Selection_Toggle-61.7 {Single selected item} -setup { .tv selection set [list red] } -body { .tv selection toggle red .tv selection } test Selection_Toggle-61.8 {Multiple unselected items} -setup { .tv selection set {} } -body { .tv selection toggle [list red green blue] .tv selection } -result {red green blue} test Selection_Toggle-61.9 {Multiple selected items} -setup { .tv selection set [list red green blue] } -body { .tv selection toggle [list red green blue] .tv selection } test Selection_Toggle-61.10 {Multiple unselected levels} -setup { .tv selection set {} } -body { .tv selection toggle [list red magenta green blue cyan] .tv selection } -result {red magenta green blue cyan} test Selection_Toggle-61.11 {Multiple selected levels} -setup { .tv selection set [list red magenta green blue cyan] } -body { .tv selection toggle [list red magenta green blue cyan] .tv selection } test Selection_Toggle-61.12 {Range of unselected items} -setup { .tv selection set {} } -body { .tv selection toggle red blue .tv selection } -result {red pink maroon darkred magenta green chartreuse lime olive teal blue} test Selection_Toggle-61.13 {Range of selected items} -setup { .tv selection set red blue } -body { .tv selection toggle red blue .tv selection } test Selection_Toggle-61.14 {Range of mixed items} -setup { .tv selection set [list red green blue] } -body { .tv selection toggle red blue .tv selection } -result {pink maroon darkred magenta chartreuse lime olive teal} test Selection_Toggle-61.15 {Duplicate Items} -setup { .tv selection set {} } -body { .tv selection toggle [list red green blue red green blue] .tv selection } test Selection_Toggle-61.16 {Cleanup} -body { destroy .tv .sx .sy } # <> Event test TreeviewSelect_Event-62.1 {Create} -body { set w [create .tv] } -result {.tv} test TreeviewSelect_Event-62.2 {Init} -body { .tv selection set red set ecount 0 bind .tv <> {incr ecount} } test TreeviewSelect_Event-62.3 {Set Item} -body { .tv selection set blue update set ecount } -result {2} test TreeviewSelect_Event-62.4 {Set Multiple} -body { .tv selection set [list red green yellow] update set ecount } -result {3} test TreeviewSelect_Event-62.5 {Set Range} -body { .tv selection set black white update set ecount } -result {4} test TreeviewSelect_Event-62.6 {Set Duplicate} -body { .tv selection set blue update set ecount } -result {5} test TreeviewSelect_Event-62.7 {Clear Selection} -body { .tv selection set {} update set ecount } -result {6} test TreeviewSelect_Event-62.8 {Repeat Clear} -body { .tv selection set {} update set ecount } -result {6} test TreeviewSelect_Event-62.9 {Add None} -body { .tv selection add [list] update set ecount } -result {6} test TreeviewSelect_Event-62.10 {Add Item} -body { .tv selection add red update set ecount } -result {7} test TreeviewSelect_Event-62.11 {Add Multiple} -body { .tv selection add [list green blue black white] update set ecount } -result {8} test TreeviewSelect_Event-62.12 {Add Range} -body { .tv selection add orange yellow update set ecount } -result {9} test TreeviewSelect_Event-62.13 {Add Duplicate} -body { .tv selection add red update set ecount } -result {9} test TreeviewSelect_Event-62.14 {Delete Unselected} -body { .tv delete purple update set ecount } -result {9} test TreeviewSelect_Event-62.15 {Delete Selected} -body { .tv delete blue update set ecount } -result {10} test TreeviewSelect_Event-62.16 {Remove None} -body { .tv selection remove [list] update set ecount } -result {10} test TreeviewSelect_Event-62.17 {Remove Item} -body { .tv selection remove green update set ecount } -result {11} test TreeviewSelect_Event-62.18 {Remove Multiple} -body { .tv selection remove [list yellow orange] set ecount } -result {11} test TreeviewSelect_Event-62.19 {Remove Range} -body { .tv selection remove [list black white] set ecount } -result {11} test TreeviewSelect_Event-62.20 {Remove Unselected} -body { .tv selection remove green update set ecount } -result {13} test TreeviewSelect_Event-62.21 {Toggle None} -body { .tv selection toggle [list] update set ecount } -result {13} test TreeviewSelect_Event-62.22 {Toggle Unselected Item} -body { .tv selection toggle green update set ecount } -result {14} test TreeviewSelect_Event-62.23 {Toggle Selected Item} -body { .tv selection toggle green update set ecount } -result {15} test TreeviewSelect_Event-62.24 {Toggle Multiple} -body { .tv selection toggle [list black white] update set ecount } -result {16} test TreeviewSelect_Event-62.25 {Toggle Range} -body { .tv selection toggle yellow white update set ecount } -result {17} test TreeviewSelect_Event-62.26 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection test Cell_Selection-63.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection-63.2 {Invalid operation} -body { .tv cellselection bogus item } -result {bad operation "bogus": must be add, anchor, has, includes, present, remove, set, size, or toggle} -returnCodes {1} test Cell_Selection-63.3 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Add test Cell_Selection_Add-64.1 {Create} -body { set w [create .tv] .tv configure -selecttype cell set w } -result {.tv} test Cell_Selection_Add-64.2 {Too few args} -body { .tv cellselection add } -result {wrong # args: should be ".tv cellselection add ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Add-64.3 {Too many args} -body { .tv cellselection add -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv cellselection add ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Add-64.4 {Invalid item} -body { .tv cellselection add {{bogus #0}} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Add-64.5 {Invalid column} -body { .tv cellselection add {{red bogus}} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Add-64.6 {Empty list} -body { .tv cellselection add {} } test Cell_Selection_Add-64.7 {Single cell} -body { .tv cellselection add [list [list red #0]] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0}} test Cell_Selection_Add-64.8 {Duplicate cell} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection add [list [list red #0]] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0}} test Cell_Selection_Add-64.9 {Multiple cells} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection add [list [list green Hex] [list blue Decimal] [list white Float]] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {green Hex} {blue Decimal} {white Float}} test Cell_Selection_Add-64.10 {Range of cells} -setup { .tv cellselection set [list [list green #0]] } -body { .tv cellselection add [list green Hex] [list green Float] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{green #0} {green Hex} {green Decimal} {green Float}} test Cell_Selection_Add-64.11 {Rect range of cells} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection add [list green #0] [list blue Float] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {green #0} {green Hex} {green Decimal} {green Float} {chartreuse #0} {chartreuse Hex} {chartreuse Decimal} {chartreuse Float} {lime #0} {lime Hex} {lime Decimal} {lime Float} {olive #0} {olive Hex} {olive Decimal} {olive Float} {teal #0} {teal Hex} {teal Decimal} {teal Float} {blue #0} {blue Hex} {blue Decimal} {blue Float}} test Cell_Selection_Add-64.12 {Range reverse order} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection add [list blue Float] [list green #0] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {green #0} {green Hex} {green Decimal} {green Float} {chartreuse #0} {chartreuse Hex} {chartreuse Decimal} {chartreuse Float} {lime #0} {lime Hex} {lime Decimal} {lime Float} {olive #0} {olive Hex} {olive Decimal} {olive Float} {teal #0} {teal Hex} {teal Decimal} {teal Float} {blue #0} {blue Hex} {blue Decimal} {blue Float}} test Cell_Selection_Add-64.13 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Anchor test Cell_Selection_Anchor-65.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection_Anchor-65.2 {Too many args} -body { .tv cellselection anchor -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv cellselection anchor ?cell?"} -returnCodes {1} test Cell_Selection_Anchor-65.3 {Invalid item} -body { .tv cellselection anchor {bogus Float} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Anchor-65.4 {Invalid column} -body { .tv cellselection anchor {red bogus} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Anchor-65.5 {Get} -body { .tv cellselection anchor } test Cell_Selection_Anchor-65.6 {Set} -body { .tv cellselection anchor {red Hex} .tv cellselection anchor } -result {red Hex} test Cell_Selection_Anchor-65.7 {Clear} -body { .tv cellselection anchor {} .tv cellselection anchor } test Cell_Selection_Anchor-65.8 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Get test Cell_Selection_Get-66.1 {Create} -body { set w [create .tv] .tv configure -selecttype cell set w } -result {.tv} test Cell_Selection_Get-66.2 {Selection none} -body { .tv cellselection } test Cell_Selection_Get-66.3 {Selection single} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0}} test Cell_Selection_Get-66.4 {Selection multiple} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal]] } -body { .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {green Hex} {blue Decimal}} test Cell_Selection_Get-66.5 {Multiple levels} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] } -body { .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {maroon Float} {green Hex} {blue Decimal} {cyan #0}} test Cell_Selection_Get-66.6 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Has test Cell_Selection_Has-67.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection_Has-67.2 {Too few args} -body { .tv cellselection has } -result {wrong # args: should be ".tv cellselection has cells"} -returnCodes {1} test Cell_Selection_Has-67.3 {Too many args} -body { .tv cellselection has cells bogus } -result {wrong # args: should be ".tv cellselection has cells"} -returnCodes {1} test Cell_Selection_Has-67.4 {Invalid item} -body { .tv cellselection has {{bogus Float}} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Has-67.5 {Invalid column} -body { .tv cellselection has {{red bogus}} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Has-67.6 {Empty list} -body { .tv cellselection has {} } -result {0} test Cell_Selection_Has-67.7 {Single item} -setup { .tv cellselection set {{red #0}} } -body { .tv cellselection has {{red #0}} } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Has-67.8 {Multiple items} -setup { .tv cellselection set [list {red #0} {green Hex} {blue Decimal}] } -body { .tv cellselection has [list {red #0} {green Hex} {blue Decimal}] } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Has-67.9 {Some selected items} -setup { .tv cellselection set [list {red #0} {green Hex} {blue Decimal}] } -body { .tv cellselection has [list {red #0} {blue Decimal}] } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Has-67.10 {More than selected items} -setup { .tv cellselection set [list {red #0} {blue Decimal}] } -body { .tv cellselection has [list {red #0} {green Hex} {blue Decimal}] } -cleanup { .tv cellselection set {} } -result {0} test Cell_Selection_Has-67.11 {Unselected item} -body { .tv cellselection has {{red Decimal}} } -result {0} test Cell_Selection_Has-67.12 {Unselected items} -body { .tv cellselection has [list {red #0} {green Hex} {blue Decimal}] } -result {0} test Cell_Selection_Has-67.13 {Duplicate Items} -setup { .tv cellselection set [list {red #0} {green Hex} {blue Decimal}] } -body { .tv cellselection has [list {red #0} {red #0} {red #0}] } -cleanup { .tv selection set {} } -result {1} test Cell_Selection_Has-67.14 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Includes test Cell_Selection_Includes-68.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection_Includes-68.2 {Too few args} -body { .tv cellselection includes } -result {wrong # args: should be ".tv cellselection includes cells"} -returnCodes {1} test Cell_Selection_Includes-68.3 {Too many args} -body { .tv cellselection includes cells bogus } -result {wrong # args: should be ".tv cellselection includes cells"} -returnCodes {1} test Cell_Selection_Includes-68.4 {Invalid item} -body { .tv cellselection includes {{bogus Float}} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Includes-68.5 {Invalid column} -body { .tv cellselection includes {{red bogus}} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Includes-68.6 {Empty list} -body { .tv cellselection includes {} } -result {0} test Cell_Selection_Includes-68.7 {Single item} -setup { .tv cellselection set {{red #0}} } -body { .tv cellselection includes {{red #0}} } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Includes-68.8 {Multiple items} -setup { .tv cellselection set [list {red #0} {green Hex} {blue Decimal}] } -body { .tv cellselection includes [list {red #0} {green Hex} {blue Decimal}] } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Includes-68.9 {Some selected items} -setup { .tv cellselection set [list {red #0} {green Hex} {blue Decimal}] } -body { .tv cellselection includes [list {red #0} {blue Decimal}] } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Includes-68.10 {More than selected items} -setup { .tv cellselection set [list {red #0} {blue Decimal}] } -body { .tv cellselection includes [list {red #0} {green Hex} {blue Decimal}] } -cleanup { .tv cellselection set {} } -result {0} test Cell_Selection_Includes-68.11 {Unselected item} -body { .tv cellselection includes {{red Decimal}} } -result {0} test Cell_Selection_Includes-68.12 {Unselected items} -body { .tv cellselection includes [list {red #0} {green Hex} {blue Decimal}] } -result {0} test Cell_Selection_Includes-68.13 {Duplicate Items} -setup { .tv cellselection set [list {red #0} {green Hex} {blue Decimal}] } -body { .tv cellselection includes [list {red #0} {red #0} {red #0}] } -cleanup { .tv selection set {} } -result {1} test Cell_Selection_Includes-68.14 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Present test Cell_Selection_Present-69.1 {Create} -body { set w [create .tv] .tv configure -selecttype cell set w } -result {.tv} test Cell_Selection_Present-69.2 {Too many args} -body { .tv cellselection present bogus } -result {wrong # args: should be ".tv cellselection present"} -returnCodes {1} test Cell_Selection_Present-69.3 {Selection none} -body { .tv cellselection present } -result {0} test Cell_Selection_Present-69.4 {Selection single} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection present } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Present-69.5 {Selection multiple} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal]] } -body { .tv cellselection present } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Present-69.6 {Multiple levels} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] } -body { .tv cellselection present } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Present-69.7 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Remove test Cell_Selection_Remove-70.1 {Create} -body { set w [create .tv] .tv configure -selecttype cell set w } -result {.tv} test Cell_Selection_Remove-70.2 {Too few args} -body { .tv cellselection remove } -result {wrong # args: should be ".tv cellselection remove ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Remove-70.3 {Too many args} -body { .tv cellselection remove -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv cellselection remove ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Remove-70.4 {Invalid item} -body { .tv cellselection remove {{bogus #0}} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Remove-70.5 {Invalid column} -body { .tv cellselection remove {{red bogus}} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Remove-70.6 {Empty list} -body { .tv cellselection remove {} } test Cell_Selection_Remove-70.7 {Single cell} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection remove [list [list red #0]] .tv selection } -cleanup { .tv cellselection set {} } test Cell_Selection_Remove-70.8 {Multiple cells} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal]] } -body { .tv cellselection remove [list [list red #0] [list green Hex] [list blue Decimal]] .tv selection } -cleanup { .tv cellselection set {} } test Cell_Selection_Remove-70.9 {Multiple levels} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] } -body { .tv cellselection remove [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] .tv selection } -cleanup { .tv cellselection set {} } test Cell_Selection_Remove-70.10 {Unselected cell} -body { .tv cellselection remove [list [list red #0]] .tv selection } test Cell_Selection_Remove-70.11 {Range of cells} -setup { .tv cellselection set [list green #0] [list green Float] } -body { .tv cellselection remove [list green #0] [list green Float] .tv selection } -cleanup { .tv cellselection set {} } test Cell_Selection_Remove-70.12 {Rect range of cells} -setup { .tv cellselection set [list green #0] [list blue Float] } -body { .tv cellselection remove [list green #0] [list blue Float] .tv selection } -cleanup { .tv cellselection set {} } test Cell_Selection_Remove-70.13 {Range reverse order} -setup { .tv cellselection set [list green #0] [list blue Float] } -body { .tv cellselection remove [list blue Float] [list green #0] .tv selection } -cleanup { .tv cellselection set {} } test Cell_Selection_Remove-70.14 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Set test Cell_Selection_Set-71.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection_Set-71.2 {Too few args} -body { .tv cellselection set } -result {wrong # args: should be ".tv cellselection set ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Set-71.3 {Too many args} -body { .tv cellselection set -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv cellselection set ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Set-71.4 {Invalid item} -body { .tv cellselection set {{bogus #0}} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Set-71.5 {Invalid column} -body { .tv cellselection set {{red bogus}} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Set-71.6 {Single cell} -body { .tv cellselection set [list [list red #0]] .tv cellselection } -result {{red #0}} test Cell_Selection_Set-71.7 {Multiple cells} -body { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal]] .tv cellselection } -result {{red #0} {green Hex} {blue Decimal}} test Cell_Selection_Set-71.8 {Multiple levels} -body { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] .tv cellselection } -result {{red #0} {maroon Float} {green Hex} {blue Decimal} {cyan #0}} test Cell_Selection_Set-71.9 {Range of cells within item} -body { .tv cellselection set [list green #0] [list green Float] .tv cellselection } -result {{green #0} {green Hex} {green Decimal} {green Float}} test Cell_Selection_Set-71.10 {Rect range of cells} -body { .tv cellselection set [list green #0] [list blue Float] .tv cellselection } -result {{green #0} {green Hex} {green Decimal} {green Float} {chartreuse #0} {chartreuse Hex} {chartreuse Decimal} {chartreuse Float} {lime #0} {lime Hex} {lime Decimal} {lime Float} {olive #0} {olive Hex} {olive Decimal} {olive Float} {teal #0} {teal Hex} {teal Decimal} {teal Float} {blue #0} {blue Hex} {blue Decimal} {blue Float}} test Cell_Selection_Set-71.11 {Rect range of cells within bounds} -body { .tv cellselection set [list green #1] [list blue #2] .tv cellselection } -result {{green Hex} {green Decimal} {chartreuse Hex} {chartreuse Decimal} {lime Hex} {lime Decimal} {olive Hex} {olive Decimal} {teal Hex} {teal Decimal} {blue Hex} {blue Decimal}} test Cell_Selection_Set-71.12 {Range reverse order} -body { .tv cellselection set [list blue Float] [list green #0] .tv cellselection } -result {{green #0} {green Hex} {green Decimal} {green Float} {chartreuse #0} {chartreuse Hex} {chartreuse Decimal} {chartreuse Float} {lime #0} {lime Hex} {lime Decimal} {lime Float} {olive #0} {olive Hex} {olive Decimal} {olive Float} {teal #0} {teal Hex} {teal Decimal} {teal Float} {blue #0} {blue Hex} {blue Decimal} {blue Float}} test Cell_Selection_Set-71.13 {Clear selection} -body { .tv cellselection set {} .tv cellselection } test Cell_Selection_Set-71.14 {Hidden column with list} -setup { .tv configure -displaycolumns {0 1} } -body { .tv cellselection set [list {red 0} {blue 2}] .tv cellselection } -cleanup { .tv configure -displaycolumns {} } -result {{red Hex} {blue Float}} test Cell_Selection_Set-71.15 {Hidden column with range} -setup { .tv configure -displaycolumns {0 1} } -body { .tv cellselection set {red 0} {blue 2} } -cleanup { .tv configure -displaycolumns {} } -result {Cell id must be in a visible column} -returnCodes {1} test Cell_Selection_Set-71.16 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Size test Cell_Selection_Size-72.1 {Create} -body { set w [create .tv] .tv configure -selecttype cell set w } -result {.tv} test Cell_Selection_Size-72.2 {Too many args} -body { .tv cellselection size bogus } -result {wrong # args: should be ".tv cellselection size"} -returnCodes {1} test Cell_Selection_Size-72.3 {Selection none} -body { .tv cellselection size } -result {0} test Cell_Selection_Size-72.4 {Selection single} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection size } -cleanup { .tv cellselection set {} } -result {1} test Cell_Selection_Size-72.5 {Selection multiple} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal]] } -body { .tv cellselection size } -cleanup { .tv cellselection set {} } -result {3} test Cell_Selection_Size-72.6 {Multiple levels} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] } -body { .tv cellselection size } -cleanup { .tv cellselection set {} } -result {5} test Cell_Selection_Size-72.7 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection Toggle test Cell_Selection_Toggle-73.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection_Toggle-73.2 {Too few args} -body { .tv cellselection toggle } -result {wrong # args: should be ".tv cellselection toggle ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Toggle-73.3 {Too many args} -body { .tv cellselection toggle -arg1 -arg2 first last bogus } -result {wrong # args: should be ".tv cellselection toggle ?cells?|?options first last?"} -returnCodes {1} test Cell_Selection_Toggle-73.4 {Invalid item} -body { .tv cellselection toggle {{bogus Hex}} } -result {Item bogus not found} -returnCodes {1} test Cell_Selection_Toggle-73.5 {Invalid column} -body { .tv cellselection toggle {{red bogus}} } -result {Invalid column index "bogus"} -returnCodes {1} test Cell_Selection_Toggle-73.6 {Empty list} -body { .tv cellselection toggle {} .tv cellselection } test Cell_Selection_Toggle-73.7 {Cell} -setup { .tv cellselection set [list [list red #0]] } -body { .tv cellselection toggle [list [list red #0]] .tv cellselection } -cleanup { .tv cellselection set {} } test Cell_Selection_Toggle-73.8 {Multiple selected cells} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal]] } -body { .tv cellselection toggle [list [list red #0] [list green Hex] [list blue Decimal]] .tv cellselection } -cleanup { .tv cellselection set {} } test Cell_Selection_Toggle-73.9 {Multiple selected levels} -setup { .tv cellselection set [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] } -body { .tv cellselection toggle [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] .tv cellselection } -cleanup { .tv cellselection set {} } test Cell_Selection_Toggle-73.10 {Range of selected cells} -setup { .tv cellselection set [list green #0] [list green Float] } -body { .tv cellselection toggle [list green #0] [list green Float] .tv cellselection } -cleanup { .tv cellselection set {} } test Cell_Selection_Toggle-73.11 {Range of selected cells} -setup { .tv cellselection set [list green #0] [list blue Float] } -body { .tv cellselection toggle [list green #0] [list blue Float] .tv cellselection } -cleanup { .tv cellselection set {} } test Cell_Selection_Toggle-73.12 {Single unselected cell} -body { .tv cellselection toggle [list [list red #0]] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0}} test Cell_Selection_Toggle-73.13 {Multiple unselected cells} -body { .tv cellselection toggle [list [list red #0] [list green Hex] [list blue Decimal]] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {green Hex} {blue Decimal}} test Cell_Selection_Toggle-73.14 {Multiple unselected levels} -body { .tv cellselection toggle [list [list red #0] [list green Hex] [list blue Decimal] [list maroon Float] [list cyan #0]] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{red #0} {maroon Float} {green Hex} {blue Decimal} {cyan #0}} test Cell_Selection_Toggle-73.15 {Rect range of unselected cells} -body { .tv cellselection toggle [list green #0] [list green Float] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{green #0} {green Hex} {green Decimal} {green Float}} test Cell_Selection_Toggle-73.16 {Rect range of unselected cells} -body { .tv cellselection toggle [list green #0] [list blue Float] .tv cellselection } -cleanup { .tv cellselection set {} } -result {{green #0} {green Hex} {green Decimal} {green Float} {chartreuse #0} {chartreuse Hex} {chartreuse Decimal} {chartreuse Float} {lime #0} {lime Hex} {lime Decimal} {lime Float} {olive #0} {olive Hex} {olive Decimal} {olive Float} {teal #0} {teal Hex} {teal Decimal} {teal Float} {blue #0} {blue Hex} {blue Decimal} {blue Float}} test Cell_Selection_Toggle-73.17 {Cleanup} -body { destroy .tv .sx .sy } # Cell Selection <> test Cell_Selection_TreeviewSelect_Event-74.1 {Create} -body { set w [create .tv] } -result {.tv} test Cell_Selection_TreeviewSelect_Event-74.2 {Init} -body { .tv cellselection set [list {red #0}] set ecount 0 bind .tv <> {incr ecount} } test Cell_Selection_TreeviewSelect_Event-74.3 {Set} -body { .tv cellselection set [list {green #1} {blue #2}] update set ecount } -result {2} test Cell_Selection_TreeviewSelect_Event-74.4 {Add} -body { .tv cellselection add [list {yellow #1} {orange #2}] update set ecount } -result {3} test Cell_Selection_TreeviewSelect_Event-74.5 {Duplicate} -body { .tv cellselection add [list {yellow #1} {orange #2}] update set ecount } -result {3} test Cell_Selection_TreeviewSelect_Event-74.6 {Toggle} -body { .tv cellselection toggle [list {yellow #1} {black #2}] update set ecount } -result {4} test Cell_Selection_TreeviewSelect_Event-74.7 {Remove} -body { .tv cellselection add [list {black #2} {orange #2}] update set ecount } -result {4} test Cell_Selection_TreeviewSelect_Event-74.8 {Delete} -body { .tv delete blue update set ecount } -result {5} test Cell_Selection_TreeviewSelect_Event-74.9 {Clear} -body { .tv cellselection set {} update set ecount } -result {6} test Cell_Selection_TreeviewSelect_Event-74.10 {Cleanup} -body { destroy .tv .sx .sy } # Search and Sort Functions # Search test Search-75.1 {Create} -body { set w [create .tv] } -result {.tv} test Search-75.2 {Too few args} -body { .tv search } -result {wrong # args: should be ".tv search parent ?-options ...? pattern"} -returnCodes {1} test Search-75.3 {Too many args} -body { .tv search {*}[lrepeat 30 {}] } -result {wrong # args: should be ".tv search parent ?-options ...? pattern"} -returnCodes {1} test Search-75.4 {Invalid item} -body { .tv search bogus pattern } -result {Item bogus not found} -returnCodes {1} test Search-75.5 {Invalid arg} -body { .tv search {} -bogus pattern } -result {bad option "-bogus": must be -all, -ascii, -backwards, -cell, -columns, -dictionary, -exact, -forwards, -glob, -hidden, -integer, -nocase, -not, -real, -recurse, -recursive, -regexp, -start, -stop, -unicode, or -wraparound} -returnCodes {1} test Search-75.6 {Ambiguous option} -body { .tv search {} -r pattern } -result {ambiguous option "-r": must be -all, -ascii, -backwards, -cell, -columns, -dictionary, -exact, -forwards, -glob, -hidden, -integer, -nocase, -not, -real, -recurse, -recursive, -regexp, -start, -stop, -unicode, or -wraparound} -returnCodes {1} test Search-75.7 {No column} -body { .tv search {} -column pattern } -result {no column specified} -returnCodes {1} test Search-75.8 {Invalid column} -body { .tv search {} -column bogus pattern } -result {Invalid column index "bogus"} -returnCodes {1} test Search-75.9 {No start item} -body { .tv search {} -start pattern } -result {no start item or cell specified} -returnCodes {1} test Search-75.10 {Invalid start item} -body { .tv search {} -start bogus pattern } -result {Item bogus not found} -returnCodes {1} test Search-75.11 {Root start item} -body { .tv search {} -start {} pattern } -result {cannot start with root item} -returnCodes {1} test Search-75.12 {Start item not under parent} -body { .tv search blue -start teal pattern } -result {Item teal is not a descendant of blue} -returnCodes {1} test Search-75.13 {Invalid start cell} -body { .tv search {} -cell -start bogus pattern } -result {Cell id must be a list of two elements} -returnCodes {1} test Search-75.14 {No stop item} -body { .tv search {} -stop pattern } -result {no stop item or cell specified} -returnCodes {1} test Search-75.15 {Invalid stop item} -body { .tv search {} -stop bogus pattern } -result {Item bogus not found} -returnCodes {1} test Search-75.16 {Root stop item} -body { .tv search {} -stop {} pattern } -result {cannot stop with root item} -returnCodes {1} test Search-75.17 {Stop item not under parent} -body { .tv search blue -stop teal pattern } -result {Item teal is not a descendant of blue} -returnCodes {1} test Search-75.18 {Invalid stop cell} -body { .tv search {} -cell -stop bogus pattern } -result {Cell id must be a list of two elements} -returnCodes {1} test Search-75.19 {No pattern} -body { .tv search {} -ascii {} } -result {red} test Search-75.20 {No dictionary pattern} -body { .tv search {} -dictionary {} } -result {red} test Search-75.21 {Invalid integer} -body { .tv search {} -integer bogus } -result {expected integer but got "bogus"} -returnCodes {1} test Search-75.22 {Invalid real} -body { .tv search {} -real bogus } -result {expected floating-point number but got "bogus"} -returnCodes {1} test Search-75.23 {Invalid regexp} -body { .tv search {} -regexp "a(" } -result {cannot compile regular expression pattern: parentheses () not balanced} -returnCodes {1} test Search-75.24 {Empty pattern} -body { .tv search {} {} } -result {red} test Search-75.25 {Compare ASCII Type} -body { .tv search {} -ascii Yellow } -result {yellow} test Search-75.26 {Compare ASCII No Match} -body { .tv search {} -ascii Violet } test Search-75.27 {Compare Dictionary Type} -body { .tv search {} -dictionary Green } -result {green} test Search-75.28 {Compare Dictionary No Match} -body { .tv search {} -dictionary Violet } test Search-75.29 {Compare Integer Type} -body { .tv search {} -integer -column Decimal 0 } -result {black} test Search-75.30 {Compare Integer No Match} -body { .tv search {} -integer -column Decimal 42 } test Search-75.31 {Compare Case Sensitive} -body { .tv search {} Blue } -result {blue} test Search-75.32 {Compare Case Sensitive No Match} -body { .tv search {} blue } test Search-75.33 {Compare Not Case Sensitive} -body { .tv search {} -nocase green } -result {green} test Search-75.34 {Compare Not Case Sensitive No Match} -body { .tv search {} -nocase violet } test Search-75.35 {Compare Real Type} -body { .tv search {} -exact -real -column Float 0 } -result {black} test Search-75.36 {Compare Real No Match} -body { .tv search {} -exact -real -column Float 42.43 } test Search-75.37 {Compare Unicode Type} -setup { .tv insert {} end -id unicode -text "\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef" -values [list #123456 42 42.43] } -body { .tv search {} -unicode -glob "*\xea*" } -result {unicode} test Search-75.38 {Compare Unicode No Match} -body { .tv search {} -unicode -glob "*\xd0*" } test Search-75.39 {Compare Unicode Type 2} -setup { .tv insert {} end -id unicode2 -text "\u1f00\u1f10\u1f20\u1f30\u1f40\u1f50\u1f60\u1f70\u1f80\u1f90\u1fa0\u1fb0\u1fc0\u1fd0\u1fe0" -values [list #654321 24 44.42] } -body { .tv search {} -unicode -glob "*\u1f60*" } -result {unicode2} test Search-75.40 {Compare Unicode No Match 2} -body { .tv search {} -unicode -glob "*\u1f61*" } test Search-75.41 {Direction Backwards Order} -body { .tv search {} -backwards -glob *n* } -result {brown} test Search-75.42 {Direction Backwards No Match} -body { .tv search {} -backwards -glob *z* } test Search-75.43 {Direction Forwards Order} -body { .tv search {} -forwards -glob *n* } -result {green} test Search-75.44 {Direction Forwards No Match} -body { .tv search {} -forwards -glob *z* } test Search-75.45 {Pattern Exact match} -body { .tv search {} -exact Green } -result {green} test Search-75.46 {Pattern Exact No Match} -body { .tv search {} -exact Violet } test Search-75.47 {Pattern Exact No Empty Match} -setup { .tv insert {} end -id empty -text Empty } -body { .tv search {} -exact Violet } test Search-75.48 {Pattern Glob Match} -body { .tv search {} -glob *lue } -result {blue} test Search-75.49 {Pattern Glob No Match} -body { .tv search {} -glob Vio* } test Search-75.50 {Pattern Regexp Match} -body { .tv search {} -regexp {Red|Yellow} } -result {red} test Search-75.51 {Pattern Regexp No Match} -body { .tv search {} -regexp {Violet|Amber} } test Search-75.52 {Pattern Regexp All Pattern} -body { .tv search {} -regexp -all {[rgb]+[ef]*} } -result {green orange purple brown gray} test Search-75.53 {Modifier Single Column} -body { .tv search {} -column #0 -all -nocase -glob *a* } -result {orange black gray} test Search-75.54 {Modifier Multiple Columns} -body { .tv search {} -columns [list #0 Hex] -all -glob B* } -result {blue brown black} test Search-75.55 {Modifier No Hidden Items} -setup { .tv item orange -hidden 1 } -body { .tv search {} -all -glob *n* } -result {green brown} test Search-75.56 {Modifier Include Hidden Items} -setup { .tv item orange -hidden 1 } -body { .tv search {} -all -glob -hidden *n* } -cleanup { .tv item orange -hidden 0 } -result {green orange brown} test Search-75.57 {Modifier Recurse } -body { .tv search {} -recurse Cyan } -result {cyan} test Search-75.58 {Modifier Recurse Glob} -body { .tv search {} -recurse -glob Dark* } -result {darkred} test Search-75.59 {Modifier Recurse All} -body { .tv search {} -all -recurse -glob Dark* } -result {darkred darkblue} test Search-75.60 {Modifier Recurse Not Hidden} -setup { .tv item orange -hidden 1 } -body { .tv search {} -recurse Coral } test Search-75.61 {Modifier Recurse Not Hidden Backwards} -setup { .tv item orange -hidden 1 } -body { .tv search {} -recurse -backwards Coral } test Search-75.62 {Modifier Recurse Hidden} -setup { .tv item orange -hidden 1 } -body { .tv search {} -recurse -hidden Coral } -result {coral} test Search-75.63 {Modifier Recurse Hidden Backwards} -setup { .tv item orange -hidden 1 } -body { .tv search {} -recurse -hidden -backwards Coral } -cleanup { .tv item orange -hidden 0 } -result {coral} test Search-75.64 {Modifier Start Item} -body { .tv search {} -start blue -glob *n* } -result {orange} test Search-75.65 {Modifier Start Item After Match} -body { .tv search {} -start black -glob *n* } test Search-75.66 {Modifier Start at End} -body { .tv search {} -start gray -glob *n* } test Search-75.67 {Modifier Stop Item} -body { .tv search {} -stop blue -glob *n* } -result {green} test Search-75.68 {Modifier Stop Item Before Match} -body { .tv search {} -stop blue -glob *o* } test Search-75.69 {Modifier Stop at Start} -body { .tv search {} -stop red -glob *n* } test Search-75.70 {Modifier Start and Stop Are Same} -body { .tv search {} -start blue -stop blue -glob *n* } test Search-75.71 {Modifier Wrap-around} -body { .tv search {} -start yellow -wrap Blue } -result {blue} test Search-75.72 {Modifier Wrap-around No Match} -body { .tv search {} -start yellow -wrap Violet } test Search-75.73 {Result All Modifier} -body { .tv search {} -all -glob *n* } -result {green orange brown} test Search-75.74 {Result Single Cell} -body { .tv search {} -cell -glob -nocase *b* } -result {{blue #0}} test Search-75.75 {Result Not Modifier} -body { .tv search {} -not -column #0 Red } -result {green} test Search-75.76 {Multiple Columns Recurse} -body { .tv search {} -columns [list #0 Hex] -all -nocase -glob -recurse *b* } -result {pink darkred blue mediumblue darkblue brown wheat black beige} test Search-75.77 {Multiple Columns Recurse with Stop Index} -body { .tv search {} -columns [list #0 Hex] -all -nocase -glob -recurse -stop brown *b* } -result {pink darkred blue mediumblue darkblue brown} test Search-75.78 {Multiple Cells and Columns} -body { .tv search {} -columns [list #0 Hex] -all -nocase -glob -recurse -cell *b* } -result {{pink Hex} {darkred Hex} {blue #0} {mediumblue #0} {darkblue #0} {darkblue Hex} {brown #0} {wheat Hex} {black #0} {beige #0}} test Search-75.79 {Multiple Columns with Stop Index} -body { .tv search {} -columns [list #0 Hex] -all -nocase -glob -recurse -cell -stop {brown Float} *b* } -result {{pink Hex} {darkred Hex} {blue #0} {mediumblue #0} {darkblue #0} {darkblue Hex} {brown #0}} test Search-75.80 {Multiple Columns with Start and Wrap} -body { .tv search {} -columns [list #0 Hex] -all -nocase -glob -recurse -cell -start {brown #0} -wrap *b* } -result {{brown #0} {wheat Hex} {black #0} {beige #0} {pink Hex} {darkred Hex} {blue #0} {mediumblue #0} {darkblue #0} {darkblue Hex}} test Search-75.81 {Multiple Columns with Start, Stop, and Wrap} -body { .tv search {} -columns [list #0 Hex] -all -nocase -glob -recurse -cell -start {brown #0} -stop {blue Float} -wrap *b* } -result {{brown #0} {wheat Hex} {black #0} {beige #0} {pink Hex} {darkred Hex} {blue #0}} test Search-75.82 {All Cells with Start, Stop, and Wrap} -body { .tv search {} -all -nocase -glob -recurse -cell -start {brown Float} -stop {orange #0} -wrap *b* } -result {{wheat Hex} {black #0} {beige #0} {pink Hex} {darkred Hex} {blue #0} {mediumblue #0} {darkblue #0} {darkblue Hex}} test Search-75.83 {All Cells in Same Item} -body { .tv search {} -all -nocase -glob -recurse -cell -start {darkblue #0} -stop {darkblue Float} -wrap *b* } -result {{darkblue #0} {darkblue Hex}} test Search-75.84 {All Cells in Same Item Reverse Order} -body { .tv search {} -all -nocase -glob -recurse -cell -start {darkblue Float} -stop {darkblue #0} -wrap -backwards *b* } -result {{darkblue Hex} {darkblue #0}} test Search-75.85 {All Cells, Forwards, and Wraparound} -body { .tv search {} -all -nocase -glob -recurse -cell -start {blue Hex} -stop {green #0} -wrap *b* } -result {{mediumblue #0} {darkblue #0} {darkblue Hex} {brown #0} {wheat Hex} {black #0} {beige #0} {pink Hex} {darkred Hex}} test Search-75.86 {All Cells, Backwards, and Wraparound} -body { .tv search {} -all -nocase -glob -recurse -cell -start {blue Hex} -stop {orange #0} -wrap -backwards *b* } -result {{blue #0} {darkred Hex} {pink Hex} {beige #0} {black #0} {wheat Hex} {brown #0}} test Search-75.87 {All Cells, Forwards, and Wraparound to Same Item} -body { .tv search {} -all -nocase -glob -recurse -cell -start {blue Hex} -wrap *b* } -result {{mediumblue #0} {darkblue #0} {darkblue Hex} {brown #0} {wheat Hex} {black #0} {beige #0} {pink Hex} {darkred Hex} {blue #0}} test Search-75.88 {All Cells, Backwards, and Wraparound to Same Item} -body { .tv search {} -all -nocase -glob -recurse -cell -start {blue Hex} -wrap -backwards *b* } -result {{blue #0} {darkred Hex} {pink Hex} {beige #0} {black #0} {wheat Hex} {brown #0} {darkblue Hex} {darkblue #0} {mediumblue #0}} test Search-75.89 {Search Setup} -body { set children [.tv children {}] .tv unhide -recurse {} } test Search-75.90 {In Child} -setup { .tv children {} $children } -body { .tv search blue -all -glob *n* } -result {cyan} test Search-75.91 {In Child No Case} -setup { .tv children {} $children } -body { .tv search blue -all -glob -nocase *n* } -result {cyan navy} test Search-75.92 {No match} -setup { .tv children {} $children } -body { .tv search {} bogus } test Search-75.93 {Childless Item} -setup { .tv children {} $children } -body { .tv search black -glob * } test Search-75.94 {No Columns But Have #0} -setup { .tv children {} $children .tv configure -columns {} } -body { .tv search {} Black } -result {black} test Search-75.95 {No Columns and No #0} -setup { .tv children {} $children .tv configure -columns {} -show headings } -body { .tv search {} Black } test Search-75.96 {Empty tree} -setup { .tv children {} {} .tv configure -columns {} -show headings } -body { .tv search {} bogus } test Search-75.97 {Cleanup} -body { destroy .tv .sx .sy } proc sortBySize {first second} { return [expr {[string length $first] - [string length $second]}] } # Sort test Sort-76.1 {Create} -body { set w [create .tv] } -result {.tv} test Sort-76.2 {Too few args} -body { .tv sort } -result {wrong # args: should be ".tv sort parent ?-options ...?"} -returnCodes {1} test Sort-76.3 {Too many args} -body { .tv sort {*}[lrepeat 30 {}] } -result {wrong # args: should be ".tv sort parent ?-options ...?"} -returnCodes {1} test Sort-76.4 {Invalid item} -body { .tv sort bogus } -result {Item bogus not found} -returnCodes {1} test Sort-76.5 {Invalid arg} -body { .tv sort {} -bogus } -match {glob} -result {bad option "-bogus": must be -ascii, -column, -command, -decreasing, -dictionary, -ignoreempty, -increasing, -integer, -nocase, -real, -recurse, -recursive, or -unicode} -returnCodes {1} test Sort-76.6 {No column} -body { .tv sort {} -column } -result {no column specified} -returnCodes {1} test Sort-76.7 {Invalid column} -body { .tv sort {} -column bogus } -result {Invalid column index "bogus"} -returnCodes {1} test Sort-76.8 {No command} -body { .tv sort {} -command } -result {"-command" option must be followed by comparison command} -returnCodes {1} test Sort-76.9 {Sort Setup} -body { set children [.tv children {}] } -result {red green blue orange yellow purple brown black white gray} test Sort-76.10 {Sort Defaults} -setup { .tv children {} $children } -body { .tv sort {} .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.11 {Column Default} -setup { .tv children {} $children } -body { .tv sort {} -column #0 .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.12 {Type ASCII} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -ascii .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.13 {Type Dictionary} -setup { .tv children {} $children } -body { .tv sort {} -column Hex -dictionary .tv children {} } -result {black blue green purple gray brown red orange yellow white} test Sort-76.14 {Type Integer} -setup { .tv children {} $children } -body { .tv sort {} -column Decimal -integer .tv children {} } -result {black blue green purple gray brown red orange yellow white} test Sort-76.15 {Type Real} -setup { .tv children {} $children } -body { .tv sort {} -column Float -real .tv children {} } -result {black blue green purple gray brown red orange yellow white} test Sort-76.16 {Type Unicode} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -unicode .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.17 {Type Command} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -command sortBySize .tv children {} } -result {red blue gray green brown black white orange yellow purple} test Sort-76.18 {Increasing ASCII} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -ascii -increasing .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.19 {Increasing Dictionary} -setup { .tv children {} $children } -body { .tv sort {} -column Hex -dictionary -increasing .tv children {} } -result {black blue green purple gray brown red orange yellow white} test Sort-76.20 {Increasing Integer} -setup { .tv children {} $children } -body { .tv sort {} -column Decimal -integer -increasing .tv children {} } -result {black blue green purple gray brown red orange yellow white} test Sort-76.21 {Increasing Real} -setup { .tv children {} $children } -body { .tv sort {} -column Float -real -increasing .tv children {} } -result {black blue green purple gray brown red orange yellow white} test Sort-76.22 {Increasing Unicode} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -unicode -increasing .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.23 {Increasing Command} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -command sortBySize -increasing .tv children {} } -result {red blue gray green brown black white orange yellow purple} test Sort-76.24 {Decreasing ASCII} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -ascii -decreasing .tv children {} } -result {yellow white red purple orange green gray brown blue black} test Sort-76.25 {Decreasing Dictionary} -setup { .tv children {} $children } -body { .tv sort {} -column Hex -dictionary -decreasing .tv children {} } -result {white yellow orange red brown gray purple green blue black} test Sort-76.26 {Decreasing Integer} -setup { .tv children {} $children } -body { .tv sort {} -column Decimal -integer -decreasing .tv children {} } -result {white yellow orange red brown gray purple green blue black} test Sort-76.27 {Decreasing Real} -setup { .tv children {} $children } -body { .tv sort {} -column Float -real -decreasing .tv children {} } -result {white yellow orange red brown gray purple green blue black} test Sort-76.28 {Decreasing Unicode} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -unicode -decreasing .tv children {} } -result {yellow white red purple orange green gray brown blue black} test Sort-76.29 {Decreasing Command} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -command sortBySize -decreasing .tv children {} } -result {orange yellow purple green brown black white blue gray red} test Sort-76.30 {Ignore Empty Setup} -body { .tv set purple Decimal "" .tv set purple Float "" } test Sort-76.31 {Ignore Empty Integer Fail} -setup { .tv children {} $children } -body { .tv sort {} -column Decimal -integer .tv children {} } -match {glob} -result {expected integer but got *} -returnCodes {1} test Sort-76.32 {Ignore Empty Integer} -setup { .tv children {} $children } -body { .tv sort {} -column Decimal -integer -ignoreempty .tv children {} } -result {purple black blue green gray brown red orange yellow white} test Sort-76.33 {Ignore Empty Real Fail} -setup { .tv children {} $children } -body { .tv sort {} -column Float -real .tv children {} } -match {glob} -result {expected floating-point number but got *} -returnCodes {1} test Sort-76.34 {Ignore Empty Real} -setup { .tv children {} $children } -body { .tv sort {} -column Float -real -ignoreempty .tv children {} } -result {purple black blue green gray brown red orange yellow white} test Sort-76.35 {No Case Setup} -body { .tv set purple #0 purple .tv set purple Hex #8ABCDE } test Sort-76.36 {No Case ASCII} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -ascii -nocase .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.37 {No Case Dictionary} -setup { .tv children {} $children } -body { .tv sort {} -column #0 -dictionary -nocase .tv children {} } -result {black blue brown gray green orange purple red white yellow} test Sort-76.38 {No Case ASCII Hex} -setup { .tv children {} $children } -body { .tv sort {} -column Hex -ascii -nocase .tv children {} } -result {black blue green gray purple brown red orange yellow white} test Sort-76.39 {No Case Dictionary Hex} -setup { .tv children {} $children } -body { .tv sort {} -column Hex -dictionary -nocase .tv children {} } -result {black blue purple green gray brown red orange yellow white} test Sort-76.40 {Sort Child} -setup { .tv children {} $children } -body { .tv sort blue .tv children blue } -result {cyan darkblue mediumblue navy turquoise} test Sort-76.41 {Recurse Sort All Increasing} -setup { .tv children {} $children } -body { .tv sort {} -recurse .tv children red } -result {darkred magenta maroon pink} test Sort-76.42 {Recurse Sort All Decreasing} -setup { .tv children {} $children } -body { .tv sort {} -decreasing -recurse .tv children red } -result {pink maroon magenta darkred} test Sort-76.43 {Childless Item} -setup { .tv children {} $children } -body { .tv sort black .tv children black } test Sort-76.44 {Empty Column} -setup { .tv children {} $children } -body { .tv configure -columns [concat [.tv cget -columns] [list new]] .tv sort {} -column new .tv children {} } -result {red green blue orange yellow purple brown black white gray} test Sort-76.45 {No Columns Have #0 Color} -setup { .tv children {} $children .tv configure -columns {} } -body { .tv sort {} .tv children {} } -result {black blue brown gray green orange red white yellow purple} test Sort-76.46 {No Columns No #0 Uses Hex} -setup { .tv children {} $children .tv configure -columns {} -show headings } -body { .tv sort {} .tv children {} } -result {black blue green gray purple brown red orange yellow white} test Sort-76.47 {Empty tree} -setup { .tv children {} {} .tv configure -columns {} -show headings } -body { .tv sort {} .tv children {} } test Sort-76.48 {Cleanup} -body { destroy .tv .sx .sy } # For tree column, can't sort by column name only id #0. # Tag Functions # Tag test Tag-77.1 {Init} -body { set w [create .tv] } -result {.tv} test Tag-77.2 {Too few args} -body { .tv tag } -result {wrong # args: should be ".tv tag option ?arg ...?"} -returnCodes {1} test Tag-77.3 {No function} -body { .tv tag {} } -result {ambiguous command "": must be add, bind, cell, configure, delete, has, names, or remove} -returnCodes {1} test Tag-77.4 {Cleanup} -body { destroy .tv .sx .sy } # Tag add test Tag_Add-78.1 {Init} -body { set w [create .tv] } -result {.tv} test Tag_Add-78.2 {Too few args} -body { .tv tag add } -result {wrong # args: should be ".tv tag add tagName items"} -returnCodes {1} test Tag_Add-78.3 {Too many args} -body { .tv tag add tagName items bogus } -result {wrong # args: should be ".tv tag add tagName items"} -returnCodes {1} test Tag_Add-78.4 {Invalid tag name} -body { .tv tag add newTag red } -cleanup { .tv tag delete newTag } test Tag_Add-78.5 {Empty list} -setup { .tv tag configure newTag } -body { .tv tag add newTag {} .tv tag has newTag } -cleanup { .tv tag delete newTag } test Tag_Add-78.6 {Add single} -setup { .tv tag configure newTag } -body { .tv tag add newTag red .tv tag has newTag } -cleanup { .tv tag delete newTag } -result {red} test Tag_Add-78.7 {Add multiple} -setup { .tv tag configure newTag } -body { .tv tag add newTag [list red green blue] .tv tag has newTag } -cleanup { .tv tag delete newTag } -result {red green blue} test Tag_Add-78.8 {Add to root} -setup { .tv tag configure newTag } -body { .tv tag add newTag {{}} .tv tag has newTag } -cleanup { .tv tag delete newTag } -result {cannot tag root item} -returnCodes {1} test Tag_Add-78.9 {Tag add with no -tags bug #3085489} -body { .tv tag add foo gray .tv item gray -tags } -result {foo} test Tag_Add-78.10 {Tag add remove no -tags bug #3085489} -body { .tv tag remove foo gray .tv item gray -tags } test Tag_Add-78.11 {Cleanup} -body { destroy .tv .sx .sy } # Tag bind proc cellEvent {w item col} { lassign [$w bbox $item $col] aX aY aW aH set aX [expr {$aX + $aW / 2}] set aY [expr {$aY + $aH / 2}] event generate $w -x $aX -y $aY } set ::test "" test Tag_Bind-79.1 {Init} -body { set w [create .tv] } -result {.tv} test Tag_Bind-79.2 {Too few args} -body { .tv tag bind } -result {wrong # args: should be ".tv tag bind tagName ?sequence? ?script?"} -returnCodes {1} test Tag_Bind-79.3 {Too many args} -body { .tv tag bind tagName sequence script bogus } -result {wrong # args: should be ".tv tag bind tagName ?sequence? ?script?"} -returnCodes {1} test Tag_Bind-79.4 {Invalid tag name} -body { .tv tag bind newTag } test Tag_Bind-79.5 {Create tag name} -body { .tv tag configure newTag .tv tag names } -result {newTag} test Tag_Bind-79.6 {Set binding for sequence} -body { .tv tag bind newTag [list test script] } test Tag_Bind-79.7 {Set binding for invalid sequence} -body { .tv tag bind newTag [list test script] } -match {glob} -result {unsupported event only key, button, motion, enter, leave, and virtual events supported} -returnCodes {1} test Tag_Bind-79.8 {Get binding for sequence} -body { .tv tag bind newTag } -result {test script} test Tag_Bind-79.9 {Get binding for invalid sequence} -body { .tv tag bind newTag } test Tag_Bind-79.10 {Get all bindings for tag} -body { .tv tag bind newTag } -result {} test Tag_Bind-79.11 {Button event} -setup { .tv tag add newTag red } -body { .tv tag bind newTag