-# 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 <glob-pattern> [...]
-# times <very-recently> <a-while-ago> (default 120 450)
-# (affect subsequent `monitor' directives)
-# monitor <monname> <#chan>[,<#chan>...]
-# <monname> must start with <username>:
-#
-# a deviceset specifies
-# monitor
-# led-group
-# led states
-# syntax
-# leds <led-group> <monname> <state>=<value>
-# 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
foreach nl $nll {
if {![string compare $nl [irctolower $nick]]} continue
if {[mon_nick_is $mm(nopresence) $nl]} continue
+ 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
}
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
}"
}
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) {}
}
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
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
}
def_ucmd nodebug {
prefix_nick
+ ta_nomore
global debugusers debug_cancelling
set debugusers {}
catch { after cancel $debug_cancelling }
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] {
}
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"] {}
}
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 }
+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
~ijackson / ircbot.git / blobdiff