Mercurial > ~darius > hgwebdir.cgi > mservtk

comparison mservtk.tcl @ 7:abe05fb9c2a6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Better debugging. Add "Awful and Skip" option.
author darius
date Mon, 16 Sep 2002 12:19:01 +0000
parents b370e0bbe050
children 81b36e5b725b
comparison
equal deleted inserted replaced
6:b370e0bbe050 7:abe05fb9c2a6
37 } else { 37 } else {
38 package require registry 1.0; 38 package require registry 1.0;
39 set state(windows) 1; 39 set state(windows) 1;
40 } 40 }
41 41
42 set state(loglevel) 0;
42 set state(port) "4444"; 43 set state(port) "4444";
43 set state(exit) 0; 44 set state(exit) 0;
44 set state(tmpphrase) ""; 45 set state(tmpphrase) "";
45 set state(sortmode) "Title"; 46 set state(sortmode) "Title";
46 47
50 51
51 f_readconf; 52 f_readconf;
52 gui_conf; 53 gui_conf;
53 54
54 if {$state(host) == "NONE"} { 55 if {$state(host) == "NONE"} {
55 log "%s" "Login cancelled"; 56 log 0 "Login cancelled";
56 exit; 57 exit;
57 } else { 58 } else {
58 log "%s" "Login OK'd"; 59 log 0 "Login OK'd";
59 } 60 }
60 61
61 f_writeconf; 62 f_writeconf;
62 63
63 wm deiconify .; 64 wm deiconify .;
82 # Copy it so we don't stomp any new additions 83 # Copy it so we don't stomp any new additions
83 set tmp $state(rtlist); 84 set tmp $state(rtlist);
84 set state(rtlist) ""; 85 set state(rtlist) "";
85 86
86 foreach t $tmp { 87 foreach t $tmp {
87 # log "%s" "Handle $t"; 88 # log 0 "Handle $t";
88 n_rthandler [lindex $t 0] [lindex $t 1]; 89 n_rthandler [lindex $t 0] [lindex $t 1];
89 } 90 }
90 } 91 }
91 92
92 if {$state(exit) == 1} { 93 if {$state(exit) == 1} {
106 if {[catch { 107 if {[catch {
107 set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host]; 108 set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host];
108 set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user]; 109 set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user];
109 set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass]; 110 set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass];
110 } msg]} { 111 } msg]} {
111 log "%s" "Failed to read registry keys - $msg"; 112 log 0 "Failed to read registry keys - $msg";
112 } 113 }
113 } else { 114 } else {
114 if {![catch { 115 if {![catch {
115 set fh [open $state(conffile)]; 116 set fh [open $state(conffile)];
116 } msg]} { 117 } msg]} {
117 if {[gets $fh] != "mservtk-0.1"} { 118 if {[gets $fh] != "mservtk-0.1"} {
118 log "%s" "Conf file has the wrong version"; 119 log 0 "Conf file has the wrong version";
119 } else { 120 } else {
120 set state(host) [gets $fh]; 121 set state(host) [gets $fh];
121 set state(user) [gets $fh]; 122 set state(user) [gets $fh];
122 set state(pass) [gets $fh]; 123 set state(pass) [gets $fh];
123 close $fh; 124 close $fh;
124 } 125 }
125 } else { 126 } else {
126 log "%s" "Failed to open $state(conffile) - $msg"; 127 log 0 "Failed to open $state(conffile) - $msg";
127 } 128 }
128 } 129 }
129 } 130 }
130 131
131 proc f_writeconf {} { 132 proc f_writeconf {} {
135 if {[catch { 136 if {[catch {
136 registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host); 137 registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host);
137 registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user); 138 registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user);
138 registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass); 139 registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass);
139 } msg]} { 140 } msg]} {
140 log "%s" "Failed to set registry keys - $msg"; 141 log 0 "Failed to set registry keys - $msg";
141 } 142 }
142 } else { 143 } else {
143 if {![catch { 144 if {![catch {
144 set fh [open $state(conffile) w]; 145 set fh [open $state(conffile) w];
145 } msg]} { 146 } msg]} {
148 puts $fh $state(user); 149 puts $fh $state(user);
149 puts $fh $state(pass); 150 puts $fh $state(pass);
150 151
151 close $fh; 152 close $fh;
152 } else { 153 } else {
153 log "%s" "Failed to open $state(conffile) - $msg"; 154 log 0 "Failed to open $state(conffile) - $msg";
154 } 155 }
155 } 156 }
156 } 157 }
157 158
158 proc gui_conf {} { 159 proc gui_conf {} {
233 } else { 234 } else {
234 grab $oldGrab 235 grab $oldGrab
235 } 236 }
236 } 237 }
237 238
238 log "%s" "Host $state(host)"; 239 log 0 "Host $state(host)";
239 } 240 }
240 241
241 proc quit_now {} { 242 proc quit_now {} {
242 global state; 243 global state;
243 244
271 .menubar.rate.m add command -label " Superb" -command "rate_song SUPERB"; 272 .menubar.rate.m add command -label " Superb" -command "rate_song SUPERB";
272 .menubar.rate.m add command -label " Good" -command "rate_song GOOD"; 273 .menubar.rate.m add command -label " Good" -command "rate_song GOOD";
273 .menubar.rate.m add command -label " Neutral" -command "rate_song NEUTRAL"; 274 .menubar.rate.m add command -label " Neutral" -command "rate_song NEUTRAL";
274 .menubar.rate.m add command -label " Bad" -command "rate_song BAD"; 275 .menubar.rate.m add command -label " Bad" -command "rate_song BAD";
275 .menubar.rate.m add command -label " Awful" -command "rate_song AWFUL"; 276 .menubar.rate.m add command -label " Awful" -command "rate_song AWFUL";
277 .menubar.rate.m add command -label " Awful and Skip" -command "rate_song AWFUL ; control_player NEXT";
276 278
277 pack .menubar.rate -side left; 279 pack .menubar.rate -side left;
278 280
279 # Add the Control menu 281 # Add the Control menu
280 menubutton .menubar.control -text "Control" -menu .menubar.control.m -underline 0; 282 menubutton .menubar.control -text "Control" -menu .menubar.control.m -underline 0;
317 -command "global state; set state(sortmode) Title; gui_updatesongs"; 319 -command "global state; set state(sortmode) Title; gui_updatesongs";
318 .menubar.sort.m add command -label " Album" \ 320 .menubar.sort.m add command -label " Album" \
319 -command "global state; set state(sortmode) Album; gui_updatesongs"; 321 -command "global state; set state(sortmode) Album; gui_updatesongs";
320 322
321 pack .menubar.sort -side left; 323 pack .menubar.sort -side left;
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;
322 331
323 # Add the Help menu 332 # Add the Help menu
324 menubutton .menubar.help -text "Help" -menu .menubar.help.m -underline 0; 333 menubutton .menubar.help -text "Help" -menu .menubar.help.m -underline 0;
325 menu .menubar.help.m -tearoff 0; 334 menu .menubar.help.m -tearoff 0;
326 .menubar.help.m add command -label " About" -command "about_box" \ 335 .menubar.help.m add command -label " About" -command "about_box" \
417 426
418 proc queue_song {id} { 427 proc queue_song {id} {
419 global songs state; 428 global songs state;
420 429
421 set tmp [lindex [lindex [array get songs *:listid:$id] 1] 0]; 430 set tmp [lindex [lindex [array get songs *:listid:$id] 1] 0];
422 log "%s" "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)"; 431 log 0 "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)";
423 432
424 set cookie [acquire_lock]; 433 set cookie [acquire_lock];
425 n_write "QUEUE [split $tmp {:}]"; 434 n_write "QUEUE [split $tmp {:}]";
426 n_getrtn rtn; 435 n_getrtn rtn;
427 release_lock $cookie; 436 release_lock $cookie;
428 437
429 if {$rtn(code) != 247} { 438 if {$rtn(code) != 247} {
430 if {$rtn(code) == 510} { 439 if {$rtn(code) == 510} {
431 msg_box "Queue" "You can't have the same\nsong in the queue twice!"; 440 msg_box "Queue" "You can't have the same\nsong in the queue twice!";
432 } else { 441 } else {
433 log "%s" "Failed to queue track ($rtn(code) $rtn(data))"; 442 log 0 "Failed to queue track ($rtn(code) $rtn(data))";
434 } 443 }
435 } 444 }
436 } 445 }
437 446
438 proc msg_box {title msg} { 447 proc msg_box {title msg} {
496 n_write "VOLUME $vol" 505 n_write "VOLUME $vol"
497 n_getrtn rtn; 506 n_getrtn rtn;
498 release_lock $cookie; 507 release_lock $cookie;
499 508
500 if {$rtn(code) != 255} { 509 if {$rtn(code) != 255} {
501 log "%s" "Couldn't set volume ($rtn(code) $rtn(data))"; 510 log 0 "Couldn't set volume ($rtn(code) $rtn(data))";
502 } 511 }
503 } 512 }
504 513
505 proc rate_song {rate} { 514 proc rate_song {rate} {
506 global state; 515 global state;
509 n_write "RATE $rate"; 518 n_write "RATE $rate";
510 n_getrtn rtn; 519 n_getrtn rtn;
511 release_lock $cookie; 520 release_lock $cookie;
512 521
513 if {$rtn(code) != 270} { 522 if {$rtn(code) != 270} {
514 log "%s" "Failed to get rate song ($rtn(code) $rtn(data))"; 523 log 0 "Failed to get rate song ($rtn(code) $rtn(data))";
515 } 524 }
516 525
517 } 526 }
518 527
519 proc control_player {cmd} { 528 proc control_player {cmd} {
520 global state; 529 global state;
521 530
531 log 0 "acquiring lock";
522 set cookie [acquire_lock]; 532 set cookie [acquire_lock];
523 log "%s" "Writing $cmd"; 533 log 0 "Writing $cmd";
524 n_write "$cmd"; 534 n_write "$cmd";
525 n_getrtn rtn; 535 log 0 "Wrote $cmd";
536 n_getrtn rtn;
537 log 0 "Got rtn";
526 release_lock $cookie; 538 release_lock $cookie;
527 539 log 0 "Lock freed";
528 # log "%s" "Control Got $rtn(code) $rtn(data)"; 540
541 # log 0 "Control Got $rtn(code) $rtn(data)";
529 } 542 }
530 543
531 proc gui_top {} { 544 proc gui_top {} {
532 global state; 545 global state;
533 546
590 } 603 }
591 604
592 proc gui_updatequeue {} { 605 proc gui_updatequeue {} {
593 global state songs queue; 606 global state songs queue;
594 607
595 # log "%s" "Updating queue"; 608 # log 0 "Updating queue";
596 609
597 .bot.queue.list delete 0 end; 610 .bot.queue.list delete 0 end;
598 611
599 con_getqueue queue; 612 con_getqueue queue;
600 613
614 n_write "UNQUEUE [split $queue($id) {:}]"; 627 n_write "UNQUEUE [split $queue($id) {:}]";
615 n_getrtn rtn; 628 n_getrtn rtn;
616 release_lock $cookie; 629 release_lock $cookie;
617 630
618 if {$rtn(code) != 254} { 631 if {$rtn(code) != 254} {
619 log "%s" "Failed to remove $id ($queue($id))"; 632 log 0 "Failed to remove $id ($queue($id))";
620 msg_box "Queue" "Failed to dequeue the song"; 633 msg_box "Queue" "Failed to dequeue the song";
621 } 634 }
622 } 635 }
623 636
624 proc gui_updateinfo {} { 637 proc gui_updateinfo {} {
656 set album "N/A"; 669 set album "N/A";
657 set rate1 "N/A"; 670 set rate1 "N/A";
658 set rate2 "N/A"; 671 set rate2 "N/A";
659 set misc "N/A"; 672 set misc "N/A";
660 if {$rtn(code) != 401} { 673 if {$rtn(code) != 401} {
661 log "%s" "Failed to get track info ($rtn(code) $rtn(data))"; 674 log 0 "Failed to get track info ($rtn(code) $rtn(data))";
662 } 675 }
663 } 676 }
664 677
665 set cookie [acquire_lock]; 678 set cookie [acquire_lock];
666 n_write "STATUS"; 679 n_write "STATUS";
705 718
706 set queue($i) $id; 719 set queue($i) $id;
707 incr i; 720 incr i;
708 } 721 }
709 } elseif {$rtn(code) == 404} { 722 } elseif {$rtn(code) == 404} {
710 # log "%s" "Queue empty"; 723 # log 0 "Queue empty";
711 } else { 724 } else {
712 log "%s" "Failed to get queue ($rtn(code) $rtn(data))"; 725 log 0 "Failed to get queue ($rtn(code) $rtn(data))";
713 } 726 }
714 } 727 }
715 728
716 proc con_getsongs {songsvar albumsvar} { 729 proc con_getsongs {songsvar albumsvar} {
717 upvar $songsvar songs; 730 upvar $songsvar songs;
745 set songs($albid:$num:rating) [lindex $foo 4]; 758 set songs($albid:$num:rating) [lindex $foo 4];
746 set songs($albid:$num:length) [lindex $foo 5]; 759 set songs($albid:$num:length) [lindex $foo 5];
747 set songs($albid:$num:albumname) $albums($albid:name); 760 set songs($albid:$num:albumname) $albums($albid:name);
748 } 761 }
749 } 762 }
750
751 } 763 }
752 764
753 proc con_getalbums {albumsvar} { 765 proc con_getalbums {albumsvar} {
754 upvar $albumsvar albums; 766 upvar $albumsvar albums;
755 767
774 } 786 }
775 set albums($id:) $id; 787 set albums($id:) $id;
776 set albums($id:author) [lindex $foo 1]; 788 set albums($id:author) [lindex $foo 1];
777 set albums($id:name) [lindex $foo 2]; 789 set albums($id:name) [lindex $foo 2];
778 790
779 # log "%s" "Album $id, ID '$albums($id:)' called '$albums($id:name)' by '$albums($id:author)'"; 791 # log 0 "Album $id, ID '$albums($id:)' called '$albums($id:name)' by '$albums($id:author)'";
780 } 792 }
781 } 793 }
782 794
783 proc update_timer {} { 795 proc update_timer {} {
784 796
785 # gui_updateinfo; 797 # gui_updateinfo;
786 798
787
788 after 900 update_timer; 799 after 900 update_timer;
789 } 800 }
790 801
791 proc con_mserv {} { 802 proc con_mserv {} {
792 global state; 803 global state;
801 fileevent $state(serv_fd) readable n_rtinput; 812 fileevent $state(serv_fd) readable n_rtinput;
802 fconfigure $state(serv_fd) -blocking 0; 813 fconfigure $state(serv_fd) -blocking 0;
803 814
804 # Greeting from server 815 # Greeting from server
805 n_getrtn rtn; 816 n_getrtn rtn;
806 log "%s" $rtn(data); 817 log 0 "$rtn(data)";
807 if {$rtn(code) != "200"} { 818 if {$rtn(code) != "200"} {
808 error "Server failed to send greeting"; 819 error "Server failed to send greeting";
809 } 820 }
810 821
811 # Login 822 # Login
826 } 837 }
827 838
828 set state(lock) ""; 839 set state(lock) "";
829 # trace variable state(lock) rw foobar; 840 # trace variable state(lock) rw foobar;
830 841
831 log "%s" "Logged in"; 842 log 0 "Logged in";
832 } 843 }
833 844
834 proc n_write {text} { 845 proc n_write {text} {
835 global state; 846 global state;
836 847
837 puts $state(serv_fd) $text; 848 puts $state(serv_fd) $text;
838 flush $state(serv_fd); 849 flush $state(serv_fd);
839 850
840 if {[eof $state(serv_fd)]} { 851 if {[eof $state(serv_fd)]} {
841 log "%s" "Server went away on write"; 852 log 0 "Server went away on write";
842 exit 1; 853 exit 1;
843 } 854 }
844 # log "%s" "Wrote - $text"; 855 # log 0 "Wrote - $text";
845 } 856 }
846 857
847 proc n_rthandler {code data} { 858 proc n_rthandler {code data} {
848 global songs; 859 global songs;
849 860
850 # log "%s" "Got RT - $code $data"; 861 # log 0 "Got RT - $code $data";
851 862
852 switch -- $code { 863 switch -- $code {
853 600 { 864 600 {
854 log "%s" "User '$data' connected"; 865 log 0 "User '$data' connected";
855 } 866 }
856 867
857 601 { 868 601 {
858 log "%s" "User '$data' disconnected"; 869 log 0 "User '$data' disconnected";
859 } 870 }
860 871
861 240 - 872 240 -
862 602 - 873 602 -
863 615 - 874 615 -
867 622 - 878 622 -
868 623 - 879 623 -
869 627 - 880 627 -
870 628 - 881 628 -
871 629 { 882 629 {
872 # log "%s" "Updating queue on idle"; 883 # log 0 "Updating queue on idle";
873 gui_updateinfo; 884 gui_updateinfo;
874 gui_updatequeue; 885 gui_updatequeue;
875 } 886 }
876 887
877 default { 888 default {
878 log "%s" "Got unhandled RT event $code $data"; 889 log 0 "Got unhandled RT event $code $data";
879 } 890 }
880 } 891 }
881 } 892 }
882 893
883 proc n_rtinput {} { 894 proc n_rtinput {} {
886 set rth ""; 897 set rth "";
887 898
888 while {1} { 899 while {1} {
889 set line [gets $state(serv_fd)]; 900 set line [gets $state(serv_fd)];
890 if {[eof $state(serv_fd)]} { 901 if {[eof $state(serv_fd)]} {
891 log "%s" "Server went away on read"; 902 log 0 "Server went away on read";
892 exit 1; 903 exit 1;
893 } 904 }
894 # log "%s" "Read - $line"; 905 log 0 "Read - $line";
895 if {$line == ""} { 906 if {$line == ""} {
896 return; 907 return;
897 } 908 }
898 # Check for RT text 909 # Check for RT text
899 set foo [split $line "\t"]; 910 set foo [split $line "\t"];
900 if {[string index $line 0] == "="} { 911 if {[string index $line 0] == "="} {
901 lappend state(rtlist) [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]]; 912 lappend state(rtlist) [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
902 # log "%s" "RT event"; 913 log 0 "RT event";
903 } else { 914 } else {
904 lappend state(tmpphrase) $line 915 lappend state(tmpphrase) $line
905 if {$line == "."} { 916 if {$line == "."} {
906 set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)]; 917 set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
907 # log "%s" "push buffer - '$state(tmpphrase)'"; 918 log 0 "push buffer - '$state(tmpphrase)'";
908 set state(tmpphrase) ""; 919 set state(tmpphrase) "";
909 } 920 }
910 } 921 }
911 } 922 }
912 } 923 }
919 catch {unset rtn(code)}; 930 catch {unset rtn(code)};
920 catch {unset rtn(data)}; 931 catch {unset rtn(data)};
921 catch {unset rtn(lines)} 932 catch {unset rtn(lines)}
922 933
923 while {[llength $state(pushbuf)] == 0} { 934 while {[llength $state(pushbuf)] == 0} {
924 # log "%s" "Sleeping for data"; 935 log 0 "Sleeping for data";
925 vwait state(pushbuf); 936 vwait state(pushbuf);
926 } 937 }
927 938
928 # log "%s" "Waking up, got $state(pushbuf)"; 939 log 0 "Waking up, got $state(pushbuf)";
929 940
930 set buf [lindex $state(pushbuf) 0]; 941 set buf [lindex $state(pushbuf) 0];
931 set state(pushbuf) [lrange $state(pushbuf) 1 end]; 942 set state(pushbuf) [lrange $state(pushbuf) 1 end];
932 943
933 while {1} { 944 while {1} {
951 962
952 lappend rtn(lines) $line; 963 lappend rtn(lines) $line;
953 } 964 }
954 965
955 if {$gotcode == 0} { 966 if {$gotcode == 0} {
956 log "%s" "Failed to parse phrase (got . before server response)"; 967 log 0 "Failed to parse phrase (got . before server response)";
957 } 968 }
958 } 969 }
959 970
960 ################################################################## 971 ##################################################################
961 # Log a message to stderr 972 # Log a message to stderr
962 # 973 #
963 proc log {format args} { 974 proc log {level message} {
975 global state;
976
964 # Extract the calling function's name 977 # Extract the calling function's name
965 if {[catch {set fname [lindex [info level -1] 0]}]} { 978 if {[catch {set fname [lindex [info level -1] 0]}]} {
966 set fname "unknown"; 979 set fname "unknown";
967 } 980 }
968 981
969 # Evaluate the supplied format string and arguments 982 if {$state(loglevel) > $level} {
970 if {[catch {set csm [eval format {$format} $args]} msg]} { 983 # Emit the message
971 set csm "bad log message. format='$format' args='$args'"; 984 catch {
972 } 985 puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $message";
973 986 flush stderr;
974 # Emit the message 987 }
975 catch {
976 puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
977 flush stderr;
978 } 988 }
979 } 989 }
980 990
981 proc acquire_lock {} { 991 proc acquire_lock {} {
982 global state; 992 global state;
984 # Extract the calling function's name 994 # Extract the calling function's name
985 if {[catch {set fname [lindex [info level -1] 0]}]} { 995 if {[catch {set fname [lindex [info level -1] 0]}]} {
986 set fname "unknown"; 996 set fname "unknown";
987 } 997 }
988 998
989 # log "%s" "Acquiring lock for $fname"; 999 log 0 "Acquiring lock for $fname";
990 1000
991 set foo 0; 1001 set foo 0;
992 1002
993 if {[info exists state(lock)]} { 1003 if {[info exists state(lock)]} {
994 while {$state(lock) != ""} { 1004 while {$state(lock) != ""} {
995 set foo 1; 1005 set foo 1;
996 log "%s" "$fname waiting for lock (held by [lindex $state(lock) 1])"; 1006 log 0 "$fname waiting for lock (held by [lindex $state(lock) 1])";
997 vwait state(lock); 1007 vwait state(lock);
998 } 1008 }
999 1009
1000 if {$foo == 1} { 1010 if {$foo == 1} {
1001 log "%s" "Lock released"; 1011 log 0 "Lock released";
1002 } 1012 }
1003 1013
1004 } 1014 }
1005 1015
1006 set cookie [clock clicks]; 1016 set cookie [clock clicks];
1007 set state(lock) [list $cookie $fname]; 1017 set state(lock) [list $cookie $fname];
1008 # log "%s" "Lock acquired"; 1018 log 0 "Lock acquired";
1009 return $cookie; 1019 return $cookie;
1010 } 1020 }
1011 1021
1012 proc release_lock {cookie} { 1022 proc release_lock {cookie} {
1013 global state; 1023 global state;
1016 if {[catch {set fname [lindex [info level -1] 0]}]} { 1026 if {[catch {set fname [lindex [info level -1] 0]}]} {
1017 set fname "unknown"; 1027 set fname "unknown";
1018 } 1028 }
1019 1029
1020 if {$cookie == ""} { 1030 if {$cookie == ""} {
1021 log "%s" "$fname trying to unlock without being locked"; 1031 log 0 "$fname trying to unlock without being locked";
1022 exit 1; 1032 exit 1;
1023 } 1033 }
1024 1034
1025 if {$cookie != [lindex $state(lock) 0]} { 1035 if {$cookie != [lindex $state(lock) 0]} {
1026 log "%s" "Lock cookie not matched!"; 1036 log 0 "Lock cookie not matched!";
1027 exit 1; 1037 exit 1;
1028 } 1038 }
1029 1039
1030 if {$fname != [lindex $state(lock) 1]} { 1040 if {$fname != [lindex $state(lock) 1]} {
1031 log "%s" "$fname tried to free [lindex $state(lock) 1]'s lock!"; 1041 log 0 "$fname tried to free [lindex $state(lock) 1]'s lock!";
1032 exit 1; 1042 exit 1;
1033 } 1043 }
1034 1044
1035 set state(lock) ""; 1045 set state(lock) "";
1036 # log "%s" "Lock for $fname now free"; 1046 log 0 "Lock for $fname now free";
1037 } 1047 }
1038 1048
1039 proc foobar {n1 n2 op} { 1049 proc foobar {n1 n2 op} {
1040 global state; 1050 global state;
1041 1051
1042 log "%s" "$op, now $state(lock)"; 1052 log 0 "$op, now $state(lock)";
1043 } 1053 }
1044 1054
1045 if {[catch {main} msg]} { 1055 if {[catch {main} msg]} {
1046 catch {tk_dialog .dummy "Error!" [format "%s\n%s" $msg $errorInfo] error 0 "OK"}; 1056 catch {tk_dialog .dummy "Error!" [format "%s\n%s" $msg $errorInfo] error 0 "OK"};
1047 exit 1; 1057 exit 1;