# $Id: presence.tcl 1391 2008-03-07 19:03:08Z 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 {connid from type x args} {
    global presence
    global processed_presence

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

    set from [tolower_node_and_domain $from]

    switch -- $type {
	error -
	unavailable {
	    catch { unset presence(type,$connid,$from) }
	    catch { unset presence(status,$connid,$from) }
	    catch { unset presence(priority,$connid,$from) }
	    catch { unset presence(meta,$connid,$from) }
	    catch { unset presence(icon,$connid,$from) }
	    catch { unset presence(show,$connid,$from) }
	    catch { unset presence(loc,$connid,$from) }
	    catch { unset presence(x,$connid,$from) }
	    catch { unset presence(error,$connid,$from) }

	    set user [node_and_server_from_jid $from]
	    if {[info exists presence(user_jids,$connid,$user)]} {
		set idx [lsearch -exact $presence(user_jids,$connid,$user) $from]
		set presence(user_jids,$connid,$user) \
		    [lreplace $presence(user_jids,$connid,$user) $idx $idx]
	    }
	    cache_preferred_jid_on_unavailable $connid $from $user
	    cache_user_status $connid $user

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

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

	    set user [node_and_server_from_jid $from]
	    if {![info exists presence(user_jids,$connid,$user)] || \
		    ![lcontain $presence(user_jids,$connid,$user) $from]} {
		lappend presence(user_jids,$connid,$user) $from
	    }

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

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

proc get_jids_of_user {connid user} {
    global presence

    if {[info exists presence(user_jids,$connid,$user)]} {
	return $presence(user_jids,$connid,$user)
    } elseif {![cequal [resource_from_jid $user] ""]} {
	if {[info exists presence(type,$connid,$user)]} {
	    return [list $user]
	}
    }
    return {}
}

proc get_jid_of_user {connid user} {
    global presence

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

proc cache_preferred_jid_on_available {connid jid user} {
    global presence

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

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

proc cache_preferred_jid_on_unavailable {connid jid user} {
    global presence

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

proc cache_preferred_jid {connid user} {
    global presence

    set jids [get_jids_of_user $connid $user]

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

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

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


proc get_jid_status {connid jid} {
    global presence

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

proc get_jid_presence_info {param connid jid} {
    global presence

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

proc get_user_status {connid user} {
    global presence

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

proc cache_user_status {connid user} {
    global presence

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

proc get_user_status_desc {connid user} {
    global presence

    set jid [get_jid_of_user $connid $user]
    if {[info exists presence(status,$connid,$jid)]} {
	return $presence(status,$connid,$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 \
        -parent .

    $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 [jlib::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 [cconcat [::msgcat::mc "invalid userstatus value "] $newstatus]
    }

    set userstatusdesc $statusdesc($newstatus)
    if {[cequal $newtextstatus ""]} {
	set status $userstatusdesc
    } else {
	set status $newtextstatus
    }

    foreach connid [jlib::connections] {
	send_presence $newstatus \
		      -stat $status \
		      -pri $userpriority \
		      -connection $connid
    }

    foreach chatid [lfilter chat::is_groupchat [chat::opened]] {
	set connid [chat::get_connid $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 $newst \
		      -to $group/$nick \
		      -stat $status \
		      -pri $userpriority \
		      -connection $connid
    }

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

    hook::run change_our_presence_post_hook $newstatus
}

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

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

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

    set userstatusdesc $statusdesc($userstatus)
    if {[cequal $textstatus ""]} {
	set status $userstatusdesc
    } else {
	set status $textstatus
    }

    set curuserstatus $userstatus
    set curtextstatus $textstatus
    set curpriority [set userpriority $loginconf(priority)]
    
    send_presence $userstatus \
		  -stat $status \
		  -pri $userpriority \
		  -connection $connid

    hook::run change_our_presence_post_hook $userstatus
}

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

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

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

    set type jid
    set stat ""
    foreach {key val} $args {
	switch -- $key {
	    -type       { set type $val }
	    -stat       { set stat $val }
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	return -code error "send_custom_presence: -connection required"
    }
    if {$stat == ""} {
	set stat $statusdesc($status)
    }
    
    switch -- $type {
	group   { set to $jid/[get_our_groupchat_nick [chat::chatid $connid $jid]] }
	default { set to $jid }
    }

    eval {send_presence $status} $args {-to $to -stat $stat -pri $userpriority}
}

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

proc send_presence {status args} {
    set xlist {}
    set newargs {}
    set stat ""
    foreach {opt val} $args {
	switch -- $opt {
	    -to         { lappend newargs -to $val }
	    -pri        { lappend newargs -pri $val }
	    -command    { lappend newargs -command $val }
	    -xlist      { set xlist $val }
	    -stat       { set stat $val }
	    -connection {
		set connid $val
		lappend newargs -connection $val
	    }
	}
    }
    if {![info exists connid]} {
	return -code error "send_presence: -connection required"
    }

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

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

    switch -- $status {
	available   { set command [list jlib::send_presence] }
	unavailable { set command [list jlib::send_presence -type $status] }
	default     { set command [list jlib::send_presence -show $status] }
    }

    debugmsg presence "$command $newargs"
    eval $command $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 connid jid} {
    upvar 0 $infovar info

    set bjid [node_and_server_from_jid $jid]
    if {[chat::is_groupchat [chat::chatid $connid $bjid]]} return

    set priority [get_jid_presence_info priority $connid $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 {connid} {
    global presence

    if {$connid == {}} {
	array unset presence
    } else {
	# TODO
	array unset presence type,$connid,*
	array unset presence status,$connid,*
	array unset presence priority,$connid,*
	array unset presence meta,$connid,*
	array unset presence icon,$connid,*
	array unset presence show,$connid,*
	array unset presence loc,$connid,*
	array unset presence error,$connid,*
	array unset presence x,$connid,*
	array unset presence user_jids,$connid,*
	array unset presence preferred_jid,$connid,*
	array unset presence cachedstatus,$connid,*
	array unset presence maxpriority,$connid,*
    }
}

hook::add disconnected_hook clear_presence_info

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

proc custom_presence_menu {m connid jid} {
    set mm [menu $m.custom_presence -tearoff 0]

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

    $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 {connid jid} {
    global userstatus

    switch -- $userstatus {
	available {
	    jlib::send_presence -to $jid -connection $connid
	}
	invisible {
	    jlib::send_presence -to $jid -type $userstatus -connection $connid
	}
	default {
	    jlib::send_presence -to $jid -show $userstatus -connection $connid
	}
    }
}

proc service_logout {connid jid} {
    jlib::send_presence -to $jid -type unavailable -connection $connid
}

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

hook::add roster_service_popup_menu_hook service_login_logout_menu_item 20

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

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