通讯编程

开发平台：
Visual C++

focusTcl.test：源码内容
							# 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.5.2.1 2003/10/29 01:08:19 hobbs Exp $
package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
proc setup1 w {
    if {$w == "."} {
	set w ""
    }
    foreach i {a b c d} {
	frame  $w.$i -width 200 -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
    }
    if {![winfo ismapped $w.b.z]} {
	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} {
    deleteWindows
    setup1 .
    update
    . configure -takefocus 0
    tk_focusNext .d
} {.a}
. configure -takefocus 1
deleteWindows
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}
deleteWindows
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
} {.}
deleteWindows
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}
deleteWindows
test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} {
    deleteWindows
    setup1 .
    .b.x configure -takefocus 0
    tk_focusNext .b
} {.b.y}
test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} {
    deleteWindows
    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
    }
    deleteWindows
    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 ""} {
    deleteWindows
    setup1 .
    .b.x configure -takefocus ""
    update
    tk_focusNext .b
} {.b.x}
test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} {
    deleteWindows
    setup1 .
    .b.x configure -takefocus ""
    pack unpack .b.x
    update
    tk_focusNext .b
} {.b.y}
test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} {
    deleteWindows
    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} {
    deleteWindows
    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}
    deleteWindows
    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} {
    deleteWindows
    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} {
    deleteWindows
    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} {
    deleteWindows
    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
# cleanup
::tcltest::cleanupTests
return

						