X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/b3d361abe62659d18e3fa9a1d3156482ea97a922..e6cc22dcd98951a1208d81f375f587d32c38a1d7:/bot.tcl?ds=inline

diff --git a/bot.tcl b/bot.tcl
index bef0ead..f3db5c1 100755
--- a/bot.tcl
+++ b/bot.tcl
@@ -57,13 +57,15 @@ proc bgerror {msg} {
 }
 
 proc onread {args} {
-    global sock
+    global sock nick
     
     if {[gets $sock line] == -1} { set terminate 1; return }
     regsub -all "\[^ -\176\240-\376\]" $line ? line
     set org $line
     if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
 	set line $remain
+	if {[regexp {^([^!]+)!} $prefix dummy maybenick] &&
+	    "[irctolower $maybenick]" == "[irctolower $nick]"} return
     } else {
 	set prefix {}
     }
@@ -145,7 +147,9 @@ proc prefix_nick {} {
     upvar 1 n n
     if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
     check_nick $n
-    if {"[irctolower $n]" == "[irctolower $nick]"} { error "from myself" }
+    if {"[irctolower $n]" == "[irctolower $nick]"} {
+	error "from myself" {} {}
+    }
 }
 
 proc showintervalsecs {howlong} {
@@ -313,15 +317,68 @@ proc msg_MODE {p c dest modelist args} {
     }
 }
 
+proc process_kickpart {chan user} {
+    check_nick $user
+    if {![ischan $chan]} { error "not a channel" }
+
+    upvar #0 nick_onchans($user) oc
+    set lc [irctolower $chan]
+    set oc [grep tc {"$tc" != "$lc"} $oc]
+}    
+
+proc msg_KICK {p c chans users comment} {
+    set chans [split $chans ,]
+    set users [split $users ,]
+    if {[llength $chans] > 1} {
+	foreach chan $chans user $users { process_kickpart $chan $user }
+    } else {
+	foreach user $users { process_kickpart [lindex $chans 0] $user }
+    }
+}
+
+proc msg_KILL {p c user why} {
+    nick_forget $user
+}
+
+set nick_arys {onchans username}
+
+proc nick_forget {n} {
+    global nick_arys
+    foreach ary $nick_arys {
+	upvar #0 nick_${ary}($n) av
+	catch { unset av }
+    }
+}
+
 proc msg_NICK {p c newnick} {
+    global nick_arys
     prefix_nick
     recordlastseen_n $n "changing nicks to $newnick" 0
     recordlastseen_n $newnick "changing nicks from $n" 1
+    foreach ary $nick_arys {
+	upvar #0 nick_${ary}($n) old
+	upvar #0 nick_${ary}($newnick) new
+	if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
+	if {[info exists old]} { set new $old; unset old }
+    }
 }
 
-proc msg_JOIN {p c chan} { recordlastseen_p $p "joining $chan" 1 }
-proc msg_PART {p c chan} { recordlastseen_p $p "leaving $chan" 1 }
-proc msg_QUIT {p c why} { recordlastseen_p $p "leaving ($why)" 0 }
+proc msg_JOIN {p c chan} {
+    prefix_nick
+    recordlastseen_n $n "joining $chan" 1
+    upvar #0 nick_onchans($n) oc
+    lappend oc [irctolower $chan]
+}
+proc msg_PART {p c chan} {
+    prefix_nick
+    recordlastseen_n $n "leaving $chan" 1
+    process_kickpart $chan $n
+}
+proc msg_QUIT {p c why} {
+    prefix_nick
+    recordlastseen_n $n "leaving ($why)" 0
+    nick_forget $n
+}
 
 proc msg_PRIVMSG {p c dest text} {
     prefix_nick
@@ -358,6 +415,49 @@ proc msg_PRIVMSG {p c dest text} {
     }
 }
 
+proc msg_INVITE {p c n chan} {
+    after 1000 [list sendout JOIN $chan]
+}
+
+proc grep {var predicate list} {
+    set o {}
+    upvar 1 $var v
+    foreach v $list {
+	if {[uplevel 1 [list expr $predicate]]} { lappend o $v }
+    }
+    return $o
+}
+
+proc msg_353 {p c dest type chan nicklist} {
+    global names_chans nick_onchans
+    if {![info exists names_chans]} { set names_chans {} }
+    set chan [irctolower $chan]
+    lappend names_chans $chan
+    foreach n [array names nick_onchans] {
+	upvar #0 nick_onchans($n) oc
+	set oc [grep tc {"$tc" != "$chan"} $oc]
+    }
+    foreach n [split $nicklist { }] {
+	regsub {^[@+]} $n {} n
+	check_nick $n
+	if {![string length $n]} continue
+	upvar #0 nick_onchans($n) oc
+	lappend oc $chan
+    }
+}
+
+proc msg_366 {p c args} {
+    global names_chans nick_onchans
+    if {[llength names_chans] > 1} {
+	foreach n [array names nick_onchans] {
+	    upvar #0 nick_onchans($n) oc
+	    set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
+	    if {![llength $oc]} { nick_forget $n }
+	}
+    }
+    unset names_chans
+}
+
 proc ta_nomore {} {
     upvar 1 text text
     if {[string length $text]} { error "too many parameters" }
@@ -386,18 +486,45 @@ proc ucmdr {priv pub args} {
     return -code return [concat [list $priv $pub] $args]
 }
 
-proc ucmd_sendhelp {} {
-    ucmdr \
-{Commands currently understood:
- help              get this list of commands
- seen <nick>       ask after someone (I'll tell them you asked)
- summon <username> invite a logged-on user onto IRC
-Send commands to be by /msg, or say them in channel with ! in front.} {}
+proc loadhelp {} {
+    global help_topics
+
+    catch { unset help_topics }
+    set f [open helpinfos r]
+    set lno 0
+    while {[gets $f l] >= 0} {
+	incr lno
+	if {[regexp {^#.*} $l]} {
+	} elseif {[regexp {^ *$} $l]} {
+	    if {[info exists topic]} {
+		set help_topics($topic) [join $lines "\n"]
+		unset topic
+		unset lines
+	    }
+	} elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
+	    if {[info exists topic]} { error "help $newtopic while in $topic" }
+	    set topic $newtopic
+	    set lines {}
+	} elseif {[regexp {^[^!#]} $l]} {
+	    set topic
+	    lappend lines [string trimright $l]
+	} else {
+	    error "eh ? $lno: $l"
+	}
+    }
+    if {[info exists topic]} { error "unfinished topic $topic" }
 }
 
-def_ucmd help { ta_nomore; ucmd_sendhelp }
+def_ucmd help {
+    upvar #0 help_topics([irctolower [string trim $text]]) info
+    if {![info exists info]} { error "no help on $text, sorry." {} }
+    ucmdr $info {}
+}
 
-def_ucmd ? { ta_nomore; ucmd_sendhelp }
+def_ucmd ? {
+    global help_topics
+    ucmdr $help_topics() {}
+}
 
 proc manyset {list args} {
     foreach val $list var $args {
@@ -494,6 +621,8 @@ if {![info exists sock]} {
     fileevent $sock readable onread
 }
 
+loadhelp
+
 #if {![regexp {tclsh} $argv0]} {
 #    vwait terminate
 #}