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#
8# RCS: @(#) $Id$
9#
10
11package require tcltest 2.1
12eval tcltest::configure $argv
13tcltest::loadTestedCommands
14
15#----------------------------------------------------------------------
16#
17# Procedures needed by this test file
18#
19#----------------------------------------------------------------------
20
21proc ToPressButton {parent btn} {
22    after 100 SendButtonPress $parent $btn mouse
23}
24
25proc ToEnterDirsByKey {parent dirs} {
26    after 100 [list EnterDirsByKey $parent $dirs]
27}
28
29proc PressButton {btn} {
30    event generate $btn <Enter>
31    event generate $btn <1> -x 5 -y 5
32    event generate $btn <ButtonRelease-1> -x 5 -y 5
33}
34
35proc EnterDirsByKey {parent dirs} {
36    global tk_strictMotif
37    if {$parent == "."} {
38	set w .__tk_choosedir
39    } else {
40	set w $parent.__tk_choosedir
41    }
42    upvar ::tk::dialog::file::__tk_choosedir data
43
44    foreach dir $dirs {
45	$data(ent) delete 0 end
46	$data(ent) insert 0 $dir
47	update
48	SendButtonPress $parent ok mouse
49	after 50
50    }
51}
52
53proc SendButtonPress {parent btn type} {
54    global tk_strictMotif
55    if {$parent == "."} {
56	set w .__tk_choosedir
57    } else {
58	set w $parent.__tk_choosedir
59    }
60    upvar ::tk::dialog::file::__tk_choosedir data
61
62    set button $data($btn\Btn)
63    if ![winfo ismapped $button] {
64	update
65    }
66
67    if {$type == "mouse"} {
68	PressButton $button
69    } else {
70	event generate $w <Enter>
71	focus $w
72	event generate $button <Enter>
73	event generate $w <KeyPress> -keysym Return
74    }
75}
76
77
78#----------------------------------------------------------------------
79#
80# The test suite proper
81#
82#----------------------------------------------------------------------
83# Make a dir for us to rely on for tests
84set real [makeDirectory choosedirTest]
85set dir [file dirname $real]
86set fake [file join $dir non-existant]
87
88set parent .
89
90foreach opt {-initialdir -mustexist -parent -title} {
91    test choosedir-1.1$opt "tk_chooseDirectory command" unix {
92	list [catch {tk_chooseDirectory $opt} msg] $msg
93    } [list 1 "value for \"$opt\" missing"]
94}
95test choosedir-1.2 "tk_chooseDirectory command" unix {
96    list [catch {tk_chooseDirectory -foo bar} msg] $msg
97} [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"]
98test choosedir-1.3 "tk_chooseDirectory command" unix {
99    list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg
100} {1 {bad window path name "foo.bar"}}
101
102
103test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unix notAqua} {
104    ToPressButton $parent cancel
105    tk_chooseDirectory -title "Press Cancel" -parent $parent
106} ""
107
108test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unix notAqua} {
109    # first enter a bogus dirname, then enter a real one.
110    ToEnterDirsByKey $parent [list $fake $real $real]
111    set result [tk_chooseDirectory \
112	    -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \
113	    -parent $parent -mustexist 1]
114    set result
115} $real
116test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unix notAqua} {
117    ToEnterDirsByKey $parent [list $fake $fake]
118    tk_chooseDirectory -title "Enter \"$fake\", press OK" \
119	    -parent $parent -mustexist 0
120} $fake
121
122test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unix notAqua} {
123    ToPressButton $parent ok
124    tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
125} $real
126test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unix notAqua} {
127    ToEnterDirsByKey $parent [list $fake $fake]
128    tk_chooseDirectory \
129	    -title "Enter \"$fake\" and press Ok" \
130	    -parent $parent -initialdir $real
131} $fake
132test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unix notAqua} {
133    catch {unset ::tk::dialog::file::__tk_choosedir}
134    ToPressButton $parent ok
135    tk_chooseDirectory \
136	    -title "Press OK" \
137	    -parent $parent -initialdir ""
138} [pwd]
139
140test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unix notAqua} {
141    ToEnterDirsByKey $parent [list "" $real $real]
142    tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \
143	    -parent $parent
144} $real
145
146# cleanup
147removeDirectory choosedirTest
148cleanupTests
149return
150