blob: 659870cc888817f76f3e9a2ed3e0c90d6f3d2ce0 (
plain)
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
|
# choosedir.tcl --
#
# Choose directory dialog implementation for Unix/Mac. Adapted from
# Christopher Nelson's (chris@pinebush.com) implementation.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: choosedir.tcl,v 1.4 2000/03/02 03:02:13 ericm Exp $
# Make sure the tk::dialog namespace, in which all dialogs should live, exists
namespace eval ::tk::dialog {}
# Make the chooseDir namespace inside the dialog namespace
namespace eval ::tk::dialog::chooseDir {
# value is an array that holds the current selection value for each dialog
variable value
}
proc ::tk::dialog::chooseDir::tkChooseDirectory { args } {
variable value
# Error messages
append err(usage) "tk_chooseDirectory "
append err(usage) "?-initialdir directory? ?-mustexist boolean? "
append err(usage) "?-parent window? ?-title title?"
set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\""
set err(badWindow) "bad window path name \"%s\""
# Default values
set opts(-initialdir) [pwd]
set opts(-mustexist) 0
set opts(-parent) .
set opts(-title) "Choose Directory"
# Process args
set len [llength $args]
for { set i 0 } { $i < $len } {incr i} {
set flag [lindex $args $i]
incr i
if { $i >= $len } {
error [format $err(valueMissing) $flag]
}
switch -glob -- $flag {
"-initialdir" -
"-mustexist" -
"-parent" -
"-title" {
set opts($flag) [lindex $args $i]
}
default {
error [format $err(unknownOpt) $flag]
}
}
}
# Handle default parent window
if { ![winfo exists $opts(-parent)] } {
error [format $err(badWindow) $opts(-parent)]
}
if {[string equal $opts(-parent) "."]} {
set opts(-parent) ""
}
if { [string equal $opts(-initialdir) ""] } {
set opts(-initialdir) [pwd]
}
set w [toplevel $opts(-parent).choosedirectory]
wm title $w $opts(-title)
# Commands for various bindings (which follow)
set okCommand [namespace code \
[list Done $w ok $opts(-mustexist)]]
set cancelCommand [namespace code \
[list Done $w cancel $opts(-mustexist)]]
# Create controls.
set lbl [label $w.l -text "Directory name:" -anchor w]
set ent [entry $w.e -width 30]
set frm [frame $w.f]
set lst [listbox $frm.lb -height 8 \
-yscrollcommand [list $frm.sb set] \
-selectmode browse \
-setgrid true \
-exportselection 0 \
-takefocus 1]
set scr [scrollbar $frm.sb -orient vertical \
-command [list $frm.lb yview]]
set bOK [button $w.ok -width 8 -text OK -command $okCommand \
-default active]
set bCan [button $w.cancel -width 8 -text Cancel -command $cancelCommand]
if {[llength [file volumes]]} {
# On Macs it would be nice to add a volume combobox
}
# Place controls on window
set padding 4
grid $lst $scr -sticky nsew
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
grid $lbl $bOK -padx $padding -pady $padding
grid $ent $bCan -padx $padding -pady $padding
grid $frm -padx $padding -pady $padding
grid configure $lbl -sticky w
grid configure $ent -sticky ew
grid configure $frm -sticky nsew
grid columnconfigure . 0 -weight 1
grid columnconfigure . 1 -weight 1
$ent insert end $opts(-initialdir)
# Set bindings
# <Return> is the same as OK
bind $w <Return> $okCommand
# <Escape> is the same as cancel
bind $w <Escape> $cancelCommand
# Closing the window is the same as cancel
wm protocol $w WM_DELETE_WINDOW $cancelCommand
# Fill listbox and bind for browsing
Refresh $lst $opts(-initialdir)
bind $lst <Return> [namespace code [list Update $ent $lst]]
bind $lst <Double-ButtonRelease-1> [namespace code [list Update $ent $lst]]
::tk::PlaceWindow $w widget [winfo parent $w]
# Set the min size when the size is known
# tkwait visibility $w
# tkChooseDirectory::MinSize $w
focus $ent
$ent selection range 0 end
grab set $w
# Wait for OK, Cancel or close
tkwait window $w
grab release $w
set dir $value($w)
unset value($w)
return $dir
}
# tkChooseDirectory::tk_chooseDirectory
proc ::tk::dialog::chooseDir::MinSize { w } {
set geometry [wm geometry $w]
regexp {([0-9]*)x([0-9]*)\+} geometry whole width height
wm minsize $w $width $height
}
proc ::tk::dialog::chooseDir::Done { w why mustexist } {
variable value
switch -- $why {
ok {
# If mustexist, validate value
set value($w) [$w.e get]
if { $mustexist } {
if { ![file exists $value($w)] } {
return
}
if { ![file isdirectory $value($w)] } {
return
}
}
}
cancel {
set value($w) ""
}
}
destroy $w
}
proc ::tk::dialog::chooseDir::Refresh { listbox dir } {
$listbox delete 0 end
# Find the parent directory; if it is different (ie, we're not
# already at the root), add a ".." entry
set parentDir [file dirname $dir]
if { ![string equal $parentDir $dir] } {
$listbox insert end ".."
}
# add the subdirs to the listbox
foreach f [lsort [glob -nocomplain $dir/*]] {
if {[file isdirectory $f]} {
$listbox insert end "[file tail $f]/"
}
}
}
proc ::tk::dialog::chooseDir::Update { entry listbox } {
set sel [$listbox curselection]
if { [string equal $sel ""] } {
return
}
set subdir [$listbox get $sel]
if {[string equal $subdir ".."]} {
set fullpath [file dirname [$entry get]]
if { [string equal $fullpath [$entry get]] } {
return
}
} else {
set fullpath [file join [$entry get] $subdir]
}
$entry delete 0 end
$entry insert end $fullpath
Refresh $listbox $fullpath
}
|
