tk/tests/choosedir.test

   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
  11 package require tcltest 2.1
  12 namespace import -force tcltest::configure
  13 namespace import -force tcltest::testsDirectory
  14 configure -testdir [file join [pwd] [file dirname [info script]]]
  15 configure -loadfile [file join [testsDirectory] constraints.tcl]
  16 tcltest::loadTestedCommands
  17
  18 namespace import -force tcltest::makeDirectory
  19
  20 #----------------------------------------------------------------------
  21 #
  22 # Procedures needed by this test file
  23 #
  24 #----------------------------------------------------------------------
  25
  26 proc ToPressButton {parent btn} {
  27     after 100 SendButtonPress $parent $btn mouse
  28 }
  29
  30 proc ToEnterDirsByKey {parent dirs} {
  31     after 100 [list EnterDirsByKey $parent $dirs]
  32 }
  33
  34 proc 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
  40 proc 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
  58 proc 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
  89 makeDirectory choosedirTest
  90 set dir [pwd]
  91 set fake [file join $dir non-existant]
  92 set real [file join $dir choosedirTest]
  93
  94 set parent .
  95
  96 foreach 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 }
 101 test 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"]
 104 test 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
 109 test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} {
 110     ToPressButton $parent cancel
 111     tk_chooseDirectory -title "Press Cancel" -parent $parent
 112 } ""
 113
 114 test 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
 122 test 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
 128 test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} {
 129     ToPressButton $parent ok
 130     tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
 131 } $real
 132 test 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
 138 test 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
 146 test 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
 154 return