# 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. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: focusTcl.test,v 1.1.4.2 1999/03/11 18:50:49 hershey Exp $ if {[lsearch [namespace children] ::test] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } 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 {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 {foo} list [tk_focusNext .] [tk_focusNext .a] } {.a .b} bind Frame {} . configure -takefocus 0 -highlightthickness 0 option clear # cleanup ::test::cleanupTests return