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}
56 listbox .time -width 5 -height $height -borderwidth 0 -background black
57 listbox .pirate -width 14 -height $height -borderwidth 0 -background black
58 listbox .msg -width 80 -height $height -borderwidth 0
59 eval pack $lw_ws -side left
60 label .overlay -relief raised -foreground white
63 proc shownotice {colour message} {
64 .overlay configure -text $message -background $colour
65 place .overlay -relx 0.5 -rely 0.5 -anchor center
72 global currentfile defaultfile
74 set newfile [tk_getOpenFile -multiple 0 -initialfile $currentfile \
75 -title "Select YPP log to track"]
76 if {![string length $newfile]} return
78 set currentfile $newfile
79 set newdefaults [open $defaultfile.new w]
80 puts $newdefaults "[list set currentfile $currentfile]"
82 file rename -force $defaultfile.new $defaultfile
98 set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
101 global times e_life retint_after otherevent
102 catch { after cancel $retint_after }
104 set now [clock seconds]
105 set latest $otherevent
106 foreach time $times {
107 set latest [expr { $time > $latest ? $time : $latest }]
109 exp( -($now >= $time ? $now-$time : 0) / $e_life )
111 tintentries .msg $i $tint
114 set next [expr { ($now - $latest < 10 ? 10 :
115 $now - $latest > 3000 ? 3000 :
118 #puts "nexting $latest $now $next"
119 set retint_after [after $next retint]
122 proc tintentries {ws y tint} {
124 #puts "$tint $tint_switched"
125 set yellow [format "%02x" [expr {round( 255 *
126 ( $tint >= $tint_switched ? $tint : 0 )
128 set black [format "%02x" [expr {round( 255 *
129 ( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
131 set fg [format "#${black}${black}${black}"]
132 set bg [format "#${yellow}${yellow}00"]
133 foreach w $ws { $w itemconfigure $y -foreground $fg -background $bg }
137 global height otherevent
138 global times pirates messages
141 for_lw { $w delete 0 end; set $l {} }
143 for {set i 0} {$i<$height} {incr i} {
144 for_lw { lappend $l {}; $w insert end {} }
148 set otherevent [clock seconds]
155 listbox .tints -width 60 -height [expr {$divs+1}]
156 for {set y 0} {$y <= $divs} {incr y} {
157 set tint [expr {($y+0.0)/$divs}]
159 "[format "#%2d %6f %4ds" $y $tint [expr {round(
160 $tint > 0 ? -log($tint) * $e_life : "9999"
161 )}]] The quick brown fox jumped over the lazy dog"
162 tintentries .tints $y $tint
164 pack .tints -side bottom
167 proc file-read-lines {lvar body} {
169 global logfile poll_after lastactivity bufdata
171 if {![info exists logfile]} {
175 if {[catch { read $logfile } got]} {
179 if {[eof $logfile]} {
180 set ago [expr { [clock seconds] - $lastactivity }]
181 set poll_after [after [expr {( $ago < 10 ? 10 :
187 set lastactivity [clock seconds]
190 if {![regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
202 proc with-file {body} {
203 global errorInfo errorCode
204 set rc [catch { uplevel 1 $body } result]
212 shownotice red "Error reading logfile $currentfile:\n$emsg"
213 catch { close $logfile }
217 # 2 - 3 - 4 return, break, continue
218 return -code $rc $errorInfo $errorCode $result
226 global poll_after logfile currentfile
227 global errorCode errorInfo bufdata lastactivity
229 catch { after cancel $poll_after }
230 if {![string length $currentfile]} {
231 shownotice red "No log file selected. Use File / Open."
234 if {![info exists logfile]} {
236 set lastactivity [clock seconds]
237 if {[catch { set logfile [open $currentfile r] } emsg]} {
238 shownotice red "Error opening logfile $currentfile:\n$emsg"
241 shownotice \#000080 "Reading $currentfile"
243 seek $logfile -1024 end
245 if {![string match {POSIX EINVAL *} $errorCode]} {
249 file-read-lines l { }
267 if {![string compare $arg --test-tints]} {
270 error "unknown option $arg"
281 if {[file exists $defaultfile]} {