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

# User Rev Content
1 greg 2.3 # RCSid: $Id: getfile.tcl,v 2.2 2003/02/22 02:07:30 greg Exp $
2 greg 2.1 #
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 greg 2.3 bind $w.fm.fl <Return> "set_curfile $w $sendproc"
100 greg 2.1 if {$transient} {
101     bind $w.fm.fl <Double-Button-1> \
102     "+if {\$curfile > {}} {destroy $w}"
103 greg 2.3 bind $w.fm.fl <Return> \
104     "+if {\$curfile > {}} {destroy $w}"
105 greg 2.1 }
106     } else {
107     bind $w.fm.fl <Double-Button-1> "set_curfile $w"
108 greg 2.3 bind $w.fm.fl <Return> "set_curfile $w"
109 greg 2.1 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     }