ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/getfile.tcl
Revision: 2.3
Committed: Sun Jun 3 20:13:51 2012 UTC (11 years, 9 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
CVS Tags: rad5R4, rad5R2, rad4R2P2, rad5R0, rad5R1, rad4R2, rad4R2P1, rad5R3, HEAD
Changes since 2.2: +5 -1 lines
Log Message:
Added work-around for broken double-click binding

File Contents

# Content
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 }