File: fs.tcl

package info (click to toggle)
ucbmpeg 1r2-6
  • links: PTS
  • area: non-free
  • in suites: hamm, potato, slink
  • size: 9,504 kB
  • ctags: 7,643
  • sloc: ansic: 79,920; tcl: 2,985; perl: 313; asm: 284; makefile: 269; csh: 13
file content (286 lines) | stat: -rw-r--r-- 8,353 bytes parent folder | download
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
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
##LEFT TO DO IS KEY BY KEY SELECT AND USE ARROWS
##still a bit messy, clean up in spare time
#---------------------------------------------
set bitmapDirectory /n/picasso/users/dvberger/vodasaurus/bitmaps

proc fillBoxes {directory mask} {

  global fileselect lastDir

  ## Fill the listboxes with files and with directories \
      using /bin/ls

  $fileselect(file_list) delete 0 end
  $fileselect(dir_list) delete 0 end

  cd $directory
  set lastDir [pwd]
  $fileselect(dir_label) configure -text $lastDir
 
  foreach i [exec /bin/ls -aF $lastDir] {
    if {[string compare $i "."] != 0 && \
	    [string compare $i ".."] != 0 && \
	    [string match */ $i] == 0} then \
	{ 
	  if {[string match $mask $i] == 1} {
	    $fileselect(file_list) insert end $i}
	} else \
	{
	 $fileselect(dir_list) insert end $i
	}
  }
}
#---------------------------------------------
proc fs {
    {cmd fileselect.default.cmd} 
    {purpose "File:"} 
    {w .fileSelectWindow} 
    {errorHandler fileselect.default.errorHandler}
} {
    
    global fileselect lastDir bitmapDirectory
    set lastDir ""
    
    set fileselect(entry) $w.fframe.entry
    set fileselect(file_list) $w.fframe.list
    set fileselect(file_yscroll) $w.fframe.yscroll
    #    set fileselect(filter) $w.fframe.filter
    #    set fileselect(buttonFilter) $w.fframe.buttonFilter
    
    set fileselect(dir_label) $w.dframe.label1
    set fileselect(dir_list) $w.dframe.list
    set fileselect(dir_yscroll) $w.dframe.yscroll
    #    set fileselect(drive) $w.fframe.filter
    #    set fileselect(filter) $w.fframe.buttonFilter
    
    set fileselect(ok) $w.bframe.ok
    set fileselect(cancel) $w.bframe.cancel
    
    
    catch {destroy $w}
    toplevel $w
    wm title $w $purpose
    
    ##FRAME FOR FILES
    
    frame $w.fframe -borderwidth 10
    label $w.fframe.label -anchor w -text "File Name:"
    label $w.fframe.spacer -text "       "
    entry $w.fframe.entry -relief sunken 
    
    scrollbar $w.fframe.yscroll -relief sunken \
	-command "$w.fframe.list yview"
    listbox $w.fframe.list -relief sunken \
	-yscroll "$w.fframe.yscroll set"
    
    frame $w.fframe.fframe
    label $w.fframe.fframe.label -text "List Files of Type:"
    label $w.fframe.fframe.filter -text\
	"Berkeley Vods Queries (*.vod)" -relief sunken
    
    menubutton $w.fframe.fframe.button -menu \
	$w.fframe.fframe.button.m -bitmap \
	@$bitmapDirectory/arrow.xbm -relief raised 
    
    menu $w.fframe.fframe.button.m
    $w.fframe.fframe.button.m add command -label \
	"Berkeley Vods Queries (*.vod)" -command \
	"fillBoxes . *.vod; $w.fframe.fframe.filter configure -text \
        \"Berkeley Vods Queries (*.vod)\""
    $w.fframe.fframe.button.m add command -label \
	"All Files (*.*)" -command \
	"fillBoxes . *.*; $w.fframe.fframe.filter configure -text \
        \"All Files (*.*)\""
    
    ##DIRECTORY
    frame $w.dframe -borderwidth 10 
    label $w.dframe.label -anchor w -text "Directories:"
    label $w.dframe.label1 -anchor w -text [pwd] 
    
    scrollbar $w.dframe.yscroll -relief sunken \
	-command "$w.dframe.list yview"
    listbox $w.dframe.list -relief sunken \
	-yscroll "$w.dframe.yscroll set" 
    
    set lastDir [pwd]
    fillBoxes "[pwd]" "*.vod"
    
    frame $w.dframe.dframe
    label $w.dframe.dframe.label -text "Drives:"
    label $w.dframe.dframe.filter -text \
	"c:/" -relief sunken
    
    menubutton $w.dframe.dframe.button -menu \
	$w.dframe.dframe.button.m -bitmap \
	@$bitmapDirectory/arrow.xbm -relief raised 
    
    menu $w.dframe.dframe.button.m
    $w.dframe.dframe.button.m add command -label \
	"c:/" -command \
	"$w.dframe.dframe.filter configure -text \
        \"c:/ \""
    $w.dframe.dframe.button.m add command -label \
	"d:/" -command \
	"$w.dframe.dframe.filter configure -text \
        \"d:/ \""
    
    ##BUTTONS
    frame $w.bframe -borderwidth 10 
    button $w.bframe.ok -text "OK" -relief raised -padx 10 -pady 10 \
	-command "fileselect.ok.cmd $w {$cmd} $errorHandler" \
	-width 4 
    label $w.bframe.label -text ""
    button $w.bframe.cancel -text Cancel -relief raised -padx 10 -pady 10\
	-command "fileselect.cancel.cmd $w" \
	-width 4 
    
    ## BINDINGS
    bind $fileselect(entry) <Return> {eval $fileselect(ok) invoke}
    bind $fileselect(entry) <Control-c> {eval $fileselect(cancel) invoke}
    
    bind $w <Control-c> {eval $fileselect(cancel) invoke}
    bind $w <Return> {eval $fileselect(ok) invoke}
    
    tk_listboxSingleSelect $fileselect(file_list)
    tk_listboxSingleSelect $fileselect(dir_list)
    
    ##FOR FILE BOX
    
    bind $fileselect(file_list) <Button-1> {
	# puts stderr "button 1 release"
	%W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
    }
    
    bind $fileselect(file_list) <Double-ButtonPress-1> {
	# puts stderr "double button 1"
	%W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
	$fileselect(ok) invoke
    }
    
    bind $fileselect(file_list) <Return> {
	%W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
	$fileselect(ok) invoke
    }
    
    ##FOR DIRECTORY BOX
    
    bind $fileselect(dir_list) <Double-ButtonPress-1> {
	# puts stderr "double button 1"
	%W select from [%W nearest %y]
	fillBoxes "[pwd]/[%W get [%W nearest %y]]" "*"
    }
    
    bind $fileselect(dir_list) <Return> {
	%W select from [%W nearest %y]
	$fileselect(entry) delete 0 end
	$fileselect(entry) insert 0 [%W get [%W nearest %y]]
	$fileselect(ok) invoke
    }
    
    # set kbd focus to entry widget
    
    focus $fileselect(entry)
    
    #PACKING THE WINDOW
    pack $w.fframe $w.dframe -fill both -expand yes -side left
    pack $w.bframe -side left -fill both
    
    pack $w.fframe.label -anchor w 
    pack $w.fframe.entry $w.fframe.spacer -fill x
    pack $w.fframe.fframe -side bottom -anchor w
    pack $w.fframe.fframe.label -anchor w
    pack $w.fframe.fframe.button $w.fframe.fframe.filter -side left -anchor w
    pack $w.fframe.list -side left -fill both -expand yes
    pack $w.fframe.yscroll -side left -fill y
    
    pack $w.dframe.label -anchor w 
    pack $w.dframe.label1 -anchor w
    pack $w.dframe.dframe -side bottom -anchor w
    pack $w.dframe.dframe.label -anchor w
    pack $w.dframe.dframe.button $w.dframe.dframe.filter -side left -anchor w
    pack $w.dframe.list -side left -fill both -expand yes
    pack $w.dframe.yscroll -side right -fill y 
    
    pack $w.bframe.ok $w.bframe.label $w.bframe.cancel 
}

#---------------------------------------------
proc fileselect.default.cmd {f} {
  return $f
#  puts stderr "selected file $f"
  ##add action to file here
}
#---------------------------------------------
proc fileselect.default.errorHandler {errorMessage} {
    puts stdout "error: $errorMessage"
    catch { cd ~ }
}
#---------------------------------------------
proc fileselect.cancel.cmd {w} {
    # puts stderr "Cancel"
    destroy $w
}
#--------------------------------------------------
proc fileselect.ok.cmd {w cmd errorHandler} {

  global fileselect 

  set mask "*"
  set selected [$fileselect(entry) get]
  #some nasty file names may cause "file isdirectory" to return an error
  set sts [catch {set isDir [file isdirectory $selected]} errorMessage ]

  #if sts is 1 then there was an error in the filename
  if {$sts != 0} then {
    $errorHandler $errorMessage
    destroy $w
    return
  }

  # clean the text entry and prepare the list
  $fileselect(entry) delete 0 end
  $fileselect(file_list) delete 0 end

  if {$isDir == 1} {
    fillBoxes $selected $mask      
    return
  } \
      else \
      {
	set dirName [file dirname $selected]
	set tail [file tail $selected]

	#put in error is use ? [] \ + etc

	if {[file isdirectory $dirName] == 1} {
	  if {[regexp {\*} $tail] == 1} {
	    fillBoxes $dirName $tail
	  } \
	      else \
	      {
		destroy $w
		if {$selected != ""} {
		  eval $cmd {$selected}}
	      }
	} \
	    else \
	    {
	      #        puts invalid_directory
	    } 
	#the error for invalid directory goes here      
      }
}
#---------------------------------------------
proc setName {selected} {

global fileName

  set fileName $selected
}
#---------------------------------------------