From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sun, 3 Oct 2010 22:34:38 +0000 (+0100)
Subject: ypp-chatlog-alerter: wip filepoll
X-Git-Tag: 6.7.0~8
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=06b95e636336ed6da001a551edf8d28a278301b3

ypp-chatlog-alerter: wip filepoll
---

diff --git a/ypp-chatlog-alerter b/ypp-chatlog-alerter
index 9db7bc6..925031d 100755
--- a/ypp-chatlog-alerter
+++ b/ypp-chatlog-alerter
@@ -48,12 +48,24 @@ proc nonportability {} {
     }
 }
 
+set lw_ls {times pirates messages}
+set lw_ws {.time .pirate .msg}
+
 proc widgets {} {
-    global height
-    listbox .t -width 5 -height $height -borderwidth 0
-    listbox .p -width 14 -height $height -borderwidth 0
-    listbox .m -width 80 -height $height -borderwidth 0
-    pack .t .p .m -side left
+    global height lw_ws
+    listbox .time -width 5 -height $height -borderwidth 0 -background black
+    listbox .pirate -width 14 -height $height -borderwidth 0 -background black
+    listbox .msg -width 80 -height $height -borderwidth 0
+    eval pack $lw_ws -side left
+    label .overlay -relief raised -foreground white
+}
+
+proc shownotice {colour message} {
+    .overlay configure -text $message -background $colour
+    place .overlay -relx 0.5 -rely 0.5 -anchor center
+}
+proc hidenotice {} {
+    place forget .overlay
 }
 
 proc newfile {} {
@@ -68,12 +80,10 @@ proc newfile {} {
     puts $newdefaults "[list set currentfile $currentfile]"
     close $newdefaults
     file rename -force $defaultfile.new $defaultfile
-    
-    #fixme refresh
-}
 
-set lw_ls {times pirates messages}
-set lw_ws {t p m}
+    clearlists
+    pollfile
+}
 
 proc for_lw {body} {
     global lw_ls lw_ws
@@ -98,14 +108,14 @@ proc retint {} {
 	set tint [expr {
 			exp( -($now >= $time ? $now-$time : 0) / $e_life )
 		    }]
-	tintentries .t $i $tint
+	tintentries .msg $i $tint
 	incr i
     }
     set next [expr { ($now - $latest < 10 ? 10 :
 		      $now - $latest > 3000 ? 3000 :
 		      $now - $latest
 		      ) * 10 }]
-puts "nexting $latest $now $next"
+#puts "nexting $latest $now $next"
     set retint_after [after $next retint]
 }
 
@@ -128,10 +138,10 @@ proc clearlists {} {
     global times pirates messages
     set currentfile {}
     
-    for_lw { .$w delete 0 end; set $l {} }
+    for_lw { $w delete 0 end; set $l {} }
     set ntimes {}
     for {set i 0} {$i<$height} {incr i} {
-	for_lw { lappend $l {}; .$w insert end {} }
+	for_lw { lappend $l {}; $w insert end {} }
 	lappend ntimes 0
     }
     set times $ntimes
@@ -154,6 +164,103 @@ proc showtints {} {
     pack .tints -side bottom
 }
 
+proc file-read-lines {lvar body} {
+    upvar 1 $lvar l
+    global logfile poll_after lastactivity bufdata
+    
+    if {![info exists logfile]} {
+	return
+    }
+    while 1 {
+	if {[catch { read $logfile } got]} {
+	    file-error $got
+	    return
+	}
+	if {[eof $logfile]} {
+	    set ago [expr { [clock seconds] - $lastactivity }]
+	    set poll_after [after [expr {( $ago < 10 ? 10 :
+					   $ago > 3000 ? 3000 :
+					   $ago ) * 100}] \
+				pollfile]
+	    return
+	}
+	set lastactivity [clock seconds]
+
+	global bufdata
+	if {![regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
+	    append bufdata $got
+	    return
+	}
+	
+	set l "$bufdata$lhs"
+	set bufdata $rhs
+puts ">>$l<<"
+	uplevel 1 $body
+    }
+}
+
+proc with-file {body} {
+    global errorInfo errorCode
+    set rc [catch { uplevel 1 $body } result]
+    switch -exact $rc {
+	0 {
+	    # ok
+	    return $result
+	}
+	1 {
+	    # error
+	    shownotice red "Error reading logfile $currentfile:\n$emsg"
+	    catch { close $logfile }
+	    set logfile {}
+	}
+	default {
+	    # 2 - 3 - 4   return, break, continue
+	    return -code $rc $errorInfo $errorCode $result
+	}
+	4 {
+	    # 
+	}
+	
+
+proc pollfile {} {
+    global poll_after logfile currentfile
+    global errorCode errorInfo bufdata lastactivity
+
+    catch { after cancel $poll_after }
+    if {![string length $currentfile]} {
+	shownotice red "No log file selected.  Use File / Open."
+	return
+    }
+    if {![info exists logfile]} {
+	set bufdata {}
+	set lastactivity [clock seconds] 
+	if {[catch { set logfile [open $currentfile r] } emsg]} {
+	    shownotice red "Error opening logfile $currentfile:\n$emsg"
+	    return
+	}
+	shownotice \#000080 "Reading $currentfile"
+	if {[catch {
+	    seek $logfile -1024 end
+	} emsg]} {
+	    if {![string match {POSIX EINVAL *} $errorCode]} {
+		file-error $emsg
+	    }
+	}
+	file-read-lines l { }
+    }
+    file-read-lines l {
+	process-line $l
+    }
+
+	with-file {
+	    
+	}
+	
+	    while 1 {
+		set data read
+    }
+}
+
 proc parseargs {} {
     global argv
     foreach arg $argv {
@@ -175,4 +282,4 @@ if {[file exists $defaultfile]} {
     source $defaultfile
 }
 
-#fixme refresh
+pollfile