# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/ctcp.tcl,v $
# $Date: 2001/06/13 07:20:28 $
# $Revision: 1.18.1.39 $
#
package provide zircon 1.18
#
proc ctcpReply {net chan nk op str} {
    if {[$net verboseCTCP]} {
	$net display @CTCP "*** CTCP $op Reply to $nk - $str"
    }
    $net queue "NOTICE $nk :\001$op $str\001"
}
#
proc handleCTCP {net op chid chan usr prefix ign param} {
    if {[ignoreSet $ign ctcp]} { return {}}
    if {![regexp -- [$net ctcpPattern] $chan]} { return {} }
    handleOn $net CTCP [list $op $prefix $param $chan]
    global zircon
    set nk [$usr name]
    switch -glob -- $op {
    ACTION -
    SED -
    ZIRCON {}
    "*\007*" {
	    $net inform "Ignoring CTCPs from $nk"
	    flipIgnore $usr CTCP
	    return {}
	}
    default {
	    switch nil $chid {
		$net inform "CTCP $op $param from $nk"
	    } default {
		$chid addText @INFO "*** CTCP $op $param from $nk"
	    }
	}
    }
    switch -exact -- $op {
    CLIENTINFO {
	    set ctcps {CLIENTINFO VERSION USERINFO ACTION TIME DCC SED ZIRCON}
	    switch {} [$net players] {} default {lappend ctcps SOUND}
    	    switch {} $param {
	        set ctcps {CLIENTINFO VERSION USERINFO ACTION TIME DCC SED ZIRCON}
	        switch {} [$net players] {} default {lappend ctcps SOUND}
	        ctcpReply $net $chan $nk $op "$ctcps: The Zircon IRC client"
	    } default {
	    	set v No
		if {[listmember $ctcps $param]} { set v Yes }
		ctcpReply $net $chan $nk $op "$param : $v"
	    }
	}
    VERSION {
	    switch {} [set v [$net versioninfo]] {
		global tk_patchLevel
		set v "Zircon $zircon(version) Pl: $zircon(patchlevel) *IX :\
tcl [info patchlevel] tk $tk_patchLevel"
	    }
	    ctcpReply $net $chan $nk $op $v
	}
    FINGER {
	    switch {} [$net fingerinfo] {} default {
		ctcpReply $net $chan $nk $op [$net fingerinfo]
	    }
	}
    USERINFO {
	    switch {} [$net userinfo] {} default {
		ctcpReply $net $chan $nk $op [$net userinfo]
	    }
	}
    PING { ctcpReply $net $chan $nk $op $param}
    ACTION {
	    handleOn $net ACTION [list $prefix $chan $param]
	    set lnk [$usr lname]
	    if {[me $chan $net]} {
		switch nil [set chid [Message :: find $nk $net]] {
		    if {[$net busy]} {
			$net queue "NOTICE $nk :[$net busymsg]"
			$net inform \
			  "Action from $nk at [getDate] : $param"
			return {}
		    } {
			handleOn $net POPUP [list $nk]
			set chid [Message :: make $net $nk]
			$chid addText $lnk "[getDate]"
		    }
		}
	    }
	    $chid addText $lnk "* $nk $param"
	}
    SED {
	    if {[me $chan $net]} {
		switch nil [set chid [Message :: find $nk $net]] {
		    if {[$net busy]} {
			$net NOTICE $nk [$net busymsg]
			set mv [decrypt $param [$usr crypt]]
			$net inform \
			  "Encrypted Message from $nk at [getDate] : $mv"
			return {}
		    } {
			handleOn $net POPUP [list $nk]
			set chid [Message :: make $net $nk]
			$chid configure -crypt [$usr crypt]
		    }
		}
	    }
	    return [decrypt $param [$chid crypt]]
	}
    TIME { ctcpReply $net $chan $nk $op [getDate] }
    SOUND { handleSound $net $usr $param $chan $prefix }
    DCC { handleDCC $net $usr $param $prefix}
    ZIRCON { handleZircon $net $prefix $usr $param }
    }
    return {}
}
#
proc doCtcp {net cmd nk} {
    switch $cmd {
    OTHER {
	    mkEntryBox .@[newName ctcp] CTCP {Enter command and parameters:} \
	      [list [list ctcp {}] [list parameters {}]] \
	      [list ok "sendOther $net [list $nk]"] [list cancel {}]
	}
    CLIENTINFO { $net CTCP CLIENTINFO $nk {}}
    ZIRCON {
	    mkEntryBox .@[newName ctcp] CTCP "Enter $cmd parameters:"  \
	      [list [list parameters {}]] \
	      [list ok "$net CTCP $cmd [list $nk]"] [list cancel {}]
	}
    SOUND { sendSound $net $nk }
    PING { $net CTCP PING $nk [clock seconds] }
    default { $net CTCP $cmd $nk {} }
    }
}
#
proc CtcpSend {net cmd par nk} {
    $net configure -lastuser $nk
    $net CTCP $cmd $nk $par
}
#
proc sendOther {net nk op par} {
   switch {} $nk return
   switch {} $op return
   $net CTCP [string toupper $op] $nk $par
}
proc chanCTCP {cmd ctl} {
    switch {} [set chan [string trim [$ctl channel]]] {} default {
	doCtcp [$ctl net] $cmd $chan
    }
}
#
proc usersCTCP {net cmd} {
    set lu [$net lastuser]
    switch $cmd {
    OTHER {
	    mkEntryBox .@[newName ctcp] CTCP "Enter nick, command and parameters:" \
	      [list [list user $lu] [list ctcp {}] [list parameters {}]] \
	      [list ok "sendOther $net"] [list cancel {}]
	}
    ZIRCON {
	    mkEntryBox .@[newName ctcp] CTCP \
	      "Enter user name and parameters for $cmd:" \
	      [list [list user $lu] [list parameters {}]] \
	      [list ok "$net CTCP $cmd"] [list cancel {}]
	}
    PING {
	    mkEntryBox .@[newName ctcp] CTCP "Enter user name for $cmd:" \
	      [list [list user $lu]] \
	      [list ok "CtcpSend $net $cmd \[clock seconds\]"] \
	      [list cancel {}]
	}
    default {
	    mkEntryBox .@[newName ctcp] CTCP "Enter user name for $cmd:" \
	      [list [list user $lu]] \
	      [list ok "CtcpSend $net $cmd {}"] [list cancel {}]

	}
    }
}