#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Net.tcl,v $
# $Date: 1997/02/28 13:36:20 $
# $Revision: 1.18.1.83 $
#
package provide zircon 1.18
#
global znetList
set znetList {}
#
proc Net {name args} {
    global XTO defaultNet
    switch $name :: {return [eval Net_[lindex $args 0] [lrange $args 1 end] ]}
    set this [objName Net]
    upvar #0 $this ndata
    set XTO([string tolower $name]) $this
    initObj $this Net
    if [info exists defaultNet] {
	array set ndata [array get $defaultNet]
	array set ndata {
	    channels	{}
	    messages	{}
	    notices	{}
	    chats	{}
	    users	{}
	    friends	{}
	    servers	{}
	    services	{}
	}
    }
    proc $this {args} "eval net_call $this \$args"
    set OType($this) Net
    set ndata(name) $name
    eval $this configure $args
    uplevel #0 lappend znetList $this
    return $this
}
#
proc net_eval {this cmd} {
    global currentNet
    set sc $currentNet
    set currentNet $this
    if [catch {set res [eval $cmd]} msg] {
	set currentNet $sc
	error $msg
    }
    set currentNet $sc
    return $res
} 
#
proc net_trimNick {this nk} {
    upvar #0 $this ndata
    if $ndata(nicksize) {
	set uh {}
	regexp {(.*)(@.*)} $nk m nk uh
	return [string range $nk 0 [expr $ndata(nicksize) - 1]]$uh
    }
    return $nk
}
#
proc net_me {this usr} {switch $usr [$this myid] {return 1} ; return 0}
#
proc net_configure {this args} {
    upvar #0 $this ndata
    while {![string match {} $args]} {
	set name [string range [set opt [lindex $args 0]] 1 end]
	set val [lindex $args 1]
	switch -glob -- $opt {
	-startup {
		if ![set ndata(startup) $val] { [$this control] startup	}
	    }
	-nickname { $this setNickname $val }
	-ircname { 
		catch {[$this control] configure -ircname $val}
		set ndata(ircname) $val
		switch {} $ndata(userinfo) {set ndata(userinfo) $val}
	    }
	-ircop {
		set ndata(ircop) $val
		[$this control] ircItems [expr {$val ? {normal} : {disabled}}]
		if $val {
		    set ndata(wallops) 1
		    set ndata(srvmsg) 1
		}
	    }
	-myid {
		switch $val $ndata(myid) {} default {
		    catch {$ndata(myid) deref}
		    set ndata(myid) $val
		    switch nil $val {} default {
			$val ref
			$this setNickname [$val name]
		    }
		}
	    }
	-restricted {
		[$this control] restricted [set ndata(restricted) $val]
	    }
	-busy -
	-invisible -
	-srvmsg -
	-wallops {
		set ndata($name) $val
		catch {[$this control] flagSet $name $val}
	    }
	-popInfo {
		set ndata(popInfo) $val
		catch {$ndata(info) configure -open $val}
	    }
	+* {
		switch {} $val {} default {
		    listincl ndata($name) $val
		}
	    }
	-undernet {
		switch {} [$this control] {} default {[$this control] undernet $val}
		set ndata(undernet) $val
	    }
	-testTime {
		if {$val < 10000} {set val 10000}
		set ndata($name) $val
	    }
	
	-notifyInterval {
		switch 0 $val {} default {if {$val < 10000} {set val 10000}}
		set ndata($name) $val
	    }
	default { set ndata($name) $val }
	}
	set args [lrange $args 2 end]
    }
}
#
proc net_register {this what name} {
    upvar #0 $this ndata
    lappend ndata($what) $name
}
#
proc net_deregister {this what name} {
    upvar #0 $this ndata
    listkill ndata($what) $name
}
#
proc net_setFlag {this flag} {
    $this MODE [$this nickname] \
      [expr {[$this $flag] ? {+} : {-}}][string index $flag 0]
}
#
proc net_toggleFlag {this flag} {
    $this MODE [$this nickname] \
      [expr {[$this $flag] ? {-} : {+}}][string index $flag 0]
}
#
proc net_flagControl {this state} {
    [$this control] flagState $state
    [$this info] flagState $state
}
#
proc net_finfo {this} {
    upvar #0 $this ndata
    return [$ndata(control) friends]
}
#
proc net_setupUsers {this} {
    set frnd [$this finfo]
    foreach frd [$this friends] {
	if [$this friendsOn] { $frd configure -notify 1 }
	if {![$this friendsOn] || [$frd ison]} { $frnd add $frd}
    }
}
#
proc net_fast {this} {
    set txt [[$this info] text]
    $txt configure -cursor arrow
    catch {grab release $txt}
    update idletasks
}
#
proc net_slow {this} {
    set txt [[$this info] text]
    catch {grab set $txt}
    $txt configure -cursor watch
    update idletasks
}
#
proc net_display {this tag txt} { [$this info] addText $tag $txt }
#
proc net_inform {this txt} { [$this info] addText {} "*** $txt" }
#
proc net_warn {this txt} { [$this info] addText @WARN "*** $txt" }
#
proc net_errmsg {this txt} { [$this info] addText @ERROR "*** $txt" }
#
proc net_call {this op args} {
    upvar #0 $this ndata
    switch $op active {switch {} $ndata(sock) {return 0} ; return 1 }
    if [info exists ndata($op)] {return $ndata($op)}
    uplevel #0 set currentNet $this
    return [eval net_$op $this $args]
}
#
proc net_host {this} {
    upvar #0 ${this}(hostid) hostid
    switch nil $hostid {return {}}
    return [$hostid host]
}
#
proc net_doQuit {this msg} {
    $this close $msg 1
    $this dccClean
}
#
proc dontQuit {net args} {
    global DOQ
    set DOQ($net) 0
}
#
proc net_quit {this} {
    global ztrans
    if {[$this active] && ![$this startup]} {
	global DOQ
	set DOQ($this) 1
	set w [mkDialog QUIT .@q$this "Quit [$this name]" \
	  "Really quit [$this name]?" \
	  "{$ztrans(message) {[lindex [$this signoffs] 0]} {} palette}" \
	  "$ztrans(ok) {$this doQuit}" "$ztrans(cancel) {dontQuit $this }"]
	switch {} $w {} default {catch {tkwait window $w}}
	return $DOQ($this)
    } {
	$this doQuit {}
    }
    return 1
}
#
proc net_show {this} {
    upvar #0 $this ndata
    switch {} $ndata(info) {
	set ndata(info) [Info info$this -net $this]
	set ndata(control) [Control ctl$this -net $this]
    }
    $this flagControl disabled
    $this setupUsers
}
#
proc net_startIRC {this srv args} {
    switch nil $srv {return 0}
    global connected zircon ztrans
    upvar #0 $this ndata
    $this show
    set server [$srv host]
    $this configure -ircop 0 -msgQueue {} -msgQTag {} -sysQueue {} \
      -hostid $srv -motdSeen 0
    set ctl [$this control]
    set ports [$srv port]
    switch {} $args {} default {
	switch [set pt [lindex $args 0]] [lindex $ports 0] {} default {
	   set ports $pt
	}
    }
    foreach port $ports {
	$ctl showServer $srv $port
	$this inform "Connecting to port $port of server $server"
	update idletasks
	$this slow
	set ndata(sock) {}
	if {[catch {socket -async $server $port} sock]} {
	    $this errmsg "Cannot connect to port $port of server $server ($sock)"
	    set ndata(sock) {}
	    $this fast
	    update
	    continue
	}
	$this fast
	fileevent $sock writable \
	  "sconf $sock ; $this cCheck $sock ; $this afterCon $sock"
	$ctl setQuit abort "$this abort $sock"
	set connected($this) 0
	vwait connected($this)
	if [set res [expr {$connected($this) != 2}]] {
	    $ctl setQuit close "$this quit"
	    return $res
	}
	$ctl setQuit open "$ctl open"
	retitleFrame .@ctl $this [$this name] 1
	retitleFrame .@inf [$this info] [$this name] 1
    }
    return 0
}
#
proc net_abort {this sock} {
    global ztrans
    close $sock
    uplevel #0 set connected($this) 2
}
#
proc net_cCheck {this sock} {
    uplevel #0 set connected($this) 1
    fileevent $sock writable {}
}
#
proc net_getIrcname {this} {
    upvar #0 $this ndata
    global user host
    switch {} [set n $ndata(ircname)] {set ndata(ircname) [set n %u@%h]}
    regsub -all %u $n $user n
    regsub -all %h $n $host n
    return $n
}
#
proc net_afterCon {this sock} {
    global user host STN DEBUG
    upvar #0 $this ndata
    set STN($sock) $this
    set ndata(sock) $sock
    set srv $ndata(hostid)
    switch nil $srv {$this closeSock $sock ; return 0}
    if ![info exists host] {set host [info hostname]}
    set server [$srv host]
    set passwd [$srv passwd]
    foreach ln [$srv script] { puts -nonewline $sock "$ln\n" }
    fileevent $sock readable "ircInput r $sock" 
    switch {} $passwd {} default {$this qSend PASS :$passwd}
    $this qSend USER $user $host $server :[$this getIrcname]
    $this qSend NICK $ndata(nickname)
    if !$ndata(noRefresh) { $this channelList { } }
    retitleFrame .@inf [$this info] [set msg "[$this name] - [$this host]"] 1
    retitleFrame .@ctl $this $msg 1
    $this configure -startup 1
    if $DEBUG { zDBGRet $this }
    return 1
}
#
proc net_changeServerPort {this srv prt} {
    foreach x [$this servers] {
	if {![string compare [$x host] $srv] && \
	  ![string compare [$x port] $prt]} {
	    $this changeServer $x
	    return
	}
    }
    $this changeServer [Server $srv -port $prt]
}
#
proc net_changeServer {this srv args} {
    global zircon connected
    if {[info exists connected($this)] && $connected($this) == 0} {
	bell
	[$this control] showServer [$this hostid]
	return
    }
    if [$this active] {
	$this inform "Closing connection to [$this host]"
	$this closeSock {Changing Servers}
	$this flagControl disabled
	foreach x {channels messages notices} {
	    foreach ch [$this $x] { $ch flag disabled }
	}
	$this irc305
	set zircon(j) 0
	$this inform "About to connect to [$srv host]"
	after 3000
    }
    $this startIRC $srv
}
#
proc showFull {net w x y yl} {
    upvar #0 $net ndata
    set chan [lindex $ndata(allChannels) [$w nearest $yl]]
    set w [toplevel .@lt$net -class Zircon]
    wm overrideredirect $w 1
    wm geometry $w +$x+$y
    pack [label $w.l -text $chan -bg yellow] -ipadx 3 -ipady 3
}
#
proc listClear {net w} {
    global $net
    $w.chn.l delete 0 end
    set ${net}(allChannels) {}
    catch {destroy .lt$net}
}
#
proc net_channelList {this doit} {
    global showList ztrans
    upvar #0 $this ndata
    set ndata(allChannels) {}
    set w .@l$this
    if ![winfo exists $w] {
	toplevel $w -class Zircon
	wm title $w "[$this name] Channel List"
	wm iconname $w "[$this name] Channel List"
	wm protocol $w WM_DELETE_WINDOW "catch {unset lcount($this)}"
	frame $w.filter -relief raised
	checkbutton $w.filter.public -variable ${this}(showPublic) \
	  -text $ztrans(public)
	checkbutton $w.filter.local -variable ${this}(showLocal) \
	  -text $ztrans(local)
	checkbutton $w.filter.private -variable ${this}(showPrivate) \
	  -text $ztrans(private)
	checkbutton $w.filter.topic -variable ${this}(topicOnly) \
	  -text {With Topic}
	checkbutton $w.filter.sorted -variable ${this}(sorted) \
	  -text $ztrans(sorted)
	checkbutton $w.filter.nocase -variable ${this}(nocase) -text {Ignore Case}

	scale $w.filter.minm \
	  -from 1 -to 25 -label {Minimum Number of Members} \
	  -showvalue 1 -orient horizontal \
	  -command "set ${this}(minMembers)"

	$w.filter.minm set $ndata(minMembers)

	grid $w.filter.minm - - -sticky ew
	scale $w.filter.maxm \
	  -from 0 -to  50 -label {Maximum Number of Members} \
	  -showvalue 1 -orient horizontal \
	  -command "set ${this}(maxMembers)"
	$w.filter.maxm set $ndata(maxMembers)

	grid $w.filter.maxm - - -sticky ew
	grid $w.filter.public $w.filter.local $w.filter.private -sticky w
	grid $w.filter.topic $w.filter.sorted $w.filter.nocase -sticky w
	labelEntry 0 $w.filter2 {-text Channel} [$this listPattern] {}
	labelEntry 0 $w.filter3 {-text Topic} [$this topicPattern] {}
	$w.filter2.entry configure -textvariable ${this}(listPattern)
	$w.filter3.entry configure -textvariable ${this}(topicPattern)
	makeLB $w.chn -width 20 -height 8
	frame $w.btn
	button $w.btn.ok -text $ztrans(dismiss) -relief raised \
	  -command "destroy $w ; catch {destroy .@lt$this}"
	button $w.btn.clear -text $ztrans(clear) -relief raised \
	  -command "listClear $this $w"
	button $w.btn.list -text $ztrans(list) -relief raised \
	  -command "listBC $w $this {}"
	pack $w.btn.list $w.btn.clear $w.btn.ok -side left -expand 1 -fill x
	grid columnconfigure $w 0 -weight 1
	grid rowconfigure $w 3 -weight 1
	grid $w.filter -sticky ew
	grid $w.filter2 -sticky ew
	grid $w.filter3 -sticky ew
	uplevel #0 set lcount($this) 0
#	grid [label $w.count -textvariable lcount($this) -relief raised] -sticky ew
	grid $w.chn -sticky nsew
	grid $w.btn -sticky ew
	bind $w.chn.l <Double-Button-1> "
	    notIdle $w $this
	    channelJoin $this \[lindex \$${this}(allChannels) \[%W nearest %y\]\] {}
	    break
	"
	bind $w.chn.l <ButtonPress-2> "
	    notIdle %W $this
	    showFull $this %W %X %Y %y
	    break
	"
	bind $w.chn.l <ButtonRelease-2> "notIdle %W $this ; catch {destroy .@lt$this}; break"
	bind $w.chn.l <Button-1> "
	    notIdle $w $this
	    [$this control] configure -channel \[lindex \$${this}(allChannels) \[%W nearest %y\]\]
	    break
	"
    } {
	popup $w
	switch {} $doit {} default {$w.chn.l delete 0 end}
    }
    set showList 0
    switch {} $doit {} default {
	listBC $w $this $doit
	set showList 1
    }
}
#
proc listBC {w net chan} {
    upvar #0 $net ndata
    $w.chn.l delete 0 end
    catch {grab set $w}
    $w configure -cursor watch
    $w.btn.list configure -state disabled
    switch {} ndata(listPattern) {
	set ndata(listPattern) .*
    } default {
	if {[catch {regexp $ndata(listPattern) test} msg]} {
	    set ndata(listPattern) .*
	    tellError {} Error "Bad regexp for list pattern:\n$msg"
	}
    }
    switch {} $ndata(topicPattern) {
	set ndata(topicPattern) .*
    } default {
	if {[catch {regexp $ndata(topicPattern) test} msg]} {
	    set ndata(topicPattern) .*
	    tellError {} Error "Bad regexp for topic pattern:\n$msg"
	}
    }
    foreach x {filter2.entry filter3.entry filter.public filter.local
      filter.topic filter.sorted filter.nocase filter.private
      filter.maxm filter.minm} {
	$w.$x configure -state disabled
    }
    set ndata(allChannels) {}
    set pbdy {global showList
    upvar #0 $net ndata
    regsub -all "\t" $pargs "\\\t" pargs
    set chan [lindex $pargs 1]
    set w .@l$net
    set memb [lindex $pargs 2]
    }
    append pbdy "if !\$showList \{switch -glob -- \$chan {\\*} "
    if $ndata(showPrivate) {
	append pbdy {{set chan Prv}}
    } {
	append pbdy {return}
    }
    if !$ndata(showLocal) {append pbdy { &* return}}
    if !$ndata(showPublic) {append pbdy { {[#+]*} return}}
    if $ndata(topicOnly) {append pbdy { ; switch {} $param return}}
    if {$ndata(minMembers) > 1 || $ndata(maxMembers) > 0} {
	if {$ndata(minMembers) > 1} {
	    append pbdy { ; if {$memb < $ndata(minMembers)} return}
	}
	if {$ndata(maxMembers) > 0} {
	    append pbdy { ; if {$memb > $ndata(maxMembers)} return}
	}
    }
    switch .* $ndata(listPattern) {} default {
	append pbdy { ; if ![regexp -nocase $ndata(listPattern) $chan] return}
    }
    switch .* $ndata(topicPattern) {} default {
	append pbdy { ; if ![regexp -nocase $ndata(topicPattern) $param] return}
    }
    append pbdy " \} ; "
    append pbdy {$net configure +allChannels $chan
    if ![catch {set lln \
	"[format {%-12s %3d %s} [string range $chan 0 11] $memb $param]"}] {
	  $w.chn.l insert end $lln
    }
    }
    proc doChkList {net pargs param} $pbdy
    if [$net undernet] { underList $net $chan } {
	switch {} $chan {$net q1Send LIST} default {$net qSend LIST :$chan}
    }
}
#
proc net_irc321 {this args} {
    if ![winfo exists .@l$this] return
    global zircon lcount
    upvar #0 ${this}(listFile) lf
    if [catch {open [file join [tmpdir] list[pid]] w+} lf] {
	set lf {}
    }
    set lcount($this) 0
}
#
proc net_irc322 {this prefix param pargs} {
    if ![winfo exists .@l$this] return
    uplevel #0 incr lcount($this)
    upvar #0 ${this}(listFile) lf
    switch {} $lf {doChkList $this $pargs $param} default {
	puts $lf $pargs
	puts $lf $param
    }
}
#
proc net_listline {this pargs param} {
    global showList
    upvar #0 $this ndata
    regsub -all "\t" $pargs "\\\t" pargs
    set chan [lindex $pargs 1]
    set w .@l$this
    if !$showList {
	switch -glob -- $chan {
	{\*}  {if !$ndata(showPrivate) return {set chan Prv }}
	&*  {if !$ndata(showLocal) return}
	{[#+]*} {if !$ndata(showPublic) return}
	}
    }
    set memb [lindex $pargs 2]
    set max 1000000
    if {$ndata(maxMembers) > 0} { set max $ndata(maxMembers) }
    if !$showList {
	switch {} $param { if $ndata(topicOnly) return }
	if {$memb < $ndata(minMembers) || $memb > $max} return
	if ![regexp -nocase $ndata(listPattern) $chan] return
	if ![regexp $ndata(topicPattern) $param] return
    }
    $this configure +allChannels $chan
    if ![catch {set lln \
	"[format {%-12s %3d %s} [string range $chan 0 11] $memb $param]"}] {
	  $w.chn.l insert end $lln
    }
}
#
proc net_irc323 {this prefix param pargs} {
    global showList zircon
    upvar #0 ${this}(listPattern) listPattern \
      ${this}(topicPattern) topicPattern $this ndata
    set showList 0
    set w .@l$this
    catch {grab release $w}
    catch {$w configure -cursor arrow}
    switch {} [set fd $ndata(listFile)] {} default {
	update
	if [winfo exists $w] {
	    seek $fd 0 start
	    set lcount -50
	    if $ndata(sorted) {
		while {![eof $fd]} {
		    lappend lst [list [gets $fd] [gets $fd]]
		    if ![incr lcount] {
			update
			if ![winfo exists $w] break
			set lcount -50
		    }
		}
		set lcount -50
		foreach x [if $ndata(nocase) {lsort -command noCase $lst} \
		  {lsort $lst}] {
		    doChkList $this [lindex $x 0] [lindex $x 1]
		    if ![incr lcount] {
			update
			if ![winfo exists $w] break
			set lcount -50
		    }
		}
	    } {
		while {![eof $fd]} {
		    doChkList $this [gets $fd] [gets $fd]
		    if ![incr lcount] {
			update
			if ![winfo exists $w] break
			set lcount -50
		    }
		}
	    }
	}
	catch {filedelete [file join [tmpdir] list[pid]] }
	close $fd
	set ndata(listFile) {}
    }
    foreach x {filter2.entry filter3.entry filter.public filter.local
      filter.topic filter.sorted filter.nocase filter.private
      filter.maxm filter.minm btn.list} {
	catch {$w.$x configure -state normal}
    }
}
#
proc noCase {t1 t2} {
    return [string compare [string tolower $t1] [string tolower $t2]]
}
#
proc net_deIRCOp {this} { $this MODE [$this nickname] -o}
#
proc net_setNickname {this nk} {
    set nk [$this trimNick $nk]
    upvar #0 $this ndata
    catch {$ndata(control) configure -nickname $nk}
    set ndata(nickname) $nk
    switch nil [set myid [$this myid]] {} default {
        switch -- [$myid name] $nk {} default {
	    foreach x {channels messages notices chats} {
		foreach id [$this $x] { $id nickChange $myid $nk }
	    }
	    $myid rename $nk
	}
    }
    set ndata(nickwait) 0
}
#
proc net_changeNickname {this nk} {
    if [$this active] {
	$this NICK $nk
	$this configure -nickwait 1
    } { $this setNickname $nk }
}
#
proc net_changeIRCName {this name} {
    $this configure -ircname $name
    if [$this active] {
	tellInfo Warning {Change will not take effect until next server change.}
    }
}
#
proc net_irc305 {this} {
    upvar #0 $this ndata
    if !$ndata(busy) {[$this control] blackit away}
    set ndata(away) 0
}
#
proc net_irc306 {this} {
    upvar #0 $this ndata
    [$this control] redit away
    set ndata(away) 1
}
#
proc net_close {this args} {
    global zircon ztrans connected
    catch {destroy .@ne$this}
    upvar #0 $this ndata
    set connected($this) 2
    set qmsg {}
    set recon [$this active]
    switch nil [set srv $ndata(hostid)] {
	set host {}
	set port 6667
    } default {
	set host [$srv host]
	set port [$srv port]
    }
    switch [llength $args] {
    2 {set msg {} ; set qmsg [lindex $args 0] ; set recon 0}
    1 { set msg [lindex $args 0] }
    0 { set msg "Server $host has closed the connection." }
    }
    foreach x $ndata(splits) { $this cleanSplit $x }
    $this closeSock $qmsg
    $this flagControl disabled
    foreach x {channels messages notices} {
	foreach id $ndata($x) { $id flag disabled }
    }
    $this irc305
    set zircon(j) 0
    handleOn $this CLOSE [list $host $port]
    if $recon {
	bell
	if [$this reconnect] {startReconn $this $srv $msg} \
	elseif {[$this srvcycle]} {
	    set s $ndata(servers)
	    set pos [lsearch $s $srv]
	    incr pos
	    switch {} [set srv [lindex $s $pos]] {set srv [lindex $s 0]}
	    after 0 $this doReconnect $srv
	} {
	    if [askUser SHUT $ztrans(shutdown) "$msg\nReconnect?"] {
	      after 0 $this doReconnect $srv
	    }
	}
    }
}
#
proc startReconn {net srv msg} {
    global ztrans
    upvar #0 $net ndata
    if ![winfo exists .@cl$net] {
	mkDialog {} .@cl$net $ztrans(shutdown) \
	  "$msg - $ztrans(reconnecting)." {} \
	  "{Stop trying} {stopReconn $net}"
    }
    set ndata(reconaft) [after 5000 $net doReconnect $srv]
}
#
proc stopReconn {net} {
    upvar #0 $net ndata
    catch {after cancel $ndata(reconaft)}
    catch {unset $ndata(reconaft)}
}
#
proc net_doReconnect {this srv} {
    if {![$this startIRC $srv] && [$this reconnect]} {
	after 0 startReconn $this $srv {{}}
    }
}
#
proc net_deMonitor {this chan} {
    upvar #0 $this ndata
    listkill ndata(monitorlst) $chan
    switch {} $ndata(monitorlst) {after cancel "$this monitorTest"}
}
#
proc net_monitor {this chan} {
    switch {} $chan return
    if ![[set chid [Channel :: make $chan $this]] active] {
	upvar #0 $this ndata
	set chan [$chid lname]
	listincl ndata(monitorlst) $chan
	$chid configure -monitor 1
	$this monitorTest
    }
}
#
proc net_monitorTest {this} {
    upvar #0 $this ndata
    switch {} $ndata(monitorlst) return
    $this NAMES [join [split $ndata(monitorlst)] ,]
    after $ndata(monitorTime) "$this monitorTest"
}
#
proc net_setupTests {this} {
    upvar #0 $this ndata
    $this ISON
    upvar #0 $this ndata
    if $ndata(ping) {
	set ndata(pinged) 0
	after $ndata(ping) "$this pingTest"
    }
    $this monitorTest
    if $ndata(notifyInterval) {after $ndata(notifyInterval) "$this isonTest"}
    after $ndata(testTime) "$this ircTests"
}
#
proc net_ircTests {this} {
    global zircon MkOp
    upvar #0 $this ndata
    incr ndata(idle) [expr {$ndata(testTime) / 1000}]
    if {!$ndata(away) && $ndata(autoAway) && $ndata(idle) > $ndata(autoAway)} {
	$this AWAY {is away}
    }
    foreach id [array names MkOp] {
	if {![string match {} [info procs $id]] && \
	  [$id active] && [$id operator]} {
	    set flag +
	    set who {}
	    set ind -1
	    foreach n $MkOp($id) {
		if ![$id isOp $n] {
		    incr ind
		    lappend who [$n name]
		    $n deref
		    append flag o
		    switch +ooo $flag {
			set who [lreplace $who $ind $ind :[lindex $who $ind]]
			$this sysQ "MODE [$id name] +ooo $who"
			set ind -1
			set who {}
			set flag +
		    }
		}
	    }
	    switch {} $who {} default {
		set who [lreplace $who $ind $ind :[lindex $who $ind]]
	    	$this sysQ "MODE [$id name] $flag $who"
	    }
	}
	unset MkOp($id)
    }
    dccCheck $this $ndata(testTime)
    after $ndata(testTime) "$this ircTests"
}
#
proc net_isonTest {this} {
    upvar #0 $this ndata
    $this ISON
    if $ndata(notifyInterval) {after $ndata(notifyInterval) "$this isonTest"}
}
#
proc net_pingTest {this} {
    upvar #0 $this ndata
    set nm [$this host]
    if $ndata(pinged) {
	$this close "Server $nm is not responding - closing the connection"
    } {
	$this PING $nm
	set ndata(pinged) 1
	after $ndata(ping) "$this pingTest"
    }
}
#
proc Net_list {} { global znetList ; return $znetList }
#
proc net_newSplit {this split} {
    global Split TSplit Heal
    upvar #0 $this ndata
    $ndata(info) optText SPLIT "*** Netsplit - $split"
    set TSplit($split) [after 600000 $this cleanSplit "{$split}"]
    catch {after cancel $Heal($split) ; unset Heal($split)}
    handleOn $this SPLIT $split
    lappend ndata(splits) [list $split]
}
#
proc net_cleanSplit {this h} {
    global Split Heal TSplit
    upvar #0 $this ndata
    if [info exists Split($h)] {
	set frnd [$this finfo]
	foreach user $Split($h) {
	    if [catch {set nk [$user name]}] continue
	    foreach x {Chat Message Notice} {
		switch nil [set msg [$x :: find $nk $this]] {} default {
		    if [$msg active] {
			$msg flag normal
			$msg addText {} \
			  "*** netsplit : $nk may have left IRC."
		    }
		}
	    }
	    foreach id [$this channels] {
		if {[$id isJoined $user] &&
		  ![normal [$id window].uFrm.userBtn.$user]} {
		    $id killUser $user
		} elseif {[$id monitor]} {
		    catch {destroy .@mon$id.users.userList.$user}
		}
	    }
	    $frnd remove [$user fobj]
	    $user deref
	}
	unset Split($h)
	listkill ndata(splits) [list $h]
    }
    catch { after cancel $TSplit($h) ; unset TSplit($h) }
    catch { after cancel $Heal($h) ; unset Heal($h) }
}
#
proc net_setMode {this chan mode args} {
    $this MODE $chan $mode [lindex $args 0]
}
#
# IRC Command procs
#
#
proc net_WHOIS {this nk args} {
    switch {} $nk return
    switch {} $args {$this qSend WHOIS :$nk} default {$this qSend WHOIS [lindex $args 0] :$nk}
}
#
proc net_WHOWAS {this nk args} {
    switch {} $nk return
    switch {} $args {$this qSend WHOWAS :$nk} default {$this qSend WHOWAS $nk :[lindex $args 0]}
}
#
proc net_INFO {this args} {
    switch {} $args {$this q1Send INFO} default {$this qSend INFO :[lindex $args 0]}
}
#
proc net_ISON {this} {
    if ![$this active] return
    set ns {}
    foreach x [$this friends] {	if [$x notify] { append ns " [$x name]"}}
    switch {} $ns return
    $this sysQ "ISON :$ns"
}
#
proc net_SQUIT {this srv} { $this qSend SQUIT :$srv }
#
proc net_TIME {this nk} { $this qSend TIME :$nk }
#
proc net_msg {this where what} { $this qSend PRIVMSG $where :$what }
#
proc net_PRIVMSG {this where what} { $this qSend PRIVMSG $where :$what }
#
proc net_NOTICE {this where what} {
    switch {} $where return
    switch {} $what return
    $this qSend NOTICE $where :$what
}
#
proc net_INVITE {this who where} {
    switch {} $who return
    switch {} $where return
    $this qSend INVITE $who :$where
}
#
proc net_KILL {this who why} { $this qSend KILL $who :$why }
#
proc net_KICK {this where who args} {
    switch {} $args {$this qSend KICK $where :$who} default {$this qSend KICK $where $who :[lindex $args 0]}
}
#
proc net_STATS {this p1 p2} { $this qSend STATS $p1 :$p2 }
#
proc net_USERHOST {this nk} { $this qSend USERHOST :$nk }
#
proc net_NICK {this name} {
    if [$this startup] {
	$this setNickname $name
    }
    $this qSend NICK :$name
}
proc net_MODE {this who mode args} {
    switch [llength $args] {
    0 {	$this qSend MODE $who :$mode }
    1 {	$this qSend MODE $who $mode :[lindex $args 0] }
    default { error "MODE Called with too many parameters" }
    }
}
#
proc net_CONNECT {this srv port remote} {
    switch {} $srv return
    $this qSend CONNECT $srv $port :$remote
}
#
proc net_LINKS {this srv mask} {
    switch {} $srv {
	switch {} $mask {$this q1Send LINKS} default {$this qSend LINKS [$this host] :$mask}
    } default {
	switch {} $mask {$this qSend LINKS :$srv} default {$this qSend LINKS $srv :$mask}
    }
}
#
proc net_nsend {this cmd par} {
    switch {} $par {$this q1Send $cmd} default {$this qSend $cmd :$par}
}
#
proc net_AWAY {this args} {
    switch {} $args {$this q1Send AWAY} default {$this qSend AWAY :[join $args]}
}
#
proc net_TOPIC {this chan args} {
    switch {} $args {$this qSend TOPIC :$chan} default {$this qSend TOPIC $chan :[lindex $args 0]}
}
#
proc net_CTCP {this cmd nk str} {
    switch {} $str {
	$this qSend PRIVMSG $nk ":\001$cmd\001"
    } default {
	$this qSend PRIVMSG $nk ":\001$cmd $str\001"
    }
}
#
proc net_PART {this chan args} {
    switch {} $args {$this qSend PART :$chan} default {$this qSend PART $chan :[lindex $args 0]}
}
#
proc net_OPER {this nk str} {
    switch {} $str return
    $this qSend OPER  $nk :$str
}
#
proc net_NAMES {this chan} { $this qSend NAMES :$chan }
#
proc net_PING {this srv} { $this qSend PING :$srv}
#
proc net_error {this prefix param pargs} {
    set hst [$this host]
    if [$this startup] {
	set msg "Cannot connect to $hst : $param"
    } {
	set msg "Closing connection to $hst, ERROR : $param"
    }
    $this close $msg
}
#
proc net_sysQ {this req} {
    upvar #0 $this ndata
    switch {} $ndata(sysQueue) {
	set ndata(sysQueue) [list $req]
	after cancel $ndata(msgQTag)
	set ndata(msgQTag) [after $ndata(sysQDelay) "$this popQueue"]
    } default {
	lappend ndata(sysQueue) $req
    }
}
#
proc net_delete {this} {
    $this quit
    foreach x {channels notices messages chats servers friends services} {
	foreach y [$this $x] { $y delete }
    }
    foreach x [$this users] { $x configure -ref 0 ; $x delete }
    deleteFrame .@ctl $this
    deleteFrame .@inf [$this info]
    catch {deleteFrame .@dbgctl $this}
    global XTO OType $this znetList
    unset XTO([string tolower [$this name]]) OType($this) $this
    listkill znetList $this
}
#
proc net_squery {this} {
    global ztrans
    mkEntryBox {} Squery {Enter your query} \
      "{$ztrans(service) {}} {$ztrans(query) {}}" \
      "$ztrans(ok) {$this SQUERY}" \
      "$ztrans(cancel) {}"}
#
proc net_servlist {this} {
    global ztrans
    mkEntryBox {} ServList {Enter your list request:} \
      "{$ztrans(name) {}} {$ztrans(type) {}}" \
      "$ztrans(ok) {$this SERVLIST}" \
      "$ztrans(cancel) {}"
}
#
proc net_SQUERY {this sv qr} {
    switch {} $sv return
    switch {} $qr return
    $this qSend SQUERY "$sv :$qr"
}
#
#
proc net_SERVLIST {this n t} {
    switch {} $n return
    switch {} $t return
    $this qSend SERVLIST "$n :$t"
}

