Mercurial > ~darius > hgwebdir.cgi > mservtk

changeset 1:c36994199c5e MSERVTK_0_1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author darius
date Wed, 03 May 2000 12:20:47 +0000
parents c5aa7d041ea8
children 175491189d54
files mservtk.tcl
diffstat 1 files changed, 730 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mservtk.tcl	Wed May 03 12:20:47 2000 +0000
@@ -0,0 +1,730 @@
+#!/usr/bin/env wish8.0
+
+#
+# This software is copyright Daniel O'Connor (darius@dons.net.au) 2000
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. Neither the name Daniel O'Connor nor the names of its contributors
+#    may be used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY DANIEL O'CONNOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+
+proc main {} {
+    global argv0 argv state albums songs;
+
+    set state(exit) 0;
+    set state(host) "lot";
+    set state(port) "4444";
+    set state(user) "Darius";
+    set state(pass) "Fnordish";
+    set state(sortmode) "Title";
+    set state(tmpphrase) "";
+
+    gui_build;
+    
+    con_mserv;
+
+    con_getalbums albums;
+    con_getsongs songs albums;
+
+    gui_updatesongs;
+    gui_updatequeue;
+
+    update_timer;
+
+    while {1} {
+	vwait state(exit);
+
+	if {$state(exit) == 1} {
+	    exit;
+	}
+    }
+}
+
+proc quit_now {} {
+    global state;
+
+    set state(exit) 1;
+}
+
+proc gui_build {} {
+    # create the toplevel
+    eval destroy [winfo child .];
+    wm title . "MServ-Tk";
+    wm minsize . 600 500;
+    wm geometry . 600x500;
+
+    # Let's have a menubar
+    frame .menubar -relief raised -bd 2;
+    pack .menubar -side top -fill x;
+
+    # 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 " Quit" -command "quit_now" \
+	-underline 2 -accelerator "Alt-q";
+    pack .menubar.file -side left;
+
+    # Add the Rate menu
+    menubutton .menubar.rate -text "Rate" -menu .menubar.rate.m -underline 0;
+    menu .menubar.rate.m -tearoff 0;
+    .menubar.rate.m add command -label " Superb" -command "rate_song SUPERB";
+    .menubar.rate.m add command -label " Good" -command "rate_song GOOD";
+    .menubar.rate.m add command -label " Neutral" -command "rate_song NEUTRAL";
+    .menubar.rate.m add command -label " Bad" -command "rate_song BAD";
+    .menubar.rate.m add command -label " Awful" -command "rate_song AWFUL";
+    
+    pack .menubar.rate -side left;
+
+    # Add the Control menu
+    menubutton .menubar.control -text "Control" -menu .menubar.control.m -underline 0;
+    menu .menubar.control.m -tearoff 0;
+    .menubar.control.m add command -label " Next" -command "control_player NEXT";
+    .menubar.control.m add command -label " Pause" -command "control_player PAUSE";
+    .menubar.control.m add command -label " Stop" -command "control_player STOP"
+    .menubar.control.m add command -label " Play" -command "control_player PLAY";
+    
+    pack .menubar.control -side left;
+
+    # Add the Volume menu
+    menubutton .menubar.vol -text "Volume" -menu .menubar.vol.m -underline 0;
+    menu .menubar.vol.m -tearoff 0;
+    .menubar.vol.m add command -label " Increase" -command "set_vol +3" \
+	-accelerator "+";
+    .menubar.vol.m add command -label " Decrease" -command "set_vol -3" \
+	-accelerator "-";
+    .menubar.vol.m add separator;
+    .menubar.vol.m add command -label " 100%" -command "set_vol 100";
+    .menubar.vol.m add command -label " 90%" -command "set_vol 90";
+    .menubar.vol.m add command -label " 80%" -command "set_vol 80";
+    .menubar.vol.m add command -label " 70%" -command "set_vol 70";
+    .menubar.vol.m add command -label " 60%" -command "set_vol 60";
+    .menubar.vol.m add command -label " 50%" -command "set_vol 50";
+    .menubar.vol.m add command -label " 40%" -command "set_vol 40";
+    .menubar.vol.m add command -label " 30%" -command "set_vol 30";
+    .menubar.vol.m add command -label " 20%" -command "set_vol 20"; 
+    .menubar.vol.m add command -label " 10%" -command "set_vol 10";
+    .menubar.vol.m add command -label " 0%" -command "set_vol 0";
+   
+    pack .menubar.vol -side left;
+
+    # Add the Sort menu
+    menubutton .menubar.sort -text "Sort" -menu .menubar.sort.m -underline 0;
+    menu .menubar.sort.m -tearoff 0;
+    .menubar.sort.m add command -label " Artist" \
+	-command "global state; set state(sortmode) Artist; gui_updatesongs";
+    .menubar.sort.m add command -label " Title" \
+	-command "global state; set state(sortmode) Title; gui_updatesongs";
+    .menubar.sort.m add command -label " Album" \
+	-command "global state; set state(sortmode) Album; gui_updatesongs";
+    
+    pack .menubar.sort -side left;
+
+    # Add the Help menu
+    menubutton .menubar.help -text "Help" -menu .menubar.help.m -underline 0;
+    menu .menubar.help.m -tearoff 0;
+    .menubar.help.m add command -label " About" -command "about_box" \
+	-underline 2;
+    pack .menubar.help -side right;
+
+    # Top frame holding tracklist and trackinfo frames
+    frame .top -relief raised -bd 1;
+    pack .top -fill both -expand 1;
+
+    # Tracklist
+    frame .top.tlist -relief raised -bd 1;
+    pack .top.tlist -side left -fill both -expand 1;
+    label .top.tlist.label -text "Track List";
+    pack .top.tlist.label -side top -expand 0;
+    listbox .top.tlist.list -relief raised -borderwidth 2 \
+	-yscrollcommand ".top.tlist.scr set";
+    pack .top.tlist.list -side left -fill both -expand 1;
+    scrollbar .top.tlist.scr -command ".top.tlist.list yview";
+    pack .top.tlist.scr -side right -fill y;
+    bind .top.tlist.list <Double-Button-1> {
+	queue_song [.top.tlist.list curselection];
+    }
+    
+    # Trackinfo
+    frame .top.tinfo -relief raised -bd 1;
+    pack .top.tinfo -side right -fill both -expand 0;
+    label .top.tinfo.label -text "Track Info";
+    pack .top.tinfo.label -side top -expand 0;
+    frame .top.tinfo.sub -relief raised -bd 1;
+    pack .top.tinfo.sub -side right -fill both -expand 0;
+    label .top.tinfo.sub.author -text "Author:";
+    pack .top.tinfo.sub.author -side top -expand 0;
+    label .top.tinfo.sub.title -text "Title:";
+    pack .top.tinfo.sub.title -side top -expand 0;
+    label .top.tinfo.sub.length -text "Length:";
+    pack .top.tinfo.sub.length -side top -expand 0;
+    label .top.tinfo.sub.time -text "Time:";
+    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.vol -text "Volume:";
+    pack .top.tinfo.sub.vol -side top -expand 0;
+
+    # Queue (and the frame holding it)
+    frame .bot -relief raised -bd 1;
+    pack .bot -fill both -expand 1;
+    label .bot.qlabel -text "Queue";
+    pack .bot.qlabel -side top -expand 0;
+    frame .bot.queue;
+    pack .bot.queue -fill both -expand 1;
+    listbox .bot.queue.list -relief raised -borderwidth 2 \
+	-yscrollcommand ".bot.queue.scr set";
+    pack .bot.queue.list -side left -fill both -expand 1;
+    scrollbar .bot.queue.scr -command ".bot.queue.list yview";
+    pack .bot.queue.scr -side right -fill y;
+    bind .bot.queue.list <Double-Button-1> {
+	gui_delqueue [.bot.queue.list curselection];
+    }
+
+    bind . <Destroy> {quit_now};
+    bind all <Alt-q> {quit_now};
+
+    bind all <KP_Add> {set_vol +3};
+    bind all <KP_Subtract> {set_vol -3};
+    bind all <plus> {set_vol +3};
+    bind all <equal> {set_vol +3};
+    bind all <minus> {set_vol -3};
+    bind all <F1> {set_vol 10};
+    bind all <F2> {set_vol 20};
+    bind all <F3> {set_vol 30};
+    bind all <F4> {set_vol 40};
+    bind all <F5> {set_vol 50};
+    bind all <F6> {set_vol 60};
+    bind all <F7> {set_vol 70};
+    bind all <F8> {set_vol 80};
+    bind all <F9> {set_vol 90};
+    bind all <F10> {set_vol 100};
+    
+    bind all <Pause> {control_player PAUSE};
+    bind all <End> {control_player NEXT};
+    bind all <Delete> {control_player STOP};
+    bind all <Home> {control_player PLAY};
+
+    update;
+}
+
+proc queue_song {id} {
+    global songs state;
+
+    set tmp [lindex [lindex [array get songs *:listid:$id] 1] 0];
+    log "%s" "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)";
+
+    n_write "QUEUE [split $tmp {:}]";
+    n_getrtn rtn;
+
+    if {$rtn(code) != 247} {
+	if {$rtn(code) == 510} {
+	    msg_box "Queue" "You can't have the same\nsong in the queue twice!";
+	} else {
+	    log  "Failed to queue track ($rtn(code) $rtn(data))";
+	}
+    }
+}
+
+proc msg_box {title msg} {
+    global state;
+
+    catch {destroy .msg};
+
+    toplevel .msg -class Dialog;
+    wm title .msg $title;
+    wm iconname .msg $title;
+
+    # 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;
+    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;
+
+    # close button
+    button .msg.close -text "Close" -command "destroy .msg";
+    pack .msg.close -side bottom -fill x;
+
+    # read text into the text widget
+    .msg.frame.text insert end $msg;
+}
+
+proc about_box {} {
+    global state;
+
+    catch {destroy .about};
+
+    toplevel .about -class Dialog;
+    wm title .about "About...";
+    wm iconname .about "About";
+
+    # text region
+    frame .about.frame;
+    pack .about.frame -side top -fill both -expand yes;
+    text .about.frame.text -font fixed -height 10 -width 40 -yscroll ".about.frame.scroll set" \
+        -wrap none;
+    scrollbar .about.frame.scroll -command ".about.frame.text yview";
+    pack .about.frame.text -side left -expand y;
+    pack .about.frame.scroll -side right -fill y;
+
+    # close button
+    button .about.close -text "Close" -command "destroy .about";
+    pack .about.close -side bottom -fill x;
+
+    # read text into the text widget
+    .about.frame.text insert end "Mserv Client\n";
+    .about.frame.text insert end "Copyright Daniel O'Connor 2000\n";
+    .about.frame.text insert end "\n";
+    .about.frame.text insert end "http://www.dons.net.au/~darius/\n";
+}
+
+proc set_vol {vol} {
+    global state;
+
+    n_write "VOLUME $vol"
+    n_getrtn rtn;
+    
+    if {$rtn(code) != 255} {
+	log "%s" "Couldn't set volume ($rtn(code) $rtn(data))";
+    }
+}
+
+proc rate_song {rate} {
+    global state;
+
+    n_write "RATE $rate";
+    n_getrtn rtn;
+
+    if {$rtn(code) != 270} {
+	log "%s" "Failed to get rate song ($rtn(code) $rtn(data))";
+    }
+    
+}
+
+proc control_player {cmd} {
+    global state;
+
+    n_write "$cmd";
+    n_getrtn rtn;
+
+    log "%s" "Control Got $rtn(code) $rtn(data)";
+}
+
+proc gui_updatesongs {} {
+    global state songs;
+
+    .top.tlist.list delete 0 end;
+
+    set tmp "";
+
+    foreach tag [array names songs "*:id"] {
+	set a $songs($tag);
+	lappend tmp [list $a $songs($a:name) $songs($a:author) $songs($a:albumname)];
+    }
+
+    switch -- $state(sortmode) {
+	"Title" {
+	    set idx 1;
+	}
+
+	"Artist" {
+	    set idx 2;
+	}
+
+	"Album" {
+	    set idx 3;
+	}
+
+	default {
+	    set idx 1;
+	}
+    }
+    set tmp [lsort -dictionary -index $idx $tmp];
+
+    foreach a [array names songs *:listid:*] {
+	unset songs($a);
+    }
+
+    set i 0;
+    foreach a $tmp {
+	.top.tlist.list insert end "'[lindex $a 1]' by '[lindex $a 2]' on '[lindex $a 3]'"
+	set songs([lindex $a 0]:listid:$i) $a;
+	incr i;
+    }
+}
+
+proc gui_updatequeue {} {
+    global state songs queue;
+
+    if {[info exists state(queuelock)]} {
+	return;
+    }
+
+    set state(queuelock) "";
+
+    log "%s" "Updating queue";
+
+    .bot.queue.list delete 0 end;
+
+    con_getqueue queue;
+
+    foreach tag [lsort [array names queue]] {
+	.bot.queue.list insert end "'$songs($queue($tag):name)' by '$songs($queue($tag):author)' on '$songs($queue($tag):albumname)'";
+    }
+
+    unset state(queuelock);
+}
+
+proc gui_delqueue {id} {
+    global queue;
+
+    if {$id == ""} {
+	return;
+    }
+
+    n_write "UNQUEUE [split $queue($id) {:}]";
+    n_getrtn rtn;
+    
+    if {$rtn(code) != 254} {
+	log "%s" "Failed to remove $id ($queue($id))";
+	msg_box "Queue" "Failed to dequeue the song";
+   }	
+}
+
+proc gui_updateinfo {} {
+    global state;
+
+    n_write "VOLUME";
+    n_getrtn rtn;
+
+    if {$rtn(code) != 235} {
+	set vol "??";
+    } else {
+	set vol "[lindex [lindex $rtn(lines) 0] 0]";
+    }
+
+    n_write "INFO";
+    n_getrtn rtn;
+
+    if {$rtn(code) == 246} {
+	set data [split [lindex $rtn(lines) 0] "\t"];
+	set author [lindex $data 4];
+	set title [lindex $data 5];
+	set length [lindex $data 14];
+	set album [lindex $data 3];
+	set tnum [lindex $data 15];
+    } else {
+	set author "N/A";
+	set title "N/A";
+	set length "N/A";
+	set album "N/A";
+	set tnum "N/A";
+	if {$rtn(code) != 401} {
+	    log "%s" "Failed to get track info ($rtn(code) $rtn(data))";
+	}
+    }
+
+
+
+    n_write "STATUS";
+    n_getrtn rtn;
+
+    if {$rtn(code) != 222} {
+	set left "x:xx";
+	set played "x:xx";
+    } else {
+	set played [lindex [split [lindex $rtn(lines) 0] "\t"] 8];
+
+#	scan $played "%d:%d" played_m played_s;
+#	set played [expr ($played_m * 60) + $played_s];
+#	scan $length "%d:%f" len_m len_s;
+#	set len [expr ($len_m * 60) + $len_s];
+
+#	set left [expr $len - $played];
+#	set left_m [expr int($left / 60)];
+#	set left [format "%02d:%02d" $left_m [expr int($left - ($left_m * 60))]];
+    }
+
+    .top.tinfo.sub.author configure -text "Author: $author";
+    .top.tinfo.sub.title configure -text "Title: $title";
+    .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.vol configure -text "Volume: $vol";
+}
+
+proc con_getqueue {queuevar} {
+    upvar $queuevar queue;
+
+    global state;
+
+    catch {unset queue};
+
+    n_write "QUEUE"
+    n_getrtn rtn;
+
+    if {$rtn(code) == 225} {
+	set i 0;
+	foreach line $rtn(lines) {
+	    set foo [split $line \011];
+	    set id "[lindex $foo 1]:[lindex $foo 2]";
+
+	    set queue($i) $id;
+	    incr i;
+	}
+    } elseif {$rtn(code) == 404} {
+	log "%s" "Queue empty";
+    } else {
+	log "%s" "Failed to get queue ($rtn(code) $rtn(data))";
+    }
+}
+
+proc con_getsongs {songsvar albumsvar} {
+    upvar $songsvar songs;
+    upvar $albumsvar albums;
+
+    global state;
+
+    catch { unset songs };
+
+    foreach i [array names albums "*:"] {
+	n_write "TRACKS $albums($i)";
+	n_getrtn rtn;
+	if {$rtn(code) != "228"} {
+	    error "Got bogus response to track request ($rtn(code) $rtn(data))";
+	}
+
+	foreach trk $rtn(lines) {
+	    set foo [split $trk \011];
+	    if {[llength $foo] != 6} {
+		continue;
+	    }
+
+	    set albid [lindex $foo 0];
+	    set num [lindex $foo 1]
+	    set songs($albid:$num:id) "$albid:$num";
+	    set songs($albid:$num:author) [lindex $foo 2];
+	    set songs($albid:$num:name) [lindex $foo 3];
+	    set songs($albid:$num:rating) [lindex $foo 4];
+	    set songs($albid:$num:length) [lindex $foo 5];
+	    set songs($albid:$num:albumname) $albums($albid:name);
+	}
+    }
+
+}
+
+proc con_getalbums {albumsvar} {
+    upvar $albumsvar albums;
+
+    global state;
+
+    catch {unset albums};
+    
+    n_write "ALBUMS";
+    n_getrtn rtn;
+    if {$rtn(code) != 227} {
+	error "Server gave bogus response to album request ($rtn(code) $rtn(data))";
+    }
+
+    foreach alb $rtn(lines) {
+	set foo [split $alb \011];
+	set id [lindex $foo 0];
+	set albums($id:) [lindex $foo 0];
+	set albums($id:author) [lindex $foo 1];
+	set albums($id:name) [lindex $foo 2];
+
+#	log "%s" "Album $i, ID $albums($i:id) called $albums($i:name) by $albums($i:author)";
+    }
+}
+
+proc update_timer {} {
+
+    gui_updateinfo;
+
+    after 900 update_timer;
+}
+
+proc con_mserv {} {
+    global state;
+
+    # Close old FD
+    catch {close state(serv_fd)};
+    catch {unset state(serv_fd)};
+
+    catch {fileevent $state(serv_fd) readable ""};
+    set state(serv_fd) [ socket $state(host) $state(port) ];
+    set state(pushbuf) "";
+    fileevent $state(serv_fd) readable n_rtinput;
+    fconfigure $state(serv_fd) -blocking 0;
+
+    # Greeting from server
+    n_getrtn rtn;
+    puts $rtn(data);
+    if {$rtn(code) != "200"} {
+	error "Server failed to send greeting";
+    }
+    
+    # Login
+    n_write "USER $state(user)"
+    n_getrtn rtn;
+    if {$rtn(code) != "201"} {
+	error "Server failed to send password request";
+    }
+
+    n_write "PASS $state(pass) RTCOMPUTER";
+    n_getrtn rtn;
+    if {$rtn(code) == "507"} {
+	error "Server rejected our credentials";
+    }
+
+    if {$rtn(code) != "202"} {
+	error "Unknown response to PASS command - $rtn(code) $rtn(data)"
+    }	
+    
+    log "%s" "Logged in";
+}
+
+proc n_write {text} {
+    global state;
+
+    puts $state(serv_fd) $text;
+#    log "%s" "Wrote - $text";
+
+    flush $state(serv_fd);
+}
+
+proc n_rthandler {code data} {
+    global songs;
+
+    log "%s" "Got RT - $code $data";
+
+    switch -- $code {
+	600 {
+	    log "%s" "User '$data' connected";
+	}
+	
+	601 {
+	    log "%s" "User '$data' disconnected";
+	}
+
+	618 -
+	619 -
+	622 -
+	627 -
+	623 {
+	    after idle gui_updatequeue;
+	}
+    }
+}
+
+proc n_rtinput {} {
+    global state;
+
+    set rth "";
+
+    set line [gets $state(serv_fd)];
+#    log "%s" "Read - $line";
+
+    # Check for RT text
+    set foo [split $line "\t"];
+    if {[string index $line 0] == "="} {
+	set rth [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
+    } else {
+	lappend state(tmpphrase) $line
+	if {$line == "."} {
+	    set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
+	    set state(tmpphrase) "";
+	}
+    }
+
+    if {$rth != ""} {
+	n_rthandler [lindex $rth 0] [lindex $rth 1];
+    }
+}
+
+proc n_getrtn {var} {
+    upvar $var rtn;
+    global state;
+
+    set gotcode 0;
+    catch {unset rtn(code)};
+    catch {unset rtn(data)};
+    catch {unset rtn(lines)}
+
+    while {[llength $state(pushbuf)] == 0} {
+	vwait state(pushbuf);
+    }
+	
+    set buf [lindex $state(pushbuf) 0];
+    set state(pushbuf) [lrange $state(pushbuf) 1 end];
+    
+    while {1} {
+	if {[llength $buf] == 0} {
+	    break;
+	}
+
+	set line [lindex $buf 0];
+	set buf [lrange $buf 1 end];
+	
+	if {[string index $line 0] == "."} {
+	    break;
+	}
+
+	if {$gotcode == 0} {
+	    set rtn(code) [string range $line 0 2];
+	    set rtn(data) [string range $line 4 end];
+	    set gotcode 1;
+	    continue;
+	}
+	    
+	lappend rtn(lines) $line;
+    }
+
+    if {$gotcode == 0} {
+	log "%s" "Failed to parse phrase (got . before server responce)";
+    }
+}
+
+##################################################################
+# Log a message to stderr
+#
+proc log {format args} {
+    # Extract the calling function's name
+    set fname [lindex [info level -1] 0];
+
+    # Evaluate the supplied format string and arguments
+    if {[catch {set csm [eval format {$format} $args]} msg]} {
+        set csm "bad log message. format='$format' args='$args'";
+    }
+
+    # Emit the message
+    puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
+    flush stderr;
+}
+
+main;