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