通讯编程

开发平台：
Visual C++

choosedir.test：源码内容
							# This file is a Tcl script to test out Tk's "tk_chooseDir" and
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: choosedir.test,v 1.10 2002/07/14 05:48:46 dgp 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
namespace import -force tcltest::makeDirectory
#----------------------------------------------------------------------
#
# Procedures needed by this test file
#
#----------------------------------------------------------------------
proc ToPressButton {parent btn} {
    after 100 SendButtonPress $parent $btn mouse
}
proc ToEnterDirsByKey {parent dirs} {
    after 100 [list EnterDirsByKey $parent $dirs]
}
proc PressButton {btn} {
    event generate $btn <Enter>
    event generate $btn <1> -x 5 -y 5
    event generate $btn <ButtonRelease-1> -x 5 -y 5
}
proc EnterDirsByKey {parent dirs} {
    global tk_strictMotif
    if {$parent == "."} {
	set w .__tk_choosedir
    } else {
	set w $parent.__tk_choosedir
    }
    upvar ::tk::dialog::file::__tk_choosedir data
    foreach dir $dirs {
	$data(ent) delete 0 end
	$data(ent) insert 0 $dir
	update
	SendButtonPress $parent ok mouse
	after 50
    }
}
proc SendButtonPress {parent btn type} {
    global tk_strictMotif
    if {$parent == "."} {
	set w .__tk_choosedir
    } else {
	set w $parent.__tk_choosedir
    }
    upvar ::tk::dialog::file::__tk_choosedir data
    set button $data($btnBtn)
    if ![winfo ismapped $button] {
	update
    }
    if {$type == "mouse"} {
	PressButton $button
    } else {
	event generate $w <Enter>
	focus $w
	event generate $button <Enter>
	event generate $w <KeyPress> -keysym Return
    }
}
#----------------------------------------------------------------------
#
# The test suite proper
#
#----------------------------------------------------------------------
# Make a dir for us to rely on for tests
makeDirectory choosedirTest
set dir [pwd]
set fake [file join $dir non-existant]
set real [file join $dir choosedirTest]
set parent .
foreach opt {-initialdir -mustexist -parent -title} {
    test choosedir-1.1 "tk_chooseDirectory command" unixOnly {
	list [catch {tk_chooseDirectory $opt} msg] $msg
    } [list 1 "value for "$opt" missing"]
}
test choosedir-1.2 "tk_chooseDirectory command" unixOnly {
    list [catch {tk_chooseDirectory -foo bar} msg] $msg
} [list 1 "bad option "-foo": must be -initialdir, -mustexist, -parent, or -title"]
test choosedir-1.3 "tk_chooseDirectory command" unixOnly {
    list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}
test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} {
    ToPressButton $parent cancel
    tk_chooseDirectory -title "Press Cancel" -parent $parent
} ""
test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} {
    # first enter a bogus dirname, then enter a real one.
    ToEnterDirsByKey $parent [list $fake $real $real]
    set result [tk_chooseDirectory 
	    -title "Enter "$fake", press OK, enter "$real", press OK" 
	    -parent $parent -mustexist 1]
    set result
} $real
test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly} {
    ToEnterDirsByKey $parent [list $fake $fake]
    tk_chooseDirectory -title "Enter "$fake", press OK" 
	    -parent $parent -mustexist 0
} $fake
test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} {
    ToPressButton $parent ok
    tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
} $real
test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unixOnly} {
    ToEnterDirsByKey $parent [list $fake $fake]
    tk_chooseDirectory 
	    -title "Enter "$fake" and press Ok" 
	    -parent $parent -initialdir $real
} $fake
test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} {
    catch {unset ::tk::dialog::file::__tk_choosedir}
    ToPressButton $parent ok
    tk_chooseDirectory 
	    -title "Press OK" 
	    -parent $parent -initialdir ""
} [pwd]
test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unixOnly} {
    ToEnterDirsByKey $parent [list "" $real $real]
    tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" 
	    -parent $parent
} $real
# cleanup
::tcltest::cleanupTests
return

						