#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/misc2.tcl,v $
# $Date: 2001/06/11 12:04:39 $
# $Revision: 1.18.1.45 $
#
#
package provide zircon 1.18
#
proc net_doMisc2 {this chid win} {
    set line [$win get]
    $win delete 0 end
    if {![doircII $this $chid $line]} {
        $chid send $line
    }
}
#
proc doircII {net chid line} {
    if {[regexp {^(/[a-zA-Z]+)( (.*))?$} $line dummy pr r1 rest]} {
	set upr [string toupper $pr]
	$chid addHist $line
	switch {} [info procs ircII_$upr] {
	    $chid addText @me "!> \"$pr\" does not exist or is unsupported.\a"
	} default {
	    $chid addText @me "!> $line"
	    ircII_$upr $net $chid [string trim $rest]
	}
	return 1
    }
    return 0
}
#
proc deCap {str} {
    set ix [string first { } $str]
    return [list [string range $str 0 [expr {$ix - 1}]] [string range $str [expr {$ix + 1}] end]]
}
#
proc ircII_/THREAD {net chid arg} {
    $net q1Send "PRIVMSG [$chid name] :\001THREAD [lindex $arg 0]\001[lrange $arg 1 end]"
}
#
proc ircII_/ABORT {net chid arg} { exit }
#
proc ircII_/ADMIN {net chid arg} { $net nsend ADMIN [lindex $arg 0]}
#
proc ircII_/ALIAS {net chid arg} { sillyPerson $net }
#
proc ircII_/AMSG {net chid arg} {
    foreach x [$net channels] {
        if {[$x active]} { $x send $arg }
    }
}
#
proc ircII_/ASSIGN {net chid arg} {
    upvar #0 uVars$net uvars
    set uvars([lindex $arg 0]) [lindex $arg 1]
}
#
proc ircII_/AWAY {net chid arg} { $net AWAY $arg }
#
proc ircII_/BEEP {net chid arg} {
    foreach nk $arg {
	$net q1Send "PRIVMSG $nk :\a"
    }
}
#
proc ircII_/BIND {net chid arg} { sillyPerson $net }
#
proc ircII_/BYE {net chid arg} { $net doQuit [lindex $arg 0]}
#
proc ircII_/CD {net chid arg} {
    switch {} $arg {
	tellInfo $net {Working Directory} [pwd]
    } default {
	cd $arg
    }
}
#
proc ircII_/CHANNEL {net chid arg} { channelJoin $net [lindex $arg 0] }
#
proc ircII_/CLEAR {net chid arg} { $chid clear 1 }
#
proc ircII_/COMMENT {net chid arg} { }
#
proc ircII_/CONNECT {net chid arg} {
    $net CONNECT [lindex $arg 0] [lindex $arg 1] [lindex $arg 3]
}
#
proc ircII_/CTCP {net chid arg} {
    set nk [lindex $arg 0]
    switch * $nk {set nk [$chid name]}
    switch [set cmd [string toupper [lindex $arg 1]]] {
    PING { $net CTCP PING $nk [clock seconds] }
    CLIENTINFO {$net CTCP $cmd $nk [lindex $arg 2]}
    ERRMSG -
    SOUND -
    ACTION -
    ECHO {$net CTCP $cmd $nk $arg }
    default { $net CTCP $cmd $nk [lrange $arg 2 end] }
    }
}
#
proc ircII_/DATE {net chid arg} { $net TIME $arg }
#
proc ircII_/DCC {net chid arg} {
    set op [string toupper [lindex $arg 0]]
    switch -- $op {
    SEND {
	   DCCSend [User :: make $net [lindex $arg 1]] [lindex $arg 2]
	}
    CHAT {[User :: make $net [lindex $arg 1]] dcc CHAT}
    GET {
	    global DCCList
	    set gusr [User :: make $net [lindex $arg 1]]
	    set file [lindex $arg 2]
	    set i 0
	    foreach l $DCCList($net) {
		switch [set op [lindex $l 0]] Send continue
		set usr [lindex $l 1]
		set addr [lindex $l 2]
		set port [lindex $l 3]
		set fln [lindex $l 4]
		set leng [lindex $l 5]
		set posn [lindex $l 6]
		switch -- $gusr $usr {
		    switch -- $file $fln {
		        doGetDCC $net $op $usr $addr $port $leng $posn $file
			$usr deref
			listdel DCCList($net) $i
			switch {} $DCCList($net) {destroy .@drq$net}
			return
		    }
		}
		incr i
	    }
	    tellError {} {DCC Get} {No such send outstanding}
	}
    CLOSE -
    LIST {buildDCCList $net}
    default { sillyPerson $net }
    }
}
#
proc ircII_/DEOP {net chid arg} { $net deIRCOp }
#
proc ircII_/DESCRIBE {net chid arg} {
    set chan [lindex $arg 0]
    if {[string compare nil [set ch [Channel :: find $chan $net]]] ||
	[string compare nil [set ch [Message :: find $chan $net]]]} {
	$ch action [lrange $arg 1 end]
    } {
	$net q1Send "PRIVMSG $chan :\001ACTION [lrange $arg 1 end]\001"
    }
}
#
proc ircII_/DIE {net chid arg} { sillyPerson $net }
#
proc ircII_/DIGRAPH {net chid arg} { sillyPerson $net }
#
proc ircII_/DMSG {net chid arg} {
    switch nil [set cht [Chat :: find [lindex $arg 0] $net]] {
	tellError $net Error {No such DCC chat  connection}
    } default {$cht send [lrange $arg 1 end]}
}
#
proc ircII_/DQUERY {net chid arg} {
    set usr [User :: make $net $arg]
    set cht [Chat :: make $net [$usr name]]
    $cht show
    if {![$cht isJoined $usr]} { $cht addUser $usr 0 0 }
}
#
proc ircII_/ECHO {net chid arg} { $net inform $arg }
#
proc ircII_/ENCRYPT {net chid arg} {
    set nk [lindex $arg 0]
    if {[string match {[#&]} $nk]} {
	set chid [Channel :: make $net $nk]
    } {
	set chid [Message :: make $net $nk]
    }
    $chid configure -key [lindex $arg 1]
}
#
proc ircII_/EVAL {net chid arg} { sillyPerson $net }
#
proc ircII_/EXEC {net chid arg} { runCmd $net $chid $arg }
#
proc ircII_/EXIT {net chid arg} { $net doQuit [lindex $arg 0]}
#
proc ircII_/FLUSH {net chid arg} { sillyPerson $net }
#
proc ircII_/FOREACH {net chid arg} { sillyPerson $net }
#
proc ircII_/HELP {net chid arg} { sillyPerson $net }
#
proc ircII_/HISTORY {net chid arg} { sillyPerson $net }
#
proc ircII_/HOOK {net chid arg} { sillyPerson $net }
#
proc ircII_/IF {net chid arg} { sillyPerson $net }
#
proc flgAdd {lst flag op} {
    switch -- $flag {
    {}	{ listincl lst $op}
    -	{ listkill lst $op }
    +	{ }
    ^	{ }
    }
    return $lst
}
#
proc ircII_/IGNORE {net chid arg} {
    global zircon
    if {[string match *@* [set nk [lindex $arg 0]]]} {
    	set nk *!$nk
    } {
    	append nk !*@*
    }
    set ign {}
    foreach x [lrange $arg 1 end] {
        regexp {^([-+^]?)(.*)} $x m flag op
        switch [string tolower $op] {
	msgs            -
	notices         -
	public          -
	invites         -
	wallops         -
	notes           -
	ctcp            -
	crap            { set ign [flgAdd $ign $flag $op] }
	all             { set ign [string tolower $zircon(ignore)] }
	none            { ignoreRemove $net $nk ; return}
	}
    }
    $net eval "ignore [list $nk] $ign"
    $net configure +confChange Ignores
}
#
proc ircII_/INFO {net chid arg} { $net INFO $arg }
#
proc ircII_/INPUT {net chid arg} { sillyPerson $net }
#
proc ircII_/INVITE {net chid arg} {
    set nk [lindex $arg 0]
    foreach x [lrange $arg 1 end] { $net INVITE $nk $x }
}

#
proc ircII_/JOIN {net chid arg} { channelJoin $net $arg }
#
proc ircII_/KICK {net chid arg} {
    set chn [lindex $arg 0]
    switch * $chn {set chn [$chid name]}
    $net KICK $chn [lindex $arg 1] [lrange $arg 2 end]
}
#
proc ircII_/KILL {net chid arg} {$net KILL [lindex $arg 0] [lrange $arg 1 end]}
#
proc ircII_/LASTLOG {net chid arg} { sillyPerson $net }
#
proc ircII_/LEAVE {net chid arg} { ircII_/PART $net $chid $arg }
#
proc ircII_/LINKS {net chid arg} { $net LINKS [lindex $arg 0] [lindex $arg 1] }
#
proc ircII_/LIST {net chid arg} { 
    set chan {}
    while {$arg != {}} {
	set inc 1
        switch -glob -- [string toupper [lindex $arg 0]] {
	-MIN	{ $net configure -minMembers [lindex $arg 1] ; set inc 2}
	-MAX	{ $net configure -maxMembers [lindex $arg 1] ; set inc 2}
	-PUBLIC { $net configure -showPublic 1 -showPrivate 0 -showLocal 0}
	-PRIVATE { $net configure -showPrivate 1 -showPublic 0 -showlocal 0}
	-ALL	{ $net configure -showPublic 1 -showPrivate 1 -showLocal 1}
	-TOPIC	{ $net configure -topicOnly 1}
	-WIDE	{ }
	-NAME	{ $net configure -sorted 1 -sortNames 1}
	-USERS	{ $net configure -sorted 1 -sortNames 0}
	-*	{ tellError $net /LIST {Invalid option} ; return }
	\*	{ set chan [$chid name] ; break }
	default { set chan [lindex $arg 0] ; break }
	}
	set arg [lrange $arg $inc end]
    }
    $net channelList $chan
}
#
proc ircII_/LOAD {net chid arg} {  sillyPerson $net }
#
proc ircII_/LUSERS {net chid arg} {$net send LUSERS [lindex $arg 0] [lindex $arg 1]}
#
proc ircII_/ME {net chid arg} { $chid action $arg }
#
proc ircII_/MLOAD {net chid arg} { sillyPerson $net }
#
proc ircII_/MODE {net chid arg} {
    set foo [deCap $arg]
    set chn [lindex $foo 0]
    switch * $chn {set chn [$chid name]}
    switch {} [set rest [colonLast [lindex $foo 1]]] {
	$net q1Send "MODE :$chn"
    } default {
	$net q1Send "MODE $chn $rest"
    }
}
#
proc ircII_/MOTD {net chid arg} { $net send MOTD $arg }
#
proc ircII_/MSG {net chid arg} {
    set foo [deCap $arg]
    $net q1Send "PRIVMSG [lindex $foo 0] :[lindex $foo 1]"
}
#
proc ircII_/NAMES {net chid arg} { $net NAMES $arg }
#
proc ircII_/NICK {net chid arg} { $net NICK $arg }
#
proc ircII_/NOTE {net chid arg} { sillyPerson $net }
#
proc ircII_/NOTICE {net chid arg} {
    $net NOTICE [lindex $arg 0] [lrange $arg 1 end]
}
#
proc ircII_/NOTIFY {net chid arg} { 
    switch -- $arg {} {
	set here {}
	set nothere {}
        foreach x [$net friends] {
	    if {[$x ison]} {
	    	lappend here $x
	    } {
	    	lappend nothere $x
	    }   
	}
	set msg "Currently present:"
	foreach x $here { append msg " [$x name]" }
	append msg "\nCurrently absent:"
	foreach x $nothere { append msg " [$x name]" }
	mkDialog ISON {} [trans notify] $msg {} ok
	return
    } + {
	set here {}
        foreach x [$net friends] {
	    if {[$x ison]} { lappend here $x } 
	}
	set msg "Currently present:"
	foreach x $here { append msg " [$x name]" }
	mkDialog ISON {} [trans notify] $msg {} ok
        return
    } - {
    	foreach x [$net friends] { $x configure -notify 0 }
        return
    }
    foreach x $arg {
        regexp {(-?)(.*)} $x m off nick
	set id [Friend :: make $net $nick]
	$id configure -notify [expr {$off == {}}]
	switch {} [$id usr] {
	    switch nil [set usr [User :: find $nick $net]] {} default {
	    	$id configure -usr $usr
	    }
	}
    }
}
#
proc ircII_/ON {net chid arg} { sillyPerson $net }
#
proc ircII_/OPER {net chid arg} {$net OPER [lindex $arg 0] [lindex $arg 1]}
#
proc ircII_/PARSEKEY {net chid arg} { sillyPerson $net }
#
proc ircII_/PART {net chid arg} {
    switch -- $arg {} - * {
	$chid doLeave {}
    } default {
	switch nil [set id [find [lindex $arg 0]]] {} default {
	    $id doLeave [lindex $arg 1]
	}
    }
}
#
proc ircII_/PING {net chid arg} { foreach nk $arg { doCtcp $net PING $nk } }
#
proc ircII_/QUERY {net chid arg} {
    set usr [User :: make $net $arg]
    set msg [Message :: make $net [$usr name]]
    $msg show
    if {![$msg isJoined $usr]} { $msg addUser $usr 0 0 }
}
#
proc ircII_/QUIT {net chid arg} { $net doQuit $arg }
#
proc ircII_/QUOTE {net chid arg} {  $net sendRaw $arg }
#
proc ircII_/RAW {net chid arg} {  $net sendRaw $arg }
#
proc ircII_/REDIRECT {net chid arg} { sillyPerson $net }
#
proc ircII_/REHASH {net chid arg} { $net q1Send REHASH }
#
proc ircII_/RESTART {net chid arg} { $net q1Send RESTART }
#
proc ircII_/SAVE {net chid arg} { saverc $net }
#
proc ircII_/SAY {net chid arg} { $chid send $arg }
#
proc ircII_/SEND {net chid arg} { $chid send $arg }
#
proc ircII_/SENDLINE {net chid arg} { sillyPerson $net }
#
proc ircII_/SERVER {net chid arg} {
    set sv [Server :: make $net [lindex $arg 0]]
    switch -regexp -- [set p [lindex $arg 1]] {
      {} {}
      {^[0-9]+$} { $sv configure +port $p }
      default {
	    tellError {} [trans port] {Port number must be numeric!}
	    return
	}
    }
    switch {} [set p [lindex $arg 2]] {} default { $sv configure -passwd $p }
    $net changeServer $sv
}
#
proc setBool {chan var val} {
    upvar #0 $chan cdata
    switch [string toupper $val] \
    ON		{ set cdata($var) 1 }
    OFF		{ set cdata($var) 1 }
    TOGGLE	{ set cdata($var) [expr {!$cdata($var)}] }
}
#
proc ircII_/SET {net chid arg} { 
    switch [string toupper [lindex $arg 0]] \
    BEEP { setBool $chid quiet [lindex $arg 1] } \
    BEEP_MAX { $net configure -beeplimit [lindex $arg 1] } \
    CHANNEL_NAME_WIDTH { $net configure -namewidth [lindex $arg 1] }
}
#
proc ircII_/SIGNOFF {net chid arg} { $net doQuit $arg }
#
proc ircII_/SLEEP {net chid arg} { after [lindex $arg 0] }
#
proc ircII_/SQUIT {net chid arg} {
    set foo [deCap $arg]
    $net SQUIT [lindex $foo 0] [lindex $foo 1]
}
#
proc ircII_/STATS {net chid arg} { $net STATS [lindex $arg 0] [lindex $arg 1] }
#
proc ircII_/SUMMON {net chid arg} { $net q1Send "SUMMON [colonLast $arg]" }
#
proc ircII_/TIME {net chid arg} { $net q1Send "TIME [colonLast $arg]" }
#
proc ircII_/TIMER {net chid arg} {
    upvar #0 timers$net timers
    switch {} $arg {
        foreach x [lsort [array names timers]] {
	    if {[catch {set info [after info $timers($x)]}]} {
	        unset timers($x)
	    } {
	        $net inform "Timer $x : [lindex [lindex $info 0] 2]"
	    }
	}
	return
    }
    set refnum {}
    switch -- [lindex $arg 0] {
    -refnum {
            set refnum [lindex $arg 1]
	    if {[info exists timers($refnum)]} {
	        $net inform "Timer $refnum already exists."
		return
	    }
	    set arg [lrange $arg 2 end]
        }
    -delete {
	    set refnum [lindex $arg 1]
	    if {[info exists timers($refnum)]} {
	    	after cancel $timers($refnum)
		$net inform "Timer $refnum deleted."
		unset timers($refnum)
	    } {
	        $net inform "No such timer as $refnum"
	    }
	    return
	}
    }
    switch {} $refnum {
        set refnum [$net timercount]
	$net configure -timercount [expr {$refnum + 1}]
    }
    set timers($refnum) [after [expr {[lindex $arg 0] * 1000}] \
        "$net eval [list [lrange $arg 1 end]] ; unset timers${net}($refnum)"]
    $net inform "Timer $refnum recorded."
}
#
proc ircII_/TOPIC {net chid arg} { $chid configure -topic $arg}
#
proc ircII_/TRACE {net chid arg} { $net nsend TRACE $arg }
#
proc ircII_/TYPE {net chid arg} { 
    [$chid window].cmd.entry insert insert $arg
}
#
proc ircII_/USERHOST {net chid arg} {
    foreach x $arg {
	if {[string compare -cmd $x]} {$net USERHOST $x} {
	    sillyPerson $net
	    break
	}
    }
}
#
proc ircII_/USERS {net chid arg} { $net send USERS $arg }
#
proc ircII_/VERSION {net chid arg} { $net send VERSION $arg }
#
proc ircII_/WAIT {net chid arg} { sillyPerson $net }
#
proc ircII_/WALLOPS {net chid arg} { sillyPerson $net }
#
proc ircII_/WHICH {net chid arg} { sillyPerson $net }
#
proc ircII_/WHILE {net chid arg} { sillyPerson $net }
#
proc ircII_/WHO {net chid arg} { $net WHO $arg }
#
proc ircII_/WHOIS {net chid arg} { $net q1Send "WHOIS [colonLast $arg]" }
#
proc ircII_/WHOWAS {net chid arg} { $net q1Send "WHOWAS [colonLast $arg]" }
#
proc ircII_/WINDOW {net chid arg} { sillyPerson $net}
#
proc ircII_/XECHO {net chid arg} { sillyPerson $net}
#
proc ircII_/XTYPE {net chid arg} { sillyPerson $net}
#
proc sillyPerson {net} {
    bell
    tellError $net Silly {Don't be silly! This is Zircon!!}
}

