3 proc manyset {list args} {
4 foreach val $list var $args {
10 set progname ypp-chatlog-alerter
13 proc menuent {w l a x} {
14 set c [list .mbar.$w add command -label $l -command $x]
15 if {[string length $a]} { lappend c -accel Command-$a }
22 foreach w {file edit} l {File Edit} {
23 menu .mbar.$w -tearoff 0
24 .mbar add cascade -menu .mbar.$w -label $l
26 foreach l {Open Quit} a {O Q} x {newfile exit} {
29 foreach l {Cut Copy Paste Clear} a {X C V {}} {
30 menuent edit $l $a [list event generate {[focus]} <<$l>>]]
32 . configure -menu .mbar
35 proc nonportability {} {
36 global progname defaultfile
38 switch -exact [tk windowingsystem] {
40 set defaultfile ~/Library/Preferences/$progname.prefs
43 set defaultfile ~/.$progname.rc
51 set lw_ls {times pirates messages}
52 set lw_ws {.time .pirate .msg}
55 global height lw_ws prtimes
56 listbox .time -width 5 -background black \
57 -listvariable prtimes -foreground white
58 listbox .pirate -width 14 -background black
59 listbox .msg -width 80
61 $w configure -height $height -borderwidth 0 -activestyle none \
64 eval pack $lw_ws -side left
65 label .overlay -relief raised -foreground white
68 proc shownotice {colour message} {
69 .overlay configure -text $message -background $colour
70 place .overlay -relx 0.5 -rely 0.5 -anchor center
77 global currentfile defaultfile logfile
79 set newfile [tk_getOpenFile -multiple 0 -initialfile $currentfile \
80 -title "Select YPP log to track"]
81 if {![string length $newfile]} return
83 catch { close $logfile }
84 catch { unset logfile }
86 set currentfile $newfile
87 set newdefaults [open $defaultfile.new w]
88 puts $newdefaults "[list set currentfile $currentfile]"
90 file rename -force $defaultfile.new $defaultfile
98 set body [lindex $args end]
99 set args [lreplace $args end end]
110 set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
113 global times e_life retint_after otherevent prtimes
114 catch { after cancel $retint_after }
116 set now [clock seconds]
117 set latest $otherevent
119 foreach time $times {
120 set age [expr {$now-$time}]
122 lappend newprtimes {}
123 } elseif {$age < 60} {
124 lappend newprtimes [format "%3ds" $age]
125 } elseif {$age < 3600} {
126 lappend newprtimes [format "%3dm" [expr {$age/60}]]
128 lappend newprtimes [format "%3dh" [expr {$age/3600}]]
130 set latest [expr { $time > $latest ? $time : $latest }]
131 set tint [expr { exp( (-($age >= 0 ? $age : 0) + 0.0) / $e_life ) }]
132 #puts "AGE $age LA $latest TI $tint"
133 tintentries .msg $i $tint
136 set prtimes $newprtimes
137 set next [expr { ($now - $latest < 10 ? 10 :
138 $now - $latest > 3000 ? 3000 :
141 #puts "nexting $latest $now $next"
142 set retint_after [after $next retint]
145 proc tintentries {ws y tint} {
147 #puts "$tint $tint_switched"
148 set yellow [format "%02x" [expr {round( 255 *
149 ( $tint >= $tint_switched ? $tint : 0 )
151 set black [format "%02x" [expr {round( 255 *
152 ( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
154 set fg [format "#${black}${black}${black}"]
155 set bg [format "#${yellow}${yellow}00"]
156 foreach w $ws { $w itemconfigure $y -foreground $fg -background $bg }
160 global height otherevent
161 global times prtimes pirates messages
164 for_lw { $w delete 0 end; set $l {} }
167 for {set i 0} {$i<$height} {incr i} {
168 for_lw { lappend $l {}; $w insert end {} }
173 set otherevent [clock seconds]
180 listbox .tints -width 60 -height [expr {$divs+1}]
181 for {set y 0} {$y <= $divs} {incr y} {
182 set tint [expr {($y+0.0)/$divs}]
184 "[format "#%2d %6f %4ds" $y $tint [expr {round(
185 $tint > 0 ? -log($tint) * $e_life : "9999"
186 )}]] The quick brown fox jumped over the lazy dog"
187 tintentries .tints $y $tint
189 pack .tints -side bottom
192 proc file-read-lines {lvar body} {
194 global logfile poll_after lastactivity bufdata
197 if {![info exists logfile]} {
201 if {[catch { read $logfile } got]} {
205 #puts "f-r-l [string length $got]"
206 if {![string length $got] && [eof $logfile]} {
207 set ago [expr { [clock seconds] - $lastactivity }]
208 set interval [expr {( $ago < 10 ? 10 :
211 #puts "requeue filepoll $interval"
212 set poll_after [after $interval pollfile]
215 set lastactivity [clock seconds]
217 while {[regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
228 proc file-error {emsg} {
231 shownotice red "Error reading logfile $currentfile:\n$emsg"
232 catch { close $logfile }
233 catch { unset logfile }
237 global poll_after logfile currentfile
238 global errorCode errorInfo bufdata lastactivity
240 catch { after cancel $poll_after }
241 if {![string length $currentfile]} {
242 shownotice red "No log file selected. Use File / Open."
245 if {![info exists logfile]} {
247 set lastactivity [clock seconds]
248 if {[catch { set logfile [open $currentfile r] } emsg]} {
249 shownotice red "Error opening logfile $currentfile:\n$emsg"
252 shownotice \#000080 "Reading $currentfile"
254 seek $logfile -1024 end
256 if {![string match {POSIX EINVAL *} $errorCode]} {
260 file-read-lines l { }
264 if {[regexp {^\[\d+:\d+:\d+\] (.*)} $l dummy rhs]} {
271 proc process-line {l} {
272 if {[regexp {^(\w+) tells ye, \"(.*)\"$} $l dummy pirate msg]} {
278 proc message {pirate msg} {
279 global times pirates messages height
280 global lw_ls lw_ws bell_again
282 set ix [lsearch -exact $pirates $pirate]
283 set now [clock seconds]
285 if {$bell_again > -2 &&
286 ($ix<0 || [lindex $times $ix] < $now-$bell_again)} {
292 foreach time $times {
293 if {$time < $oldest} {
300 set $l [lreplace [set $l] $ix $ix]
305 set ix [expr {$height-1}]
307 for_lw new [list $now $pirate $msg] {
308 set $l [lreplace [set $l] $ix $ix $new]
313 .pirate itemconfigure $ix -foreground white
320 if {![string compare $arg --test-tints]} {
322 } elseif {![string compare $arg --no-bell]} {
325 error "unknown option $arg"
336 if {[file exists $defaultfile]} {