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