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