Mercurial > ~darius > hgwebdir.cgi > mservtk
diff mservtk.tcl @ 3:4343bc7f829a
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 |
line wrap: on
line diff
--- a/mservtk.tcl Tue Oct 23 10:09:01 2007 +0930 +++ b/mservtk.tcl Fri May 05 08:55:29 2000 +0000 @@ -29,23 +29,44 @@ # proc main {} { - global argv0 argv state albums songs; + global argv0 argv state albums songs tcl_platform; - set state(exit) 0; - set state(host) "lot"; + if {[string first "Windows" $tcl_platform(os)] == -1} { + set state(conffile) "~/.mservtk"; + set state(windows) 0; + } else { + package require registry 1.0; + set state(windows) 1; + } + set state(port) "4444"; - set state(user) "Darius"; - set state(pass) "Fnordish"; - set state(sortmode) "Title"; + set state(exit) 0; set state(tmpphrase) ""; + set state(sortmode) "Title"; - gui_build; + wm withdraw .; + + f_readconf; + gui_conf; + if {$state(host) == "NONE"} { + log "%s" "Login cancelled"; + exit; + } else { + log "%s" "Login OK'd"; + } + + f_writeconf; + + wm deiconify .; con_mserv; con_getalbums albums; con_getsongs songs albums; + gui_build; + focus -force .; + gui_updatesongs; gui_updatequeue; @@ -60,6 +81,149 @@ } } +proc f_readconf {} { + global state; + + set state(host) "NONE"; + set state(user) "NONE"; + set state(pass) ""; + + if {$state(windows) == 1} { + if {[catch { + set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host]; + set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user]; + set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass]; + } msg]} { + log "%s" "Failed to read registry keys - $msg"; + } + } else { + if {![catch { + set fh [open $state(conffile)]; + } msg]} { + if {[gets $fh] != "mservtk-0.1"} { + log "%s" "Conf file has the wrong version"; + } else { + set state(host) [gets $fh]; + set state(user) [gets $fh]; + set state(pass) [gets $fh]; + close $fh; + } + } else { + log "%s" "Failed to open $state(conffile) - $msg"; + } + } +} + +proc f_writeconf {} { + global state; + + if {$state(windows) == 1} { + if {[catch { + registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host); + registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user); + registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass); + } msg]} { + log "%s" "Failed to set registry keys - $msg"; + } + } else { + if {![catch { + set fh [open $state(conffile) w]; + } msg]} { + puts $fh "mservtk-0.1"; + puts $fh $state(host); + puts $fh $state(user); + puts $fh $state(pass); + + close $fh; + } else { + log "%s" "Failed to open $state(conffile) - $msg"; + } + } +} + +proc gui_conf {} { + global state; + + catch {destroy .conf}; + + toplevel .conf -class Dialog; + wm title .conf "Authentication"; + wm iconname .conf "Authentication"; + + frame .conf.host; + pack .conf.host -side top -pady 2m -fill x; + label .conf.host.label -text "Host:" -width 10 -anchor e; + + entry .conf.host.entry -relief sunken -width 30 -textvariable state(host) + pack .conf.host.label .conf.host.entry -side left -padx 1m + + frame .conf.user + pack .conf.user -side top -pady 2m -fill x + label .conf.user.label -text "User:" -width 10 -anchor e + entry .conf.user.entry -relief sunken -width 8 -textvariable state(user) + pack .conf.user.label .conf.user.entry -side left -padx 1m + + frame .conf.password + pack .conf.password -side top -pady 2m -fill x + label .conf.password.label -text "Password:" -width 10 -anchor e + entry .conf.password.entry -relief sunken -width 8 -textvariable state(pass) -show *; + bind .conf.password.entry <Return> ".conf.buttons.ok invoke"; + pack .conf.password.label .conf.password.entry -side left -padx 1m + + frame .conf.buttons + pack .conf.buttons -side top -pady 1m -fill x + button .conf.buttons.ok -text OK -width 6 -command { + destroy .conf; + } + button .conf.buttons.cancel -text Cancel -width 6 -command { + set state(host) "NONE"; + set state(user) "NONE"; + set state(pass) "NONE"; + destroy .conf; + } + pack .conf.buttons.ok -side left -padx 1m; + pack .conf.buttons.cancel -side right -padx 1m; + + + # Withdraw the window, then update all the geometry information + # so we know how big it wants to be, then center the window in the + # display and de-iconify it. + + wm withdraw .conf + update idletasks + set x [expr [winfo screenwidth .conf]/2 - [winfo reqwidth .conf]/2 \ + - [winfo vrootx [winfo parent .conf]]] + set y [expr [winfo screenheight .conf]/2 - [winfo reqheight .conf]/2 \ + - [winfo vrooty [winfo parent .conf]]] + wm geom .conf +$x+$y + wm deiconify .conf + + # Set a grab and claim the focus too. + + set oldFocus [focus] + set oldGrab [grab current .conf] + if {$oldGrab != ""} { + set grabStatus [grab status $oldGrab] + } + grab .conf + tkwait visibility .conf + if {$state(host) == "NONE"} { + focus .conf.host.entry; + } else { + focus .conf.password.entry; + } + tkwait window .conf; + if {$oldGrab != ""} { + if {$grabStatus == "global"} { + grab -global $oldGrab + } else { + grab $oldGrab + } + } + + log "%s" "Host $state(host)"; +} + proc quit_now {} { global state; @@ -80,6 +244,8 @@ # Add the File menu menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0; menu .menubar.file.m -tearoff 0; + .menubar.file.m add command -label " Top" -command "gui_top" + .menubar.file.m add separator; .menubar.file.m add command -label " Quit" -command "quit_now" \ -underline 2 -accelerator "Alt-q"; pack .menubar.file -side left; @@ -181,8 +347,12 @@ pack .top.tinfo.sub.time -side top -expand 0; label .top.tinfo.sub.album -text "Album:"; pack .top.tinfo.sub.album -side top -expand 0; - label .top.tinfo.sub.trackno -text "Misc:"; - pack .top.tinfo.sub.trackno -side top -expand 0; + label .top.tinfo.sub.misc -text "Misc:"; + pack .top.tinfo.sub.misc -side top -expand 0; + label .top.tinfo.sub.rate1 -text "Rating:"; + pack .top.tinfo.sub.rate1 -side top -expand 0; + label .top.tinfo.sub.rate2 -text "Temporally Adjusted:"; + pack .top.tinfo.sub.rate2 -side top -expand 0; label .top.tinfo.sub.vol -text "Volume:"; pack .top.tinfo.sub.vol -side top -expand 0; @@ -259,8 +429,7 @@ # text region frame .msg.frame; pack .msg.frame -side top -fill both -expand yes; - text .msg.frame.text -font fixed -height 10 -width 40 -yscroll ".msg.frame.scroll set" \ - -wrap none; + text .msg.frame.text -font fixed -yscroll ".msg.frame.scroll set" -wrap none; scrollbar .msg.frame.scroll -command ".msg.frame.text yview"; pack .msg.frame.text -side left -expand y -fill both; pack .msg.frame.scroll -side right -fill y; @@ -334,6 +503,22 @@ log "%s" "Control Got $rtn(code) $rtn(data)"; } +proc gui_top {} { + global state; + + n_write "TOP" + n_getrtn rtn; + + set msg "List of songs most likely to be played next\n\n"; + + foreach t $rtn(lines) { + set tmp [split $t \011]; + append msg "[lindex $tmp 0]%\t[lindex $tmp 4] by [lindex $tmp 3]\n"; + } + + msg_box "Top Listing" $msg; +} + proc gui_updatesongs {} { global state songs; @@ -436,20 +621,22 @@ set title [lindex $data 5]; set length [lindex $data 14]; set album [lindex $data 3]; - set tnum [lindex $data 15]; + set rate1 [lindex $data 9]; + set rate2 [lindex $data 10]; + set misc [lindex $data 15]; } else { set author "N/A"; set title "N/A"; set length "N/A"; set album "N/A"; - set tnum "N/A"; + set rate1 "N/A"; + set rate2 "N/A"; + set misc "N/A"; if {$rtn(code) != 401} { log "%s" "Failed to get track info ($rtn(code) $rtn(data))"; } } - - n_write "STATUS"; n_getrtn rtn; @@ -474,7 +661,9 @@ .top.tinfo.sub.length configure -text "Length: $length"; .top.tinfo.sub.time configure -text "Time: $played"; .top.tinfo.sub.album configure -text "Album: $album"; - .top.tinfo.sub.trackno configure -text "Misc: $tnum"; + .top.tinfo.sub.misc configure -text "Misc: $misc"; + .top.tinfo.sub.rate1 configure -text "Rating: $rate1"; + .top.tinfo.sub.rate2 configure -text "Temporally Adjusted: $rate2"; .top.tinfo.sub.vol configure -text "Volume: $vol"; } @@ -715,7 +904,9 @@ # proc log {format args} { # Extract the calling function's name - set fname [lindex [info level -1] 0]; + if {[catch {set fname [lindex [info level -1] 0]}]} { + set fname "unknown"; + } # Evaluate the supplied format string and arguments if {[catch {set csm [eval format {$format} $args]} msg]} {