1 |
# SCCSid "$SunId$ LBL" |
2 |
# |
3 |
# Usage: getfile [-win w] [-perm] [-glob pattern] [-view proc] [-send proc] |
4 |
# |
5 |
# Create a dialog box (in window w if given) to get file name. |
6 |
# Normally, a single file name and return as value. |
7 |
# If perm switch is given, keep window up for multiple file entries. |
8 |
# If pattern is given, start with list of all the specified files, |
9 |
# breaking the string into directory and file match parts. |
10 |
# If a view procedure is given, a separate "View" button appears |
11 |
# for allowing the user to preview a selected file. |
12 |
# If a send procedure is given, a file name is sent upon |
13 |
# each double-click, and no File entry is displayed. |
14 |
# |
15 |
|
16 |
proc getfile args { # get filename interactively |
17 |
# Create necessary globals |
18 |
global curdir curfile curpat |
19 |
# Set defaults |
20 |
set w .fpwin |
21 |
set topwin 1 |
22 |
set curdir . |
23 |
set curpat * |
24 |
set transient 1 |
25 |
# Get options |
26 |
while {[llength $args]} { |
27 |
switch -glob -- [lindex $args 0] { |
28 |
-win* { |
29 |
set w [lindex $args 1] |
30 |
set topwin 0 |
31 |
set args [lreplace $args 1 1] |
32 |
} |
33 |
-perm* { |
34 |
set transient 0 |
35 |
} |
36 |
-glob { |
37 |
set curdir [file dirname [lindex $args 1]] |
38 |
set curpat [file tail [lindex $args 1]] |
39 |
set args [lreplace $args 1 1] |
40 |
} |
41 |
-vi* { |
42 |
set viewproc [lindex $args 1] |
43 |
set args [lreplace $args 1 1] |
44 |
} |
45 |
-send { |
46 |
set sendproc [lindex $args 1] |
47 |
set args [lreplace $args 1 1] |
48 |
} |
49 |
default { error "bad argument to getfile: [lindex $args 0]" } |
50 |
} |
51 |
set args [lreplace $args 0 0] |
52 |
} |
53 |
# Save initial directory |
54 |
set startdir [pwd] |
55 |
# Create widgets |
56 |
catch {destroy $w} |
57 |
if $topwin { |
58 |
toplevel $w -geometry 400x410 |
59 |
wm title $w "File Picker" |
60 |
wm iconname $w "Files" |
61 |
wm minsize $w 400 300 |
62 |
} else { |
63 |
frame $w -geometry 400x410 |
64 |
pack $w |
65 |
} |
66 |
label $w.dt -text Directory: |
67 |
place $w.dt -relx .0625 -rely .03125 -relwidth .15625 -relheight .0625 |
68 |
helplink $w.dt file directory intro |
69 |
button $w.ls -text List -command "update_dir $w" |
70 |
place $w.ls -relx .0625 -rely .125 -relwidth .125 -relheight .0625 |
71 |
helplink $w.ls file directory list |
72 |
entry $w.de -textvariable curdir -relief sunken |
73 |
place $w.de -relx .25 -rely .03125 -relwidth .6875 -relheight .0625 |
74 |
focus $w.de |
75 |
helplink $w.de file directory intro |
76 |
bind $w.de <Return> "update_dir $w" |
77 |
entry $w.pw -relief sunken -textvariable curpat |
78 |
place $w.pw -relx .25 -rely .125 -relwidth .34375 -relheight .0625 |
79 |
bind $w.pw <Return> "update_dir $w" |
80 |
helplink $w.pw file directory match |
81 |
frame $w.fm |
82 |
scrollbar $w.fm.sb -relief sunken -command "$w.fm.fl yview" |
83 |
listbox $w.fm.fl -relief sunken -yscroll "$w.fm.sb set" |
84 |
pack $w.fm.sb -side right -fill y |
85 |
pack $w.fm.fl -side left -expand yes -fill both |
86 |
place $w.fm -relx .25 -rely .21875 -relwidth .6875 -relheight .625 |
87 |
tk_listboxSingleSelect $w.fm.fl |
88 |
helplink $w.fm.fl file file intro |
89 |
if [info exists sendproc] { |
90 |
bind $w.fm.fl <Double-Button-1> "set_curfile $w $sendproc" |
91 |
if {$transient} { |
92 |
bind $w.fm.fl <Double-Button-1> \ |
93 |
"+if {\$curfile > {}} {destroy $w}" |
94 |
} |
95 |
} else { |
96 |
bind $w.fm.fl <Double-Button-1> "set_curfile $w" |
97 |
label $w.fl -text File: |
98 |
place $w.fl -relx .10625 -rely .875 \ |
99 |
-relwidth .10625 -relheight .0625 |
100 |
entry $w.fn -relief sunken -textvariable curfile |
101 |
place $w.fn -relx .25 -rely .875 \ |
102 |
-relwidth .6875 -relheight .0625 |
103 |
focus $w.fn |
104 |
helplink $w.fn file file entry |
105 |
if $transient { |
106 |
bind $w.fn <Return> "destroy $w" |
107 |
} else { |
108 |
bind $w.fn <Return> {} |
109 |
} |
110 |
} |
111 |
if {$transient != [info exists sendproc]} { |
112 |
button $w.ok -text OK -command "destroy $w" |
113 |
place $w.ok -relx .0625 -rely .28125 \ |
114 |
-relwidth .125 -relheight .0625 |
115 |
} |
116 |
if {$transient || [info exists sendproc]} { |
117 |
button $w.cancel -text Cancel \ |
118 |
-command "destroy $w; unset curdir" |
119 |
place $w.cancel -relx .0625 -rely .375 \ |
120 |
-relwidth .125 -relheight .0625 |
121 |
} |
122 |
if [info exists viewproc] { |
123 |
button $w.vi -text View -state disabled \ |
124 |
-command "$viewproc \[$w.fm.fl get \[$w.fm.fl curselection\]\]" |
125 |
place $w.vi -relx .0625 -rely .46875 \ |
126 |
-relwidth .125 -relheight .0625 |
127 |
bind $w.fm.fl <ButtonRelease-1> "+chk_select $w" |
128 |
helplink $w.vi file file view |
129 |
} |
130 |
# Load current directory |
131 |
update_dir $w |
132 |
if $transient { |
133 |
tkwait window $w |
134 |
cd $startdir |
135 |
if [info exists sendproc] { |
136 |
return [info exists curdir] |
137 |
} |
138 |
if [info exists curdir] { |
139 |
return $curdir/$curfile |
140 |
} |
141 |
return |
142 |
} elseif {[info exists sendproc]} { |
143 |
tkwait window $w |
144 |
cd $startdir |
145 |
if [info exists curdir] { |
146 |
return 1 |
147 |
} |
148 |
return 0 |
149 |
} |
150 |
# Else return the dialog window |
151 |
return $w |
152 |
} |
153 |
|
154 |
|
155 |
proc update_dir w { # Update working directory |
156 |
global curdir curpat |
157 |
if {"$curpat" == ""} { |
158 |
set curpat * |
159 |
} |
160 |
if {"$curdir" == {}} {set curdir {~}} |
161 |
if [catch {cd $curdir} curdir] { |
162 |
set oldcol [lindex [$w.de config -foreground] 4] |
163 |
$w.de config -foreground Red |
164 |
update idletasks |
165 |
after 1500 |
166 |
$w.de config -foreground $oldcol |
167 |
} |
168 |
set curdir [pwd] |
169 |
$w.fm.fl delete 0 end |
170 |
set ls ../ |
171 |
foreach f [glob *] { |
172 |
if [file isdirectory $f] { |
173 |
lappend ls $f/ |
174 |
} |
175 |
} |
176 |
foreach f [eval glob -nocomplain [split $curpat]] { |
177 |
if [file isfile $f] { |
178 |
lappend ls $f |
179 |
} |
180 |
} |
181 |
eval $w.fm.fl insert end [lsort $ls] |
182 |
} |
183 |
|
184 |
|
185 |
proc set_curfile {w {sp ""}} { # change current file selection |
186 |
global curdir curfile |
187 |
set f [$w.fm.fl get [$w.fm.fl curselection]] |
188 |
if [string match */ $f] { |
189 |
set curdir [string range $f 0 [expr [string length $f]-2]] |
190 |
update_dir $w |
191 |
} else { |
192 |
set curfile $f |
193 |
if {"$sp" > ""} { |
194 |
$sp $curdir/$curfile |
195 |
} |
196 |
} |
197 |
} |
198 |
|
199 |
|
200 |
proc chk_select w { # check if current selection is file |
201 |
set s [$w.fm.fl curselection] |
202 |
if {"$s" > "" && [file isfile [$w.fm.fl get $s]]} { |
203 |
$w.vi configure -state normal |
204 |
} else { |
205 |
$w.vi configure -state disabled |
206 |
} |
207 |
} |