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