#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Friends.tcl,v $
# $Date: 1997/03/07 13:53:57 $
# $Revision: 1.18.1.16 $
#
package provide zircon 1.18
#
# Handle all stuff related to Friends menu/window
#
#
proc Friend_save {desc net} {
    set cm 1
    foreach x [$net friends] {
	set ln "Friend [list [$x nick]]"
	if ![$x menu] { append ln " -menu 0"}
	if ![$x notify] { append ln " -notify 0" }
	switch {} [$x id] {} default {append ln " -id {[$x id]}"}
	if $cm { puts $desc "#\n# Users\n#" ; set cm 0 }
	puts $desc $ln
    }
}
#
proc Friend_find {name net} {
    upvar #0 FTO$net FTO UTO$net UTO
    set ln [string tolower $name]
    if [info exists FTO($ln)] { return $FTO($ln) }
    if [info exist UTO($ln)] { return [$UTO($ln) fobj] }
    return nil
}
#
proc Friend_make {name net} {
    upvar #0 FTO$net FTO
    set ln [string tolower $name]
    if [info exists FTO($ln)] { return $FTO($ln) }
    return [$net eval "Friend [list $name]"]
}
#
proc Friend {name args} {
    switch -- $name :: {return [eval Friend_[lindex $args 0] [lrange $args 1 end]]}
    set this [objName Friend]
    initObj $this Friend
    upvar #0 currentNet net
    upvar #0 FTO$net FTO $this fdata
    set fdata(nick) [set name [$net trimNick $name]]
    set fdata(net) $net
    $net register friends $this
    set fdata(lnick) [string tolower $name]
    proc $this {args} "eval friend_call $this \$args"
    eval $this configure $args
    if [info exists FTO($fdata(lnick)] {
	set other $FTO($fdata(lnick))
	switch -- $fdata(id) [$other id] {
	    $this delete
	    return nil
	} default {
	    switch {} $fdata(id) {$this delete ; return nil }
	    switch {} [$other id] {$other delete ; return nil }
# OOPS!!! Need to rewrite the friends mechanisms to cope with this
# one!!
	    tellError {} Friends {You have two Friend declarations \
with the same name but different id's. Currently Zircon cannot handle
this.

Sorry!!}
	    $this delete
	    return nil	    
	}
    } {
	set FTO([set fdata(lnick) [string tolower $name]]) $this
    }
    return $this
}
#
proc Friend_pack {net} {
    makeArray ${net}FTO
    foreach f [$net friends] { $f pack $net }
}
#
proc Friend_unpack {net} {
    upvar #0 ${net}FTO newFTO
    foreach u [array names newFTO] { $newFTO($u) unpack $net }
    unset newFTO
}
#
proc friend_doNotify {this} {
    upvar #0 $this fdata
    switch nil $fdata(usr) {} default {
	$fdata(usr) configure -notify $fdata(notify)
    }
    if $fdata(notify) { [$this net] ISON } {
	if [$this ison] { [[$this net] finfo] mark $this {} }
    }
}
#
proc friend_pack {this net} {
    upvar #0 ${net}FTO newt $this fdata
    uplevel #0 array set new$this \[array get $this\]
    set newt($fdata(lnick)) $this
}
#
proc friend_unpack {this net} {
    upvar #0 new$this newu ${net}FTO newt $this fdata
    foreach v {nick notify menu id} {$this configure -$v $newu($v)}
    unset newu newt($fdata(lnick))
    $this configure -usr [User :: find [$this nick] $net]
}
#
proc friend_name {this} {
    upvar #0 $this fdata
    switch nil $fdata(usr) {return $fdata(nick)}
    return [$fdata(usr) name]
}
#
proc friend_lname {this} {
    upvar #0 $this fdata
    switch nil $fdata(usr) {return $fdata(lnick)}
    return [$fdata(usr) lname]
}
#
proc friend_delete {this} {
    $this configure -notify 0
    upvar #0 $this fdata
    set net $fdata(net)
    upvar #0 FTO$net FTO
    unset FTO($fdata(lnick)) fdata
    $net deregister friends $this
}
#
proc friend_configure {this args} {
    upvar #0 $this fdata
    set net $fdata(net)
    while {![string match {} $args]} {
	set op [lindex $args 0]
	set val [lindex $args 1]
	switch -- $op {
	-nick {
		upvar #0 FTO$net FTO
		set ln $fdata(lnick)
		set fdata(nick) [set name [[$this net] trimNick $val]]
		set fdata(lnick) [string tolower $name]
		unset FTO($ln)
		set FTO($fdata(lnick)) $this
	    }
	-usr {
		switch nil $val {} default {$val configure -fobj $this}
	    }
	default { set fdata([string range $op 1 end]) $val }
	}
	set args [lrange $args 2 end]
    }
}
#
proc friend_call {this op args} {
    upvar #0 $this fdata    
    if [info exists fdata($op)] { return $fdata($op) }
    return [eval friend_$op $this $args]
}
#
# This is the code for the Friends window
#
proc friends_call {this op args} {
    switch $op {
    enable { eval friends_state $this normal $args }
    disable { eval friends_state $this disabled $args }
    default { eval friends_$op $this $args }
    }
}
#
proc friends_rename {this frd nnk} {
    if [$this menu] {
	global Fctl
	set ctl [$Fctl($this) window]
	if {[set x [indexHack $ctl.friends.menu [$frd name] 1]] >= 0} {
	    $ctl.friends.menu entryconfigure $x -label $nnk
	}
    } {
	if [winfo exists .@$this.users.userList.$frd] {
	    switch -- $nnk [$frd nick] {} default {append nnk "\n([$frd nick])"}
	    .@$this.users.userList.$frd config -text $nnk
	}
    }
}
#
proc friends_absent {this frd} {
    if [$this menu] {
	global Fctl
	set ctl [$Fctl($this) window]
	if {[set x [indexHack $ctl.friends.menu [$frd name] 1]] >= 0} {
	    set v [$ctl.friends.menu entrycget $x -state]
	    switch normal $v {} default {return 1}
	}
	return 0	
    } {
	return [expr {[winfo exists .@$this.users.userList.$frd] \
	      && ![normal .@$this.users.userList.$frd]}]
    }
}
#
proc friends_menu {this} {
    global Fctl
    switch menu [[$Fctl($this) net] friendsStyle] {return 1}
    return 0
}
#
proc friends_mark {this frd what} {
    if [$this menu] {
# Dont do anything at the moment
    } \
    elseif [winfo exists .@$this.users.userList.$frd] {
	markButton .@$this.users.userList.$frd $what
	popup .@$this
    }
}
#
proc friends_delete {this} { catch {destroy .@$this} }
#
proc friends_state {this state args} {
    if [$this menu] {
	global Fctl
	set ctl [$Fctl($this) window]
	foreach id $args {
	    if {[set x [indexHack $ctl.friends.menu $id 1]] >= 0} {
		$ctl.friends.menu entryconfigure $x -state $state
	    }
	}
    } {
	foreach id $args {
	    if [winfo exists .@$this.users.userList.$id] {
		.@$this.users.userList.$id conf -state $state
	    }
	}
    }
}
#
proc Friends {name args} {
    global Fctl
    set Fctl($name) [lindex $args 1]
    proc $name {args} "eval friends_call $name \$args"
    return $name
}
#
proc friends_show {this} {
    if [$this menu] {
	global Fctl
	makeFriendsMenu $this [$Fctl($this) window].friends.menu
    } elseif {[winfo exists .@$this]} {popup .@$this} {makeFriends $this}
}
#
proc makeFriendsMenu {this win} {menu $win ; insertFriends $this}
#
proc makeFriends {this} {
    global ztrans
    set w [toplevel .@$this -class Zircon]
    wm title $w "Friends"
    wm resizable $w 0 1
    wm protocol $w WM_DELETE_WINDOW "killWindow $w"

    set win [frame $w.users -relief raised]
    scrollbar $win.vscroller -command "$win.userList yview" 
    text $win.userList -yscrollcommand "bsSet $win.vscroller" \
      -width 14 -height 10 -relief flat -borderwidth 0
    bindtags $win.userList {null}
    button $win.ok -text $ztrans(dismiss) -command "killWindow $w"
    pack $win.ok -side right -fill y
    pack $win.userList -side left -fill y -expand 1
    pack $win -expand 1 -fill y
    insertFriends $this
}
#
proc insertFriends {this} {
    global Fctl
    set net [$Fctl($this) net]
    foreach frd [$net friends] {
	if {[$frd menu] && ![$net me [$frd usr]]} {
	    if [$net friendsOn] {
		$frd configure -notify 1
		if [$frd ison] { $this add $frd }
	    } {
		$this add $frd
	    }
	}
    }
    if [$net friendsOn] { $net ISON }
}
#
proc friends_add {this frd} {
    switch nil $frd {} default {
	if [$this menu] {
	    global Fctl
	    set w [$Fctl($this) window].friends.menu
	    if ![winfo exists $w.$frd] {
		$w add cascade -label [$frd name] -menu $w.$frd
		makeUserMenu nil $w.$frd $frd
	    }
	} \
	elseif [winfo exists .@$this] {
	    set win .@$this.users.userList
	    set winb $win.$frd
	    if ![winfo exists $winb] {
		menubutton $winb -text [$frd name] -menu $winb.menu -width 12
		makeUserMenu nil $winb.menu $frd
		$win window create end -window $winb
		if [$frd ison] { markButton $winb ison }
	    }
	}
    }
}
#
proc friends_remove {this frd} {
    switch nil $frd return
    global Fctl
    if [$this menu] {
	set ctl [$Fctl($this) window]
	if {[set x [indexHack $ctl.friends.menu [$frd name] 1]] >= 0} {
	    $ctl.friends.menu delete $x
	}
    } \
    elseif [winfo exists .@$this.users.userList.$frd] {
	if [[$Fctl($this) net] friendsOn] {
	    if [normal .@$this.users.userList.$frd] {
		destroy .@$this.users.userList.$frd
	    }
	} {
	    $this mark $frd {}
	}
	popup .@$this
    }
}
