X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=blobdiff_plain;f=ledmodule.tcl;h=b4a20fd858b890e3eddc1073c7733fe8cc517ec6;hb=HEAD;hp=22cfb08b7cdaed55fbd87037e33ba171b6c4af04;hpb=f4c66f88ac93f4598c719b427530e2601180d684;p=ircbot.git diff --git a/ledmodule.tcl b/ledmodule.tcl index 22cfb08..b4a20fd 100644 --- a/ledmodule.tcl +++ b/ledmodule.tcl @@ -1,36 +1,5 @@ -# maintains local list of users to userv-slurp config from -# each user provides list of -# monitors -# devicesets -# -# a monitor specifies -# name -# IRC channel(s) -# nicks ignore totally -# nicks ignore presence -# nicks prefer speech -# time for `a while ago' -# time for `very-recently' -# syntax -# nick ignore|nopresence|prefer [...] -# times (default 120 450) -# (affect subsequent `monitor' directives) -# monitor <#chan>[,<#chan>...] -# must start with : -# -# a deviceset specifies -# monitor -# led-group -# led states -# syntax -# leds = -# where state is one of -# [pref]talk[now] any non-ignored (with `pref', only any preferred) -# nick(s) spoke at least somewhat recently -# (with `now', only if they spoke very recently) -# present at least some non-nopresence nicks present -# default always matches -# where the first matching state wins; if none, no LEDs are set +# see ledbot.html +# $Id$ set helpfile ledhelp @@ -144,8 +113,10 @@ proc_mon gotchanlist {ch nll} { foreach nl $nll { if {![string compare $nl [irctolower $nick]]} continue if {[mon_nick_is $mm(nopresence) $nl]} continue - lappend $l $nl + if {[mon_nick_is $mm(ignore) $nl]} continue + lappend l $nl } + ldebug m$m "$ch names: $l" set mm(present-$ch) $l mon_updateall $m } @@ -208,10 +179,16 @@ proc_mon destroy {} { proc proc_dset {name argl body} { proc dset_$name [concat d $argl] " upvar #0 deviceset/\$d dd - if {\[catch { + set returncode \[catch { $body - } emsg\]==1} { + } emsg\] + global errorInfo errorCode + if {\$returncode==1} { reporterr \"error on \$d: \$emsg\" + } elseif {\$returncode==2} { + return \$emsg + } else { + return -code \$returncode -errorinfo \$errorInfo -errorcode \$errorCode }" } @@ -300,15 +277,16 @@ proc reloaduser {username} { set l $contin set contin {} if {[regexp {^\#} $l]} { - } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \ - $l dummy kind globs]} { + } elseif {![regexp {\S} $l]} { + } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(.*)$} \ + "$l " dummy kind globs]} { set cc($kind) {} foreach gl [split $globs " "] { if {![string length $gl]} continue string match $gl {} lappend cc($kind) $gl } - } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy r rnow]} { + } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy rnow r]} { foreach cv {{} now} { set cc(time-recent$cv) [set r$cv] } } elseif {[regexp {^monitor\s+(\S+)\s+(\S.*)$} $l dummy m cl]} { set cc(chans) {} @@ -455,33 +433,13 @@ proc config_change {} { } proc allchans_shortly {} { - global chan_after onchans shortly_alling - if {[info exists shortly_alling]} { - ldebug {} "global check already pending" - return - } - foreach ch [array names onchans] { - manyset $onchans($ch) status after - if {"$status" != "shortly"} continue - set idle - } - set shortly_alling [after $chan_after allchans_sendnames] -} - -proc allchans_sendnames {} { - global shortly_alling - unset shortly_alling - ldebug {} "asking for global namelist" - sendout NAMES + global onchans + foreach ch [array names onchans] { chan_shortly $ch } } proc chan_shortly {ch} { - global chan_after shortly_alling + global chan_after set ch [irctolower $ch] - if {[info exists shortly_alling]} { - ldebug c$ch "global check already pending" - return - } upvar #0 onchans($ch) oc if {[info exists oc]} { manyset $oc status after @@ -498,7 +456,7 @@ proc msg_353 {p c dest type chan nicklist} { set lchan [irctolower $chan] set nll [irctolower $nicklist] regsub -all {[=@*]} $nll {} nll - ldebug c$lchan "got names $nll" + ldebug c$lchan "all names: $nll" foreach m [list_objs monitor] { mon_gotchanlist $m $lchan $nll } @@ -539,6 +497,7 @@ def_ucmd debug { def_ucmd nodebug { prefix_nick + ta_nomore global debugusers debug_cancelling set debugusers {} catch { after cancel $debug_cancelling } @@ -546,6 +505,13 @@ def_ucmd nodebug { reporterr "debug disabled by $n" } +proc_dset visibledest {} { + regsub {\:[^:]*/} $d/ { } p + regsub {^([^:]+)\:\d+\:} $p {\1, } p + regsub { $} $p {} p + return $p +} + def_ucmd who { set r {} foreach m [list_objs monitor] { @@ -554,8 +520,10 @@ def_ucmd who { } foreach d [list_objs deviceset] { upvar #0 deviceset/$d dd - regexp {^[^:]*\:[^:]*} $dd(group) dest - lappend r "sending $dd(monname) to $dest" + set m $dd(monname) + upvar #0 monitor/$m mm + if {![info exists mm(chans)]} continue + lappend r "sending $m to [dset_visibledest $d]" } ucmdr [join $r "\n"] {} } @@ -569,10 +537,34 @@ proc connected {} { config_change } -proc msg_JOIN {p c chan} { chan_shortly $chan } +proc warn_pref {n} { + set nl [irctolower $n] + set l {} + foreach d [list_objs deviceset] { + upvar #0 deviceset/$d dd + set m $dd(monname) + upvar #0 monitor/$m mm + if {![info exists mm(prefer)]} continue + if {![mon_nick_is $mm(prefer) $nl]} continue + foreach ch $mm(chans) { set wch($ch) 1 } + lappend l [dset_visibledest $d] + } + if {[llength $l]} { + sendprivmsg $nl "LEDs are watching you on [\ + join [lsort [array names wch]] ","]: [join $l " "]" + } +} + +proc msg_JOIN {p c chan} { + prefix_nick + set nl [irctolower $n] + chan_shortly $chan + warn_pref $n +} proc msg_PART {p c chan} { chan_shortly $chan } proc msg_KILL {p c user why} { allchans_shortly } proc msg_QUIT {p c why} { allchans_shortly } +proc msg_NICK {p c newnick} { allchans_shortly; warn_pref $newnick } proc msg_KICK {p c chans users comment} { if {[llength $chans] > 1} { allchans_shortly