summaryrefslogtreecommitdiffstats
path: root/tests/choosedir.test
blob: f6987f863a514395658958086122db0bf5ad954a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
# 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.4 2000/03/03 00:14:33 ericm Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

#----------------------------------------------------------------------
#
# Procedures needed by this test file
#
#----------------------------------------------------------------------

proc ToPressButton {parent btn} {
    after 100 SendButtonPress $parent $btn mouse
}

proc ToEnterDirByKey {parent dir} {
    after 100 EnterDirByKey $parent [list $dir]
}

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 EnterDirByKey {parent dir} {
    if {$parent == "."} {
	set w .choosedirectory
    } else {
	set w $parent.choosedirectory
    }

    $w.e delete 0 end
    $w.e insert 0 $dir

    update
    SendButtonPress $parent ok mouse
}

proc SendButtonPress {parent btn type} {
    if {$parent == "."} {
	set w .choosedirectory
    } else {
	set w $parent.choosedirectory
    }

    set button $w.$btn
    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
#
#----------------------------------------------------------------------
catch {unset err}
append err(usage) "tk_chooseDirectory "
append err(usage) "?-initialdir directory? ?-mustexist boolean? "
append err(usage) "?-parent window? ?-title title?"

set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""

# Make a dir for us to rely on for tests
makeDirectory choosedirTest
set dir $::tcltest::temporaryDirectory
set fake [file join $dir non-existant]
set real [file join $dir choosedirTest]

set parent .

foreach opt {-initialdir -mustexist -parent -title} {
    test filebox-1.1 "tk_chooseDirectory command" {
	list [catch {tk_chooseDirectory $opt} msg] $msg
    } [list 1 [format $err(valueMissing) $opt]]
}
test filebox-1.2 "tk_chooseDirectory command" {
    list [catch {tk_chooseDirectory -foo bar} msg] $msg
} [list 1 [format $err(unknownOpt) "-foo"]]
test filebox-1.3 "tk_chooseDirectory command" {
    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} {
    ToEnterDirByKey $parent $fake
    after 25
    ToEnterDirByKey $parent $real
    tk_chooseDirectory \
	    -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \
	    -parent $parent -mustexist 1
} $real
test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly} {
    ToEnterDirByKey $parent $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} {
    ToEnterDirByKey $parent $fake
    tk_chooseDirectory \
	    -title "Enter \"$fake\" and press Ok" \
	    -parent $parent -initialdir $real
} $fake
test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} {
    ToPressButton $parent ok
    tk_chooseDirectory \
	    -title "Press OK" \
	    -parent $parent -initialdir ""
} [pwd]



# cleanup
::tcltest::cleanupTests
return