#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/User.tcl,v $
# $Date: 2002/01/18 12:22:24 $
# $Revision: 1.18.1.47 $
#
package provide zircon 1.18
#
proc User {name args} {
    switch -- $name :: {return [eval User_[lindex $args 0] [lrange $args 1 end]]}
    upvar #0 currentNet net
    set name [$net trimNick $name]
    set this [makeNObj $name $net User $args]
    upvar #0 UTO$net UTO $this udata
    set udata(lname) [string tolower $name]
    switch nil [set fobj [Friend :: find $name $net]] {} default {
	$fobj configure -usr $this
	set udata(fobj) $fobj
    }
    set UTO($udata(lname)) $this
    return $this
}
#
proc user_configure {this args} {
    upvar #0 $this udata
    foreach {op val} $args {
	switch -- $op {
	-friend { set udata(menu) $val }
	default { set udata([string range $op 1 end]) $val }
	}
    }
}
#
proc user_ref {this} { uplevel #0 incr ${this}(refcount) ; return $this }
#
proc user_deref {this} { uplevel #0 incr ${this}(refcount) -1 }
#
proc user_use {this}  { $this ref ; return $this }
#
proc user_delete {this} {
    upvar #0 $this udata
    $udata(net) deregister users $this
    switch nil $udata(fobj) {} default { $udata(fobj) configure -usr nil }
    safeUnset [list UTO$udata(net)($udata(lname))] OType($this) $this
    rename $this {}
}
#
proc user_substitute {this orig} {
    $this ref
    foreach x [$this channels] { $x replace $this $orig }
    set ln [$this lname]
    foreach x {Message Notice Chat} {
	switch nil [set old [$x :: find $ln [$this net]]] {} default {
	    $old replace $this $orig
	}
    }
    upvar #0 AChat[$this net] AChat
    if {[info exists AChat($this)]} { 
	$orig ref
	set AChat($orig) $AChat($this)
	unset AChat($this)
    }
    $this deref
}
#
proc user_rename {this nk} {
    set net [$this net]
    upvar #0 UTO$net UTO
    set nk [$net trimNick $nk]
    upvar #0 $this udata
    switch nil [set f [$this fobj]] {} default {[$net finfo] rename $f $nk}
    set udata(name) $nk
    unset UTO($udata(lname))
    set UTO([set udata(lname) [string tolower $nk]]) $this
}
#
proc user_join {this chan} {
    upvar #0 $this udata
    if {[lsearch $udata(channels) $chan] < 0} {
	lappend udata(channels) $chan
	$this ref
    }
}
#
proc user_leave {this chan} {
    upvar #0 $this udata
    if {[set x [lsearch $udata(channels) $chan]] >= 0} {
	listdel udata(channels) $x
	$this deref
    }
}
#
proc user_doNotify {this} {
    if {[$this notify]} {
	set fobj [Friend :: make [$this net] [$this name]]
	$fobj configure -notify 1
	$this configure -fobj $fobj
	[$this net] ISON
    } {
	switch nil [set fobj [$this fobj]] {} default {
	    if {[$fobj ison]} {[[$this net] finfo] mark $fobj {}}
	    $fobj configure -notify 0
	}
    }
}
#
proc user_off {this} {
    $this unChServ
    handleOn [$this net] ISOFF [$this name]
}
#
proc user_finger {this} { finger [$this net] [$this name] }
#
proc user_mode {this mode args} {
    [$this net] send MODE [$this name] $mode [lindex $args 0]
}
#
proc user_kill {this} { kill [$this net] [$this name] }
#
proc user_protect {this chan culprit mode} {
    switch [set frd [$this fobj]] nil return
    if {[string match :* $culprit]} {
        set culprit [string range $culprit 1 end]
    }
    set nm [$chan name]
    foreach x [$frd protect] {
	if {[regexp -nocase -- [lindex $x 0] $nm]} {
	    foreach y [lindex $x 1] {
	        if {[regexp -- [lindex $y 0] $mode]} {
		    friendAction $this $chan $culprit [lindex $y 1]
		    culpritAction $culprit $this $chan [lindex $y 2]
		    return
		}
	    }
	}
    }
}
#
proc user_pack {this net} {
    upvar #0 ${net}UTO newt
    uplevel #0 array set new$this \[array get $this\]
    set ln [$this lname]
    set newt($ln) $this
}
#
proc user_unpack {this net} {
    upvar #0 new$this newu ${net}UTO UTO
    foreach v {name notify menu id} {$this configure -$v $newu($v)}
    unset newu UTO([$this lname])
}
#
# Procs for the class User
#
proc User_find {nk net} {
    upvar #0 UTO$net UTO
    set name [string tolower [$net trimNick $nk]]
    if {[info exists UTO($name)]} { return $UTO($name) }
    return nil
}
#
proc User_make {net nk args} {
    upvar #0 UTO$net UTO
    set name [string tolower [$net trimNick $nk]]
    if {[info exists UTO($name)]} { set nm $UTO($name) } {
	set nm [$net eval [list User $nk]]
    }
    switch {} $args {} default { $nm configure -id [lindex $args 0] }
    return $nm
}
