ypp-chatlog-alerter

   1 #!/usr/bin/wish
   2
   3 proc manyset {list args} {
   4     foreach val $list var $args {
   5         upvar 1 $var my
   6         set my $val
   7     }
   8 }
   9
  10 set progname ypp-chatlog-alerter
  11 set height 5
  12
  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 }
  16     eval $c
  17 }
  18 proc menus {} {
  19     global height
  20
  21     menu .mbar -tearoff 0
  22     foreach w {file edit} l {File Edit} {
  23         menu .mbar.$w -tearoff 0
  24         .mbar add cascade -menu .mbar.$w -label $l
  25     }
  26     foreach l {Open Quit} a {O Q} x {newfile exit} {
  27         menuent file $l $a $x
  28     }
  29     foreach l {Cut Copy Paste Clear} a {X C V {}} {
  30         menuent edit $l $a [list event generate {[focus]} <<$l>>]]
  31     }
  32     . configure -menu .mbar
  33 }
  34
  35 proc nonportability {} {
  36     global progname defaultfile
  37
  38     switch -exact [tk windowingsystem] {
  39         aqua {
  40             set defaultfile ~/Library/Preferences/$progname.prefs
  41         }
  42         x11 {
  43             set defaultfile ~/.$progname.rc
  44         }
  45         default {
  46             error ?
  47         }
  48     }
  49 }
  50
  51 proc widgets {} {
  52     global height
  53     listbox .t -width 5 -height $height -borderwidth 0
  54     listbox .p -width 14 -height $height -borderwidth 0
  55     listbox .m -width 80 -height $height -borderwidth 0
  56     pack .t .p .m -side left
  57 }
  58
  59 proc newfile {} {
  60     global currentfile defaultfile
  61
  62     set newfile [tk_getOpenFile -multiple 0 -initialfile $currentfile \
  63                      -title "Select YPP log to track"]
  64     if {![string length $newfile]} return
  65
  66     set currentfile $newfile
  67     set newdefaults [open $defaultfile.new w]
  68     puts $newdefaults "[list set currentfile $currentfile]"
  69     close $newdefaults
  70     file rename -force $defaultfile.new $defaultfile
  71
  72     #fixme refresh
  73 }
  74
  75 set lw_ls {times pirates messages}
  76 set lw_ws {t p m}
  77
  78 proc for_lw {body} {
  79     global lw_ls lw_ws
  80     uplevel 1 [list \
  81                    foreach l $lw_ls \
  82                            w $lw_ws \
  83                        $body]
  84 }
  85
  86 set e_life 120
  87 set tint_switch 90
  88 set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
  89
  90 proc retint {} {
  91     global times e_life
  92     set i 0
  93     set now [clock seconds]
  94     foreach time $times {
  95         set agescale [expr {
  96                             exp( -($now >= $time ? $now-$time : 0) / $e_life )
  97                         }]
  98     }
  99 }
 100
 101 proc tintentry {w y tint} {
 102     global tint_switched
 103     #puts "$tint $tint_switched"
 104     set yellow [format "%02x" [expr {round( 255 *
 105         ( $tint >= $tint_switched ? $tint : 0 )
 106                                             )}]]
 107     set black [format "%02x" [expr {round( 255 *
 108         ( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
 109                                            )}]]
 110     $w itemconfigure $y \
 111         -foreground [format "#${black}${black}${black}"] \
 112         -background [format "#${yellow}${yellow}00"]
 113 }
 114
 115 proc clearlists {} {
 116     global height
 117     global times pirates messages
 118     set currentfile {}
 119
 120     for_lw { .$w delete 0 end; set $l {} }
 121     for {set i 0} {$i<$height} {incr i} {
 122         for_lw { lappend $l {}; .$w insert end {} }
 123     }
 124 }
 125
 126 proc showtints {} {
 127     global e_life
 128     set divs 20
 129     listbox .tints -width 60 -height [expr {$divs+1}]
 130     for {set y 0} {$y <= $divs} {incr y} {
 131         set tint [expr {($y+0.0)/$divs}]
 132         puts "$y $tint"
 133         .tints insert end \
 134             "[format "#%2d   %6f   %4ds" $y $tint [expr {round(
 135                 $tint > 0 ? -log($tint) * $e_life : "9999"
 136             )}]]  The quick brown fox jumped over the lazy dog"
 137         tintentry .tints $y $tint
 138     }
 139     pack .tints -side bottom
 140 }
 141
 142 proc parseargs {} {
 143     global argv
 144     foreach arg $argv {
 145         if {![string compare $arg --test-tints]} {
 146             showtints
 147         } else {
 148             error "unknown option $arg"
 149         }
 150     }
 151 }
 152
 153 menus
 154 nonportability
 155 parseargs
 156 widgets
 157 clearlists
 158
 159 if {[file exists $defaultfile]} {
 160     source $defaultfile
 161 }
 162
 163 #fixme refresh