#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Chat.tcl,v $
# $Date: 2002/01/18 12:22:22 $
# $Revision: 1.18.1.50 $
#
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_onShow {unusedthis} { }
#
proc chat_setTitles {this} {
    set id {}
    switch nil [set usr [$this user]] {} default {
	switch {} [set id [$usr id]] {} default { set id " ($id)"}
    }
    set nam [$this name]
    return [list "Chat $nam" "DCC Chat with $nam$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]} {
	[$this ufrm].userBtn.$usr configure -text $nnk
	$w.users.menu entryconfigure 3 -label $nnk
# Check for self abuse!!
	switch $usr [$this user] {$this nChange $nnk}
    } {
	$this nChange $nnk
    }
}
#
proc chat_nChange {this nnk} {
    if {[$this active]} {
	switch nil [set usr [$this user]] {} default {
	    switch {} [set id [$usr id]] {} default { set id " ($id)"}
	}
	[$this wid] setTitle $this "DCC Chat with $nnk$id"
    }
    upvar #0 CHTO[$this net] CHTO $this cdata
    set ln [string tolower $nnk]
    unset CHTO($cdata(lname))
    set CHTO($ln) $this
    array set cdata [list\
	lname	$ln \
	name	$nnk \
    ]
}
#
proc chat_replace {this unusedusr1 usr2} {$this nChange [$usr2 name]}
#
proc chat_call {this op pars} {
    switch {} [info procs chat_$op] { return [objCall channel $this $op $pars] }
    return [eval chat_$op $this $pars]
}
#
proc makeChat {chan} {
    global defChat
    upvar #0 currentNet net
    set this [objName Chat]
    proc $this {unusedop args} "chat_call $this \$unusedop \$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]
    array set cdata [list \
	buttons $b \
	name	$chan \
	lname	$lchan \
	net	$net \
    ]
    $net register chats $this
    set CHTO($lchan) $this
    return $this
}
#
proc chat_configure {this args} {
    upvar #0 $this cdata
    foreach {name val} $args {
	switch -glob -- $name {
	-caller { set cdata(caller) [$val ref] }
	default { channel_configure $this $name $val }
	}
    }
}
#
proc chat_user {this} {
    upvar #0 $this cdata
    switch nil $cdata(caller) {return [User :: find $cdata(name) $cdata(net)]}
    return $cdata(caller)
}
#
proc chat_isJoined {this usr} {
    switch $usr [$this user] {return 1}
    return 0
}
#
proc chat_delete {this} {
    upvar #0 $this cdata CHTO[set net [$this net]] CHTO
    $this doLog Close
    switch {} [set win [$this window]] {} default {
	foreach x $cdata(users) {$x leave $this}
    }
    set cdata(users) {}
    $this configure -wid {}
    set chan $cdata(lname)
    catch {[$this user] deref}
    rename $this {}
    switch {} $cdata(sock) {} default {closeChat $this $chan $cdata(sock)}
    safeUnset [list CHTO${net}($chan)] $this
    $net deregister chats $this
    if {[winfo exists .@dls$net]} { buildDCCList $net }
}
#
proc chat_leave {this} {
    set chan [$this name]
    if {[askUser LEAVE "Leaving $chan" "Really leave DCC chat with $chan?"]} {
	switch {} [info procs $this] {} default { $this doLeave {} }
    }
}
#
proc Chat_make {net name} {
    upvar #0 CHTO$net CHTO
    set ln [string tolower $name]
    if {[info exists CHTO($ln)]} { return $CHTO($ln) }
    return [$net eval [list Chat $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} { mncSave $desc $this defChat DChat }
#
proc ChatServer {usr nk} {
    set net [$usr net]
    upvar #0 AChat${net}($usr) acvar
    foreach {acvar cinfo} [makeServer "acceptChat $usr"] break
    $usr ref
    $net CTCP DCC $nk "CHAT chat [ipPack [ipAddress]] [lindex $cinfo 2]"
}
#
proc chat_heal {this} {
    if {[$this active]} {
	$this flag normal
	$this addText {} "*** netsplit : [$this name] may have left IRC."
    }
}