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