chiark / gitweb /
ypp-chatlog-alerter: wip filepoll
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 3 Oct 2010 22:34:38 +0000 (23:34 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 3 Oct 2010 22:34:44 +0000 (23:34 +0100)
ypp-chatlog-alerter

index 9db7bc61e7b3763050a653eb79a0ce5281a3bc58..925031d6fc6f6854b9a7b1a84006045feecbb3be 100755 (executable)
@@ -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