#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Net.tcl,v $
# $Date: 2002/05/09 21:18:00 $
# $Revision: 1.18.1.172 $
#
package provide zircon 1.18
#
proc Net {name args} {
    global XTO defaultNet
    switch $name :: {return [eval Net_[lindex $args 0] [lrange $args 1 end] ]}
    set this [makeObj Net $args]
    upvar #0 $this ndata
    set XTO([string tolower $name]) $this
    if {[info exists defaultNet]} {
        # FRINK : nocheck
	array set ndata [array get $defaultNet]
	array set ndata {
	    channels	{}
	    messages	{}
	    notices	{}
	    chats	{}
	    users	{}
	    friends	{}
	    servers	{}
	    services	{}
	    info	{}
	    control	{}
	    listid	{}
	}
    }
    foreach x {Get Send Resume Offer AChat} {
	uplevel #0 trace variable $x$this u unsetSGO
    }
    set ndata(name) $name
    uplevel #0 lappend znetList $this
    return $this
}
#
proc net_call {this op pars} {
    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 $pars]
}
#
proc net_channelList {this chn} {
    $this configure -allChannels {} -showlist 0
    [set lst [$this listid]] show
    switch {} $chn {} default {
    	$lst configure -channel $chn
	$lst doit
	$this configure -showlist 1
    }
}
#
proc net_irc321 {this args} { [$this listid] irc321 }
#
proc net_irc322 {this prefix param pargs} {
    [$this listid] irc322 $prefix $param $pargs
}
#
proc net_irc323 {this unusedprefix unusedparam unusedpargs} { [$this listid] process }
#
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
    foreach {opt val} $args {
	set name [string range $opt 1 end]
	switch -glob -- $opt {
	-lagmeter {
		if {$val && $ndata(ping) == 0} {
		    set ndata(ping) 30000
		}
		set ndata(lagmeter) $val
	    }
	-toInfo -
	-noConfirm {
		set ndata($name) {}
		foreach x $val {lappend ndata($name) [string toupper $x]}
	    }
	-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}
	    }
	-gircop -
	-ircop {
		set ndata(ircop) $val
		[$this control] ircItems [expr {$val ? {normal} : {disabled}}]
		if {$val} {
		    set ndata(wallops) 1
		    set ndata(srvmsg) 1
		} {
		    set ndata(gircop) 0
		}
		switch -- $opt -gircop { set ndata(gircop) $val }
	    }
	-myid {
		if {$val != $ndata(myid)} {
		    catch {$ndata(myid) deref}
		    set ndata(myid) $val
		    if {{nil} != $val} {
			$val ref
			$this setNickname [$val name]
		    }
		}
	    }
	-restricted {
		if {!$ndata(norestrict)} {
		   [$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 }
	}
    }
}
#
proc net_register {this what name} {
    uplevel #0 lappend ${this}($what) $name
}
#
proc net_deregister {this what name} {
    uplevel #0 listkill ${this}($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
    switch {} $ndata(control) { return nil }
    return [$ndata(control) friends]
}
#
proc net_setupUsers {this} {
    set frnd [$this finfo]
    foreach frd [$this friends] {
	if {[$this friendsOn]} { $frd configure -notify 1 }
	switch nil $frnd {} default {
	    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 @INFO "*** $txt" }
#
proc net_warn {this txt} { [$this info] addText @WARN "*** $txt" }
#
proc net_errmsg {this txt} { [$this info] addText @ERROR "*** $txt" }
#
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} {
    if {[$this active] && ![$this startup]} {
	global DOQ
	set DOQ($this) 1
	set w [mkDialog QUIT .@q$this "Quit [$this name]" \
	  "Really quit [$this name]?" \
	  [list [list message [lindex [$this signoffs] 0] {} palette]] \
	  "ok {$this doQuit}" "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(control) [Control -net $this]
	set ndata(info) [Info -net $this]
	set ndata(listid) [List -net $this]
    }
    $this flagControl disabled
    $this setupUsers
}
#
proc net_startIRC {this srv args} {
    switch nil $srv {return 0}
    global connected zircon
    upvar #0 $this ndata
    $this show
    set server [$srv host]
    $this configure -ircop 0 -msgQueue {} -msgQTag {} -sysQueue {} \
      -hostid $srv -motdSeen 0 closing {} -whohandler {} -uhhandler {}
    set ctl [$this control]
    set ost [$ctl openState]
    set ports [$srv selport]
    set noret 0
    switch -- $args {} {} -noretry { set noret 1} default {
	$srv configure +port [lindex $args 0]
    }
    set enc [$srv encoding]
    while {1} {
	while {1} {
	    set port [$srv selport]
	    $ctl showServer $srv $port
	    switch [set scmd [$this sockcmd]] socket {
		foreach x {myaddr myport} {
		    switch {} $ndata($x) {} default {
			append scmd " -$x $ndata($x)"
		    }
		}
	    } default {
		switch {} [set ip [$srv ip]] {
		    $this errmsg "No IP address for host $server. Cannot use SOCKS."
		    return 0
		}
		set server $ip
	    }
	    $this inform "Connecting to port $port of server $server"
	    update idletasks
	    $this slow
	    set ndata(sock) {}
	    if {[catch {eval "$scmd -async $server $port"} sock]} {
		$this errmsg "Cannot connect to port $port of server $server ($sock)"
		set ndata(sock) {}
		$this fast
		update
		set rtc 2
	    } {
		$ctl setQuit abort "$this abort $sock"
		$this fast
		fileevent $sock writable "sconf $sock [list $enc]; $this afterCon $sock"
		set connected($this) 0
		vwait connected($this)
		set rtc $connected($this)
		unset connected($this)
		if {$rtc < 2} {
		    $ctl setQuit close "$this quit"
		    return 1
		}
		$ctl setQuit open "$ctl open"
		$ctl setOpen $ost
	    }
	    if {$rtc == 2} {
	    	$this inform {Connection attempt failed}
		retitleFrame [MainControl] $this [$this name] $this 1
		if {!$ndata(integrate)} {
		    retitleFrame [MainInfo] [$this info] [$this name] $this 1
		}
	    } {
	    	$this inform {Connection attempt aborted}
		retitleFrame [MainControl] $this [$this name] $this 1
		if {!$ndata(integrate)} {
		    retitleFrame [MainInfo] [$this info] [$this name] $this 1
		}
	    }
	    switch {} [$srv nextPort] break
	}
	$ctl showServer $srv [lindex $ports 0]
	if {$noret} { return 0}
	if {$rtc == 2} {
	    if {![askUser NOCON [trans connect] \
	      "Cannot connect to any ports of $server.\nTry again?"]} {
		return 0
	    }
	}
    }
    # PRAGMA: notreached
}
#
proc net_abort {this sock} {
    fileevent $sock writable {}
    close $sock
    uplevel #0 set connected($this) 3
}
#
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
    fileevent $sock writable {}
    upvar #0 $this ndata
    set STN($sock) $this
    set ndata(sock) $sock
    set srv $ndata(hostid)
    switch nil $srv {$this closeSock {} ; return }
    if {![info exists host]} {set host [info hostname]}
    set server [$srv host]
    set passwd [$srv passwd]
    foreach ln [$srv script] { if {[catch {$this q1Send $ln}]} return}
    fileevent $sock readable "ircInput r $sock" 
    switch {} $passwd {} default { if {[$this q1Send "PASS $passwd"]} return}
    if {[$this q1Send "USER $user $host $server :[$this getIrcname]"]} {
	# not connected....
	return
    }
    if {[$this q1Send "NICK $ndata(nickname)"]} {
	# connection dropped after USER
	return
    }
    uplevel #0 set connected($this) 1
    retitleFrame [MainControl] $this [set msg "[$this name] - [$this host]"] $this 1
    if {!$ndata(integrate)} {
        retitleFrame [MainInfo] [$this info] $msg $this 1
    }
    $this configure -startup 1
    if {$DEBUG} { zDBGRet $this }
}
#
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]} {
	set host [$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
	switch {} [$this closing] {} default {
	    $this inform "Waiting for $host to close."
	    uplevel #0 vwait ${this}(closing)
	}
    }
    $this startIRC $srv
}
#
proc net_deIRCOp {this} {
    if {[$this gircop]} { set md -o } { set md -O }
    $this MODE [$this nickname] $md
}
#
proc net_setNickname {this nk} {
    set nk [$this trimNick $nk]
    upvar #0 $this ndata
    catch {$ndata(control) confirmNick $nk}
    set ndata(nickname) $nk
    if {{nil} != [set myid [$this myid]]} {
	if {[$myid name] != $nk} {
	    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
	if {![$this nickwait]} {
	    [$this control] flagNick 
	    $this configure -nickwait 1
	}
    } { $this setNickname $nk }
}
#
proc net_changeIRCName {this name} {
    $this configure -ircname $name
    if {[$this active]} {
	tellInfo $this 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 connected
    catch {destroy .@ne$this}
    upvar #0 $this ndata
    set start 0
    if {[info exists connected($this)]} {
	set connected($this) 2
	set start 1
    }
    set qmsg {}
    set recon [$this active]
    switch nil [set srv $ndata(hostid)] {
	set host {}
	set port 6667
    } default {
	set host [$srv host]
	set port [[$this control] port]
    }
    switch [llength $args] {
    2 {set msg {} ; switch {} [set qmsg [lindex $args 0]] { set qmsg { }}; 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
    $this configure -restricted 0
    foreach x {channels messages notices} {
	foreach id $ndata($x) { $id flag disabled }
    }
    $this irc305
    if {!$start} {
	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 {[listmember [$this alwayslog] CLOSE]} {$this inform $msg}
		if {[askUser SHUT [trans shutdown] "$msg\nReconnect?"]} {
		    set ndata(reconaft) [after 5000 $this doReconnect $srv]
		}
	    }
	}
    }
}
#
proc startReconn {net srv msg} {
    upvar #0 $net ndata
    if {![winfo exists .@cl$net]} {
	mkDialog {} .@cl$net [trans shutdown] \
	  "$msg - [trans reconnecting]." {} \
	  "{Stop trying} {stopReconn $net}"
    }
    set ndata(reconaft) [after 5000 $net doReconnect $srv]
}
#
proc stopReconn {this} {
    upvar #0 $this ndata
    if {[info exists ndata(reconaft)]} {
	catch {after cancel $ndata(reconaft)}
	unset ndata(reconaft)
    }
}
#
proc net_doReconnect {this srv} {
    upvar #0 $this ndata
    catch {unset ndata(reconaft)}
    if {![$this startIRC $srv [$ndata(control) port]] && [$this reconnect]} {
	set ndata(reconaft) [after 5000 startReconn $this $srv {{}}]
    }
}
#
proc net_deMonitor {this chid} {
    upvar #0 $this ndata
    listkill ndata(monitorlst) [$chid lname]
    switch {} $ndata(monitorlst) {after cancel "$this monitorTest"}
}
#
proc net_monitor {this chid} {
    if {![$chid active]} {
	upvar #0 $this ndata
	listincl ndata(monitorlst) [$chid lname]
	$chid monitorOn
	$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_clearTest {this} {
    set lst {}
    foreach x {messages notices} {
	foreach chn [$this $x] {
	    foreach usr [$chn users] {
		if {![$this me $usr]} {
		    append lst " [$usr name]"
		    lappend mc $usr
		}
	    }
	}
    }
    switch {} $lst {} default {
	$this sysQ "ISON :$lst"
	$this configure -msgclear $mc
    }
    after 600000 "$this clearTest"
}
#
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"
    if {$ndata(cleargone)} {
	after 600000 "$this clearTest"
    }
}
#
proc net_ircTests {this} {
    upvar #0 MkOp$this MkOp $this ndata
    incr ndata(idle) [expr {$ndata(testTime) / 1000}]
    if {!$ndata(away) && $ndata(autoAway) && $ndata(idle) > $ndata(autoAway)} {
	$this AWAY {is away}
    }
    # PRAGMA : array wus
    foreach id [array names MkOp] {
	if {![string match {} [info procs $id]] && [$id active] && [$id operator]} {
	    set flag +
	    set ind -1
	    foreach n $MkOp($id) {
		if {![$id isOp $n]} {
		    incr ind
		    append flag o
		    switch +ooo $flag {
			$this sysQ "MODE [$id name] +ooo [$wus(0) name] [$wus(1) name] :[$n name]"
			set ind -1
			set flag +
		    } default {
			set wus($ind) $n
		    }
		    $n deref
		}
	    }
	    switch $flag +o {
		$this sysQ "MODE [$id name] +o :[$wus(0) name]"
	    } +oo {
		$this sysQ "MODE [$id name] +oo [$wus(0) name] :[$wus(1) name]"
	    }
	}
	unset MkOp($id)
    }
    dccCheck $this $ndata(testTime)
    after $ndata(testTime) "$this ircTests"
}
#
proc net_isonTest {this} {
    upvar #0 $this ndata
    $this ISON
    foreach gf  [$this globfriend] {
	$this sysQ "WHO :$gf"
	lappend ndata(whohandler) globfon
    }
    if {$ndata(notifyInterval)} {after $ndata(notifyInterval) "$this isonTest"}
}
#
proc net_pingTest {this} {
    upvar #0 $this ndata
    set nm [$this host]
    if {$ndata(pinged) != 0} {
	$this close "Server $nm is not responding - closing the connection"
    } {
	$this PING $nm
	set ndata(pinged) [clock seconds]
	after $ndata(ping) "$this pingTest"
    }
}
#
proc net_handlePong {this} {
    upvar #0 $this ndata
    if {$ndata(lagmeter)} {
	[$this control] lag [expr {[clock seconds] - $ndata(pinged)}]
    }
    set ndata(pinged) 0
}
#
proc Net_list {} { global znetList ; return $znetList }
#
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 q1Send "WHOIS :$nk"} default {$this q1Send "WHOIS [lindex $args 0] :$nk"}
}
#
proc net_WHOWAS {this nk args} {
    switch {} $nk return
    switch {} $args {$this q1Send "WHOWAS :$nk"} default {$this q1Send "WHOWAS $nk :[lindex $args 0]"}
}
#
proc net_INFO {this args} {
    switch {} $args {$this q1Send INFO} default {$this q1Send "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 reason} { 
    switch {} $reason { set reason {No reason given} }
    $this q1Send "SQUIT $srv :$reason"
}
#
proc net_TIME {this nk} { $this q1Send "TIME :$nk" }
#
proc net_PRIVMSG {this where what} { $this q1Send "PRIVMSG $where :$what" }
#
proc net_NOTICE {this where what} {
    switch {} $where return
    switch {} $what return
    $this q1Send "NOTICE $where :$what"
}
#
proc net_INVITE {this who where} {
    switch {} $who return
    switch {} $where return
    $this q1Send "INVITE $who :$where"
}
#
proc net_JOIN {this chan args} { channelJoin $this $chan $args }
#
proc net_KILL {this who why} { $this q1Send "KILL $who :$why" }
#
proc net_KICK {this where who args} {
    switch {} $args {$this q1Send "KICK $where :$who"} \
      default {$this q1Send "KICK $where $who :[lindex $args 0]"}
}
#
proc net_STATS {this p1 p2} { $this q1Send "STATS $p1 :$p2" }
#
proc net_USERHOST {this nk} { $this q1Send "USERHOST :$nk" }
#
proc net_NICK {this name} {
    if {[$this startup]} { $this setNickname $name }
    $this q1Send "NICK :$name"
}
proc net_MODE {this who mode args} {
    switch [llength $args] {
    0 {	$this q1Send "MODE $who :$mode" }
    1 {	$this q1Send "MODE $who $mode :[lindex $args 0]" }
    default { error "MODE Called with too many parameters" }
    }
}
#
proc net_WHO {this chans} {
    upvar #0 $this ndata
    lappend ndata(whohandler) doWhoLine
    $this q1Send "WHO [colonLast $chans]"
}
#
proc net_CONNECT {this srv port remote} {
    switch {} $srv return
    $this q1Send "CONNECT $srv $port :$remote"
}
#
proc net_LINKS {this srv mask} {
    switch {} $srv {
	switch {} $mask {$this q1Send LINKS} default {$this q1Send "LINKS [$this host] :$mask"}
    } default {
	switch {} $mask {$this q1Send "LINKS :$srv"} default {$this q1Send "LINKS $srv :$mask"}
    }
}
#
proc net_nsend {this cmd par} {
    switch {} $par {$this q1Send $cmd} default {$this q1Send "$cmd :$par"}
}
#
proc net_AWAY {this args} {
    switch {} $args {$this q1Send AWAY} default {$this q1Send "AWAY :[join $args]"}
}
#
proc net_TOPIC {this chan args} {
    switch {} $args {$this q1Send "TOPIC :$chan"} default {$this q1Send "TOPIC $chan :[lindex $args 0]"}
}
#
proc net_CTCP {this cmd nk str} {
    switch {} $str {
	$this q1Send "PRIVMSG $nk :\001$cmd\001"
    } default {
	$this q1Send "PRIVMSG $nk :\001$cmd $str\001"
    }
}
#
proc net_PART {this chan args} {
    switch {} $args {$this q1Send "PART :$chan"} default {$this q1Send "PART $chan :[lindex $args 0]"}
}
#
proc net_OPER {this nk str} {
    switch {} $str return
    $this q1Send "OPER  $nk :$str"
}
#
proc net_NAMES {this chan} { $this q1Send "NAMES :$chan" }
#
proc net_PING {this srv} { $this q1Send "PING :$srv"}
#
proc net_error {this unusedprefix param unusedpargs} {
    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 1
}
#
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 }
    [$this control] delete
    [$this info] delete
    [$this listid] delete
    catch {deleteFrame .@dbgctl $this}
    $this removeAfters
    safeUnset [list XTO([string tolower [$this name]])] OType($this) \
      $this Split$this Heal$this TSplit$this
    global znetList
    listkill znetList $this
    remShareLook $this
    rename $this {}
}
#
proc net_removeAfters {this} {
    upvar #0 TSplit$this TSplit Heal$this Heal
    foreach {x y} [array get TSplit] { after cancel $y }
    foreach {x y} [array get Heal] { after cancel $y }
}
#
proc net_squery {this} {
    mkEntryBox {} Squery {Enter your query} \
      [list [list service {}] [list query {}]] \
      [list ok "$this SQUERY"] [list cancel {}]
}
#
proc net_servlist {this} {
    mkEntryBox {} ServList {Enter your list request:} \
      [list [list name {}] [list type {}]] \
      [list ok "$this SERVLIST"] [list cancel {}]
}
#
proc net_SQUERY {this sv qr} {
    switch {} $sv return
    switch {} $qr return
    $this q1Send "SQUERY $sv :$qr"
}
#
#
proc net_SERVLIST {this n t} {
    switch {} $n return
    switch {} $t return
    $this q1Send "SERVLIST $n :$t"
}
#
proc net_clearMsgs {this usrs} {
    switch {} [set mc [$this msgclear]] {} default {
	foreach frd $usrs { listkill mc $frd }
	foreach frd $mc {
	    set nm [$frd name]
	    foreach x {Message Notice} {
		switch nil [set chn [$x :: find $nm $this]] continue
		$chn doLeave {}
	    }
	}
	$this configure -msgclear $mc
    }
}
#
proc net_fileProcess {this pfile usr} {
    foreach x [$this helpers] {
	if {[regexp -- [lindex $x 0] $pfile]} {
	    set cmd [lindex $x 1]
	    set np [lindex $x 2]
	    if {[regexp -nocase -- $np [$usr name]]} {
		regsub -all %s $cmd $pfile cmd
		if {[catch {eval exec $cmd &} msg]} {
	    	    tellError {} Error "Error executing helper cmd $cmd - $msg"
		}
		return
	    }
	}
    }
}
#
proc net_cleanup {this where} {
    foreach nm {servers channels messages chats notices friends services} {
        foreach x [$this $nm] {
	    safeUnset ${where}$x
	}
    }
}
