|
5
|
1 #!/usr/bin/env wish8.2
|
|
1
|
2
|
|
|
3 #
|
|
|
4 # This software is copyright Daniel O'Connor (darius@dons.net.au) 2000
|
|
|
5 #
|
|
|
6 # Redistribution and use in source and binary forms, with or without
|
|
|
7 # modification, are permitted provided that the following conditions
|
|
|
8 # are met:
|
|
|
9 # 1. Redistributions of source code must retain the above copyright
|
|
|
10 # notice, this list of conditions and the following disclaimer.
|
|
|
11 # 2. Redistributions in binary form must reproduce the above copyright
|
|
|
12 # notice, this list of conditions and the following disclaimer in the
|
|
|
13 # documentation and/or other materials provided with the distribution.
|
|
|
14 # 3. Neither the name Daniel O'Connor nor the names of its contributors
|
|
|
15 # may be used to endorse or promote products derived from this software
|
|
|
16 # without specific prior written permission.
|
|
|
17 #
|
|
|
18 # THIS SOFTWARE IS PROVIDED BY DANIEL O'CONNOR AND CONTRIBUTORS ``AS IS'' AND
|
|
|
19 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
|
20 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
|
21 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
|
|
|
22 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
|
23 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
|
24 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
|
25 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
|
26 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
|
27 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
|
28 # SUCH DAMAGE.
|
|
|
29 #
|
|
|
30
|
|
|
31 proc main {} {
|
|
3
|
32 global argv0 argv state albums songs tcl_platform;
|
|
1
|
33
|
|
3
|
34 if {[string first "Windows" $tcl_platform(os)] == -1} {
|
|
|
35 set state(conffile) "~/.mservtk";
|
|
|
36 set state(windows) 0;
|
|
|
37 } else {
|
|
|
38 package require registry 1.0;
|
|
|
39 set state(windows) 1;
|
|
|
40 }
|
|
|
41
|
|
1
|
42 set state(port) "4444";
|
|
3
|
43 set state(exit) 0;
|
|
1
|
44 set state(tmpphrase) "";
|
|
3
|
45 set state(sortmode) "Title";
|
|
1
|
46
|
|
4
|
47 set state(rtlist) "";
|
|
|
48
|
|
3
|
49 wm withdraw .;
|
|
|
50
|
|
|
51 f_readconf;
|
|
|
52 gui_conf;
|
|
1
|
53
|
|
3
|
54 if {$state(host) == "NONE"} {
|
|
|
55 log "%s" "Login cancelled";
|
|
|
56 exit;
|
|
|
57 } else {
|
|
|
58 log "%s" "Login OK'd";
|
|
|
59 }
|
|
|
60
|
|
|
61 f_writeconf;
|
|
|
62
|
|
|
63 wm deiconify .;
|
|
1
|
64 con_mserv;
|
|
|
65
|
|
|
66 con_getalbums albums;
|
|
|
67 con_getsongs songs albums;
|
|
|
68
|
|
3
|
69 gui_build;
|
|
|
70 focus -force .;
|
|
|
71
|
|
1
|
72 gui_updatesongs;
|
|
|
73 gui_updatequeue;
|
|
|
74
|
|
|
75 update_timer;
|
|
|
76
|
|
|
77 while {1} {
|
|
4
|
78 vwait state;
|
|
|
79
|
|
|
80 if {$state(rtlist) != ""} {
|
|
|
81 # Copy it so we don't stomp any new additions
|
|
|
82 set tmp $state(rtlist);
|
|
|
83 set state(rtlist) "";
|
|
|
84
|
|
5
|
85 foreach t $tmp {
|
|
|
86 # log "%s" "Handle $t";
|
|
4
|
87 n_rthandler [lindex $t 0] [lindex $t 1];
|
|
|
88 }
|
|
|
89 }
|
|
1
|
90
|
|
|
91 if {$state(exit) == 1} {
|
|
|
92 exit;
|
|
|
93 }
|
|
|
94 }
|
|
|
95 }
|
|
|
96
|
|
3
|
97 proc f_readconf {} {
|
|
|
98 global state;
|
|
|
99
|
|
|
100 set state(host) "NONE";
|
|
|
101 set state(user) "NONE";
|
|
|
102 set state(pass) "";
|
|
|
103
|
|
|
104 if {$state(windows) == 1} {
|
|
|
105 if {[catch {
|
|
|
106 set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host];
|
|
|
107 set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user];
|
|
|
108 set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass];
|
|
|
109 } msg]} {
|
|
|
110 log "%s" "Failed to read registry keys - $msg";
|
|
|
111 }
|
|
|
112 } else {
|
|
|
113 if {![catch {
|
|
|
114 set fh [open $state(conffile)];
|
|
|
115 } msg]} {
|
|
|
116 if {[gets $fh] != "mservtk-0.1"} {
|
|
|
117 log "%s" "Conf file has the wrong version";
|
|
|
118 } else {
|
|
|
119 set state(host) [gets $fh];
|
|
|
120 set state(user) [gets $fh];
|
|
|
121 set state(pass) [gets $fh];
|
|
|
122 close $fh;
|
|
|
123 }
|
|
|
124 } else {
|
|
|
125 log "%s" "Failed to open $state(conffile) - $msg";
|
|
|
126 }
|
|
|
127 }
|
|
|
128 }
|
|
|
129
|
|
|
130 proc f_writeconf {} {
|
|
|
131 global state;
|
|
|
132
|
|
|
133 if {$state(windows) == 1} {
|
|
|
134 if {[catch {
|
|
|
135 registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host);
|
|
|
136 registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user);
|
|
|
137 registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass);
|
|
|
138 } msg]} {
|
|
|
139 log "%s" "Failed to set registry keys - $msg";
|
|
|
140 }
|
|
|
141 } else {
|
|
|
142 if {![catch {
|
|
|
143 set fh [open $state(conffile) w];
|
|
|
144 } msg]} {
|
|
|
145 puts $fh "mservtk-0.1";
|
|
|
146 puts $fh $state(host);
|
|
|
147 puts $fh $state(user);
|
|
|
148 puts $fh $state(pass);
|
|
|
149
|
|
|
150 close $fh;
|
|
|
151 } else {
|
|
|
152 log "%s" "Failed to open $state(conffile) - $msg";
|
|
|
153 }
|
|
|
154 }
|
|
|
155 }
|
|
|
156
|
|
|
157 proc gui_conf {} {
|
|
|
158 global state;
|
|
|
159
|
|
|
160 catch {destroy .conf};
|
|
|
161
|
|
|
162 toplevel .conf -class Dialog;
|
|
|
163 wm title .conf "Authentication";
|
|
|
164 wm iconname .conf "Authentication";
|
|
|
165
|
|
|
166 frame .conf.host;
|
|
|
167 pack .conf.host -side top -pady 2m -fill x;
|
|
|
168 label .conf.host.label -text "Host:" -width 10 -anchor e;
|
|
|
169
|
|
|
170 entry .conf.host.entry -relief sunken -width 30 -textvariable state(host)
|
|
|
171 pack .conf.host.label .conf.host.entry -side left -padx 1m
|
|
|
172
|
|
|
173 frame .conf.user
|
|
|
174 pack .conf.user -side top -pady 2m -fill x
|
|
|
175 label .conf.user.label -text "User:" -width 10 -anchor e
|
|
|
176 entry .conf.user.entry -relief sunken -width 8 -textvariable state(user)
|
|
|
177 pack .conf.user.label .conf.user.entry -side left -padx 1m
|
|
|
178
|
|
|
179 frame .conf.password
|
|
|
180 pack .conf.password -side top -pady 2m -fill x
|
|
|
181 label .conf.password.label -text "Password:" -width 10 -anchor e
|
|
|
182 entry .conf.password.entry -relief sunken -width 8 -textvariable state(pass) -show *;
|
|
|
183 bind .conf.password.entry <Return> ".conf.buttons.ok invoke";
|
|
|
184 pack .conf.password.label .conf.password.entry -side left -padx 1m
|
|
|
185
|
|
|
186 frame .conf.buttons
|
|
|
187 pack .conf.buttons -side top -pady 1m -fill x
|
|
|
188 button .conf.buttons.ok -text OK -width 6 -command {
|
|
|
189 destroy .conf;
|
|
|
190 }
|
|
|
191 button .conf.buttons.cancel -text Cancel -width 6 -command {
|
|
|
192 set state(host) "NONE";
|
|
|
193 set state(user) "NONE";
|
|
|
194 set state(pass) "NONE";
|
|
|
195 destroy .conf;
|
|
|
196 }
|
|
|
197 pack .conf.buttons.ok -side left -padx 1m;
|
|
|
198 pack .conf.buttons.cancel -side right -padx 1m;
|
|
|
199
|
|
|
200
|
|
|
201 # Withdraw the window, then update all the geometry information
|
|
|
202 # so we know how big it wants to be, then center the window in the
|
|
|
203 # display and de-iconify it.
|
|
|
204
|
|
|
205 wm withdraw .conf
|
|
|
206 update idletasks
|
|
|
207 set x [expr [winfo screenwidth .conf]/2 - [winfo reqwidth .conf]/2 \
|
|
|
208 - [winfo vrootx [winfo parent .conf]]]
|
|
|
209 set y [expr [winfo screenheight .conf]/2 - [winfo reqheight .conf]/2 \
|
|
|
210 - [winfo vrooty [winfo parent .conf]]]
|
|
|
211 wm geom .conf +$x+$y
|
|
|
212 wm deiconify .conf
|
|
|
213
|
|
|
214 # Set a grab and claim the focus too.
|
|
|
215
|
|
|
216 set oldFocus [focus]
|
|
|
217 set oldGrab [grab current .conf]
|
|
|
218 if {$oldGrab != ""} {
|
|
|
219 set grabStatus [grab status $oldGrab]
|
|
|
220 }
|
|
|
221 grab .conf
|
|
|
222 tkwait visibility .conf
|
|
|
223 if {$state(host) == "NONE"} {
|
|
|
224 focus .conf.host.entry;
|
|
|
225 } else {
|
|
|
226 focus .conf.password.entry;
|
|
|
227 }
|
|
|
228 tkwait window .conf;
|
|
|
229 if {$oldGrab != ""} {
|
|
|
230 if {$grabStatus == "global"} {
|
|
|
231 grab -global $oldGrab
|
|
|
232 } else {
|
|
|
233 grab $oldGrab
|
|
|
234 }
|
|
|
235 }
|
|
|
236
|
|
|
237 log "%s" "Host $state(host)";
|
|
|
238 }
|
|
|
239
|
|
1
|
240 proc quit_now {} {
|
|
|
241 global state;
|
|
|
242
|
|
|
243 set state(exit) 1;
|
|
|
244 }
|
|
|
245
|
|
|
246 proc gui_build {} {
|
|
|
247 # create the toplevel
|
|
|
248 eval destroy [winfo child .];
|
|
|
249 wm title . "MServ-Tk";
|
|
|
250 wm minsize . 600 500;
|
|
|
251 wm geometry . 600x500;
|
|
|
252
|
|
|
253 # Let's have a menubar
|
|
|
254 frame .menubar -relief raised -bd 2;
|
|
|
255 pack .menubar -side top -fill x;
|
|
|
256
|
|
|
257 # Add the File menu
|
|
|
258 menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0;
|
|
|
259 menu .menubar.file.m -tearoff 0;
|
|
3
|
260 .menubar.file.m add command -label " Top" -command "gui_top"
|
|
5
|
261 .menubar.file.m add command -label " Update Queue" -command "gui_updatequeue"
|
|
3
|
262 .menubar.file.m add separator;
|
|
1
|
263 .menubar.file.m add command -label " Quit" -command "quit_now" \
|
|
|
264 -underline 2 -accelerator "Alt-q";
|
|
|
265 pack .menubar.file -side left;
|
|
|
266
|
|
|
267 # Add the Rate menu
|
|
|
268 menubutton .menubar.rate -text "Rate" -menu .menubar.rate.m -underline 0;
|
|
|
269 menu .menubar.rate.m -tearoff 0;
|
|
|
270 .menubar.rate.m add command -label " Superb" -command "rate_song SUPERB";
|
|
|
271 .menubar.rate.m add command -label " Good" -command "rate_song GOOD";
|
|
|
272 .menubar.rate.m add command -label " Neutral" -command "rate_song NEUTRAL";
|
|
|
273 .menubar.rate.m add command -label " Bad" -command "rate_song BAD";
|
|
|
274 .menubar.rate.m add command -label " Awful" -command "rate_song AWFUL";
|
|
|
275
|
|
|
276 pack .menubar.rate -side left;
|
|
|
277
|
|
|
278 # Add the Control menu
|
|
|
279 menubutton .menubar.control -text "Control" -menu .menubar.control.m -underline 0;
|
|
|
280 menu .menubar.control.m -tearoff 0;
|
|
|
281 .menubar.control.m add command -label " Next" -command "control_player NEXT";
|
|
|
282 .menubar.control.m add command -label " Pause" -command "control_player PAUSE";
|
|
|
283 .menubar.control.m add command -label " Stop" -command "control_player STOP"
|
|
|
284 .menubar.control.m add command -label " Play" -command "control_player PLAY";
|
|
|
285
|
|
|
286 pack .menubar.control -side left;
|
|
|
287
|
|
|
288 # Add the Volume menu
|
|
|
289 menubutton .menubar.vol -text "Volume" -menu .menubar.vol.m -underline 0;
|
|
|
290 menu .menubar.vol.m -tearoff 0;
|
|
|
291 .menubar.vol.m add command -label " Increase" -command "set_vol +3" \
|
|
|
292 -accelerator "+";
|
|
|
293 .menubar.vol.m add command -label " Decrease" -command "set_vol -3" \
|
|
|
294 -accelerator "-";
|
|
|
295 .menubar.vol.m add separator;
|
|
|
296 .menubar.vol.m add command -label " 100%" -command "set_vol 100";
|
|
|
297 .menubar.vol.m add command -label " 90%" -command "set_vol 90";
|
|
|
298 .menubar.vol.m add command -label " 80%" -command "set_vol 80";
|
|
|
299 .menubar.vol.m add command -label " 70%" -command "set_vol 70";
|
|
|
300 .menubar.vol.m add command -label " 60%" -command "set_vol 60";
|
|
|
301 .menubar.vol.m add command -label " 50%" -command "set_vol 50";
|
|
|
302 .menubar.vol.m add command -label " 40%" -command "set_vol 40";
|
|
|
303 .menubar.vol.m add command -label " 30%" -command "set_vol 30";
|
|
|
304 .menubar.vol.m add command -label " 20%" -command "set_vol 20";
|
|
|
305 .menubar.vol.m add command -label " 10%" -command "set_vol 10";
|
|
|
306 .menubar.vol.m add command -label " 0%" -command "set_vol 0";
|
|
|
307
|
|
|
308 pack .menubar.vol -side left;
|
|
|
309
|
|
|
310 # Add the Sort menu
|
|
|
311 menubutton .menubar.sort -text "Sort" -menu .menubar.sort.m -underline 0;
|
|
|
312 menu .menubar.sort.m -tearoff 0;
|
|
|
313 .menubar.sort.m add command -label " Artist" \
|
|
|
314 -command "global state; set state(sortmode) Artist; gui_updatesongs";
|
|
|
315 .menubar.sort.m add command -label " Title" \
|
|
|
316 -command "global state; set state(sortmode) Title; gui_updatesongs";
|
|
|
317 .menubar.sort.m add command -label " Album" \
|
|
|
318 -command "global state; set state(sortmode) Album; gui_updatesongs";
|
|
|
319
|
|
|
320 pack .menubar.sort -side left;
|
|
|
321
|
|
|
322 # Add the Help menu
|
|
|
323 menubutton .menubar.help -text "Help" -menu .menubar.help.m -underline 0;
|
|
|
324 menu .menubar.help.m -tearoff 0;
|
|
|
325 .menubar.help.m add command -label " About" -command "about_box" \
|
|
|
326 -underline 2;
|
|
|
327 pack .menubar.help -side right;
|
|
|
328
|
|
|
329 # Top frame holding tracklist and trackinfo frames
|
|
|
330 frame .top -relief raised -bd 1;
|
|
|
331 pack .top -fill both -expand 1;
|
|
|
332
|
|
|
333 # Tracklist
|
|
|
334 frame .top.tlist -relief raised -bd 1;
|
|
|
335 pack .top.tlist -side left -fill both -expand 1;
|
|
|
336 label .top.tlist.label -text "Track List";
|
|
|
337 pack .top.tlist.label -side top -expand 0;
|
|
|
338 listbox .top.tlist.list -relief raised -borderwidth 2 \
|
|
|
339 -yscrollcommand ".top.tlist.scr set";
|
|
|
340 pack .top.tlist.list -side left -fill both -expand 1;
|
|
|
341 scrollbar .top.tlist.scr -command ".top.tlist.list yview";
|
|
|
342 pack .top.tlist.scr -side right -fill y;
|
|
|
343 bind .top.tlist.list <Double-Button-1> {
|
|
|
344 queue_song [.top.tlist.list curselection];
|
|
5
|
345 gui_updatequeue;
|
|
1
|
346 }
|
|
|
347
|
|
|
348 # Trackinfo
|
|
|
349 frame .top.tinfo -relief raised -bd 1;
|
|
|
350 pack .top.tinfo -side right -fill both -expand 0;
|
|
|
351 label .top.tinfo.label -text "Track Info";
|
|
|
352 pack .top.tinfo.label -side top -expand 0;
|
|
|
353 frame .top.tinfo.sub -relief raised -bd 1;
|
|
|
354 pack .top.tinfo.sub -side right -fill both -expand 0;
|
|
|
355 label .top.tinfo.sub.author -text "Author:";
|
|
|
356 pack .top.tinfo.sub.author -side top -expand 0;
|
|
|
357 label .top.tinfo.sub.title -text "Title:";
|
|
|
358 pack .top.tinfo.sub.title -side top -expand 0;
|
|
|
359 label .top.tinfo.sub.length -text "Length:";
|
|
|
360 pack .top.tinfo.sub.length -side top -expand 0;
|
|
|
361 label .top.tinfo.sub.time -text "Time:";
|
|
|
362 pack .top.tinfo.sub.time -side top -expand 0;
|
|
|
363 label .top.tinfo.sub.album -text "Album:";
|
|
|
364 pack .top.tinfo.sub.album -side top -expand 0;
|
|
3
|
365 label .top.tinfo.sub.misc -text "Misc:";
|
|
|
366 pack .top.tinfo.sub.misc -side top -expand 0;
|
|
|
367 label .top.tinfo.sub.rate1 -text "Rating:";
|
|
|
368 pack .top.tinfo.sub.rate1 -side top -expand 0;
|
|
|
369 label .top.tinfo.sub.rate2 -text "Temporally Adjusted:";
|
|
|
370 pack .top.tinfo.sub.rate2 -side top -expand 0;
|
|
1
|
371 label .top.tinfo.sub.vol -text "Volume:";
|
|
|
372 pack .top.tinfo.sub.vol -side top -expand 0;
|
|
|
373
|
|
|
374 # Queue (and the frame holding it)
|
|
|
375 frame .bot -relief raised -bd 1;
|
|
|
376 pack .bot -fill both -expand 1;
|
|
|
377 label .bot.qlabel -text "Queue";
|
|
|
378 pack .bot.qlabel -side top -expand 0;
|
|
|
379 frame .bot.queue;
|
|
|
380 pack .bot.queue -fill both -expand 1;
|
|
|
381 listbox .bot.queue.list -relief raised -borderwidth 2 \
|
|
|
382 -yscrollcommand ".bot.queue.scr set";
|
|
|
383 pack .bot.queue.list -side left -fill both -expand 1;
|
|
|
384 scrollbar .bot.queue.scr -command ".bot.queue.list yview";
|
|
|
385 pack .bot.queue.scr -side right -fill y;
|
|
|
386 bind .bot.queue.list <Double-Button-1> {
|
|
|
387 gui_delqueue [.bot.queue.list curselection];
|
|
|
388 }
|
|
|
389
|
|
|
390 bind . <Destroy> {quit_now};
|
|
|
391 bind all <Alt-q> {quit_now};
|
|
|
392
|
|
|
393 bind all <KP_Add> {set_vol +3};
|
|
|
394 bind all <KP_Subtract> {set_vol -3};
|
|
|
395 bind all <plus> {set_vol +3};
|
|
|
396 bind all <equal> {set_vol +3};
|
|
|
397 bind all <minus> {set_vol -3};
|
|
|
398 bind all <F1> {set_vol 10};
|
|
|
399 bind all <F2> {set_vol 20};
|
|
|
400 bind all <F3> {set_vol 30};
|
|
|
401 bind all <F4> {set_vol 40};
|
|
|
402 bind all <F5> {set_vol 50};
|
|
|
403 bind all <F6> {set_vol 60};
|
|
|
404 bind all <F7> {set_vol 70};
|
|
|
405 bind all <F8> {set_vol 80};
|
|
|
406 bind all <F9> {set_vol 90};
|
|
|
407 bind all <F10> {set_vol 100};
|
|
|
408
|
|
|
409 bind all <Pause> {control_player PAUSE};
|
|
|
410 bind all <End> {control_player NEXT};
|
|
|
411 bind all <Delete> {control_player STOP};
|
|
|
412 bind all <Home> {control_player PLAY};
|
|
|
413
|
|
|
414 update;
|
|
|
415 }
|
|
|
416
|
|
|
417 proc queue_song {id} {
|
|
|
418 global songs state;
|
|
|
419
|
|
|
420 set tmp [lindex [lindex [array get songs *:listid:$id] 1] 0];
|
|
|
421 log "%s" "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)";
|
|
|
422
|
|
|
423 n_write "QUEUE [split $tmp {:}]";
|
|
|
424 n_getrtn rtn;
|
|
|
425
|
|
|
426 if {$rtn(code) != 247} {
|
|
|
427 if {$rtn(code) == 510} {
|
|
|
428 msg_box "Queue" "You can't have the same\nsong in the queue twice!";
|
|
|
429 } else {
|
|
5
|
430 log "%s" "Failed to queue track ($rtn(code) $rtn(data))";
|
|
1
|
431 }
|
|
|
432 }
|
|
|
433 }
|
|
|
434
|
|
|
435 proc msg_box {title msg} {
|
|
|
436 global state;
|
|
|
437
|
|
|
438 catch {destroy .msg};
|
|
|
439
|
|
|
440 toplevel .msg -class Dialog;
|
|
|
441 wm title .msg $title;
|
|
|
442 wm iconname .msg $title;
|
|
|
443
|
|
|
444 # text region
|
|
|
445 frame .msg.frame;
|
|
|
446 pack .msg.frame -side top -fill both -expand yes;
|
|
3
|
447 text .msg.frame.text -font fixed -yscroll ".msg.frame.scroll set" -wrap none;
|
|
1
|
448 scrollbar .msg.frame.scroll -command ".msg.frame.text yview";
|
|
|
449 pack .msg.frame.text -side left -expand y -fill both;
|
|
|
450 pack .msg.frame.scroll -side right -fill y;
|
|
|
451
|
|
|
452 # close button
|
|
|
453 button .msg.close -text "Close" -command "destroy .msg";
|
|
|
454 pack .msg.close -side bottom -fill x;
|
|
|
455
|
|
|
456 # read text into the text widget
|
|
|
457 .msg.frame.text insert end $msg;
|
|
|
458 }
|
|
|
459
|
|
|
460 proc about_box {} {
|
|
|
461 global state;
|
|
|
462
|
|
|
463 catch {destroy .about};
|
|
|
464
|
|
|
465 toplevel .about -class Dialog;
|
|
|
466 wm title .about "About...";
|
|
|
467 wm iconname .about "About";
|
|
|
468
|
|
|
469 # text region
|
|
|
470 frame .about.frame;
|
|
|
471 pack .about.frame -side top -fill both -expand yes;
|
|
|
472 text .about.frame.text -font fixed -height 10 -width 40 -yscroll ".about.frame.scroll set" \
|
|
|
473 -wrap none;
|
|
|
474 scrollbar .about.frame.scroll -command ".about.frame.text yview";
|
|
|
475 pack .about.frame.text -side left -expand y;
|
|
|
476 pack .about.frame.scroll -side right -fill y;
|
|
|
477
|
|
|
478 # close button
|
|
|
479 button .about.close -text "Close" -command "destroy .about";
|
|
|
480 pack .about.close -side bottom -fill x;
|
|
|
481
|
|
|
482 # read text into the text widget
|
|
|
483 .about.frame.text insert end "Mserv Client\n";
|
|
|
484 .about.frame.text insert end "Copyright Daniel O'Connor 2000\n";
|
|
|
485 .about.frame.text insert end "\n";
|
|
|
486 .about.frame.text insert end "http://www.dons.net.au/~darius/\n";
|
|
|
487 }
|
|
|
488
|
|
|
489 proc set_vol {vol} {
|
|
|
490 global state;
|
|
|
491
|
|
5
|
492 set cookie [acquire_lock];
|
|
1
|
493 n_write "VOLUME $vol"
|
|
|
494 n_getrtn rtn;
|
|
5
|
495 release_lock $cookie;
|
|
|
496
|
|
1
|
497 if {$rtn(code) != 255} {
|
|
|
498 log "%s" "Couldn't set volume ($rtn(code) $rtn(data))";
|
|
|
499 }
|
|
|
500 }
|
|
|
501
|
|
|
502 proc rate_song {rate} {
|
|
|
503 global state;
|
|
|
504
|
|
5
|
505 set cookie [acquire_lock];
|
|
1
|
506 n_write "RATE $rate";
|
|
|
507 n_getrtn rtn;
|
|
5
|
508 release_lock $cookie;
|
|
1
|
509
|
|
|
510 if {$rtn(code) != 270} {
|
|
|
511 log "%s" "Failed to get rate song ($rtn(code) $rtn(data))";
|
|
|
512 }
|
|
|
513
|
|
|
514 }
|
|
|
515
|
|
|
516 proc control_player {cmd} {
|
|
|
517 global state;
|
|
|
518
|
|
5
|
519 set cookie [acquire_lock];
|
|
|
520 log "%s" "Writing $cmd";
|
|
1
|
521 n_write "$cmd";
|
|
|
522 n_getrtn rtn;
|
|
5
|
523 release_lock $cookie;
|
|
1
|
524
|
|
|
525 log "%s" "Control Got $rtn(code) $rtn(data)";
|
|
|
526 }
|
|
|
527
|
|
3
|
528 proc gui_top {} {
|
|
|
529 global state;
|
|
|
530
|
|
5
|
531 set cookie [acquire_lock];
|
|
3
|
532 n_write "TOP"
|
|
|
533 n_getrtn rtn;
|
|
5
|
534 release_lock $cookie;
|
|
3
|
535
|
|
|
536 set msg "List of songs most likely to be played next\n\n";
|
|
|
537
|
|
|
538 foreach t $rtn(lines) {
|
|
|
539 set tmp [split $t \011];
|
|
|
540 append msg "[lindex $tmp 0]%\t[lindex $tmp 4] by [lindex $tmp 3]\n";
|
|
|
541 }
|
|
|
542
|
|
|
543 msg_box "Top Listing" $msg;
|
|
|
544 }
|
|
|
545
|
|
1
|
546 proc gui_updatesongs {} {
|
|
|
547 global state songs;
|
|
|
548
|
|
|
549 .top.tlist.list delete 0 end;
|
|
|
550
|
|
|
551 set tmp "";
|
|
|
552
|
|
|
553 foreach tag [array names songs "*:id"] {
|
|
|
554 set a $songs($tag);
|
|
|
555 lappend tmp [list $a $songs($a:name) $songs($a:author) $songs($a:albumname)];
|
|
|
556 }
|
|
|
557
|
|
|
558 switch -- $state(sortmode) {
|
|
|
559 "Title" {
|
|
|
560 set idx 1;
|
|
|
561 }
|
|
|
562
|
|
|
563 "Artist" {
|
|
|
564 set idx 2;
|
|
|
565 }
|
|
|
566
|
|
|
567 "Album" {
|
|
|
568 set idx 3;
|
|
|
569 }
|
|
|
570
|
|
|
571 default {
|
|
|
572 set idx 1;
|
|
|
573 }
|
|
|
574 }
|
|
|
575 set tmp [lsort -dictionary -index $idx $tmp];
|
|
|
576
|
|
|
577 foreach a [array names songs *:listid:*] {
|
|
|
578 unset songs($a);
|
|
|
579 }
|
|
|
580
|
|
|
581 set i 0;
|
|
|
582 foreach a $tmp {
|
|
|
583 .top.tlist.list insert end "'[lindex $a 1]' by '[lindex $a 2]' on '[lindex $a 3]'"
|
|
|
584 set songs([lindex $a 0]:listid:$i) $a;
|
|
|
585 incr i;
|
|
|
586 }
|
|
|
587 }
|
|
|
588
|
|
|
589 proc gui_updatequeue {} {
|
|
|
590 global state songs queue;
|
|
|
591
|
|
|
592 log "%s" "Updating queue";
|
|
|
593
|
|
|
594 .bot.queue.list delete 0 end;
|
|
|
595
|
|
|
596 con_getqueue queue;
|
|
|
597
|
|
|
598 foreach tag [lsort [array names queue]] {
|
|
|
599 .bot.queue.list insert end "'$songs($queue($tag):name)' by '$songs($queue($tag):author)' on '$songs($queue($tag):albumname)'";
|
|
|
600 }
|
|
|
601 }
|
|
|
602
|
|
|
603 proc gui_delqueue {id} {
|
|
|
604 global queue;
|
|
|
605
|
|
|
606 if {$id == ""} {
|
|
|
607 return;
|
|
|
608 }
|
|
|
609
|
|
5
|
610 set cookie [acquire_lock];
|
|
1
|
611 n_write "UNQUEUE [split $queue($id) {:}]";
|
|
|
612 n_getrtn rtn;
|
|
5
|
613 release_lock $cookie;
|
|
|
614
|
|
1
|
615 if {$rtn(code) != 254} {
|
|
|
616 log "%s" "Failed to remove $id ($queue($id))";
|
|
|
617 msg_box "Queue" "Failed to dequeue the song";
|
|
|
618 }
|
|
|
619 }
|
|
|
620
|
|
|
621 proc gui_updateinfo {} {
|
|
|
622 global state;
|
|
|
623
|
|
5
|
624 set cookie [acquire_lock];
|
|
1
|
625 n_write "VOLUME";
|
|
|
626 n_getrtn rtn;
|
|
5
|
627 release_lock $cookie;
|
|
1
|
628
|
|
|
629 if {$rtn(code) != 235} {
|
|
|
630 set vol "??";
|
|
|
631 } else {
|
|
|
632 set vol "[lindex [lindex $rtn(lines) 0] 0]";
|
|
|
633 }
|
|
|
634
|
|
5
|
635 set cookie [acquire_lock];
|
|
1
|
636 n_write "INFO";
|
|
|
637 n_getrtn rtn;
|
|
5
|
638 release_lock $cookie;
|
|
1
|
639
|
|
|
640 if {$rtn(code) == 246} {
|
|
|
641 set data [split [lindex $rtn(lines) 0] "\t"];
|
|
|
642 set author [lindex $data 4];
|
|
|
643 set title [lindex $data 5];
|
|
|
644 set length [lindex $data 14];
|
|
|
645 set album [lindex $data 3];
|
|
3
|
646 set rate1 [lindex $data 9];
|
|
|
647 set rate2 [lindex $data 10];
|
|
|
648 set misc [lindex $data 15];
|
|
1
|
649 } else {
|
|
|
650 set author "N/A";
|
|
|
651 set title "N/A";
|
|
|
652 set length "N/A";
|
|
|
653 set album "N/A";
|
|
3
|
654 set rate1 "N/A";
|
|
|
655 set rate2 "N/A";
|
|
|
656 set misc "N/A";
|
|
1
|
657 if {$rtn(code) != 401} {
|
|
|
658 log "%s" "Failed to get track info ($rtn(code) $rtn(data))";
|
|
|
659 }
|
|
|
660 }
|
|
|
661
|
|
5
|
662 set cookie [acquire_lock];
|
|
1
|
663 n_write "STATUS";
|
|
|
664 n_getrtn rtn;
|
|
5
|
665 release_lock $cookie;
|
|
1
|
666
|
|
|
667 if {$rtn(code) != 222} {
|
|
|
668 set left "x:xx";
|
|
|
669 set played "x:xx";
|
|
|
670 } else {
|
|
|
671 set played [lindex [split [lindex $rtn(lines) 0] "\t"] 8];
|
|
|
672
|
|
|
673 # scan $played "%d:%d" played_m played_s;
|
|
|
674 # set played [expr ($played_m * 60) + $played_s];
|
|
|
675 # scan $length "%d:%f" len_m len_s;
|
|
|
676 # set len [expr ($len_m * 60) + $len_s];
|
|
|
677
|
|
|
678 # set left [expr $len - $played];
|
|
|
679 # set left_m [expr int($left / 60)];
|
|
|
680 # set left [format "%02d:%02d" $left_m [expr int($left - ($left_m * 60))]];
|
|
|
681 }
|
|
|
682
|
|
|
683 .top.tinfo.sub.author configure -text "Author: $author";
|
|
|
684 .top.tinfo.sub.title configure -text "Title: $title";
|
|
|
685 .top.tinfo.sub.length configure -text "Length: $length";
|
|
|
686 .top.tinfo.sub.time configure -text "Time: $played";
|
|
|
687 .top.tinfo.sub.album configure -text "Album: $album";
|
|
3
|
688 .top.tinfo.sub.misc configure -text "Misc: $misc";
|
|
|
689 .top.tinfo.sub.rate1 configure -text "Rating: $rate1";
|
|
|
690 .top.tinfo.sub.rate2 configure -text "Temporally Adjusted: $rate2";
|
|
1
|
691 .top.tinfo.sub.vol configure -text "Volume: $vol";
|
|
5
|
692
|
|
1
|
693 }
|
|
|
694
|
|
|
695 proc con_getqueue {queuevar} {
|
|
|
696 upvar $queuevar queue;
|
|
|
697
|
|
|
698 global state;
|
|
|
699
|
|
|
700 catch {unset queue};
|
|
|
701
|
|
5
|
702 set cookie [acquire_lock];
|
|
1
|
703 n_write "QUEUE"
|
|
|
704 n_getrtn rtn;
|
|
5
|
705 release_lock $cookie;
|
|
|
706
|
|
1
|
707 if {$rtn(code) == 225} {
|
|
|
708 set i 0;
|
|
|
709 foreach line $rtn(lines) {
|
|
|
710 set foo [split $line \011];
|
|
|
711 set id "[lindex $foo 1]:[lindex $foo 2]";
|
|
|
712
|
|
|
713 set queue($i) $id;
|
|
|
714 incr i;
|
|
|
715 }
|
|
|
716 } elseif {$rtn(code) == 404} {
|
|
|
717 log "%s" "Queue empty";
|
|
|
718 } else {
|
|
|
719 log "%s" "Failed to get queue ($rtn(code) $rtn(data))";
|
|
|
720 }
|
|
|
721 }
|
|
|
722
|
|
|
723 proc con_getsongs {songsvar albumsvar} {
|
|
|
724 upvar $songsvar songs;
|
|
|
725 upvar $albumsvar albums;
|
|
|
726
|
|
|
727 global state;
|
|
|
728
|
|
|
729 catch { unset songs };
|
|
|
730
|
|
|
731 foreach i [array names albums "*:"] {
|
|
5
|
732 set cookie [acquire_lock];
|
|
1
|
733 n_write "TRACKS $albums($i)";
|
|
|
734 n_getrtn rtn;
|
|
5
|
735 release_lock $cookie;
|
|
|
736
|
|
1
|
737 if {$rtn(code) != "228"} {
|
|
|
738 error "Got bogus response to track request ($rtn(code) $rtn(data))";
|
|
|
739 }
|
|
|
740
|
|
|
741 foreach trk $rtn(lines) {
|
|
|
742 set foo [split $trk \011];
|
|
|
743 if {[llength $foo] != 6} {
|
|
|
744 continue;
|
|
|
745 }
|
|
|
746
|
|
|
747 set albid [lindex $foo 0];
|
|
|
748 set num [lindex $foo 1]
|
|
|
749 set songs($albid:$num:id) "$albid:$num";
|
|
|
750 set songs($albid:$num:author) [lindex $foo 2];
|
|
|
751 set songs($albid:$num:name) [lindex $foo 3];
|
|
|
752 set songs($albid:$num:rating) [lindex $foo 4];
|
|
|
753 set songs($albid:$num:length) [lindex $foo 5];
|
|
|
754 set songs($albid:$num:albumname) $albums($albid:name);
|
|
|
755 }
|
|
|
756 }
|
|
|
757
|
|
|
758 }
|
|
|
759
|
|
|
760 proc con_getalbums {albumsvar} {
|
|
|
761 upvar $albumsvar albums;
|
|
|
762
|
|
|
763 global state;
|
|
|
764
|
|
|
765 catch {unset albums};
|
|
|
766
|
|
5
|
767 set cookie [acquire_lock];
|
|
1
|
768 n_write "ALBUMS";
|
|
|
769 n_getrtn rtn;
|
|
5
|
770 release_lock $cookie;
|
|
|
771
|
|
1
|
772 if {$rtn(code) != 227} {
|
|
|
773 error "Server gave bogus response to album request ($rtn(code) $rtn(data))";
|
|
|
774 }
|
|
|
775
|
|
|
776 foreach alb $rtn(lines) {
|
|
|
777 set foo [split $alb \011];
|
|
|
778 set id [lindex $foo 0];
|
|
5
|
779 if {$id == ""} {
|
|
|
780 continue;
|
|
|
781 }
|
|
|
782 set albums($id:) $id;
|
|
1
|
783 set albums($id:author) [lindex $foo 1];
|
|
|
784 set albums($id:name) [lindex $foo 2];
|
|
|
785
|
|
5
|
786 # log "%s" "Album $id, ID '$albums($id:)' called '$albums($id:name)' by '$albums($id:author)'";
|
|
1
|
787 }
|
|
|
788 }
|
|
|
789
|
|
|
790 proc update_timer {} {
|
|
|
791
|
|
|
792 gui_updateinfo;
|
|
|
793
|
|
|
794 after 900 update_timer;
|
|
|
795 }
|
|
|
796
|
|
|
797 proc con_mserv {} {
|
|
|
798 global state;
|
|
|
799
|
|
|
800 # Close old FD
|
|
|
801 catch {close state(serv_fd)};
|
|
|
802 catch {unset state(serv_fd)};
|
|
|
803
|
|
|
804 catch {fileevent $state(serv_fd) readable ""};
|
|
|
805 set state(serv_fd) [ socket $state(host) $state(port) ];
|
|
|
806 set state(pushbuf) "";
|
|
|
807 fileevent $state(serv_fd) readable n_rtinput;
|
|
|
808 fconfigure $state(serv_fd) -blocking 0;
|
|
|
809
|
|
|
810 # Greeting from server
|
|
|
811 n_getrtn rtn;
|
|
|
812 puts $rtn(data);
|
|
|
813 if {$rtn(code) != "200"} {
|
|
|
814 error "Server failed to send greeting";
|
|
|
815 }
|
|
|
816
|
|
|
817 # Login
|
|
|
818 n_write "USER $state(user)"
|
|
|
819 n_getrtn rtn;
|
|
|
820 if {$rtn(code) != "201"} {
|
|
|
821 error "Server failed to send password request";
|
|
|
822 }
|
|
|
823
|
|
|
824 n_write "PASS $state(pass) RTCOMPUTER";
|
|
|
825 n_getrtn rtn;
|
|
|
826 if {$rtn(code) == "507"} {
|
|
|
827 error "Server rejected our credentials";
|
|
|
828 }
|
|
|
829
|
|
|
830 if {$rtn(code) != "202"} {
|
|
|
831 error "Unknown response to PASS command - $rtn(code) $rtn(data)"
|
|
|
832 }
|
|
5
|
833
|
|
|
834 set state(lock) "";
|
|
|
835 # trace variable state(lock) rw foobar;
|
|
|
836
|
|
1
|
837 log "%s" "Logged in";
|
|
|
838 }
|
|
|
839
|
|
|
840 proc n_write {text} {
|
|
|
841 global state;
|
|
|
842
|
|
|
843 puts $state(serv_fd) $text;
|
|
5
|
844 flush $state(serv_fd);
|
|
1
|
845
|
|
5
|
846 if {[eof $state(serv_fd)]} {
|
|
|
847 log "%s" "Server went away on write";
|
|
|
848 exit 1;
|
|
|
849 }
|
|
|
850 # log "%s" "Wrote - $text";
|
|
1
|
851 }
|
|
|
852
|
|
|
853 proc n_rthandler {code data} {
|
|
|
854 global songs;
|
|
|
855
|
|
5
|
856 log "%s" "Got RT - $code $data";
|
|
1
|
857
|
|
|
858 switch -- $code {
|
|
|
859 600 {
|
|
|
860 log "%s" "User '$data' connected";
|
|
|
861 }
|
|
|
862
|
|
|
863 601 {
|
|
|
864 log "%s" "User '$data' disconnected";
|
|
|
865 }
|
|
|
866
|
|
5
|
867 240 -
|
|
1
|
868 618 -
|
|
|
869 619 -
|
|
5
|
870 620 -
|
|
1
|
871 622 -
|
|
5
|
872 623 -
|
|
1
|
873 627 -
|
|
5
|
874 628 -
|
|
|
875 629 {
|
|
|
876 log "%s" "Updating queue on idle";
|
|
|
877 gui_updatequeue;
|
|
|
878 }
|
|
|
879
|
|
|
880 default {
|
|
|
881 log "%s" "Got unhandled RT event $code $data";
|
|
1
|
882 }
|
|
|
883 }
|
|
|
884 }
|
|
|
885
|
|
|
886 proc n_rtinput {} {
|
|
|
887 global state;
|
|
|
888
|
|
|
889 set rth "";
|
|
|
890
|
|
5
|
891 while {1} {
|
|
|
892 set line [gets $state(serv_fd)];
|
|
|
893 if {[eof $state(serv_fd)]} {
|
|
|
894 log "%s" "Server went away on read";
|
|
|
895 exit 1;
|
|
|
896 }
|
|
|
897 # log "%s" "Read - $line";
|
|
|
898 if {$line == ""} {
|
|
|
899 return;
|
|
1
|
900 }
|
|
5
|
901 # Check for RT text
|
|
|
902 set foo [split $line "\t"];
|
|
|
903 if {[string index $line 0] == "="} {
|
|
|
904 lappend state(rtlist) [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
|
|
|
905 # log "%s" "RT event";
|
|
|
906 } else {
|
|
|
907 lappend state(tmpphrase) $line
|
|
|
908 if {$line == "."} {
|
|
|
909 set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
|
|
|
910 # log "%s" "push buffer - '$state(tmpphrase)'";
|
|
|
911 set state(tmpphrase) "";
|
|
|
912 }
|
|
|
913 }
|
|
|
914 }
|
|
1
|
915 }
|
|
|
916
|
|
|
917 proc n_getrtn {var} {
|
|
|
918 upvar $var rtn;
|
|
|
919 global state;
|
|
|
920
|
|
|
921 set gotcode 0;
|
|
|
922 catch {unset rtn(code)};
|
|
|
923 catch {unset rtn(data)};
|
|
|
924 catch {unset rtn(lines)}
|
|
|
925
|
|
|
926 while {[llength $state(pushbuf)] == 0} {
|
|
5
|
927 # log "%s" "Sleeping for data";
|
|
1
|
928 vwait state(pushbuf);
|
|
|
929 }
|
|
5
|
930
|
|
|
931 # log "%s" "Waking up, got $state(pushbuf)";
|
|
|
932
|
|
1
|
933 set buf [lindex $state(pushbuf) 0];
|
|
|
934 set state(pushbuf) [lrange $state(pushbuf) 1 end];
|
|
|
935
|
|
|
936 while {1} {
|
|
|
937 if {[llength $buf] == 0} {
|
|
|
938 break;
|
|
|
939 }
|
|
|
940
|
|
|
941 set line [lindex $buf 0];
|
|
|
942 set buf [lrange $buf 1 end];
|
|
|
943
|
|
|
944 if {[string index $line 0] == "."} {
|
|
|
945 break;
|
|
|
946 }
|
|
|
947
|
|
|
948 if {$gotcode == 0} {
|
|
|
949 set rtn(code) [string range $line 0 2];
|
|
|
950 set rtn(data) [string range $line 4 end];
|
|
|
951 set gotcode 1;
|
|
|
952 continue;
|
|
|
953 }
|
|
|
954
|
|
|
955 lappend rtn(lines) $line;
|
|
|
956 }
|
|
|
957
|
|
|
958 if {$gotcode == 0} {
|
|
5
|
959 log "%s" "Failed to parse phrase (got . before server response)";
|
|
1
|
960 }
|
|
|
961 }
|
|
|
962
|
|
|
963 ##################################################################
|
|
|
964 # Log a message to stderr
|
|
|
965 #
|
|
|
966 proc log {format args} {
|
|
|
967 # Extract the calling function's name
|
|
3
|
968 if {[catch {set fname [lindex [info level -1] 0]}]} {
|
|
|
969 set fname "unknown";
|
|
|
970 }
|
|
1
|
971
|
|
|
972 # Evaluate the supplied format string and arguments
|
|
|
973 if {[catch {set csm [eval format {$format} $args]} msg]} {
|
|
|
974 set csm "bad log message. format='$format' args='$args'";
|
|
|
975 }
|
|
|
976
|
|
|
977 # Emit the message
|
|
5
|
978 catch {
|
|
|
979 puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
|
|
|
980 flush stderr;
|
|
|
981 }
|
|
|
982 }
|
|
|
983
|
|
|
984 proc acquire_lock {} {
|
|
|
985 global state;
|
|
|
986
|
|
|
987 # Extract the calling function's name
|
|
|
988 if {[catch {set fname [lindex [info level -1] 0]}]} {
|
|
|
989 set fname "unknown";
|
|
|
990 }
|
|
|
991
|
|
|
992 # log "%s" "Acquiring lock for $fname";
|
|
|
993
|
|
|
994 set foo 0;
|
|
|
995
|
|
|
996 if {[info exists state(lock)]} {
|
|
|
997 while {$state(lock) != ""} {
|
|
|
998 set foo 1;
|
|
|
999 log "%s" "$fname waiting for lock (held by [lindex $state(lock) 1])";
|
|
|
1000 vwait state(lock);
|
|
|
1001 }
|
|
|
1002
|
|
|
1003 if {$foo == 1} {
|
|
|
1004 log "%s" "Lock released";
|
|
|
1005 }
|
|
|
1006
|
|
|
1007 }
|
|
|
1008
|
|
|
1009 set cookie [clock clicks];
|
|
|
1010 set state(lock) [list $cookie $fname];
|
|
|
1011 # log "%s" "Lock acquired";
|
|
|
1012 return $cookie;
|
|
1
|
1013 }
|
|
|
1014
|
|
5
|
1015 proc release_lock {cookie} {
|
|
|
1016 global state;
|
|
|
1017
|
|
|
1018 # Extract the calling function's name
|
|
|
1019 if {[catch {set fname [lindex [info level -1] 0]}]} {
|
|
|
1020 set fname "unknown";
|
|
|
1021 }
|
|
|
1022
|
|
|
1023 if {$cookie == ""} {
|
|
|
1024 log "%s" "$fname trying to unlock without being locked";
|
|
|
1025 exit 1;
|
|
|
1026 }
|
|
|
1027
|
|
|
1028 if {$cookie != [lindex $state(lock) 0]} {
|
|
|
1029 log "%s" "Lock cookie not matched!";
|
|
|
1030 exit 1;
|
|
|
1031 }
|
|
|
1032
|
|
|
1033 if {$fname != [lindex $state(lock) 1]} {
|
|
|
1034 log "%s" "$fname tried to free [lindex $state(lock) 1]'s lock!";
|
|
|
1035 exit 1;
|
|
|
1036 }
|
|
|
1037
|
|
|
1038 set state(lock) "";
|
|
|
1039 # log "%s" "Lock for $fname now free";
|
|
|
1040 }
|
|
|
1041
|
|
|
1042 proc foobar {n1 n2 op} {
|
|
|
1043 global state;
|
|
|
1044
|
|
|
1045 log "%s" "$op, now $state(lock)";
|
|
|
1046 }
|
|
|
1047
|
|
|
1048 if {[catch {main} msg]} {
|
|
|
1049 catch {tk_dialog .dummy "Error!" $msg error 0 "OK"};
|
|
|
1050 }
|
|
|
1051
|
