diff options
Diffstat (limited to 'tk/tests/focusTcl.test')
| -rw-r--r-- | tk/tests/focusTcl.test | 279 |
1 files changed, 279 insertions, 0 deletions
diff --git a/tk/tests/focusTcl.test b/tk/tests/focusTcl.test new file mode 100644 index 00000000000..19dc0a09c47 --- /dev/null +++ b/tk/tests/focusTcl.test @@ -0,0 +1,279 @@ +# This file is a Tcl script to test out the features of the script +# file focus.tcl, which includes the procedures tk_focusNext and +# tk_focusPrev, among other things. This file is organized in the +# standard fashion for Tcl tests. +# +# Copyright (c) 1995 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id$ + +if {[info procs test] != "test"} { + source defs +} + +eval destroy [winfo children .] +wm geometry . {} +raise . + +proc setup1 w { + if {$w == "."} { + set w "" + } + foreach i {a b c d} { + frame $w.$i -width 100 -height 50 -bd 2 -relief raised + pack $w.$i + } + .b configure -width 0 -height 0 + foreach i {x y z} { + button $w.b.$i -text "Button $w.b.$i" + pack $w.b.$i -side left + } + tkwait visibility $w.b.z +} + +option add *takeFocus 1 +option add *highlightThickness 2 +. configure -takefocus 1 -highlightthickness 2 +test focusTcl-1.1 {tk_focusNext procedure, no children} { + tk_focusNext . +} {.} +setup1 . +test focusTcl-1.2 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext . +} {.a} +test focusTcl-1.3 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .a +} {.b} +test focusTcl-1.4 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .b +} {.b.x} +test focusTcl-1.5 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .b.x +} {.b.y} +test focusTcl-1.6 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .b.y +} {.b.z} +test focusTcl-1.7 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .b.z +} {.c} +test focusTcl-1.8 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .c +} {.d} +test focusTcl-1.9 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .d +} {.} +foreach w {.b .b.x .b.y .c .d} { + $w configure -takefocus 0 +} +test focusTcl-1.10 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .a +} {.b.z} +test focusTcl-1.11 {tk_focusNext procedure, basic tree traversal} { + tk_focusNext .b.z +} {.} +test focusTcl-1.12 {tk_focusNext procedure, basic tree traversal} { + eval destroy [winfo child .] + setup1 . + update + . configure -takefocus 0 + tk_focusNext .d +} {.a} +. configure -takefocus 1 + +eval destroy [winfo child .] +setup1 . +toplevel .t +wm geom .t +0+0 +toplevel .t2 +wm geom .t2 -0+0 +raise .t .a +test focusTcl-2.1 {tk_focusNext procedure, toplevels} { + tk_focusNext .a +} {.b} +test focusTcl-2.2 {tk_focusNext procedure, toplevels} { + tk_focusNext .d +} {.} +test focusTcl-2.3 {tk_focusNext procedure, toplevels} { + tk_focusNext .t +} {.t} +setup1 .t +raise .t.b +test focusTcl-2.4 {tk_focusNext procedure, toplevels} { + tk_focusNext .t +} {.t.a} +test focusTcl-2.5 {tk_focusNext procedure, toplevels} { + tk_focusNext .t.b.z +} {.t} + +eval destroy [winfo child .] +test focusTcl-3.1 {tk_focusPrev procedure, no children} { + tk_focusPrev . +} {.} +setup1 . +test focusTcl-3.2 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev . +} {.d} +test focusTcl-3.3 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .d +} {.c} +test focusTcl-3.4 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .c +} {.b.z} +test focusTcl-3.5 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .b.z +} {.b.y} +test focusTcl-3.6 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .b.y +} {.b.x} +test focusTcl-3.7 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .b.x +} {.b} +test focusTcl-3.8 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .b +} {.a} +test focusTcl-3.9 {tk_focusPrev procedure, basic tree traversal} { + tk_focusPrev .a +} {.} + +eval destroy [winfo child .] +setup1 . +toplevel .t +wm geom .t +0+0 +toplevel .t2 +wm geom .t2 -0+0 +raise .t .a +test focusTcl-4.1 {tk_focusPrev procedure, toplevels} { + tk_focusPrev . +} {.d} +test focusTcl-4.2 {tk_focusPrev procedure, toplevels} { + tk_focusPrev .b +} {.a} +test focusTcl-4.3 {tk_focusPrev procedure, toplevels} { + tk_focusPrev .t +} {.t} +setup1 .t +update +.t configure -takefocus 0 +raise .t.b +test focusTcl-4.4 {tk_focusPrev procedure, toplevels} { + tk_focusPrev .t +} {.t.b.z} +test focusTcl-4.5 {tk_focusPrev procedure, toplevels} { + tk_focusPrev .t.a +} {.t.b.z} + +eval destroy [winfo child .] +test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} { + eval destroy [winfo child .] + setup1 . + .b.x configure -takefocus 0 + tk_focusNext .b +} {.b.y} +test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} { + eval destroy [winfo child .] + setup1 . + pack forget .b + update + .b configure -takefocus "" + .b.y configure -takefocus "" + .b.z configure -takefocus "" + list [tk_focusNext .a] [tk_focusNext .b.x] +} {.c .c} +test focusTcl-5.3 {tkFocusOK procedure, -takefocus procedure} { + proc t w { + if {$w == ".b.x"} { + return 1 + } elseif {$w == ".b.y"} { + return "" + } + return 0 + } + eval destroy [winfo child .] + setup1 . + pack forget .b.y + update + .b configure -takefocus "" + foreach w {.b.x .b.y .b.z .c} { + $w configure -takefocus t + } + list [tk_focusNext .a] [tk_focusNext .b.x] +} {.b.x .d} +test focusTcl-5.4 {tkFocusOK procedure, -takefocus ""} { + eval destroy [winfo child .] + setup1 . + .b.x configure -takefocus "" + update + tk_focusNext .b +} {.b.x} +test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} { + eval destroy [winfo child .] + setup1 . + .b.x configure -takefocus "" + pack unpack .b.x + update + tk_focusNext .b +} {.b.y} +test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} { + eval destroy [winfo child .] + setup1 . + foreach w {.b.x .b.y .b.z} { + $w configure -takefocus "" + } + pack unpack .b + update + tk_focusNext .b +} {.c} +test focusTcl-5.7 {tkFocusOK procedure, -takefocus "", not mapped} { + eval destroy [winfo child .] + setup1 . + .b.y configure -takefocus 1 + pack unpack .b.y + update + tk_focusNext .b.x +} {.b.z} +test focusTcl-5.8 {tkFocusOK procedure, -takefocus "", not mapped} { + proc always args {return 1} + eval destroy [winfo child .] + setup1 . + .b.y configure -takefocus always + pack unpack .b.y + update + tk_focusNext .b.x +} {.b.y} +test focusTcl-5.9 {tkFocusOK procedure, -takefocus "", window disabled} { + eval destroy [winfo child .] + setup1 . + foreach w {.b.x .b.y .b.z} { + $w configure -takefocus "" + } + update + .b.x configure -state disabled + tk_focusNext .b +} {.b.y} +test focusTcl-5.10 {tkFocusOK procedure, -takefocus "", check for bindings} { + eval destroy [winfo child .] + setup1 . + foreach w {.a .b .c .d} { + $w configure -takefocus "" + } + update + bind .a <Key> {foo} + list [tk_focusNext .] [tk_focusNext .a] +} {.a .b.x} +test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} { + eval destroy [winfo child .] + setup1 . + foreach w {.a .b .c .d} { + $w configure -takefocus "" + } + update + bind Frame <Key> {foo} + list [tk_focusNext .] [tk_focusNext .a] +} {.a .b} + +bind Frame <Key> {} +. configure -takefocus 0 -highlightthickness 0 +option clear |