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