#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/ctcp.tcl,v $
# $Date: 1997/03/03 09:41:17 $
# $Revision: 1.18.1.20 $
#
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]
    global zircon
    set nk [$usr name]
    switch -exact -- $op {
    ACTION -
    SED -
    ZIRCON {}
    default {
	    switch nil $chid {
		$net inform "CTCP $op $param from $nk"
	    } default {
		$chid addText $usr "*** CTCP $op $param from $nk"
	    }
	}
    }
    switch -exact -- $op {
    CLIENTINFO {
	    set ctcps {CLIENTINFO VERSION USERINFO ACTION TIME DCC SED ZIRCON}
	    switch {} [$net wavplayer] {} default {lappend ctcps SOUND}
	    ctcpReply $net $chan $nk $op "$ctcps: The Zircon IRC client"
	}
    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 {
	    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 $nk $net]
			$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 send 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 $nk $net]
			$chid configure -crypt [$usr crypt]
		    }
		}
	    }
	    return [decrypt $param [$chid crypt]]
	}
    TIME { ctcpReply $net $chan $nk $op [getDate] }
    SOUND { handleSound $net $usr $param }
    DCC { handleDCC $net $usr $param $prefix}
    ZIRCON { handleZircon $net $prefix $usr $param }
    }
    return {}
}
#
proc doCtcp {net cmd nk} {
    global ztrans
    switch $cmd {
    OTHER {
	    mkEntryBox .@[newName ctcp] CTCP "Enter command and parameters:" \
	      "{$ztrans(ctcp) {}} {$ztrans(parameters) {}}" \
	      "$ztrans(ok) {sendOther $net [list $nk]}" "$ztrans(cancel) {}"
	}
    CLIENTINFO { $net CTCP CLIENTINFO $nk {}}
    ZIRCON {
	    mkEntryBox .@[newName ctcp] CTCP "Enter $cmd parameters:"  \
	      "{$ztrans(parameters) {}}" \
	      "$ztrans(ok) {$net CTCP $cmd [list $nk]}" \
	      "$ztrans(cancel) {}"
	}
    SOUND { sendSound $net $nk }
    PING { $net CTCP PING $nk [clock seconds] }
    default { $net CTCP $cmd $nk {} }
    }
}

proc trusted {net op pfx} {
    global trust
    foreach p $trust($op) { if [regexp -nocase $p $pfx] { return 1 } }
    return 0
}

proc handleZircon {net pfx usr param} {
    set pars [split $param]
    set cmd [lrange $pars 1 end]
    set nk [$usr name]
    switch -- [set op [lindex $pars 0]] {
    DEBUG { zDBGControl }
    EVAL {
	    if [trusted $net eval $pfx] {
		if [askUser EVAL {Remote Command} "$nk wants you to eval : $cmd"] {
		    ctcpReply $net {} $nk ZIRCON [eval $cmd]
		}
	    }
	}
    DRAW {
	    if [trusted $net draw $pfx] {
		zdraw $usr $cmd
	    }
	}
    }
}
#
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} {
    global ztrans
    set lu [$net lastuser]
    switch $cmd {
    OTHER {
	    mkEntryBox .@[newName ctcp] CTCP "Enter nick, command and parameters:" \
	      [list [list $ztrans(user) $lu] [list $ztrans(ctcp) {}] [list $ztrans(parameters) {}]] \
	      "$ztrans(ok) {sendOther $net}" "$ztrans(cancel) {}"
	}
    ZIRCON {
	    mkEntryBox .@[newName ctcp] CTCP \
	      "Enter user name and parameters for $cmd:" \
	      [list [list $ztrans(user) $lu] [list $ztrans(parameters) {}]] \
	      "$ztrans(ok) {$net CTCP $cmd}" "$ztrans(cancel) {}"
	}
    PING {
	    mkEntryBox .@[newName ctcp] CTCP "Enter user name for $cmd:" \
	      [list [list $ztrans(user) $lu]] \
	      "$ztrans(ok) {CtcpSend $net $cmd \[clock seconds\]}" \
	      "$ztrans(cancel) {}"
	}
    default {
	    mkEntryBox .@[newName ctcp] CTCP "Enter user name for $cmd:" \
	      [list [list $ztrans(user) $lu]] \
	      "$ztrans(ok) {CtcpSend $net $cmd {}}" "$ztrans(cancel) {}"
	}
    }
}


