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