choosedir.tcl
1 # choosedir.tcl -- 2 # 3 # Choose directory dialog implementation for Unix/Mac. 4 # 5 # Copyright (c) 1998-2000 by Scriptics Corporation. 6 # All rights reserved. 7 8 # Make sure the tk::dialog namespace, in which all dialogs should live, exists 9 namespace eval ::tk::dialog {} 10 namespace eval ::tk::dialog::file {} 11 12 # Make the chooseDir namespace inside the dialog namespace 13 namespace eval ::tk::dialog::file::chooseDir { 14 namespace import -force ::tk::msgcat::* 15 } 16 17 # ::tk::dialog::file::chooseDir:: -- 18 # 19 # Implements the TK directory selection dialog. 20 # 21 # Arguments: 22 # args Options parsed by the procedure. 23 # 24 proc ::tk::dialog::file::chooseDir:: {args} { 25 variable ::tk::Priv 26 set dataName __tk_choosedir 27 upvar ::tk::dialog::file::$dataName data 28 Config $dataName $args 29 30 if {$data(-parent) eq "."} { 31 set w .$dataName 32 } else { 33 set w $data(-parent).$dataName 34 } 35 36 # (re)create the dialog box if necessary 37 # 38 if {![winfo exists $w]} { 39 ::tk::dialog::file::Create $w TkChooseDir 40 } elseif {[winfo class $w] ne "TkChooseDir"} { 41 destroy $w 42 ::tk::dialog::file::Create $w TkChooseDir 43 } else { 44 set data(dirMenuBtn) $w.contents.f1.menu 45 set data(dirMenu) $w.contents.f1.menu.menu 46 set data(upBtn) $w.contents.f1.up 47 set data(icons) $w.contents.icons 48 set data(ent) $w.contents.f2.ent 49 set data(okBtn) $w.contents.f2.ok 50 set data(cancelBtn) $w.contents.f2.cancel 51 set data(hiddenBtn) $w.contents.f2.hidden 52 } 53 if {$::tk::dialog::file::showHiddenBtn} { 54 $data(hiddenBtn) configure -state normal 55 grid $data(hiddenBtn) 56 } else { 57 $data(hiddenBtn) configure -state disabled 58 grid remove $data(hiddenBtn) 59 } 60 61 # When using -mustexist, manage the OK button state for validity 62 $data(okBtn) configure -state normal 63 if {$data(-mustexist)} { 64 $data(ent) configure -validate key \ 65 -validatecommand [list ::tk::dialog::file::chooseDir::IsOK? $w %P] 66 } else { 67 $data(ent) configure -validate none 68 } 69 70 # Dialog boxes should be transient with respect to their parent, 71 # so that they will always stay on top of their parent window. However, 72 # some window managers will create the window as withdrawn if the parent 73 # window is withdrawn or iconified. Combined with the grab we put on the 74 # window, this can hang the entire application. Therefore we only make 75 # the dialog transient if the parent is viewable. 76 77 if {[winfo viewable [winfo toplevel $data(-parent)]] } { 78 wm transient $w $data(-parent) 79 } 80 81 trace add variable data(selectPath) write \ 82 [list ::tk::dialog::file::SetPath $w] 83 $data(dirMenuBtn) configure \ 84 -textvariable ::tk::dialog::file::${dataName}(selectPath) 85 86 set data(filter) "*" 87 set data(previousEntryText) "" 88 ::tk::dialog::file::UpdateWhenIdle $w 89 90 # Withdraw the window, then update all the geometry information 91 # so we know how big it wants to be, then center the window in the 92 # display (Motif style) and de-iconify it. 93 94 ::tk::PlaceWindow $w widget $data(-parent) 95 wm title $w $data(-title) 96 97 # Set a grab and claim the focus too. 98 99 ::tk::SetFocusGrab $w $data(ent) 100 $data(ent) delete 0 end 101 $data(ent) insert 0 $data(selectPath) 102 $data(ent) selection range 0 end 103 $data(ent) icursor end 104 105 # Wait for the user to respond, then restore the focus and 106 # return the index of the selected button. Restore the focus 107 # before deleting the window, since otherwise the window manager 108 # may take the focus away so we can't redirect it. Finally, 109 # restore any grab that was in effect. 110 111 vwait ::tk::Priv(selectFilePath) 112 113 ::tk::RestoreFocusGrab $w $data(ent) withdraw 114 115 # Cleanup traces on selectPath variable 116 # 117 118 foreach trace [trace info variable data(selectPath)] { 119 trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] 120 } 121 $data(dirMenuBtn) configure -textvariable {} 122 123 # Return value to user 124 # 125 126 return $Priv(selectFilePath) 127 } 128 129 # ::tk::dialog::file::chooseDir::Config -- 130 # 131 # Configures the Tk choosedir dialog according to the argument list 132 # 133 proc ::tk::dialog::file::chooseDir::Config {dataName argList} { 134 upvar ::tk::dialog::file::$dataName data 135 136 # 0: Delete all variable that were set on data(selectPath) the 137 # last time the file dialog is used. The traces may cause troubles 138 # if the dialog is now used with a different -parent option. 139 # 140 foreach trace [trace info variable data(selectPath)] { 141 trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] 142 } 143 144 # 1: the configuration specs 145 # 146 set specs { 147 {-mustexist "" "" 0} 148 {-initialdir "" "" ""} 149 {-parent "" "" "."} 150 {-title "" "" ""} 151 } 152 153 # 2: default values depending on the type of the dialog 154 # 155 if {![info exists data(selectPath)]} { 156 # first time the dialog has been popped up 157 set data(selectPath) [pwd] 158 } 159 160 # 3: parse the arguments 161 # 162 tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList 163 164 if {$data(-title) eq ""} { 165 set data(-title) "[mc "Choose Directory"]" 166 } 167 168 # Stub out the -multiple value for the dialog; it doesn't make sense for 169 # choose directory dialogs, but we have to have something there because we 170 # share so much code with the file dialogs. 171 set data(-multiple) 0 172 173 # 4: set the default directory and selection according to the -initial 174 # settings 175 # 176 if {$data(-initialdir) ne ""} { 177 # Ensure that initialdir is an absolute path name. 178 if {[file isdirectory $data(-initialdir)]} { 179 set old [pwd] 180 cd $data(-initialdir) 181 set data(selectPath) [pwd] 182 cd $old 183 } else { 184 set data(selectPath) [pwd] 185 } 186 } 187 188 if {![winfo exists $data(-parent)]} { 189 return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ 190 "bad window path name \"$data(-parent)\"" 191 } 192 } 193 194 # Gets called when user presses Return in the "Selection" entry or presses OK. 195 # 196 proc ::tk::dialog::file::chooseDir::OkCmd {w} { 197 upvar ::tk::dialog::file::[winfo name $w] data 198 199 # This is the brains behind selecting non-existant directories. Here's 200 # the flowchart: 201 # 1. If the icon list has a selection, join it with the current dir, 202 # and return that value. 203 # 1a. If the icon list does not have a selection ... 204 # 2. If the entry is empty, do nothing. 205 # 3. If the entry contains an invalid directory, then... 206 # 3a. If the value is the same as last time through here, end dialog. 207 # 3b. If the value is different than last time, save it and return. 208 # 4. If entry contains a valid directory, then... 209 # 4a. If the value is the same as the current directory, end dialog. 210 # 4b. If the value is different from the current directory, change to 211 # that directory. 212 213 set selection [$data(icons) selection get] 214 if {[llength $selection] != 0} { 215 set iconText [$data(icons) get [lindex $selection 0]] 216 set iconText [file join $data(selectPath) $iconText] 217 Done $w $iconText 218 } else { 219 set text [$data(ent) get] 220 if {$text eq ""} { 221 return 222 } 223 set text [file join {*}[file split [string trim $text]]] 224 if {![file exists $text] || ![file isdirectory $text]} { 225 # Entry contains an invalid directory. If it's the same as the 226 # last time they came through here, reset the saved value and end 227 # the dialog. Otherwise, save the value (so we can do this test 228 # next time). 229 if {$text eq $data(previousEntryText)} { 230 set data(previousEntryText) "" 231 Done $w $text 232 } else { 233 set data(previousEntryText) $text 234 } 235 } else { 236 # Entry contains a valid directory. If it is the same as the 237 # current directory, end the dialog. Otherwise, change to that 238 # directory. 239 if {$text eq $data(selectPath)} { 240 Done $w $text 241 } else { 242 set data(selectPath) $text 243 } 244 } 245 } 246 return 247 } 248 249 # Change state of OK button to match -mustexist correctness of entry 250 # 251 proc ::tk::dialog::file::chooseDir::IsOK? {w text} { 252 upvar ::tk::dialog::file::[winfo name $w] data 253 254 set ok [file isdirectory $text] 255 $data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}] 256 257 # always return 1 258 return 1 259 } 260 261 proc ::tk::dialog::file::chooseDir::DblClick {w} { 262 upvar ::tk::dialog::file::[winfo name $w] data 263 set selection [$data(icons) selection get] 264 if {[llength $selection] != 0} { 265 set filenameFragment [$data(icons) get [lindex $selection 0]] 266 set file $data(selectPath) 267 if {[file isdirectory $file]} { 268 ::tk::dialog::file::ListInvoke $w [list $filenameFragment] 269 return 270 } 271 } 272 } 273 274 # Gets called when user browses the IconList widget (dragging mouse, arrow 275 # keys, etc) 276 # 277 proc ::tk::dialog::file::chooseDir::ListBrowse {w text} { 278 upvar ::tk::dialog::file::[winfo name $w] data 279 280 if {$text eq ""} { 281 return 282 } 283 284 set file [::tk::dialog::file::JoinFile $data(selectPath) $text] 285 $data(ent) delete 0 end 286 $data(ent) insert 0 $file 287 } 288 289 # ::tk::dialog::file::chooseDir::Done -- 290 # 291 # Gets called when user has input a valid filename. Pops up a 292 # dialog box to confirm selection when necessary. Sets the 293 # Priv(selectFilePath) variable, which will break the "vwait" 294 # loop in tk_chooseDirectory and return the selected filename to the 295 # script that calls tk_getOpenFile or tk_getSaveFile 296 # 297 proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} { 298 upvar ::tk::dialog::file::[winfo name $w] data 299 variable ::tk::Priv 300 301 if {$selectFilePath eq ""} { 302 set selectFilePath $data(selectPath) 303 } 304 if {$data(-mustexist) && ![file isdirectory $selectFilePath]} { 305 return 306 } 307 set Priv(selectFilePath) $selectFilePath 308 }