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