# $Id: presence.tcl 1898 2010-01-30 12:46:13Z sergei $

###############################################################################

array set long_statusdesc [list \
    available   [::msgcat::mc "is available"] \
    chat        [::msgcat::mc "is free to chat"] \
    away        [::msgcat::mc "is away"] \
    xa          [::msgcat::mc "is extended away"] \
    dnd         [::msgcat::mc "doesn't want to be disturbed"] \
    invisible   [::msgcat::mc "is invisible"] \
    unavailable [::msgcat::mc "is unavailable"]]

proc get_long_status_desc {status} {
    set ::long_statusdesc($status)
}

###############################################################################

proc client:presence {xlib from type x args} {
    global presence
    global processed_presence

    debugmsg presence "PRESENCE: $from; $type; $x; $args"

    set from [::xmpp::jid::normalize $from]

    switch -- $type {
	error -
	unavailable {
	    catch { unset presence(type,$xlib,$from) }
	    catch { unset presence(status,$xlib,$from) }
	    catch { unset presence(priority,$xlib,$from) }
	    catch { unset presence(show,$xlib,$from) }
	    catch { unset presence(x,$xlib,$from) }
	    catch { unset presence(error,$xlib,$from) }

	    set user [::xmpp::jid::stripResource $from]
	    if {[info exists presence(user_jids,$xlib,$user)]} {
		set idx [lsearch -exact $presence(user_jids,$xlib,$user) $from]
		set presence(user_jids,$xlib,$user) \
		    [lreplace $presence(user_jids,$xlib,$user) $idx $idx]
	    }
	    cache_preferred_jid_on_unavailable $xlib $from $user
	    cache_user_status $xlib $user

	    foreach {attr val} $args {
		switch -- $attr {
		    -status {
			set presence(status,$xlib,$from) $val
			if {[get_user_status $xlib $user] == "unavailable"} {
			    set presence(status,$xlib,$user) $val
			}
		    }
		    -error {
			set presence(error,$xlib,$from) $val
		    }
		}
	    }

	    debugmsg presence "$xlib $from unavailable"
	}
	subscribe {}
	subscribed {}
	unsubscribe {}
	unsubscribed {}
	probe {}
	default {
	    set type available
	    set presence(type,$xlib,$from)     available
	    set presence(status,$xlib,$from)   ""
	    set presence(priority,$xlib,$from) 0
	    set presence(show,$xlib,$from)     available
	    set presence(x,$xlib,$from)        $x
	    catch { unset presence(error,$xlib,$from) }
	    
	    foreach {attr val} $args {
		switch -- $attr {
		    -status   {set presence(status,$xlib,$from)   $val}
		    -priority {set presence(priority,$xlib,$from) $val}
		    -show     {set presence(show,$xlib,$from)     $val}
		}
	    }
	    
	    set presence(show,$xlib,$from) \
		[normalize_show $presence(show,$xlib,$from)]

	    set user [::xmpp::jid::stripResource $from]
	    if {![info exists presence(user_jids,$xlib,$user)] || \
		    ![lcontain $presence(user_jids,$xlib,$user) $from]} {
		lappend presence(user_jids,$xlib,$user) $from
	    }

	    cache_preferred_jid_on_available $xlib $from $user
	    cache_user_status $xlib $user
	}
    }
    
    eval {hook::run client_presence_hook $xlib $from $type $x} $args
}

###############################################################################

proc get_jids_of_user {xlib user} {
    global presence

    if {[info exists presence(user_jids,$xlib,$user)]} {
	return $presence(user_jids,$xlib,$user)
    } elseif {![cequal [::xmpp::jid::resource $user] ""]} {
	if {[info exists presence(type,$xlib,$user)]} {
	    return [list $user]
	}
    }
    return {}
}

proc get_jid_of_user {xlib user} {
    global presence

    if {[info exists presence(preferred_jid,$xlib,$user)]} {
	return $presence(preferred_jid,$xlib,$user)
    } else {
	return $user
    }
}

proc cache_preferred_jid_on_available {xlib jid user} {
    global presence

    if {[info exists presence(maxpriority,$xlib,$user)]} {
	set maxpri $presence(maxpriority,$xlib,$user)
    } else {
	cache_preferred_jid $xlib $user
	return
    }
    
    set pri $presence(priority,$xlib,$jid)

    if {$pri > $maxpri} {
	set presence(maxpriority,$xlib,$user) $pri
	set presence(preferred_jid,$xlib,$user) $jid
    }
}

proc cache_preferred_jid_on_unavailable {xlib jid user} {
    global presence

    if {![info exists presence(maxpriority,$xlib,$user)]} {
	cache_preferred_jid $xlib $user
	return
    }
    
    if {$presence(preferred_jid,$xlib,$user) == $jid} {
	unset presence(preferred_jid,$xlib,$user)
	unset presence(maxpriority,$xlib,$user)
	cache_preferred_jid $xlib $user
    }
}

proc cache_preferred_jid {xlib user} {
    global presence

    set jids [get_jids_of_user $xlib $user]

    if {$jids != {}} {
	set rjid [lindex $jids 0]
	set pri $presence(priority,$xlib,$rjid)

	foreach jid $jids {
	    if {$presence(priority,$xlib,$jid) > $pri} {
		set pri $presence(priority,$xlib,$jid)
		set rjid $jid
	    }
	}

	set presence(maxpriority,$xlib,$user) $pri
	set presence(preferred_jid,$xlib,$user) $rjid
    }
}


proc get_jid_status {xlib jid} {
    global presence

    set j $jid
    if {[info exists presence(show,$xlib,$j)]} {
	return $presence(show,$xlib,$j)
    } else {
	return unavailable
    }
}

proc get_jid_presence_info {param xlib jid} {
    global presence

    if {[info exists presence($param,$xlib,$jid)]} {
	return $presence($param,$xlib,$jid)
    } else {
	return ""
    }
}

proc get_user_status {xlib user} {
    global presence

    if {[info exists presence(cachedstatus,$xlib,$user)]} {
	return $presence(cachedstatus,$xlib,$user)
    } elseif {[info exists presence(show,$xlib,$user)]} {
	return $presence(show,$xlib,$user)
    } else {
	return unavailable
    }
}

proc cache_user_status {xlib user} {
    global presence

    set jid [get_jid_of_user $xlib $user]
    if {[info exists presence(show,$xlib,$jid)]} {
	set presence(cachedstatus,$xlib,$user) $presence(show,$xlib,$jid)
    } else {
	set presence(cachedstatus,$xlib,$user) unavailable
    }
}

proc get_user_status_desc {xlib user} {
    global presence

    set jid [get_jid_of_user $xlib $user]
    if {[info exists presence(error,$xlib,$jid)]} {
	return [::xmpp::stanzaerror::message $presence(error,$xlib,$jid)]
    } elseif {[info exists presence(status,$xlib,$jid)]} {
	return $presence(status,$xlib,$jid)
    } else {
	return ""
    }
}

array set status_priority {
    unavailable 1
    xa          2
    away        3
    dnd         4
    available   5
    chat        6
}

proc compare_status {s1 s2} {
    global status_priority
    set p1 $status_priority($s1)
    set p2 $status_priority($s2)
    if {$p1 > $p2} {
	return 1
    } elseif {$p1 == $p2} {
	return 0
    } else {
	return -1
    }
}

proc max_status {s1 s2} {
    global status_priority
    set p1 $status_priority($s1)
    set p2 $status_priority($s2)
    if {$p1 >= $p2} {
	return $s1
    } else {
	return $s2
    }
}

###############################################################################

set curpriority   0
set curuserstatus unavailable
set curtextstatus ""

custom::defvar userpriority 0 [::msgcat::mc "Stored user priority."] \
    -type integer -group Hidden
custom::defvar userstatus available [::msgcat::mc "Stored user status."] \
    -type string -group Hidden
custom::defvar textstatus "" [::msgcat::mc "Stored user text status."] \
    -type string -group Hidden

set userstatusdesc [::msgcat::mc "Not logged in"]

set statusdesc(available)   [::msgcat::mc "Available"]
set statusdesc(chat)        [::msgcat::mc "Free to chat"]
set statusdesc(away)        [::msgcat::mc "Away"]
set statusdesc(xa)          [::msgcat::mc "Extended away"]
set statusdesc(dnd)         [::msgcat::mc "Do not disturb"]
set statusdesc(invisible)   [::msgcat::mc "Invisible"]
set statusdesc(unavailable) [::msgcat::mc "Unavailable"]

###############################################################################

proc change_priority_dialog {} {
    global tmppriority
    global userpriority

    set tmppriority $userpriority

    set w .change_priority
    if {[winfo exists $w]} {
	focus -force $w
	return
    }

    Dialog $w -title [::msgcat::mc "Change Presence Priority"] \
	-modal none -separator 1 -anchor e -default 0 -cancel 1

    $w add -text [::msgcat::mc "OK"] \
	-command [list do_change_priority $w]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
    
    set f [$w getframe]
    label $f.lpriority -text [::msgcat::mc "Priority:"]
    Spinbox $f.priority -1000 1000 1 tmppriority

    grid $f.lpriority -row 0 -column 0 -sticky e
    grid $f.priority  -row 0 -column 1 -sticky ew

    grid columnconfigure $f 0 -weight 1 
    grid columnconfigure $f 1 -weight 1

    $w draw
}

###############################################################################

proc do_change_priority {w} {
    global userstatus
    global tmppriority
    global userpriority

    destroy $w
    if {![cequal $userpriority $tmppriority]} {
        set userpriority $tmppriority
	set userstatus $userstatus
    }
}

###############################################################################

trace variable userstatus w change_our_presence
trace variable logoutuserstatus w change_our_presence

###############################################################################

proc change_our_presence {name1 name2 op} {
    global userstatus logoutuserstatus curuserstatus
    global textstatus logouttextstatus curtextstatus
    global userpriority logoutpriority curpriority
    global statusdesc userstatusdesc

    switch -- $name1 {
	logoutuserstatus {
	    set newstatus $logoutuserstatus
	    set newtextstatus $logouttextstatus
	    set newpriority $logoutpriority
	}
	default {
	    if {[lempty [connections]]} return
	    set newstatus $userstatus
	    set newtextstatus $textstatus
	    set newpriority $userpriority
	}
    }

    if {[cequal $newstatus $curuserstatus] \
	    && [cequal $newtextstatus $curtextstatus] \
	    && [cequal $newpriority $curpriority]} {
	return
    }

    if {[lsearch -exact [array names statusdesc] $newstatus] < 0} {
	error [::msgcat::mc "Invalid userstatus value %s" $newstatus]
    }

    set userstatusdesc $statusdesc($newstatus)
    set status $newtextstatus

    foreach xlib [connections] {
	send_presence $xlib $newstatus \
		      -status $status \
		      -priority $newpriority
    }

    foreach chatid [lfilter chat::is_groupchat [chat::opened]] {
	set xlib [chat::get_xlib $chatid]
	set group [chat::get_jid $chatid]
	set nick [get_our_groupchat_nick $chatid]

	if {$newstatus == "invisible"} {
	    set newst available
	} else {
	    set newst $newstatus
	}

	send_presence $xlib $newst \
		      -to $group/$nick \
		      -status $status \
		      -priority $userpriority
    }

    set curuserstatus $newstatus
    set curtextstatus $newtextstatus
    set curpriority $newpriority

    hook::run change_our_presence_post_hook $newstatus
}

###############################################################################

proc send_first_presence {xlib} {
    global userstatus curuserstatus statusdesc userstatusdesc
    global textstatus curtextstatus
    global userpriority curpriority
    global loginconf

    if {[lsearch -exact [array names statusdesc] $userstatus] < 0} {
	error [::msgcat::mc "Invalid userstatus value %s" $userstatus]
    }

    set userstatusdesc $statusdesc($userstatus)
    set status $textstatus

    set curuserstatus $userstatus
    set curtextstatus $textstatus
    set curpriority [set userpriority $loginconf(priority)]
    
    send_presence $xlib $userstatus \
		  -status $status \
		  -priority $userpriority

    hook::run change_our_presence_post_hook $userstatus
}

hook::add connected_hook [namespace current]::send_first_presence 15

###############################################################################

proc send_custom_presence {xlib jid status args} {
    global userpriority
    global statusdesc

    set type jid
    set stat ""
    foreach {key val} $args {
	switch -- $key {
	    -type   { set type $val }
	    -status { set stat $val }
	}
    }

    switch -- $type {
	group   {
	    set to $jid/[get_our_groupchat_nick [chat::chatid $xlib $jid]]
	}
	default {
	    set to $jid
	}
    }

    eval {send_presence $xlib $status} $args \
	 {-to $to -status $stat -priority $userpriority}
}

###############################################################################

proc send_presence {xlib status args} {
    set newargs [eval [list presence_args $xlib $status] $args]
    eval [list ::xmpp::sendPresence $xlib] $newargs
}

###############################################################################

proc presence_args {xlib status args} {
    switch -- $status {
	available   {
	    set newargs {}
	}
	unavailable {
	    set newargs [list -type $status]
	}
	default     {
	    set newargs [list -show $status]
	}
    }

    set xlist {}
    set stat ""
    foreach {opt val} $args {
	switch -- $opt {
	    -id       { lappend newargs -id $val }
	    -to       { lappend newargs -to $val }
	    -priority { lappend newargs -priority $val }
	    -xlist    { set xlist $val }
	    -status   { set stat $val }
	}
    }

    if {$stat != ""} {
	lappend newargs -status $stat
    }

    hook::run presence_xlist_hook xlist $xlib $stat
    lappend newargs -xlist $xlist

    debugmsg presence "$newargs"
    return $newargs
}

###############################################################################

proc normalize_show {show} {
    set res $show
    
    switch -- $show {
	away        {}
	chat        {}
    	dnd         {}
	xa          {}
	unavailable {}
	default     {set res available}
    }
    return $res
}

###############################################################################

proc add_presence_to_popup_info {infovar xlib jid} {
    upvar 0 $infovar info

    set bjid [::xmpp::jid::stripResource $jid]
    if {[chat::is_groupchat [chat::chatid $xlib $bjid]]} return

    set priority [get_jid_presence_info priority $xlib $jid]
    if {$priority != ""} {
	append info [format "\n\t[::msgcat::mc {Priority:}] %s" $priority]
    }
}

hook::add roster_user_popup_info_hook add_presence_to_popup_info 20

###############################################################################

proc clear_presence_info {xlib} {
    global curuserstatus
    global userstatusdesc
    global presence

    array unset presence type,$xlib,*
    array unset presence status,$xlib,*
    array unset presence priority,$xlib,*
    array unset presence show,$xlib,*
    array unset presence error,$xlib,*
    array unset presence x,$xlib,*
    array unset presence user_jids,$xlib,*
    array unset presence preferred_jid,$xlib,*
    array unset presence cachedstatus,$xlib,*
    array unset presence maxpriority,$xlib,*

    if {[connections] == {}} {
	set_status "Disconnected"

	set curuserstatus unavailable
	set userstatusdesc [::msgcat::mc "Not logged in"]
	hook::run change_our_presence_post_hook unavailable
    }
}

hook::add disconnected_hook clear_presence_info

###############################################################################

proc custom_presence_menu {m xlib jid} {
    set chatid [chat::chatid $xlib [::xmpp::jid::stripResource $jid]]
    set chatid1 [chat::chatid $xlib $jid]

    if {[chat::is_groupchat $chatid] && ![chat::is_groupchat $chatid1]} {
	return
    }

    set mm [menu $m.custom_presence -tearoff 0]

    $mm add command -label [::msgcat::mc "Available"] \
		    -command [list send_custom_presence $xlib $jid available]
    $mm add command -label [::msgcat::mc "Free to chat"] \
		    -command [list send_custom_presence $xlib $jid chat]
    $mm add command -label [::msgcat::mc "Away"] \
		    -command [list send_custom_presence $xlib $jid away]
    $mm add command -label [::msgcat::mc "Extended away"] \
		    -command [list send_custom_presence $xlib $jid xa]
    $mm add command -label [::msgcat::mc "Do not disturb"] \
		    -command [list send_custom_presence $xlib $jid dnd]
    $mm add command -label [::msgcat::mc "Unavailable"] \
		    -command [list send_custom_presence $xlib $jid unavailable]

    $m add cascade -label [::msgcat::mc "Send custom presence"] \
		   -menu $mm
}

hook::add chat_create_user_menu_hook custom_presence_menu 43
hook::add roster_jid_popup_menu_hook custom_presence_menu 43
hook::add roster_service_popup_menu_hook custom_presence_menu 43
hook::add chat_create_conference_menu_hook custom_presence_menu 43

###############################################################################

proc service_login {xlib jid} {
    global userstatus curtextstatus

    set newargs {}

    if {$curtextstatus != ""} {
	lappend newargs -status $curtextstatus
    }

    switch -- $userstatus {
	available {
	    set command [list ::xmpp::sendPresence $xlib -to $jid]
	}
	invisible {
	    set command [list ::xmpp::sendPresence $xlib -to $jid -type $userstatus]
	}
	default {
	    set command [list ::xmpp::sendPresence $xlib -to $jid -show $userstatus]
	}
    }

    eval $command $newargs
}

proc service_logout {xlib jid} {
    global curtextstatus

    set newargs {}

    if {$curtextstatus != ""} {
	lappend newargs -status $curtextstatus
    }

    set command [list ::xmpp::sendPresence $xlib -to $jid -type unavailable]

    eval $command $newargs
}

proc service_login_logout_menu_item {m xlib jid} {
    # TODO
    $m add command -label [::msgcat::mc "Log in"] \
		   -command [list service_login $xlib $jid]
    $m add command -label [::msgcat::mc "Log out"] \
		   -command [list service_logout $xlib $jid]
}

hook::add roster_service_popup_menu_hook service_login_logout_menu_item 20

###############################################################################

# vim:ts=8:sw=4:sts=4:noet
