1# This file is a Tcl script to test out Tk's "tk_chooseDir" and
2# It is organized in the standard fashion for Tcl tests.
3#
4# Copyright (c) 1996 Sun Microsystems, Inc.
5# Copyright (c) 1998-1999 by Scriptics Corporation.
6# All rights reserved.
7
8package require tcltest 2.2
9namespace import ::tcltest::*
10eval tcltest::configure $argv
11tcltest::loadTestedCommands
12
13#----------------------------------------------------------------------
14#
15# Procedures needed by this test file
16#
17#----------------------------------------------------------------------
18
19proc ToPressButton {parent btn} {
20    after 100 SendButtonPress $parent $btn mouse
21}
22
23proc ToEnterDirsByKey {parent dirs} {
24    after 100 [list EnterDirsByKey $parent $dirs]
25}
26
27proc PressButton {btn} {
28    event generate $btn <Enter>
29    event generate $btn <1> -x 5 -y 5
30    event generate $btn <ButtonRelease-1> -x 5 -y 5
31}
32
33proc EnterDirsByKey {parent dirs} {
34    global tk_strictMotif
35    if {$parent == "."} {
36	set w .__tk_choosedir
37    } else {
38	set w $parent.__tk_choosedir
39    }
40    upvar ::tk::dialog::file::__tk_choosedir data
41
42    foreach dir $dirs {
43	$data(ent) delete 0 end
44	$data(ent) insert 0 $dir
45	update
46	SendButtonPress $parent ok mouse
47	after 50
48    }
49}
50
51proc SendButtonPress {parent btn type} {
52    global tk_strictMotif
53    if {$parent == "."} {
54	set w .__tk_choosedir
55    } else {
56	set w $parent.__tk_choosedir
57    }
58    upvar ::tk::dialog::file::__tk_choosedir data
59
60    set button $data($btn\Btn)
61    if ![winfo ismapped $button] {
62	update
63    }
64
65    if {$type == "mouse"} {
66	PressButton $button
67    } else {
68	event generate $w <Enter>
69	focus $w
70	event generate $button <Enter>
71	event generate $w <KeyPress> -keysym Return
72    }
73}
74
75
76#----------------------------------------------------------------------
77#
78# The test suite proper
79#
80#----------------------------------------------------------------------
81# Make a dir for us to rely on for tests
82set real [makeDirectory choosedirTest]
83set dir [file dirname $real]
84set fake [file join $dir non-existant]
85
86set parent .
87
88test choosedir-1.1 {tk_chooseDirectory command} -body {
89    tk_chooseDirectory -initialdir
90} -returnCodes error -result {value for "-initialdir" missing}
91test choosedir-1.2 {tk_chooseDirectory command} -body {
92    tk_chooseDirectory -mustexist
93} -returnCodes error -result {value for "-mustexist" missing}
94test choosedir-1.3 {tk_chooseDirectory command} -body {
95    tk_chooseDirectory -parent
96} -returnCodes error -result {value for "-parent" missing}
97test choosedir-1.4 {tk_chooseDirectory command} -body {
98    tk_chooseDirectory -title
99} -returnCodes error -result {value for "-title" missing}
100test choosedir-1.5.1 {tk_chooseDirectory command} -constraints notAqua -body {
101    tk_chooseDirectory -foo bar
102} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
103test choosedir-1.5.2 {tk_chooseDirectory command} -constraints aqua -body {
104    tk_chooseDirectory -foo bar
105} -returnCodes error -result {bad option "-foo": must be -initialdir, -message, -mustexist, -parent, -title, or -command}
106test choosedir-1.6 {tk_chooseDirectory command} -body {
107    tk_chooseDirectory -parent foo.bar
108} -returnCodes error -result {bad window path name "foo.bar"}
109
110
111test choosedir-2.1 {tk_chooseDirectory command, cancel gives null} -constraints {
112	unix notAqua
113} -body {
114    ToPressButton $parent cancel
115    tk_chooseDirectory -title "Press Cancel" -parent $parent
116} -result {}
117
118
119test choosedir-3.1 {tk_chooseDirectory -mustexist 1} -constraints {
120	unix notAqua
121} -body {
122    # first enter a bogus dirname, then enter a real one.
123    ToEnterDirsByKey $parent [list $fake $real $real]
124    set result [tk_chooseDirectory \
125	    -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \
126	    -parent $parent -mustexist 1]
127    set result
128} -result $real
129test choosedir-3.2 {tk_chooseDirectory -mustexist 0} -constraints {
130	unix notAqua
131} -body {
132    ToEnterDirsByKey $parent [list $fake $fake]
133    tk_chooseDirectory -title "Enter \"$fake\", press OK" \
134	    -parent $parent -mustexist 0
135} -result $fake
136
137
138test choosedir-4.1 {tk_chooseDirectory command, initialdir} -constraints {
139	unix notAqua
140} -body {
141    ToPressButton $parent ok
142    tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
143} -result $real
144test choosedir-4.2 {tk_chooseDirectory command, initialdir} -constraints {
145	unix notAqua
146} -body {
147    ToEnterDirsByKey $parent [list $fake $fake]
148    tk_chooseDirectory \
149	    -title "Enter \"$fake\" and press Ok" \
150	    -parent $parent -initialdir $real
151} -result $fake
152test choosedir-4.3 {tk_chooseDirectory command, {} initialdir} -constraints {
153	unix notAqua
154} -body {
155    catch {unset ::tk::dialog::file::__tk_choosedir}
156    ToPressButton $parent ok
157    tk_chooseDirectory \
158	    -title "Press OK" \
159	    -parent $parent -initialdir ""
160} -result [pwd]
161
162
163test choosedir-5.1 {tk_chooseDirectory, handles {} entry text} -constraints {
164	unix notAqua
165} -body {
166    ToEnterDirsByKey $parent [list "" $real $real]
167    tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \
168	    -parent $parent
169} -result $real
170
171# cleanup
172removeDirectory choosedirTest
173cleanupTests
174return
175