#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/User.tcl,v $
# $Date: 1997/03/07 13:54:08 $
# $Revision: 1.18.1.21 $
#
package provide zircon 1.18
#
proc User {name args} {
    switch -- $name :: {return [eval User_[lindex $args 0] [lrange $args 1 end]]}
    set this [objName User]
    initObj $this User
    proc $this {args} "eval user_call $this \$args"
    upvar #0 currentNet net
    upvar #0 UTO$net UTO $this udata
    set name [$net trimNick $name]
    set udata(name) $name
    set udata(net) $net
    $net register users $this
    switch nil [set fobj [Friend :: find $name $net]] {} default {
	$fobj configure -usr $this
	set udata(fobj) $fobj
    }
    set UTO([set udata(lname) [string tolower $name]]) $this
    eval $this configure $args
    return $this
}
#
proc user_configure {this args} {
    upvar #0 $this udata
    while {![string match {} $args]} {
	set op [lindex $args 0]
	set val [lindex $args 1]
	switch -- $op {
	-friend { set udata(menu) $val }
	default { set udata([string range $op 1 end]) $val }
	}
	set args [lrange $args 2 end]
    }
}
#
proc traceback {} {
    set x [info level]
    puts stderr {}
    while {$x > 0} { incr x -1 ; puts stderr [info level $x] }
}
#
proc user_call {this op args} {
    upvar #0 $this udata
    switch $op {
    ref { incr udata(refcount) ; return }
    deref { incr udata(refcount) -1 ;  return }
    }
    if [info exists udata($op)] { return $udata($op) }
    return [eval user_$op $this $args]
}
#
proc user_delete {this} {
    global TFn TFa TFg TBg TAF TAB TBl Bl IFlag OType
    upvar #0 $this udata
    [set net $udata(net)] deregister users $this
    switch nil $udata(fobj) {} default { $udata(fobj) configure -usr nil }
    upvar #0 UTO$net UTO
    unset UTO([$this lname]) OType($this) udata
    foreach z {TFn TFa TFg TBg TAF TAB TBl Bl IFlag} {
	foreach v [array names $z $this,*] { unset ${z}($v) }
    }
    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)] { 
	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} {
    global TAB TAF TBg TFg TBl TFa TFn
    upvar #0 $chan cdata
    upvar #0 $this udata
    set ln [$this lname]
    catch {unset cdata(Op,$this) cdata(Spk,$this)}
    foreach x {TAB TAF TBg TFg TBl TFa TFn} { catch {unset ${x}($chan,$ln)} }
    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 name] [$this net]]
	$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}
#
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]
}
#
set zFileTypes {
  {{All Files} {.*}}
  {{Gif Images} {.\[gG\]\[iI\]\[fF\]} GIFF}
  {{JPEG Images} {.\[jJ\]\[pP\]\[eE\]?\[gG\]} JFIF}
  {{Wav Sounds} {.\[wW\]\[aA\]\[vV\]}}
}
#
proc user_heal {this} {
    global Split Heal TSplit
    set told 0
    set net [$this net]
    foreach sl [array names Split] {
	if {[set x [lsearch $Split($sl) $this]] >= 0} {
	    catch {after cancel $TSplit($sl) ; unset TSplit($sl)}
	    if ![info exists Heal($sl)] {
		set told 1
		[$net info] optText HEAL "*** Heal - $sl"
		handleOn $net HEAL $sl
	    }
	    set v $Split($sl)
	    listdel v $x
	    $this deref
	    switch {} $v {
		    unset Split($sl)
		    catch {after cancel Heal($sl) ; unset Heal($sl)}
	    } default {
		set Split($sl) $v
		catch {after cancel $Heal($sl)}
		set Heal($sl) [after 120000 $net cleanSplit "{$sl}"]
	    }
	}
    }
    foreach x {Notice Message} {
	switch nil [set id [$x :: find [$this lname] $net]] continue 
	if [$id active] {
	    $id addText {} {*** Heal}
	    $id flag normal
	}
    }
    foreach x [$net channels] {
	if {[$x monitor] && [winfo exists .@mon$x.users.userList.$this]} {
	    .@mon$x.users.userList.$this configure -state normal
	}
    }
}
#
proc user_kill {this} { kill [$this net] [$this name] }
#
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
    foreach v {name notify menu id} {$this configure -$v $newu($v)}
    unset newu
    global ${net}UTO
    unset ${net}UTO([$this lname])
}
#
proc user_split {this split} {
    global Split
    set net [$this net]
    if ![info exists Split($split)] { $net newSplit $split }
    foreach id [$net channels] {$id userSplit $this $split}
    foreach x {Notice Message} {
	switch nil [set id [$x :: find [$this lname] $net]] continue
	if [$id active] {
	    $id addText {} "*** Netsplit - $split"
	    $id flag disabled
	}
    }
    switch nil [set fobj [$this fobj]] {} default {
	[$net finfo] disable $fobj
	$fobj configure -limbo 1
    }
    lappend Split($split) $this
    $this ref
    handleOn $net USPLIT [list $split [$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 {nk net 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 "User [list $nk]"]
   }
   switch {} $args {} default { $nm configure -id [lindex $args 0] }
   return $nm
}
