Mercurial > ~darius > hgwebdir.cgi > mservtk

comparison mservtk.tcl @ 3:4343bc7f829a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add config file/registry support. Add 'top song' list. Add auth dialog. Force focus for Windows after the auth dialog.
author darius
date Fri, 05 May 2000 08:55:29 +0000
parents c36994199c5e
children 32f624fc18cc
comparison
equal deleted inserted replaced
2:175491189d54 3:4343bc7f829a
27 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
28 # SUCH DAMAGE. 28 # SUCH DAMAGE.
29 # 29 #
30 30
31 proc main {} { 31 proc main {} {
32 global argv0 argv state albums songs; 32 global argv0 argv state albums songs tcl_platform;
33 33
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
42 set state(port) "4444";
34 set state(exit) 0; 43 set state(exit) 0;
35 set state(host) "lot"; 44 set state(tmpphrase) "";
36 set state(port) "4444";
37 set state(user) "Darius";
38 set state(pass) "Fnordish";
39 set state(sortmode) "Title"; 45 set state(sortmode) "Title";
40 set state(tmpphrase) ""; 46
41 47 wm withdraw .;
42 gui_build; 48
43 49 f_readconf;
50 gui_conf;
51
52 if {$state(host) == "NONE"} {
53 log "%s" "Login cancelled";
54 exit;
55 } else {
56 log "%s" "Login OK'd";
57 }
58
59 f_writeconf;
60
61 wm deiconify .;
44 con_mserv; 62 con_mserv;
45 63
46 con_getalbums albums; 64 con_getalbums albums;
47 con_getsongs songs albums; 65 con_getsongs songs albums;
48 66
67 gui_build;
68 focus -force .;
69
49 gui_updatesongs; 70 gui_updatesongs;
50 gui_updatequeue; 71 gui_updatequeue;
51 72
52 update_timer; 73 update_timer;
53 74
56 77
57 if {$state(exit) == 1} { 78 if {$state(exit) == 1} {
58 exit; 79 exit;
59 } 80 }
60 } 81 }
82 }
83
84 proc f_readconf {} {
85 global state;
86
87 set state(host) "NONE";
88 set state(user) "NONE";
89 set state(pass) "";
90
91 if {$state(windows) == 1} {
92 if {[catch {
93 set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host];
94 set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user];
95 set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass];
96 } msg]} {
97 log "%s" "Failed to read registry keys - $msg";
98 }
99 } else {
100 if {![catch {
101 set fh [open $state(conffile)];
102 } msg]} {
103 if {[gets $fh] != "mservtk-0.1"} {
104 log "%s" "Conf file has the wrong version";
105 } else {
106 set state(host) [gets $fh];
107 set state(user) [gets $fh];
108 set state(pass) [gets $fh];
109 close $fh;
110 }
111 } else {
112 log "%s" "Failed to open $state(conffile) - $msg";
113 }
114 }
115 }
116
117 proc f_writeconf {} {
118 global state;
119
120 if {$state(windows) == 1} {
121 if {[catch {
122 registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host);
123 registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user);
124 registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass);
125 } msg]} {
126 log "%s" "Failed to set registry keys - $msg";
127 }
128 } else {
129 if {![catch {
130 set fh [open $state(conffile) w];
131 } msg]} {
132 puts $fh "mservtk-0.1";
133 puts $fh $state(host);
134 puts $fh $state(user);
135 puts $fh $state(pass);
136
137 close $fh;
138 } else {
139 log "%s" "Failed to open $state(conffile) - $msg";
140 }
141 }
142 }
143
144 proc gui_conf {} {
145 global state;
146
147 catch {destroy .conf};
148
149 toplevel .conf -class Dialog;
150 wm title .conf "Authentication";
151 wm iconname .conf "Authentication";
152
153 frame .conf.host;
154 pack .conf.host -side top -pady 2m -fill x;
155 label .conf.host.label -text "Host:" -width 10 -anchor e;
156
157 entry .conf.host.entry -relief sunken -width 30 -textvariable state(host)
158 pack .conf.host.label .conf.host.entry -side left -padx 1m
159
160 frame .conf.user
161 pack .conf.user -side top -pady 2m -fill x
162 label .conf.user.label -text "User:" -width 10 -anchor e
163 entry .conf.user.entry -relief sunken -width 8 -textvariable state(user)
164 pack .conf.user.label .conf.user.entry -side left -padx 1m
165
166 frame .conf.password
167 pack .conf.password -side top -pady 2m -fill x
168 label .conf.password.label -text "Password:" -width 10 -anchor e
169 entry .conf.password.entry -relief sunken -width 8 -textvariable state(pass) -show *;
170 bind .conf.password.entry <Return> ".conf.buttons.ok invoke";
171 pack .conf.password.label .conf.password.entry -side left -padx 1m
172
173 frame .conf.buttons
174 pack .conf.buttons -side top -pady 1m -fill x
175 button .conf.buttons.ok -text OK -width 6 -command {
176 destroy .conf;
177 }
178 button .conf.buttons.cancel -text Cancel -width 6 -command {
179 set state(host) "NONE";
180 set state(user) "NONE";
181 set state(pass) "NONE";
182 destroy .conf;
183 }
184 pack .conf.buttons.ok -side left -padx 1m;
185 pack .conf.buttons.cancel -side right -padx 1m;
186
187
188 # Withdraw the window, then update all the geometry information
189 # so we know how big it wants to be, then center the window in the
190 # display and de-iconify it.
191
192 wm withdraw .conf
193 update idletasks
194 set x [expr [winfo screenwidth .conf]/2 - [winfo reqwidth .conf]/2 \
195 - [winfo vrootx [winfo parent .conf]]]
196 set y [expr [winfo screenheight .conf]/2 - [winfo reqheight .conf]/2 \
197 - [winfo vrooty [winfo parent .conf]]]
198 wm geom .conf +$x+$y
199 wm deiconify .conf
200
201 # Set a grab and claim the focus too.
202
203 set oldFocus [focus]
204 set oldGrab [grab current .conf]
205 if {$oldGrab != ""} {
206 set grabStatus [grab status $oldGrab]
207 }
208 grab .conf
209 tkwait visibility .conf
210 if {$state(host) == "NONE"} {
211 focus .conf.host.entry;
212 } else {
213 focus .conf.password.entry;
214 }
215 tkwait window .conf;
216 if {$oldGrab != ""} {
217 if {$grabStatus == "global"} {
218 grab -global $oldGrab
219 } else {
220 grab $oldGrab
221 }
222 }
223
224 log "%s" "Host $state(host)";
61 } 225 }
62 226
63 proc quit_now {} { 227 proc quit_now {} {
64 global state; 228 global state;
65 229
78 pack .menubar -side top -fill x; 242 pack .menubar -side top -fill x;
79 243
80 # Add the File menu 244 # Add the File menu
81 menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0; 245 menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0;
82 menu .menubar.file.m -tearoff 0; 246 menu .menubar.file.m -tearoff 0;
247 .menubar.file.m add command -label " Top" -command "gui_top"
248 .menubar.file.m add separator;
83 .menubar.file.m add command -label " Quit" -command "quit_now" \ 249 .menubar.file.m add command -label " Quit" -command "quit_now" \
84 -underline 2 -accelerator "Alt-q"; 250 -underline 2 -accelerator "Alt-q";
85 pack .menubar.file -side left; 251 pack .menubar.file -side left;
86 252
87 # Add the Rate menu 253 # Add the Rate menu
179 pack .top.tinfo.sub.length -side top -expand 0; 345 pack .top.tinfo.sub.length -side top -expand 0;
180 label .top.tinfo.sub.time -text "Time:"; 346 label .top.tinfo.sub.time -text "Time:";
181 pack .top.tinfo.sub.time -side top -expand 0; 347 pack .top.tinfo.sub.time -side top -expand 0;
182 label .top.tinfo.sub.album -text "Album:"; 348 label .top.tinfo.sub.album -text "Album:";
183 pack .top.tinfo.sub.album -side top -expand 0; 349 pack .top.tinfo.sub.album -side top -expand 0;
184 label .top.tinfo.sub.trackno -text "Misc:"; 350 label .top.tinfo.sub.misc -text "Misc:";
185 pack .top.tinfo.sub.trackno -side top -expand 0; 351 pack .top.tinfo.sub.misc -side top -expand 0;
352 label .top.tinfo.sub.rate1 -text "Rating:";
353 pack .top.tinfo.sub.rate1 -side top -expand 0;
354 label .top.tinfo.sub.rate2 -text "Temporally Adjusted:";
355 pack .top.tinfo.sub.rate2 -side top -expand 0;
186 label .top.tinfo.sub.vol -text "Volume:"; 356 label .top.tinfo.sub.vol -text "Volume:";
187 pack .top.tinfo.sub.vol -side top -expand 0; 357 pack .top.tinfo.sub.vol -side top -expand 0;
188 358
189 # Queue (and the frame holding it) 359 # Queue (and the frame holding it)
190 frame .bot -relief raised -bd 1; 360 frame .bot -relief raised -bd 1;
257 wm iconname .msg $title; 427 wm iconname .msg $title;
258 428
259 # text region 429 # text region
260 frame .msg.frame; 430 frame .msg.frame;
261 pack .msg.frame -side top -fill both -expand yes; 431 pack .msg.frame -side top -fill both -expand yes;
262 text .msg.frame.text -font fixed -height 10 -width 40 -yscroll ".msg.frame.scroll set" \ 432 text .msg.frame.text -font fixed -yscroll ".msg.frame.scroll set" -wrap none;
263 -wrap none;
264 scrollbar .msg.frame.scroll -command ".msg.frame.text yview"; 433 scrollbar .msg.frame.scroll -command ".msg.frame.text yview";
265 pack .msg.frame.text -side left -expand y -fill both; 434 pack .msg.frame.text -side left -expand y -fill both;
266 pack .msg.frame.scroll -side right -fill y; 435 pack .msg.frame.scroll -side right -fill y;
267 436
268 # close button 437 # close button
332 n_getrtn rtn; 501 n_getrtn rtn;
333 502
334 log "%s" "Control Got $rtn(code) $rtn(data)"; 503 log "%s" "Control Got $rtn(code) $rtn(data)";
335 } 504 }
336 505
506 proc gui_top {} {
507 global state;
508
509 n_write "TOP"
510 n_getrtn rtn;
511
512 set msg "List of songs most likely to be played next\n\n";
513
514 foreach t $rtn(lines) {
515 set tmp [split $t \011];
516 append msg "[lindex $tmp 0]%\t[lindex $tmp 4] by [lindex $tmp 3]\n";
517 }
518
519 msg_box "Top Listing" $msg;
520 }
521
337 proc gui_updatesongs {} { 522 proc gui_updatesongs {} {
338 global state songs; 523 global state songs;
339 524
340 .top.tlist.list delete 0 end; 525 .top.tlist.list delete 0 end;
341 526
434 set data [split [lindex $rtn(lines) 0] "\t"]; 619 set data [split [lindex $rtn(lines) 0] "\t"];
435 set author [lindex $data 4]; 620 set author [lindex $data 4];
436 set title [lindex $data 5]; 621 set title [lindex $data 5];
437 set length [lindex $data 14]; 622 set length [lindex $data 14];
438 set album [lindex $data 3]; 623 set album [lindex $data 3];
439 set tnum [lindex $data 15]; 624 set rate1 [lindex $data 9];
625 set rate2 [lindex $data 10];
626 set misc [lindex $data 15];
440 } else { 627 } else {
441 set author "N/A"; 628 set author "N/A";
442 set title "N/A"; 629 set title "N/A";
443 set length "N/A"; 630 set length "N/A";
444 set album "N/A"; 631 set album "N/A";
445 set tnum "N/A"; 632 set rate1 "N/A";
633 set rate2 "N/A";
634 set misc "N/A";
446 if {$rtn(code) != 401} { 635 if {$rtn(code) != 401} {
447 log "%s" "Failed to get track info ($rtn(code) $rtn(data))"; 636 log "%s" "Failed to get track info ($rtn(code) $rtn(data))";
448 } 637 }
449 } 638 }
450
451
452 639
453 n_write "STATUS"; 640 n_write "STATUS";
454 n_getrtn rtn; 641 n_getrtn rtn;
455 642
456 if {$rtn(code) != 222} { 643 if {$rtn(code) != 222} {
472 .top.tinfo.sub.author configure -text "Author: $author"; 659 .top.tinfo.sub.author configure -text "Author: $author";
473 .top.tinfo.sub.title configure -text "Title: $title"; 660 .top.tinfo.sub.title configure -text "Title: $title";
474 .top.tinfo.sub.length configure -text "Length: $length"; 661 .top.tinfo.sub.length configure -text "Length: $length";
475 .top.tinfo.sub.time configure -text "Time: $played"; 662 .top.tinfo.sub.time configure -text "Time: $played";
476 .top.tinfo.sub.album configure -text "Album: $album"; 663 .top.tinfo.sub.album configure -text "Album: $album";
477 .top.tinfo.sub.trackno configure -text "Misc: $tnum"; 664 .top.tinfo.sub.misc configure -text "Misc: $misc";
665 .top.tinfo.sub.rate1 configure -text "Rating: $rate1";
666 .top.tinfo.sub.rate2 configure -text "Temporally Adjusted: $rate2";
478 .top.tinfo.sub.vol configure -text "Volume: $vol"; 667 .top.tinfo.sub.vol configure -text "Volume: $vol";
479 } 668 }
480 669
481 proc con_getqueue {queuevar} { 670 proc con_getqueue {queuevar} {
482 upvar $queuevar queue; 671 upvar $queuevar queue;
713 ################################################################## 902 ##################################################################
714 # Log a message to stderr 903 # Log a message to stderr
715 # 904 #
716 proc log {format args} { 905 proc log {format args} {
717 # Extract the calling function's name 906 # Extract the calling function's name
718 set fname [lindex [info level -1] 0]; 907 if {[catch {set fname [lindex [info level -1] 0]}]} {
908 set fname "unknown";
909 }
719 910
720 # Evaluate the supplied format string and arguments 911 # Evaluate the supplied format string and arguments
721 if {[catch {set csm [eval format {$format} $args]} msg]} { 912 if {[catch {set csm [eval format {$format} $args]} msg]} {
722 set csm "bad log message. format='$format' args='$args'"; 913 set csm "bad log message. format='$format' args='$args'";
723 } 914 }