1# This file is a Tcl script to test the Windows specific behavior of 2# the common dialog boxes. It is organized in the standard 3# fashion for Tcl tests. 4# 5# Copyright (c) 1997 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# Copyright (c) 1998-1999 ActiveState Corporation. 8# 9# RCS: @(#) $Id: winDialog.test,v 1.9 2002/07/13 20:28:36 dgp Exp $ 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 18testConstraint testwinevent [llength [info commands testwinevent]] 19 20catch {testwinevent debug 1} 21 22proc start {arg} { 23 set ::tk_dialog 0 24 set ::iter_after 0 25 26 after 1 $arg 27} 28 29proc then {cmd} { 30 set ::command $cmd 31 set ::dialogresult {} 32 33 afterbody 34 vwait ::dialogresult 35 return $::dialogresult 36} 37 38proc afterbody {} { 39 if {$::tk_dialog == 0} { 40 if {[incr ::iter_after] > 30} { 41 set ::dialogresult ">30 iterations waiting on tk_dialog" 42 return 43 } 44 after 150 {afterbody} 45 return 46 } 47 uplevel #0 {set dialogresult [eval $command]} 48} 49 50proc Click {button} { 51 testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b 52 testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b 53} 54 55proc GetText {button} { 56 return [testwinevent $::tk_dialog $button WM_GETTEXT] 57} 58 59proc SetText {button text} { 60 return [testwinevent $::tk_dialog $button WM_SETTEXT $text] 61} 62 63test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} { 64} {} 65 66test winDialog-2.1 {ColorDlgHookProc} {nt} { 67} {} 68 69test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent} { 70 start {tk_getOpenFile} 71 then { 72 set x [GetText 2] 73 Click 2 74 } 75 set x 76} {Cancel} 77 78test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} { 79 start {tk_getSaveFile} 80 then { 81 set x [GetText 2] 82 Click 2 83 } 84 set x 85} {Cancel} 86 87test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} { 88 start {tk_getOpenFile -title Open} 89 then { 90 Click cancel 91 } 92} {0} 93test winDialog-5.2 {GetFileName: one argument} {nt} { 94 list [catch {tk_getOpenFile -foo} msg] $msg 95} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}} 96test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} { 97 start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} 98 then { 99 Click cancel 100 } 101} {0} 102test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} { 103 list [catch {tk_getOpenFile -foo bar -abc} msg] $msg 104} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}} 105test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { 106 start {tk_getOpenFile -title bar} 107 then { 108 Click cancel 109 } 110} {0} 111test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} { 112 list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg 113} {1 {value for "-title" missing}} 114test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent} { 115# if (string[0] == '.') { 116# string++; 117# } 118 119 start {set x [tk_getSaveFile -defaultextension .foo -title Save]} 120 then { 121 SetText 0x480 bar 122 Click 1 123 } 124 string totitle $x 125} [string totitle [file join [pwd] bar.foo]] 126test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent} { 127 start {set x [tk_getSaveFile -defaultextension foo -title Save]} 128 then { 129 SetText 0x480 bar 130 Click 1 131 } 132 string totitle $x 133} [string totitle [file join [pwd] bar.foo]] 134test winDialog-5.10 {GetFileName: file types} {nt testwinevent} { 135# case FILE_TYPES: 136 137 start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} 138 then { 139 set x [GetText 0x470] 140 Click cancel 141 } 142 set x 143} {foo files (*.foo)} 144test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} { 145# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) 146 147 list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg 148} {1 {bad Macintosh file type "FOO"}} 149test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { 150# case FILE_INITDIR: 151 152 start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]} 153 then { 154 Click 1 155 } 156 set x 157} {C:/12x 455} 158test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \ 159 {nt} { 160# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 161 162 list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg 163} {1 {user "12x" doesn't exist}} 164test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} { 165# case FILE_INITFILE: 166 167 start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} 168 then { 169 Click 1 170 } 171 string totitle $x 172} [string totitle [file join [pwd] "12x 456"]] 173test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} { 174# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 175 list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg 176} {1 {user "12x" doesn't exist}} 177set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 178append a $a 179append a $a 180append a $a 181append a $a 182test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} { 183 start {set x [tk_getSaveFile -initialfile $a -title Long]} 184 then { 185 Click 1 186 } 187 string totitle $x 188} [string totitle [string range [file join [pwd] $a] 0 257]] 189test winDialog-5.17 {GetFileName: parent} {nt} { 190# case FILE_PARENT: 191 192 toplevel .t 193 set x 0 194 start {tk_getOpenFile -parent .t -title Parent; set x 1} 195 then { 196 destroy .t 197 } 198 set x 199} {1} 200test winDialog-5.18 {GetFileName: title} {nt testwinevent} { 201# case FILE_TITLE: 202 203 start {tk_getOpenFile -title Narf} 204 then { 205 Click 2 206 } 207} {0} 208test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} { 209# if (ofn.lpstrFilter == NULL) 210 211 start {tk_getOpenFile -title Filter} 212 then { 213 set x [GetText 0x470] 214 Click 2 215 } 216 set x 217} {All Files (*.*)} 218test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} { 219# if (Tk_WindowId(parent) == None) 220 221 toplevel .t 222 start {tk_getOpenFile -parent .t -title Open} 223 then { 224 destroy .t 225 } 226} {} 227test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} { 228 toplevel .t 229 update 230 start {tk_getOpenFile -parent .t -title Open} 231 then { 232 destroy .t 233 } 234} {} 235test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} { 236# winCode = GetOpenFileName(&ofn); 237 238 start {tk_getOpenFile -title Open} 239 then { 240 set x [GetText 1] 241 Click 2 242 } 243 set x 244} {&Open} 245test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} { 246# winCode = GetSaveFileName(&ofn); 247 248 start {tk_getSaveFile -title Save} 249 then { 250 set x [GetText 1] 251 Click 2 252 } 253 set x 254} {&Save} 255test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} { 256 start {set x [tk_getSaveFile -title Back]} 257 then { 258 SetText 0x480 "c:\\12x 457" 259 Click 1 260 } 261 set x 262} {c:/12x 457} 263 264test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {} 265 266test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} 267 268test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {} 269 270## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows 271## because somehow the GetOpenFileName ends up a noop in the static 272## build. 273## 274test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} { 275 start {tk_chooseDirectory} 276 then { 277 Click cancel 278 } 279} {0} 280test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { 281 list [catch {tk_chooseDirectory -foo} msg] $msg 282} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} 283test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} { 284 start { 285 tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test 286 } 287 then { 288 Click cancel 289 } 290} {0} 291test winDialog-9.4 {Tk_ChooseDirectoryObjCmd:\ 292 Tcl_GetIndexFromObj() != TCL_OK} {nt} { 293 list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg 294} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} 295test winDialog-9.5 {Tk_ChooseDirectoryObjCmd:\ 296 Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { 297 start {tk_chooseDirectory -title bar} 298 then { 299 Click cancel 300 } 301} {0} 302test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\ 303 valid option, but missing value} {nt} { 304 list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg 305} {1 {value for "-title" missing}} 306test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} { 307# case DIR_INITIAL: 308 309 start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} 310 then { 311 Click 1 312 } 313 string tolower [set x] 314} {c:/} 315test winDialog-9.8 {Tk_ChooseDirectoryObjCmd:\ 316 initial directory: Tcl_TranslateFilename()} {nt} { 317# if (Tcl_TranslateFileName(interp, string, 318# &utfDirString) == NULL) 319 320 list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg 321} {1 {user "12x" doesn't exist}} 322 323catch {testwinevent debug 0} 324 325# cleanup 326::tcltest::cleanupTests 327return 328