#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Chat.tcl,v $
# $Date: 1997/02/05 12:42:07 $
# $Revision: 1.18.1.21 $
#
package provide zircon 1.18
#
proc Chat {name args} {
    switch -- $name :: {
	set op [lindex $args 0]
	switch {} [info procs Chat_$op] {
	    return [eval Channel_$op [lrange $args 1 end] ]
	}
	return [eval Chat_$op [lrange $args 1 end] ]
    }
    global currentNet
    switch nil [set id [Chat :: find $name $currentNet]] {set id [makeChat $name]}
    eval $id configure $args
    return $id
}
#
proc chat_nickChange {this usr nnk} {
    switch {} [set w [$this window]] return
    set net [$this net]
    $this optText NICK "*** [$usr name] is now known as $nnk"
    if [$net me $usr] {
	$w.uFrm.userBtn.$usr configure -text $nnk
	$w.users.menu entryconfigure 3 -label $nnk
# Check for self abuse!!
	switch $usr [$this caller] {$this nChange $nnk}
    } {
	$this nChange $nnk
    }
}
#
proc chat_nChange {this nnk} {
    set net [$this net]
    if [$this active] {
	switch nil [set usr [User :: find [$this name] $net]] {} default {
	    switch {} [set id [$usr id]] {} default { set id " ($id)"}
	}
	[$this wid] setTitle $this "DCC Chat with $nnk$id"
    }
    upvar #0 CHTO$net CHTO $this cdata
    set ln [string tolower $nnk]
    unset CHTO($cdata(lname))
    set CHTO($ln) $this
    set cdata(lname) $ln
    set cdata(name) $nnk
}
#
proc chat_replace {this usr1 usr2} {$this nChange [$usr2 name]}
#
proc chat_call {this op args} {
    switch {} [info procs chat_$op] {
	return [eval channel_call $this $op $args]
    }
    return [eval chat_$op $this $args]
}
#
proc makeChat {chan} {
    global defChat
    upvar #0 currentNet net
    set this [objName Chat]
    proc $this {args} "eval chat_call $this \$args"
    initObj $this Channel DChat
    upvar #0 $this cdata CHTO$net CHTO
    set lchan [string tolower $chan]
    if [catch {set def $defChat($net)}] {
	global defaultNet defChan
	if [catch {set def $defChat($defaultNet)}] {
	    set def $defChan($defaultNet)
	}
	set b 0
    } {
	set b [$def buttons]
    }
    array set cdata [uplevel #0 array get $def]
    set cdata(buttons) $b
    set cdata(name) $chan
    set cdata(lname) $lchan
    set cdata(net) $net
    $net register chats $this
    set CHTO($lchan) $this
    return $this
}
#
proc chat_configure {this args} {
    upvar #0 $this cdata
    while {![string match {} $args]} {
	set val [lindex $args 1]
	set name [lindex $args 0]
	switch -glob -- $name {
	-caller { set cdata(caller) $val ; $val ref}
	default { channel_configure $this $name $val }
	}
	set args [lrange $args 2 end]
    }
}
#
proc chat_isJoined {this usr} {
    switch $usr [User :: find [$this name] [$this net]] {return 1}
    return 0
}
#
proc chat_delete {this} {
    upvar #0 $this cdata CHTO[set net [$this net]] CHTO
    switch {} $cdata(logfd) {} default { close $cdata(logfd) }
    switch {} [set win [$this window]] {} default {
	foreach x $cdata(users) {$x leave $this}
    }
    set cdata(users) {}
    $this configure -wid {}
    set chan $cdata(lname)
    catch {$cdata(caller) deref}
    rename $this {}
    switch {} $cdata(sock) {} default {closeChat $this $chan $cdata(sock)}
    unset CHTO($chan) cdata
    $net deregister chats $this
}
#
proc chat_leave {this} {
    global ztrans
    set chan [$this name]
    if [askUser LEAVE "Leaving $chan" "Really leave DCC chat with $chan?"] {
	$this doLeave {}
    }
}
#
proc Chat_make {name net} {
    upvar #0 CHTO$net CHTO
    set ln [string tolower $name]
    if [info exists CHTO($ln)] { return $CHTO($ln) }
    return [$net eval "Chat [list $name]"]
}
#
proc Chat_find {name net} {
    upvar #0 CHTO$net CHTO
    set ln [string tolower $name]
    return [expr {[info exists CHTO($ln)] ? $CHTO($ln) : {nil}}]
}
#
proc Chat_save {desc net} { defSave $desc defChat $net DChat }
#
proc chat_save {this desc} { }
#
proc ChatServer {usr nk} {
    set net [$usr net]
    upvar #0 AChat$net AChat
    if [catch {socket -server "acceptChat $usr" 0} sock] { error $sock }
    if [catch {fconfigure $sock -sockname} xx] {
	error "Cannot get port for server - $xx"
    }
    set AChat($usr) $sock
    $usr ref
    $net CTCP DCC $nk "CHAT chat [ipPack [ipAddress]] [lindex $xx 2]"
}
