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
  12 menu .mbar -tearoff 0
  13 foreach w {file edit} l {File Edit} {
  14     menu .mbar.$w -tearoff 0
  15     .mbar add cascade -menu .mbar.$w -label $l
  16 }
  17 proc menuent {w l a x} {
  18     set c [list .mbar.$w add command -label $l -command $x]
  19     if {[string length $a]} { lappend c -accel Command-$a }
  20     eval $c
  21 }
  22 foreach l {Open Quit} a {O Q} x {newfile exit} {
  23     menuent file $l $a $x
  24 }
  25 foreach l {Cut Copy Paste Clear} a {X C V {}} {
  26     menuent edit $l $a [list event generate {[focus]} <<$l>>]]
  27 }
  28 . configure -menu .mbar
  29
  30 switch -exact [tk windowingsystem] {
  31     aqua {
  32         set defaultfile ~/Library/Preferences/$progname.prefs
  33     }
  34     x11 {
  35         set defaultfile ~/.$progname.rc
  36     }
  37     default {
  38         error ?
  39     }
  40 }
  41
  42 set height 5
  43
  44 listbox .t -width 5 -height $height -borderwidth 0
  45 listbox .p -width 14 -height $height -borderwidth 0
  46 listbox .m -width 80 -height $height -borderwidth 0
  47 pack .t .p .m -side left
  48
  49 proc newfile {} {
  50     global currentfile defaultfile
  51
  52     set newfile [tk_getOpenFile -multiple 0 -initialfile $currentfile \
  53                      -title "Select YPP log to track"]
  54     if {![string length $newfile]} return
  55
  56     set currentfile $newfile
  57     set newdefaults [open $defaultfile.new w]
  58     puts $newdefaults "[list set currentfile $currentfile]"
  59     close $newdefaults
  60     file rename -force $defaultfile.new $defaultfile
  61     refresh
  62 }
  63
  64 proc for_ll {varname body} {
  65     upvar 1 $varname l
  66     foreach l {times pirates messages} {
  67         set rc [catch { uplevel 1 $body } emsg]
  68         switch -exact $rc {
  69             0 {
  70                 # ok
  71             }
  72             4 {
  73                 # continue
  74             }
  75             3 {
  76                 # break
  77                 return
  78             }
  79             default {
  80                 # error, return, etc.
  81                 return -code $rc -errorinfo $errorInfo \
  82                     -errorcode $errorCode $emsg
  83             }
  84         }
  85     }
  86 }
  87
  88 proc retint {} {
  89     global messages
  90     set i 0
  91     set now [clock seconds]
  92     foreach minfo $messages {
  93         manyset $minfo then pirate msg
  94         set !
  95 }
  96
  97 proc init {} {
  98     global currentfile height
  99     global times pirates messages
 100     set currentfile {}
 101
 102     foreach w {t p m} { .$w delete 0 end }
 103     foreach l {times pirates messages}
 104     for {set i 0} {$i<$height} {incr i} {
 105         lappend times 0
 106         lappend pirates {}
 107         lappend messages {}
 108         foreach w {t p m} { .$w insert end {} }
 109     }
 110 }
 111
 112 proc refresh {} {
 113 }
 114
 115 init
 116
 117 if {[file exists $defaultfile]} {
 118     source $defaultfile
 119 }
 120
 121 refresh