File: file.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 (279 lines) | stat: -rw-r--r-- 7,647 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
###PROCEDURES WHICH DEAL WITH THE FILE MENU---START######
proc loadQueryStart {w} {

  global var continueCommand

  #continueCommand is used if we have to pop up a sequence of windows, eg. \
      if need to prompt user for saving a query, then for loading it \
      my structure would forget about the second command.  therefore, set \
      continueCommand to be the procedure to be invoked and if it has a \
      command in it, fs will pick it up after ok is clicked on.
  
  set continueCommand "loadQueryStart $w"
  set yes_proc "saveQueryStart $w"
  set no_proc "fs {loadQueryEnd $w} {Load Query:}"
  set cancel_proc "return"

  #Can specify procedures for each button in a dialog box.  \
      Don't pop a dialog up unless query has changed 

  if {$var({$w}changed) == "true"} {
    dialogBox question.ppm "Save changes before opening\n a different canvas?" \
	"Save ?" yes_no_cancel $yes_proc $no_proc $cancel_proc
  } \
  else \
  {
    fs "loadQueryEnd $w" "Load Query:"
  }
}
#-----------------------------------------------------------
proc loadQueryEnd {w selected} {
  #Called from the file selector box with a file, but there is no 
  #guarantee that the file exists

  global fileName var

  #filter selected and such

    if {[file isfile $selected] != 0} {
      set fd [readQuery $w $selected]
      if {$fd != -1} {

	#would get a -1 if it was not a vod file

        close $fd
        set fileName($w) $selected
	wm title $w "VODS Query[string trim $w .query] - $selected"
        set var({$w}changed) false
      } \
      else \
      {
        dialogBox "Not A Berkeley VOD Query!" ok "" "" ""
      }  
    } \
    else \
    {
       dialogBox "File does not exist!" ok "" "" ""
    }
}
#-----------------------------------------------------------
proc saveQueryStart {w} {

  global fileName continueCommand

  set continueCommand ""
  set okCommand "saveQueryEnd $w"
  set num [string trim $w .query]


  if {$fileName($w) == ""} {
    fs "$okCommand" "Save Query $num:"
    #use fileselector box, if no name exists for this query yet. \
	second argument to savequeryend provided from fileselector
  } \
  else \
  {
    saveQueryEnd $w $fileName($w)
  }
}
#-----------------------------------------------------------
proc saveQueryEnd {w selected} {

  global fileName continueCommand var

  #filter selected for spaces and crap
  #overWrite $selected? if okay, continue, else return
  
  set fd [writeQuery $w $selected]
  close $fd
  set fileName($w) $selected
  wm title $w "VODS Query[string trim $w .query] - $selected"
  set var({$w}changed) false
  eval $continueCommand
  set continueCommand ""
}
#-----------------------------------------------------------
proc saveAsQueryStart {w} {

  fs "saveQueryEnd $w" "Save As File:"
}
#-----------------------------------------------------------
proc writeQuery {w name} {

  global NatLangList

  set fd [open $name w]
  puts $fd [composeQuery $w]
  return $fd
}
#-----------------------------------------------------------
proc readQuery {w name} {
    
  global NatLangList qstate ver var
  
  #clear this query entirely

  set fd [open $name r]
  gets $fd data
  set extras [lindex $data 0]
  set verify [lindex $extras 0]
  if {$verify == "Vodasaurus $ver"} {
    set var({$w}granularity) [lindex $extras 1]
    changeGranularity $w $var({$w}granularity)
    set var({$w}mpeg_one) [lindex $extras 2]
    set var({$w}mpeg_two) [lindex $extras 3]
    set var({$w}jpeg) [lindex $extras 4]
    set fileData [lindex $data 1]
    putDataInWindow $w $fileData
  } \
      else \
  {
    close $fd
    set fd -1
  }       
  return $fd
}
#-----------------------------------------------------------
###PROCEDURES WHICH DEAL WITH THE FILE MENU---END######

proc killWindow {w} {

  global winList NatLangList
  
  set num [string trim $w .query]
  set index [lsearch $winList $num]
  set winList [lreplace $winList $index $index]
  destroy $w
  unset NatLangList($w)
  if {[llength $winList] == 0} {destroy .}
}
  
  
proc quitQuery {w} {

  global var winList continueCommand

  set yes_proc "saveQueryStart $w"
  set no_proc "killWindow $w"
  set cancel_proc "return"
  set num [string trim $w .query]
  set where [lsearch $winList $num]
  set continueCommand "killWindow $w"
  
  if {$var({$w}changed) == "true"} {
    dialogBox question.ppm "Save changes before quitting?" "Save ?" yes_no_cancel "$yes_proc" $no_proc $cancel_proc
    update
  } \
      else \
      {
	killWindow $w
      }
}

proc exitProgram {} {

  global var winList continueCommand

  if {[llength $winList] != 0} {
    set index [lindex $winList 0]
    set w .query$index
    
    if {$var({$w}changed) == "true"} {
      set yes_proc "saveQueryStart $w; set continueCommand \"killWindow $w;exitProgram\""
      #Why such an ugly hack. Well if tcl had a way to control windows in a linear fashion \
	  then I'd be able to say put this window up and wait in procedures associated with \
	  that window.  But, no.  I have to put a window up, return from the proc that \
	  created the window and then deal with life.  So, in SaveQueryEnd, I reset \
	  continueCommand, which destroys the ability to keep going through the window list \
	  therefore, I must reset it here when the yes is activated from the dialog box \
	  ecch!
      
      set no_proc "killWindow $w;exitProgram"
      set cancel_proc "return"      
      set continueCommand "killWindow $w;exitProgram"
      dialogBox question.ppm "Save changes before quitting?"\
	  "Save Changes to Query $index ?" yes_no_cancel\
	  "$yes_proc" $no_proc $cancel_proc
    } \
	else \
	{
	  killWindow $w;exitProgram
	}
  }
}

  

proc notYet {} {
  dialogBox exclamation.ppm \
      {Feature not implemented yet} {Preferences} ok {} {} {}
}

proc clearQueryDialog {w} {

  set yes_proc "clearQuery $w"
  set no_proc "return"
  set cancel_proc "return"
  
  dialogBox question.ppm "Clear current query settings?"\
      "Clear ?" yes_no_cancel $yes_proc $no_proc $cancel_proc

}

proc clearQuery {w} {

  global NatLangList qstate

  set data $NatLangList($w)
  set length [llength $data]
  $w.query.list delete 0  end 
  for {set i 0} {$i < $length} {incr i} {
      set temp [lindex $data $i]
      set menu [lindex $temp $qstate(menu)]
      set menu_index [lindex $temp $qstate(menu_index)]
      set attrib_eng [lindex $temp $qstate(attrib_eng)]
      set all_value [lindex $temp $qstate(all_value)]
      set theMenu "$w.$menu"
      $theMenu entryconfigure $menu_index -label "$attrib_eng = $all_value"
  }
  set NatLangList($w) ""
}


proc duplicateQuery {w} {

  global NatLangList 

  set num [windowNumber]
  newQuery $num
  set data $NatLangList($w)
  set w ".query$num"  
  putDataInWindow $w $data
}

proc putDataInWindow {w data} {

  global qstate NatLangList
  
  set length [llength $data]
  for {set i 0} {$i < $length} {incr i} {
    set temp [lindex $data $i]
    set menu [lindex $temp $qstate(menu)]
    set menu_index [lindex $temp $qstate(menu_index)]
    set attrib_eng [lindex $temp $qstate(attrib_eng)]
    set attrib_op [lindex $temp $qstate(attrib_op)]
    set attrib_val [lindex $temp $qstate(attrib_val)]
    set attrib_op_eng [lindex $temp $qstate(attrib_op_eng)]
    set all_value [lindex $temp $qstate(all_value)]
    set theMenu "$w.$menu"
    #pathname for reconfigured menu
    
    #just hard-coded this, fix it
    $w.query.list insert end "[string trim $attrib_eng "  "] $attrib_op_eng $attrib_val"
    set NatLangList($w) [linsert $NatLangList($w) \
				    [llength $NatLangList($w)] $temp]
    
    $theMenu entryconfigure $menu_index -label "$attrib_eng $attrib_op $attrib_val"
    #menu
  }
}