File: choosedir.tcl

package info (click to toggle)
saods9 3.0.3-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 86,868 kB
  • ctags: 82,021
  • sloc: ansic: 663,637; tcl: 111,403; cpp: 52,727; sh: 27,784; makefile: 6,177; asm: 3,355; lex: 2,890; ada: 1,637; pascal: 1,621; xml: 1,221; yacc: 883; f90: 84; perl: 82; python: 33; fortran: 17; ruby: 13; sed: 12; php: 11
file content (283 lines) | stat: -rw-r--r-- 8,985 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
# choosedir.tcl --
#
#	Choose directory dialog implementation for Unix/Mac.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: choosedir.tcl,v 1.1.1.1 2004/04/02 22:35:05 joye Exp $

# Make sure the tk::dialog namespace, in which all dialogs should live, exists
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {}

# Make the chooseDir namespace inside the dialog namespace
namespace eval ::tk::dialog::file::chooseDir {
    namespace import ::tk::msgcat::*
}

# ::tk::dialog::file::chooseDir:: --
#
#	Implements the TK directory selection dialog.
#
# Arguments:
#	args		Options parsed by the procedure.
#
proc ::tk::dialog::file::chooseDir:: {args} {
    variable ::tk::Priv
    set dataName __tk_choosedir
    upvar ::tk::dialog::file::$dataName data
    ::tk::dialog::file::chooseDir::Config $dataName $args

    if {[string equal $data(-parent) .]} {
        set w .$dataName
    } else {
        set w $data(-parent).$dataName
    }

    # (re)create the dialog box if necessary
    #
    if {![winfo exists $w]} {
	::tk::dialog::file::Create $w TkChooseDir
    } elseif {[string compare [winfo class $w] TkChooseDir]} {
	destroy $w
	::tk::dialog::file::Create $w TkChooseDir
    } else {
	set data(dirMenuBtn) $w.f1.menu
	set data(dirMenu) $w.f1.menu.menu
	set data(upBtn) $w.f1.up
	set data(icons) $w.icons
	set data(ent) $w.f2.ent
	set data(okBtn) $w.f2.ok
	set data(cancelBtn) $w.f3.cancel
    }

    # Dialog boxes should be transient with respect to their parent,
    # so that they will always stay on top of their parent window.  However,
    # some window managers will create the window as withdrawn if the parent
    # window is withdrawn or iconified.  Combined with the grab we put on the
    # window, this can hang the entire application.  Therefore we only make
    # the dialog transient if the parent is viewable.

    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
	wm transient $w $data(-parent)
    }

    trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
    $data(dirMenuBtn) configure \
	    -textvariable ::tk::dialog::file::${dataName}(selectPath)

    set data(filter) "*"
    set data(previousEntryText) ""
    ::tk::dialog::file::UpdateWhenIdle $w

    # Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    ::tk::PlaceWindow $w widget $data(-parent)
    wm title $w $data(-title)

    # Set a grab and claim the focus too.

    ::tk::SetFocusGrab $w $data(ent)
    $data(ent) delete 0 end
    $data(ent) insert 0 $data(selectPath)
    $data(ent) selection range 0 end
    $data(ent) icursor end

    # Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    vwait ::tk::Priv(selectFilePath)

    ::tk::RestoreFocusGrab $w $data(ent) withdraw

    # Cleanup traces on selectPath variable
    #

    foreach trace [trace vinfo data(selectPath)] {
	trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
    }
    $data(dirMenuBtn) configure -textvariable {}

    # Return value to user
    #
    
    return $Priv(selectFilePath)
}

# ::tk::dialog::file::chooseDir::Config --
#
#	Configures the Tk choosedir dialog according to the argument list
#
proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
    upvar ::tk::dialog::file::$dataName data

    # 0: Delete all variable that were set on data(selectPath) the
    # last time the file dialog is used. The traces may cause troubles
    # if the dialog is now used with a different -parent option.
    #
    foreach trace [trace vinfo data(selectPath)] {
	trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
    }

    # 1: the configuration specs
    #
    set specs {
	{-mustexist "" "" 0}
	{-initialdir "" "" ""}
	{-parent "" "" "."}
	{-title "" "" ""}
    }

    # 2: default values depending on the type of the dialog
    #
    if {![info exists data(selectPath)]} {
	# first time the dialog has been popped up
	set data(selectPath) [pwd]
    }

    # 3: parse the arguments
    #
    tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList

    if {$data(-title) == ""} {
	set data(-title) "[mc "Choose Directory"]"
    }
    
    # Stub out the -multiple value for the dialog; it doesn't make sense for
    # choose directory dialogs, but we have to have something there because we
    # share so much code with the file dialogs.
    set data(-multiple) 0

    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if {$data(-initialdir) != ""} {
	# Ensure that initialdir is an absolute path name.
	if {[file isdirectory $data(-initialdir)]} {
	    set old [pwd]
	    cd $data(-initialdir)
	    set data(selectPath) [pwd]
	    cd $old
	} else {
	    set data(selectPath) [pwd]
	}
    }

    if {![winfo exists $data(-parent)]} {
	error "bad window path name \"$data(-parent)\""
    }
}

# Gets called when user presses Return in the "Selection" entry or presses OK.
#
proc ::tk::dialog::file::chooseDir::OkCmd {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    # This is the brains behind selecting non-existant directories.  Here's
    # the flowchart:
    # 1.  If the icon list has a selection, join it with the current dir,
    #     and return that value.
    # 1a.  If the icon list does not have a selection ...
    # 2.  If the entry is empty, do nothing.
    # 3.  If the entry contains an invalid directory, then...
    # 3a.   If the value is the same as last time through here, end dialog.
    # 3b.   If the value is different than last time, save it and return.
    # 4.  If entry contains a valid directory, then...
    # 4a.   If the value is the same as the current directory, end dialog.
    # 4b.   If the value is different from the current directory, change to
    #       that directory.

    set selection [tk::IconList_Curselection $data(icons)]
    if { [llength $selection] != 0 } {
	set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]]
	set iconText [file join $data(selectPath) $iconText]
	::tk::dialog::file::chooseDir::Done $w $iconText
    } else {
	set text [$data(ent) get]
	if { [string equal $text ""] } {
	    return
	}
	set text [eval file join [file split [string trim $text]]]
	if { ![file exists $text] || ![file isdirectory $text] } {
	    # Entry contains an invalid directory.  If it's the same as the
	    # last time they came through here, reset the saved value and end
	    # the dialog.  Otherwise, save the value (so we can do this test
	    # next time).
	    if { [string equal $text $data(previousEntryText)] } {
		set data(previousEntryText) ""
		::tk::dialog::file::chooseDir::Done $w $text
	    } else {
		set data(previousEntryText) $text
	    }
	} else {
	    # Entry contains a valid directory.  If it is the same as the
	    # current directory, end the dialog.  Otherwise, change to that
	    # directory.
	    if { [string equal $text $data(selectPath)] } {
		::tk::dialog::file::chooseDir::Done $w $text
	    } else {
		set data(selectPath) $text
	    }
	}
    }
    return
}

proc ::tk::dialog::file::chooseDir::DblClick {w} {
    upvar ::tk::dialog::file::[winfo name $w] data
    set selection [tk::IconList_Curselection $data(icons)]
    if { [llength $selection] != 0 } {
	set filenameFragment \
		[tk::IconList_Get $data(icons) [lindex $selection 0]]
	set file $data(selectPath)
	if {[file isdirectory $file]} {
	    ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
	    return
	}
    }
}    

# Gets called when user browses the IconList widget (dragging mouse, arrow
# keys, etc)
#
proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
    upvar ::tk::dialog::file::[winfo name $w] data

    if {[string equal $text ""]} {
	return
    }

    set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
    $data(ent) delete 0 end
    $data(ent) insert 0 $file
}

# ::tk::dialog::file::chooseDir::Done --
#
#	Gets called when user has input a valid filename.  Pops up a
#	dialog box to confirm selection when necessary. Sets the
#	Priv(selectFilePath) variable, which will break the "vwait"
#	loop in tk_chooseDirectory and return the selected filename to the
#	script that calls tk_getOpenFile or tk_getSaveFile
#
proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
    upvar ::tk::dialog::file::[winfo name $w] data
    variable ::tk::Priv

    if {[string equal $selectFilePath ""]} {
	set selectFilePath $data(selectPath)
    }
    if { $data(-mustexist) } {
	if { ![file exists $selectFilePath] || \
		![file isdir $selectFilePath] } {
	    return
	}
    }
    set Priv(selectFilePath) $selectFilePath
}