#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/IRC.tcl,v $
# $Date: 1997/02/18 16:37:30 $
# $Revision: 1.18.1.22 $
#
package provide zircon 1.18
#
#   Handle IRC cmds
#
proc ctcpAnswer {net usr nk cp} {
    handleOn [$usr net] CTCPREPLY [list $nk $cp]
    set chn {}
    foreach x [$usr channels] {
	if {[$x active] && [[$x wid] visible]} {lappend chn $x}
    }
    regsub -all "\[\x01-\x1f\]" $nk {} nk
    switch {} $chn {
	mkInfoBox $net CTCP .@ctcp$usr {CTCP Reply} "CTCP Reply from $nk:\n$cp"
    } default {
	foreach x $chn {
	    $x addText $usr "*** CTCP Reply from $nk: $cp"
	}
    }
}
#
proc ircERROR {net prefix param pargs} { $net error $prefix $param $pargs }
#
proc ircPONG {net prefix param pargs} { $net configure -pinged 0 }
#
proc mungNotice {msg} {
    if [regexp \
      {Received KILL message for ([^ ]+). From ([^ ]+) Path: ([^ ]+) (.*)} \
      $msg match user from path rest] {
	return "*** KILL from $from for $user $rest"
    }
    return $msg
}
#
proc pingVal {val} {
    if [regexp "^PING\[ \t\]+(\[0-9\]+).*" $val m t] {
	return "[zping $t] secs"
    }
    return {Corrupt PING value}
}
#
proc ircNOTICE {net prefix param pargs} {
    set nkinfo [mungPrefix $net $prefix]
    if [ignoreSet [lindex $nkinfo 3] notices] {ditchPrefix $nkinfo ; return}
    set id [find [set chan [lindex $pargs 0]] $net]
    switch {} [lindex $nkinfo 2] {
	if [$id active] {
	    $id addText {} "-$prefix- $param"
	} {
	    switch nil $id {
	        $net inform [mungNotice $param]
	        set chan {}
	    }
	}
    } default {
	set nk [[set usr [lindex $nkinfo 0]] name]
	while [regexp "(\[^\001\]*)\001(\[^\001\]*)\001(.*)" $param sub a cp b] {
	    switch -glob -- $cp {
	    {ZIRCON Sorry*} { }
	    {PING *} {ctcpAnswer $net $usr $nk "PING - [pingVal $cp]"}
	    default { ctcpAnswer $net $usr $nk $cp }
  	    }
	    switch {} [set param $a$b] return
	}
	if {[string match {[#$&]*} $chan]} {
	    $id addText $usr "-$nk- $param"
	} \
	elseif {![string compare nil [set id [Notice :: find $nk $net]]] &&
	  ![string compare nil [set id [Message :: find $nk $net]]]} {
	    if {[$net busy] || [listmember [$net toInfo] NOTICE]} {
		$net inform "Notice from $nk at [getDate] : $param"
	    } {
		handleOn $net POPUP [list $nk]
		set id [Notice :: make $nk $net]
		$id addText {} "[getDate]\n$param"
	    }
	} {
	    if ![$id active] {$id show}
	    $id addText $usr $param
	}
    }
    handleOn $net NOTICE [list $prefix $param $chan]
    ditchPrefix $nkinfo
}
#
proc ircMODE {net prefix param pargs} {
    global userFlags
    set chan [lindex $pargs 0]
    switch nil [set id [Channel :: find $chan $net]] {
	if [me $chan $net] {
	    switch {} [set md [lindex $pargs 1]] {set md $param}
	    foreach m [split $md {}] {
		switch -- $m {
	 	- { set val 0 }
		+ { set val 1 }
		default { catch {$net configure -$userFlags($m) $val} }
		}
	    }
	}
	return
    }
    $id mode [lrange $pargs 1 end]
    $id optText MODE "*** Mode change \"[string trim \
      [join [lrange $pargs 1 end]]]\" on channel $chan by\
      [lindex [mung1Prefix $net $prefix] 0]"
}
#
proc ircPRIVMSG {net prefix param pargs} {
    set nkinfo [mungPrefix $net $prefix]
    set usr [lindex $nkinfo 0]
    set ign [lindex $nkinfo 3]
    set chan [lindex $pargs 0]
    set where [find $chan $net]
    while {[regexp "(\[^\001\]*)\001\[ \t\]*(\[^ \t\001\]+)\[ \t\]*(\[^\001\]*)\001(.*)" $param sub a op cp b]} {
	switch {} \
	  [set param $a[handleCTCP $net $op $where $chan $usr $prefix $ign $cp]$b] {
	    ditchPrefix $nkinfo
	    return
	}
    }
    regsub -all "\[\x01-\x1f\]" "<[set nk [$usr name]]>" {} pfx
    if [me $chan $net] {
	if [ignoreSet $ign notes] return
	switch nil [set where [Message :: find $nk $net]] {
	    global zircon
	    if [$net busy] {
		$net queue "NOTICE $nk :[$net busymsg]"
		$net inform "Message from $nk at [getDate] : $param"
	    } {
		handleOn $net POPUP [list $nk]
		[Message :: make $nk $net] addText $usr "[getDate]\n$pfx $param"
	    }
	    ditchPrefix $nkinfo
	    return
	} default {
	    $where show
	    if ![$where isJoined $usr] {$where addUser $usr 0 0}
	}
	set chan [$usr lname]
    } {
	if [ignoreSet $ign public] return
	set where [Channel :: find $chan $net]
    }
    switch nil $where {
	set where [$net info]
	regsub -all "\[\x01-\x1f\]" "<$nk/$chan>" {} pfx
    }
    $where addText $usr "$pfx $param"
    foreach p [$where patterns] {
	set pt [lindex $p 0]
	if {[regexp -nocase [lindex $pt 0] $pfx] && \
	  [regexp [lindex $pt 1] $param]} {
	    if [catch {uplevel #0 [lindex $p 1]} msg] {
		tellError {} {Pattern Command Error} \
		  "Error when executing pattern command \"[lindex $p 1]\" : $msg"
	    }
	}
    }
    ditchPrefix $nkinfo
}
#
proc ircJOIN {net prefix param pargs} {
    if ![regexp "^(.*)\a(\[ov\])\$" $param m chan ov] {
	set chan $param
	set ov {}
    }
    if [notAnon $chan $prefix] {
	set nkinfo [mungPrefix $net $prefix]
	if [lindex $nkinfo 1] { [Channel :: make $chan $net] show } {
	    [Channel :: find $chan $net ] doJoin [lindex $nkinfo 0] \
	      [lindex $nkinfo 2] $prefix $ov
	}
	ditchPrefix $nkinfo
    }
    handleOn $net JOIN [list $chan $prefix $ov]
}
#
proc ircNICK {net prefix param pargs} {
    set usr [lindex [set nkinfo [mungPrefix $net $prefix]] 0]
    if [lindex $nkinfo 1] { $net configure -nickname $param } \
    elseif {[string compare nil [set orig [User :: find $param $net]]] &&
	[string compare $usr $orig]} {
	$usr substitute $orig
    } {
	foreach id [$net channels] {
	    if [$id isJoined $usr] { $id nickChange $usr $param }
	}
	foreach x {Message Notice Chat} {
	    switch nil [set old [$x :: find [$usr lname] $net]] {} default {
		$old nickChange $usr $param
	    }
	}
	$usr rename $param
    }
    handleOn $net NICK [list $prefix $param]
    ditchPrefix $nkinfo
}
#
proc notAnon {c p} {
    switch :anonymous!anonymous@anonymous $p {
	switch -glob $c {[#+]*} { return 1 }
	return 0
    }
    return 1
}
#
proc ircPART {net prefix param pargs} {
    set chan [Channel :: find [set chn [lindex $pargs 0]] $net]
    if [notAnon $chn $prefix] {
	set nkinfo [mungPrefix $net $prefix]
	if [lindex $nkinfo 1] {$chan delete} {
	    set usr [lindex $nkinfo 0]
	    set msg {}
	    switch {} $param {} default { set msg " : ($param)" }
	    $chan optText LEAVE "*** [$usr name] has left channel $chn$msg"
	    $chan killUser $usr
	}
	ditchPrefix $nkinfo
    }
    handleOn $net LEAVE [list $chn $prefix $param]
}
#
proc netsplit {string} {
    return [regexp -nocase \
      {^([a-z0-9*_-]+\.)+([a-z0-9_-]+) ([a-z0-9*_-]+\.)+([a-z0-9_-]+)$} $string]
}
#
proc ircQUIT {net prefix param pargs} {
    if ![lindex [set nkinfo [mungPrefix $net $prefix]] 1] {
	set nk [[set usr [lindex $nkinfo 0]] name]
	if {![$net nosplit] && [netsplit $param]} {
	    $usr split $param
	} {
	    switch nil [set fobj [Friend :: find $nk $net]] {} default {
		$fobj configure -ison 0 -usr nil
		[$net finfo] remove $fobj
	    }
	    $usr off

	    if [set ti [listmember [$net toInfo] SIGNOFF]] {
		$net display @QUIT "*** Signoff: $nk ($param)"
	    }
	    set lnk [$usr lname]
	    foreach x {channels messages notices chats} {
		foreach id [$net $x] {
		    if [$id active] {
			if [$id isJoined $usr] {
			    if !$ti {$id optText QUIT "*** Signoff: $nk ($param)"}
			    $id killUser $usr
		        } {
		            switch -- [$id lname] $lnk {
				$id addText @QUIT "*** $nk has signed off : $param"
			    }
			}
		    }
		}
	    }
	    handleOn $net QUIT [list $prefix]
	}
    }
    ditchPrefix $nkinfo
}
#
proc ircKICK {net prefix param pargs} {
    set nkinfo [mungPrefix $net $prefix]
    set chan [lindex $pargs 0]
    set nk [[set who [User :: make [lindex $pargs 1] $net]] name]
    set kicker [[lindex $nkinfo 0] name]
    set id [Channel :: find $chan $net]
    if [$net me $who] {
	$id quiesce
	if [askUser KICKED "Kicked from $chan" \
	  "You have been kicked off channel $chan by $kicker\
($param). Do you want to rejoin?"] { $id sendJoin} {$id delete}
    } {
	$id optText KICK \
	  "*** $nk has been kicked off channel $chan by $kicker ($param)"
	$id killUser $who
   }
   handleOn $net KICK [list $chan $prefix $nk $param]
   ditchPrefix $nkinfo
}
#
proc ircINVITE {net prefix param pargs} {
    if ![ignoreSet [lindex [set nkinfo [mungPrefix $net $prefix]] 3] invites] {
	set name [[lindex $nkinfo 0] name]
	if [askUser {} Invitation  "$name invites you to channel $param."] {
	    set chid [Channel :: make $param $net]
	    catch {destroy .@kick$chid}
	    $chid sendJoin {}
	}
    }
    handleOn $net INVITE [list $prefix $param]
    ditchPrefix $nkinfo
}
#
proc ircKILL {net prefix param pargs} {
    set nkinfo [mung1Prefix $net $prefix]
    [set who [User :: make [lindex $pargs 0] $net]] off
    $who ref
    set nk [$who name]
    if [$net me $who] {
	tellInfo Killed "You have been killed by [lindex $nkinfo 0] ($param)"
    } {
	foreach x {channels notices messages} {
	    foreach id [$net $x] {
		if {[$id isJoined $who]} {
		    $id optText KILL \
		      "*** $nk has been killed by [lindex $nkinfo 0] ($param)"
		    $id killUser $who
		}
	    }
	}
    }
    handleOn $net KILL [list $prefix $nk]
    $who deref
}
#
proc ircTOPIC {net prefix param pargs} {
    set id [Channel :: find [set chan [lindex $pargs 0]] $net]
    $id setTopic $param
    set who [lindex [mung1Prefix $net $prefix] 0]
    $id optText TOPIC "*** $who has set the topic: \"$param\""
    $id log "*** $who has set the topic: $param"
    handleOn $net TOPIC [list $chan $prefix $param]
}
#
proc ircWALLOPS {net prefix param pargs} {
   $net display WALLOP "[getDate] $prefix (WALLOPS) - $param"
}
#
proc ircNUM {net number pargs} {
    global ztrans
    set number [string range $number  3 end]
    foreach arg [lrange [lindex $pargs 4] 1 end] {
	switch {} $arg {} default {append txt " $arg"}
    }
    append txt " [lindex $pargs 3]"
    switch -glob $number {
    [45]* {
	    set txt "Error $number from [string range [lindex $pargs 2] 1 end] : $txt"
	    tellError $net "$ztrans(error) $number" $txt
	}
    default { $net inform $txt } 
    }
}
#
#	proc mungPrefix : breaks up the prefix to an IRC message
#	returns : {user object, me?, user@host, ignores}
#
proc mungPrefix {net prefix} {
    if ![regexp {:([^!]*)!(.*)} $prefix m1 nk nm] {
	set nk [string range $prefix 1 end]
	set nm {}
	return [list nil 0 $nm {}]
    }
    [set usr [User :: make $nk $net $nm]] ref
    return [list $usr [$net me $usr] $nm [z_ignore $usr $nm]]
}
#
proc mung1Prefix {net prefix} {
    if ![regexp {:([^!]*)!(.*)} $prefix m1 nk nm] {
	set nk [string range $prefix 1 end]
	set nm {}
    }
    return [list $nk $nm]
}
#
proc ditchPrefix {mng} { catch {[lindex $mng 0] deref} }
