# $Id: iroster.tcl 1506 2008-10-10 20:08:57Z sergei $

Tree .faketree
foreach {k v} [list background       White \
		    foreground       Black] {
    if {[cequal [set t$k [option get .faketree $k Tree]] ""]} {
	set t$k $v
    }
}
destroy .faketree
Button .fakebutton
foreach {k v} [list background       Gray \
		    activeBackground LightGray] {
    if {[cequal [set b$k [option get .fakebutton $k Button]] ""]} {
	set b$k $v
    }
}
destroy .fakebutton

option add *Roster.cbackground           $tbackground       widgetDefault
option add *Roster.groupindent           22                 widgetDefault
option add *Roster.jidindent             24                 widgetDefault
option add *Roster.jidmultindent         40                 widgetDefault
option add *Roster.subjidindent          34                 widgetDefault
option add *Roster.groupiconindent        2                 widgetDefault
option add *Roster.subgroupiconindent    22                 widgetDefault
option add *Roster.iconindent             3                 widgetDefault
option add *Roster.subitemtype            1                 widgetDefault
option add *Roster.subiconindent         13                 widgetDefault
option add *Roster.textuppad              1	            widgetDefault
option add *Roster.textdownpad            1	            widgetDefault
option add *Roster.linepad                2	            widgetDefault
option add *Roster.foreground            $tforeground       widgetDefault
option add *Roster.jidfill               $tbackground       widgetDefault
option add *Roster.jidhlfill             $bactiveBackground widgetDefault
option add *Roster.jidborder             $tbackground       widgetDefault
option add *Roster.groupfill             $bbackground       widgetDefault
option add *Roster.groupcfill            $bbackground       widgetDefault
option add *Roster.grouphlfill           $bactiveBackground widgetDefault
option add *Roster.groupborder           $tforeground       widgetDefault
option add *Roster.connectionfill        $tbackground       widgetDefault
option add *Roster.connectioncfill       $tbackground       widgetDefault
option add *Roster.connectionhlfill      $bactiveBackground widgetDefault
option add *Roster.connectionborder      $tforeground       widgetDefault
option add *Roster.unsubscribedforeground #663333            widgetDefault
option add *Roster.unavailableforeground #666666            widgetDefault
option add *Roster.dndforeground         #666633            widgetDefault
option add *Roster.xaforeground          #004d80            widgetDefault
option add *Roster.awayforeground        #004d80            widgetDefault
option add *Roster.availableforeground   #0066cc            widgetDefault
option add *Roster.chatforeground        #0099cc            widgetDefault

unset tbackground tforeground bbackground bactiveBackground

namespace eval roster {
    custom::defgroup Roster [::msgcat::mc "Roster options."] -group Tkabber
    custom::defvar use_aliases 1 \
	[::msgcat::mc "Use aliases to show multiple users in one roster item."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar show_only_online 0 \
	[::msgcat::mc "Show only online users in roster."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar show_transport_icons 0 \
	[::msgcat::mc "Show native icons for transports/services in roster."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar show_transport_user_icons 0 \
	[::msgcat::mc "Show native icons for contacts, connected to transports/services in roster."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar options(nested) 0 \
	[::msgcat::mc "Enable nested roster groups."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar options(nested_delimiter) "::" \
	[::msgcat::mc "Default nested roster group delimiter."] \
	-type string -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar options(show_own_resources) 0 \
	[::msgcat::mc "Show my own resources in the roster."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar options(chats_group) 0 \
	[::msgcat::mc "Add chats group in roster."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar options(use_filter) 0 \
	[::msgcat::mc "Use roster filter."] \
	-type boolean -group Roster \
	-command [namespace current]::pack_filter_entry
    custom::defvar options(match_jids) 0 \
	[::msgcat::mc "Match contact JIDs in addition to nicknames in roster filter."] \
	-type boolean -group Roster \
	-command [namespace current]::redraw_after_idle
    custom::defvar options(free_drop) 1 \
	[::msgcat::mc "Roster item may be dropped not only over group name\
but also over any item in group."] \
	-type boolean -group Roster
    custom::defvar options(show_subscription) 0 \
	[::msgcat::mc "Show subscription type in roster item tooltips."] \
	-type boolean -group Roster
    custom::defvar options(show_conference_user_info) 0 \
	[::msgcat::mc "Show detailed info on conference room members in roster item tooltips."] \
	-type boolean -group Roster
    custom::defvar options(chat_on_doubleclick) 1 \
	[::msgcat::mc "If set then open chat window/tab when user doubleclicks roster item.\
		       Otherwise open normal message window."] \
	-type boolean -group Roster

#   {jid1 {group1 1 group2 0} jid2 {group3 0 group4 0}}
    custom::defvar collapsed_group_list {} \
	[::msgcat::mc "Stored collapsed roster groups."] \
	-type string -group Hidden
#   {jid1 {group1 1 group2 0} jid2 {group3 0 group4 0}}
    custom::defvar show_offline_group_list {} \
	[::msgcat::mc "Stored show offline roster groups."] \
	-type string -group Hidden
    custom::defvar options(filter) "" \
	[::msgcat::mc "Roster filter."] \
	-type string -group Hidden \
	-command [namespace current]::redraw_after_idle

    variable menu_item_idx 0

    variable undef_group_name $::roster::undef_group_name
    variable chats_group_name $::roster::chats_group_name
    variable own_resources_group_name $roster::own_resources_group_name
}

proc roster::get_group_lists {} {
    variable collapsed_group_list
    variable show_offline_group_list
    variable collapsed
    variable show_offline

    foreach {jid grlist} $collapsed_group_list {
	foreach {group val} $grlist {
	    set collapsed($jid,$group) $val
	}
    }
    foreach {jid grlist} $show_offline_group_list {
	foreach {group val} $grlist {
	    set show_offline($jid,$group) $val
	}
    }
}

hook::add finload_hook [namespace current]::roster::get_group_lists

proc roster::set_group_lists {connid} {
    variable collapsed_group_list
    variable show_offline_group_list
    variable collapsed
    variable show_offline
    variable roster
    variable options
    variable undef_group_name
    variable chats_group_name

    set _collapsed_group_list $collapsed_group_list
    set _show_offline_group_list $show_offline_group_list

    if {$connid == {}} {
	set connidlist [jlib::connections]
    } else {
	set connidlist [list $connid]
    }

    foreach connid $connidlist {
	if {[catch { set bare_jid [jlib::connection_bare_jid $connid] }]} {
	    continue
	}
	if {[catch { set groups [roster::get_groups $connid -raw 1] }]} {
	    continue
	}
	if {$options(nested)} {
	    set tmp {}
	    foreach group $groups {
		set tmp1 [msplit $group $options(nested_delimiter)]
		for {set i 0} {$i < [llength $tmp1]} {incr i} {
		    lappend tmp [lrange $tmp1 0 $i]
		}
	    }
	    set groups [lrmdups $tmp]
	}
	lappend groups $undef_group_name $chats_group_name
	set tmpc {}
	set tmps {}
	foreach group $groups {
	    if {$options(nested)} {
		set grname [join $group $options(nested_delimiter)]
		set gid [list $connid $group]
	    } else {
		set grname [list $group]
		set gid [list $connid $grname]
	    }
	    if {[info exists roster(collapsed,$gid)]} {
		set collapsed($bare_jid,$grname) $roster(collapsed,$gid)
		lappend tmpc $grname $roster(collapsed,$gid)
	    }
	    if {[info exists roster(show_offline,$gid)]} {
		set show_offline($bare_jid,$grname) $roster(show_offline,$gid)
		lappend tmps $grname $roster(show_offline,$gid)
	    }
	}
	if {![lempty $tmpc]} {
	    while {[set idx [lsearch -exact $_collapsed_group_list $bare_jid]] >= 0} {
		set _collapsed_group_list \
		    [lreplace $_collapsed_group_list $idx [expr {$idx + 1}]]
	    }
	    lappend _collapsed_group_list $bare_jid $tmpc
	}
	if {![lempty $tmps]} {
	    while {[set idx [lsearch -exact $_show_offline_group_list $bare_jid]] >= 0} {
		set _show_offline_group_list \
		    [lreplace $_show_offline_group_list $idx [expr {$idx + 1}]]
	    }
	    lappend _show_offline_group_list $bare_jid $tmps
	}
    }

    set collapsed_group_list $_collapsed_group_list
    set show_offline_group_list $_show_offline_group_list
}

hook::add predisconnected_hook [namespace current]::roster::set_group_lists

proc roster::process_item {connid jid name groups subsc ask} {
    after cancel [namespace parent]::update_chat_titles
    after idle [namespace parent]::update_chat_titles
}

hook::add roster_item_hook [namespace current]::roster::process_item 90
hook::add roster_push_hook [namespace current]::roster::process_item 90

proc roster::create_filter_entry {} {
    entry .roster_filter -textvariable [namespace current]::options(filter) \
			 -width 1
    bind .roster_filter <Escape> \
	 [list set [namespace current]::options(filter) ""]
    pack_filter_entry
}

hook::add finload_hook [namespace current]::roster::create_filter_entry

proc roster::pack_filter_entry {args} {
    global usetabbar
    variable options

    if {$options(use_filter)} {
	if {$usetabbar} {
	    pack .roster_filter -before .roster \
				-anchor w \
				-side bottom \
				-fill x \
				-expand no \
				-in $::ifacetk::rw
	} else {
	    grid .roster_filter -row 2 \
				-column 1 \
				-sticky we \
				-in [$::ifacetk::mf getframe]
	}
	focus .roster_filter
    } else {
	if {$usetabbar} {
	    pack forget .roster_filter
	} else {
	    grid forget .roster_filter
	}
    }
    redraw_after_idle
}

# TODO: get rid of roster::roster
proc roster::redraw {} {
    upvar #0 roster::aliases aliases
    variable roster
    variable options
    variable config
    variable show_only_online
    variable use_aliases
    variable show_transport_user_icons
    variable undef_group_name
    variable chats_group_name
    variable own_resources_group_name
    variable collapsed
    variable show_offline

    clear .roster 0
    
    set connections [jlib::connections]
    switch -- [llength $connections] {
	0 {
	    update_scrollregion .roster
	    return
	}
	1 {
	    set draw_connection 0
	    set gindent 0
	}
	default {
	    set draw_connection 1
	    set gindent 0
	}
    }

    foreach connid $connections {
        # Suppress display of aliases, but not if "main" JID is unavailable.
        # If main JID is unavailable, perform reordering of aliases.
        # Suppression means that aliases wont get a line in the roster for
	# themselves, but will be places as children under "main" JID element
	if {$use_aliases} {
	    foreach jid [array names aliases] {
		set status [get_user_status $connid $jid]
		if {$status == "unavailable"} {
		    # Need to look an alternative for main JID,
		    # which is offline.
		    set jidstatus [get_user_aliases_status_and_jid $connid $jid]
                    switch -- [lindex $jidstatus 1] {
                        unavailable {
                            # Main JID and all aliases are unavailable.
			    # Will skip them all
                        }
                        default {
                            # Make "most available" JID the main JID,
			    # put main JID into list of aliases
                            set new_jid [lindex $jidstatus 0]
                            set idx [lsearch -exact $aliases($jid) $new_jid]
                            set new_aliases [lreplace $aliases($jid) $idx $idx]
                            # If this already have some aliases defined,
			    # merge them in
                            if {[info exists aliases($new_jid)]} {
                                set new_aliases \
				    [lsort -unique -dictionary -index 0 \
					 [lappend new_aliases \
					      $aliases($new_jid)]]
                            }
                            set aliases($new_jid) $new_aliases
                            # Remove aliases of old "main" JID
                            set aliases($jid) {}
                        }
                    }
                }
                # Main JID is online, suppress alternatives
                foreach alias $aliases($jid) {
                    set ignore_jid($alias) ""
                }
            }
        }
        
	if {$draw_connection} {
	    if {![info exists roster(collapsed,[list connid $connid])]} {
		set roster(collapsed,[list connid $connid]) 0
	    }
	    addline .roster connection \
		[jlib::connection_jid $connid] \
		[list connid $connid] [list connid $connid] 0
	    
	    if {$roster(collapsed,[list connid $connid])} {
		continue
	    }
	}

	if {[lempty [::roster::get_jids $connid]]} {
	    continue
	}
	set bare_jid [jlib::connection_bare_jid $connid]
	set groups {}
	array unset jidsingroup
	array unset jidsundergroup
	array unset groupsundergroup
	foreach jid [::roster::get_jids $connid] {
	    if {$options(use_filter) && $options(filter) != ""} {
		if {[string first [string tolower $options(filter)] \
				  [string tolower [::roster::get_label $connid $jid]]] < 0} {
		    if {!$options(match_jids) || \
			    [string first [string tolower $options(filter)] \
					  [string tolower $jid]] < 0} {
			continue
		    }
		}
	    }
	    if {[info exists ignore_jid($jid)]} continue
	    set jid_groups [::roster::itemconfig $connid $jid -group]
	    if {![lempty $jid_groups]} {
		foreach group $jid_groups {
		    if {$options(nested)} {
			set sgroup [msplit $group $options(nested_delimiter)]
		    } else {
			set sgroup [list $group]
		    }
		    lappend groups [list [join $sgroup "\u0000"] $sgroup]
		    lappend jidsingroup($sgroup) $jid
		    set deep [expr {[llength $sgroup] - 1}]
		    for {set i 0} {$i < $deep} {incr i} {
			set sgr [lrange $sgroup 0 $i]
			lappend groups [list [join $sgr "\u0000"] $sgr]
			lappend jidsundergroup($sgr) $jid
			lappend groupsundergroup($sgr) $sgroup
			if {![info exists jidsingroup($sgr)]} {
			    set jidsingroup($sgr) {}
			}
		    }
		    if {![info exists jidsundergroup($sgroup)]} {
			set jidsundergroup($sgroup) {}
		    }
		    if {![info exists groupsundergroup($sgroup)]} {
			set groupsundergroup($sgroup) {}
		    }
		}
	    } else {
		set sgroup [list $undef_group_name]
		lappend jidsingroup($sgroup) $jid
		set groupsundergroup($sgroup) {}
		if {![info exists jidsundergroup($sgroup)]} {
		    set jidsundergroup($sgroup) {}
		}
	    }
	}
	set groups [lsort -unique -dictionary -index 0 $groups]
	set ugroup [list $undef_group_name]
	if {[info exists jidsingroup($ugroup)]} {
	    lappend groups [list [join $ugroup "\u0000"] $ugroup]
	}
	if {$options(chats_group)} {
	    set cgroup [list $chats_group_name]
	    foreach chatid [chat::opened $connid] {
		set jid [chat::get_jid $chatid]
		lappend jidsingroup($cgroup) $jid
		if {[cequal [roster::itemconfig $connid $jid -isuser] ""]} {
		    roster::itemconfig $connid $jid \
			-name [chat::get_nick $connid $jid chat]
		    roster::itemconfig $connid $jid -subsc none
		}
	    }
	    if {[info exists jidsingroup($cgroup)]} {
		set groups [linsert $groups 0 [list [join $cgroup "\u0000"] $cgroup]]
	    }
	    set groupsundergroup($cgroup) {}
	    set jidsundergroup($cgroup) {}
	}
	if {$options(show_own_resources)} {
	    set cgroup [list $own_resources_group_name]
	    set jid [tolower_node_and_domain [::jlib::connection_bare_jid $connid]]
	    set jidsingroup($cgroup) [list $jid]
	    set groups [linsert $groups 0 [list [join $cgroup "\u0000"] $cgroup]]
	    roster::itemconfig $connid $jid -subsc both
	    set groupsundergroup($cgroup) {}
	    set jidsundergroup($cgroup) {}
	}
	foreach group $groups {
	    set group [lindex $group 1]
	    set gid [list $connid $group]
	    if {![info exists roster(show_offline,$gid)]} {
		if {$options(nested)} {
		    set gname [join $group $options(nested_delimiter)]
		} else {
		    set gname $group
		}
		if {[info exists show_offline($bare_jid,$gname)]} {
		    set roster(show_offline,$gid) $show_offline($bare_jid,$gname)
		} else {
		    set roster(show_offline,$gid) 0
		}
	    }
	}
	foreach group $groups {
	    set group [lindex $group 1]
	    set jidsingroup($group) [lrmdups $jidsingroup($group)]
	    set groupsundergroup($group) [lrmdups $groupsundergroup($group)]
	    set gid [list $connid $group]
	    if {![info exists roster(collapsed,$gid)]} {
		if {$options(nested)} {
		    set gname [join $group $options(nested_delimiter)]
		} else {
		    set gname $group
		}
		if {[info exists collapsed($bare_jid,$gname)]} {
		    set roster(collapsed,$gid) $collapsed($bare_jid,$gname)
		} else {
		    set roster(collapsed,$gid) 0
		}
	    }
	    set indent [expr {[llength $group] - 1}]
	    set collapse 0
	    set show_offline_users 0
	    set show_offline_group 0
	    foreach undergroup $groupsundergroup($group) {
		if {$roster(show_offline,[list $connid $undergroup])} {
		    set show_offline_group 1
		    break
		}
	    }
	    for {set i 0} {$i < $indent} {incr i} {
		set sgr [list $connid [lrange $group 0 $i]]
		if {$roster(collapsed,$sgr)} {
		    set collapse 1
		    break
		}
		if {$roster(show_offline,$sgr)} {
		    set show_offline_users 1
		    set show_offline_group 1
		}
	    }
	    incr indent $gindent
	    if {$collapse} continue
	    set group_name "[lindex $group end]"
	    set online 0
	    set users 0
	    set not_users 0
	    set sub_jids 0
	    foreach jid [concat $jidsingroup($group) $jidsundergroup($group)] {
		if {[::roster::itemconfig $connid $jid -isuser]} {
		    incr users
		    set status [get_user_aliases_status $connid $jid]
		    set jstat($jid) $status
		    if {$status != "unavailable"} {
			incr online
			set useronline($jid) 1
		    } else {
			set useronline($jid) 0
		    }
		} else {
		    incr not_users
		}
	    }
	    if {!$show_only_online || $show_offline_group || \
		    $roster(show_offline,$gid) || \
		    ($options(use_filter) && $options(filter) != "") || \
		    $online + $not_users + $sub_jids > 0} {
		if {$users} {
		    addline .roster group "$group_name ($online/$users)" \
			$gid $gid $indent
		} else {
		    addline .roster group $group_name \
			$gid $gid $indent
		}
	    }
	    if {!$roster(collapsed,$gid)} {
		set jid_names {}
		foreach jid $jidsingroup($group) {
		    lappend jid_names [list $jid [::roster::get_label $connid $jid]]
		}
		set jid_names [lsort -index 1 -dictionary $jid_names]
		foreach jid_name $jid_names {
		    lassign $jid_name jid name
		    if {$options(chats_group)} {
			set chatid [chat::chatid $connid $jid]
			if {[info exists chat::chats(messages,$chatid)] && \
				$chat::chats(messages,$chatid) > 0} {
			    append name " \[$chat::chats(messages,$chatid)\]"
			}
		    }
		    set cjid [list $connid $jid]
		    if {!$show_only_online || $show_offline_users || $roster(show_offline,$gid) || \
			    ($options(use_filter) && $options(filter) != "") || \
			    ![info exists useronline($jid)] || $useronline($jid)} {
			lassign [::roster::get_category_and_subtype $connid $jid] category type
			set jids [get_jids_of_user $connid $jid]
			set numjids [llength $jids]
			if {($numjids > 1) && ($config(subitemtype) > 0) && \
				$category == "user"} {
			    if {$config(subitemtype) & 1} {
				if {$category == "conference"} {
				    set numjids [expr {$numjids - 1}]
				}
				set label "$name ($numjids)"
			    } else {
				set label "$name"
			    }
			    addline .roster jid $label $cjid $gid $indent $jids
			    changeicon .roster $cjid [get_jid_icon $connid $jid]
			    changeforeground .roster $cjid [get_jid_foreground $connid $jid]
			    
			    if {!$roster(collapsed,$cjid)} {
				foreach subjid $jids {
				    set subjid_resource [resource_from_jid $subjid]
				    if {$subjid_resource != ""} {
					addline .roster jid2 \
					    $subjid_resource [list $connid $subjid] \
					    $gid $indent \
					    [list $subjid]
					changeicon .roster \
					    [list $connid $subjid] [get_jid_icon $connid $subjid]
					changeforeground .roster \
					    [list $connid $subjid] [get_jid_foreground $connid $subjid]
				    }
				}
			    }
			} else {
			    if {$numjids <= 1 && $category == "user" && \
				    !$show_transport_user_icons} {
				if {[info exists jstat($jid)]} {
				    set status $jstat($jid)
				} else {
				    set status [get_user_aliases_status $connid $jid]
				}
				set subsc [::roster::itemconfig $connid $jid -subsc]
				if {([cequal $subsc from] || [cequal $subsc none]) && \
					$status == "unavailable"} {
				    set status unsubscribed
				}
				addline .roster jid $name $cjid $gid $indent \
				    $jids \
				    roster/user/$status \
				    $config(${status}foreground)
			    } else {
				addline .roster jid $name $cjid $gid $indent $jids
				changeicon .roster $cjid [get_jid_icon $connid $jid]
				changeforeground .roster $cjid [get_jid_foreground $connid $jid]
			    }
			}
		    }
		}
	    }
	}
    }
    update_scrollregion .roster
}

proc roster::redraw_after_idle {args} {
    variable redraw_afterid

    if {[info exists redraw_afterid]} return

    if {![winfo exists .roster.canvas]} return

    set redraw_afterid \
	[after idle "[namespace current]::redraw
		     unset [namespace current]::redraw_afterid"]
}

# Callback
proc ::redraw_roster {args} {
    ifacetk::roster::redraw_after_idle
}

proc roster::get_jids_of_user {connid user} {
    upvar #0 roster::aliases aliases
    variable use_aliases

    if {$use_aliases && [info exists aliases($user)]} {
	set jids [::get_jids_of_user $connid $user]
	foreach alias $aliases($user) {
	    set jids [concat $jids [::get_jids_of_user $connid $alias]]
	}
	return $jids
    } else {
	return [::get_jids_of_user $connid $user]
    }
}

proc roster::get_user_aliases_status {connid user} {
    set jidstatus [get_user_aliases_status_and_jid $connid $user]
    return [lindex $jidstatus 1]
}

proc roster::get_user_aliases_status_and_jid {connid user} {
    upvar #0 roster::aliases aliases
    variable use_aliases

    if {$use_aliases && [info exists aliases($user)]} {
	set status [get_user_status $connid $user]
        set jid $user

	foreach alias $aliases($user) {
	    set new_status [max_status $status [get_user_status $connid $alias]]
            if {$status != $new_status} {
                set status $new_status
                set jid $alias
	}
	}
	return [list $jid $status]
    } else {
	return [list $user [get_user_status $connid $user]]
    }
}

proc roster::get_jid_foreground {connid jid} {
    lassign [::roster::get_category_and_subtype $connid $jid] category type

    switch -- $category {
	"" -
	user {
	    return [get_user_foreground $connid $jid]
	}
	conference {
	    if {[get_jid_status $connid $jid] != "unavailable"} {
		return available
	    } else {
		return unavailable
	    }
	}
	server  -
	gateway -
	service {
	    return [get_service_foreground $connid $jid $type]
	}
	default {
	    return ""
	}
    }
}

proc roster::get_service_foreground {connid service type} {
    switch -- $type {
	jud {return ""}
	}
    if {![cequal [::roster::itemconfig $connid $service -subsc] none]} {
	return [get_user_status $connid $service]
    } else {
	return unsubscribed
    }
}

proc roster::get_user_foreground {connid user} {
    set status [get_user_aliases_status $connid $user]

    set subsc [::roster::itemconfig $connid $user -subsc]
    if {[cequal $subsc ""]} {
	set subsc [::roster::itemconfig $connid \
		       [::roster::find_jid $connid $user] -subsc]
    }

    if {([cequal $subsc from] || [cequal $subsc none]) && \
	    $status == "unavailable"} {
	return unsubscribed
    } else {
	return $status
    }
}

proc roster::get_jid_icon {connid jid {status ""}} {
    lassign [::roster::get_category_and_subtype $connid $jid] category type

    switch -- $category {
	"" -
	user {
	    if {$status == ""} {
		set status [get_user_aliases_status $connid $jid]
	    }
	    return [get_user_icon $connid $jid $status]
	}
	conference {
	    if {$status == ""} {
		set status [get_jid_status $connid $jid]
	    }
	    if {$status != "unavailable"} {
		return roster/conference/available
	    }
	    return roster/conference/unavailable
	}
	server  -
	gateway -
	service {
	    if {$status == ""} {
		set status [get_user_status $connid $jid]
	    }
	    return [get_service_icon $connid $jid $type $status]
	}
	default {
	    if {$status == ""} {
		set status [get_jid_status $connid $jid]
	    }
	    return [get_user_icon $connid $jid $status]
	}
    }
}

proc roster::get_service_icon {connid service type status} {
    variable show_transport_icons

    if {$show_transport_icons} {
	switch -- $type {
	    jud {return services/jud}
	    sms {return services/sms}
	}
	if {![cequal [::roster::itemconfig $connid $service -subsc] none]} {
	    if {![catch { image type services/$type/$status }]} {
		return services/$type/$status
	    } else {
		return roster/user/$status
	    }
	} else {
	    return roster/user/unsubscribed
	}
    } else {
	if {![cequal [::roster::itemconfig $connid $service -subsc] none]} {
	    return roster/user/$status
	} else {
	    return roster/user/unsubscribed
	}
    }
}

proc roster::get_user_icon {connid user status} {
    variable show_transport_user_icons

    set subsc [::roster::itemconfig $connid $user -subsc]
    if {[cequal $subsc ""]} {
	set subsc [::roster::itemconfig $connid \
	               [::roster::find_jid $connid $user] -subsc]
    }

    if {!([cequal $subsc from] || [cequal $subsc none]) || \
	    $status != "unavailable"} {
	if {$show_transport_user_icons} {
	    set service [server_from_jid $user]
	    lassign [::roster::get_category_and_subtype $connid $service] category type
	    switch -glob -- $category/$type {
		directory/* -
		*/jud {
		    return services/jud
		}
		*/sms {
		    return services/sms
		}
	    }
	    if {![catch { image type services/$type/$status }]} {
		return services/$type/$status
	    } else {
		return roster/user/$status
	    }
	} else {
	    return roster/user/$status
	}
    } else {
	return roster/user/unsubscribed
    }
}

proc roster::changeicon {w jid icon} {
    set c $w.canvas
    set tag [jid_to_tag $jid]

    $c itemconfigure jid$tag&&icon -image $icon
}

proc roster::changeforeground {w jid fg {color ""}} {
    variable config

    set c $w.canvas
    set tag [jid_to_tag $jid]
    if {$color == ""} {
	set color $config(${fg}foreground)
    }
    $c itemconfigure jid$tag&&text -fill $color
}

proc roster::create {w args} {
    variable iroster
    variable config

    set c $w.canvas
    
    set width 150
    set height 100
    set popupproc {}
    set grouppopupproc {}
    set singleclickproc {}
    set doubleclickproc {}
    foreach {attr val} $args {
	switch -- $attr {
	    -width {set width $val}
	    -height {set height $val}
	    -popup {set popupproc $val}
	    -grouppopup {set grouppopupproc $val}
	    -singleclick {set singleclickproc $val}
	    -doubleclick {set doubleclickproc $val}
	    -draginitcmd {set draginitcmd $val}
	    -dropovercmd {set dropovercmd $val}
	    -dropcmd {set dropcmd $val}
	}
    }

    frame $w -relief sunken -borderwidth $::tk_borderwidth -class Roster
    set sw [ScrolledWindow $w.sw]
    pack $sw -fill both -expand yes

    set config(groupindent)        [option get $w groupindent Roster] 
    set config(jidindent)          [option get $w jidindent   Roster]
    set config(jidmultindent)      [option get $w jidmultindent   Roster]
    set config(jid2indent)         [option get $w subjidindent Roster]
    set config(groupiconindent)    [option get $w groupiconindent  Roster]
    set config(subgroupiconindent) [option get $w subgroupiconindent  Roster]
    set config(iconindent)         [option get $w iconindent  Roster]
    set config(subitemtype)        [option get $w subitemtype  Roster]
    set config(subiconindent)      [option get $w subiconindent  Roster]
    set config(textuppad)          [option get $w textuppad   Roster]
    set config(textdownpad)        [option get $w textdownpad Roster]
    set config(linepad)	           [option get $w linepad     Roster]
    set config(background)  [option get $w cbackground Roster] 
    set config(jidfill)	    [option get $w jidfill     Roster]
    set config(jidhlfill)   [option get $w jidhlfill   Roster]
    set config(jidborder)   [option get $w jidborder   Roster]
    set config(jid2fill)    $config(jidfill)
    set config(jid2hlfill)  $config(jidhlfill)
    set config(jid2border)  $config(jidborder)
    set config(groupfill)   [option get $w groupfill   Roster]
    set config(groupcfill)  [option get $w groupcfill  Roster]
    set config(grouphlfill) [option get $w grouphlfill Roster]
    set config(groupborder) [option get $w groupborder Roster]
    set config(connectionfill)   [option get $w connectionfill   Roster]
    set config(connectioncfill)  [option get $w connectioncfill  Roster]
    set config(connectionhlfill) [option get $w connectionhlfill Roster]
    set config(connectionborder) [option get $w connectionborder Roster]
    set config(foreground)             [option get $w foreground  Roster]
    set config(unsubscribedforeground) [option get $w unsubscribedforeground Roster]
    set config(unavailableforeground)  [option get $w unavailableforeground Roster]
    set config(dndforeground)          [option get $w dndforeground Roster]
    set config(xaforeground)           [option get $w xaforeground Roster]
    set config(awayforeground)         [option get $w awayforeground Roster]
    set config(availableforeground)    [option get $w availableforeground Roster]
    set config(chatforeground)         [option get $w chatforeground Roster]

    canvas $c -bg $config(background) \
	-highlightthickness $::tk_highlightthickness \
	-scrollregion {0 0 0 0} \
	-width $width -height $height

    $sw setwidget $c

    set iroster($w,ypos) 1
    set iroster($w,width) 0
    set iroster($w,popup) $popupproc
    set iroster($w,grouppopup) $grouppopupproc
    set iroster($w,singleclick) $singleclickproc
    set iroster($w,doubleclick) $doubleclickproc

    bindscroll $c

    if {[info exists draginitcmd]} {
	DragSite::register $c -draginitcmd $draginitcmd
    }

    set args {}
    if {[info exists dropovercmd]} {
	lappend args -dropovercmd $dropovercmd
    }
    if {[info exists dropcmd]} {
	lappend args -dropcmd $dropcmd
    }
    if {![lempty $args]} {
	eval [list DropSite::register $c -droptypes {JID}] $args
    }
}

proc roster::addline {w type text jid group indent {jids {}} {icon ""} {foreground ""}} {
    upvar #0 roster::aliases aliases
    variable roster
    variable iroster
    variable config
    variable use_aliases

    set c $w.canvas

    set tag [jid_to_tag $jid]
    set grouptag [jid_to_tag $group]

    set ypad 1
    set linespace [font metric $::RosterFont -linespace]
    set lineheight [expr {$linespace + $ypad}]

    set uy $iroster($w,ypos)
    set ly [expr {$uy + $lineheight + $config(textuppad) + \
		      $config(textdownpad)}]

    set levindent [expr $config(groupindent)*$indent]

    set border $config(${type}border)
    set hlfill $config(${type}hlfill)

    if {($type == "group" || $type == "connection") && \
	[info exists roster(collapsed,$jid)] && \
	$roster(collapsed,$jid)} {
	set rfill $config(${type}cfill)
    } else {
	set rfill $config(${type}fill)
    }
    
    if {$type == "connection"} {
	set type group
    }

    $c create rectangle [expr {1 + $levindent}] $uy 10000 $ly -fill $rfill \
	-outline $border -tags [list jid$tag group$grouptag $type rect]


    if {[cequal $type jid]} {
	lassign $jid connid jjid
	set isuser [::roster::itemconfig $connid $jjid -isuser]
	if {[cequal $isuser ""]} {
	    set isuser 1
	}

	set y [expr {($uy + $ly)/2}]
	set x [expr {$config(iconindent) + $levindent}]

	if {$icon == ""} {
	    $c create image $x $y -image roster/user/unavailable \
		-anchor w \
		-tags [list jid$tag group$grouptag $type icon]
	} else {
	    $c create image $x $y -image $icon \
		-anchor w \
		-tags [list jid$tag group$grouptag $type icon]
	}
	if {[llength $jids] > 1} {
	    if {[info exists roster(collapsed,$jid)] && !$roster(collapsed,$jid)} {
		set jid_state opened
	    } else {
		set roster(collapsed,$jid) 1
		set jid_state closed
	    }
	    if {$config(subitemtype) > 0} {
		if {($config(subitemtype) & 2) && $isuser} {
		    set y [expr {($uy + $ly)/2}]
		    set x [expr {$config(subgroupiconindent) + $levindent}]
		    $c create image $x $y -image roster/group/$jid_state -anchor w \
			-tags [list jid$tag group$grouptag $type group]
		}
	    }
	} else {
	    set roster(collapsed,$jid) 1
	}
    } elseif {[cequal $type jid2]} {
	#set jids [get_jids_of_user $jid]
	set y [expr {($uy + $ly)/2}]
	set x [expr {$config(subiconindent) + $levindent}]

	$c create image $x $y -image roster/user/unavailable -anchor w \
	    -tags [list jid$tag group$grouptag $type icon]
    } elseif {[cequal $type group]} {
	set y [expr {($uy + $ly)/2}]
	set x [expr {$config(groupiconindent) + $levindent}]
	if {[info exists roster(collapsed,$jid)] && $roster(collapsed,$jid)} {
	    set group_state closed
	} else {
	    set group_state opened
	}
	$c create image $x $y -image roster/group/$group_state -anchor w \
	    -tags [list jid$tag group$grouptag $type icon]
    }

    if {([cequal $type jid]) && ($config(subitemtype) > 0) && ($config(subitemtype) & 2)} {
	#set jids [get_jids_of_user $jid]
	if {$isuser && ([llength $jids] > 1)} {
	    set x [expr {$config(jidmultindent) + $levindent}]
	} else {
	    set x [expr {$config(jidindent) + $levindent}]
	}
    } else {
	set x [expr {$config(${type}indent) + $levindent}]
    }
    incr uy $config(textuppad)

    if {$foreground == ""} {
	if {[cequal $type jid] || [cequal $type jid2]} {
	    set foreground $config(unavailableforeground)
	} else {
	    set foreground $config(foreground)
	}
    }
    $c create text $x $uy -text $text -anchor nw -font $::RosterFont \
	-fill $foreground -tags [list jid$tag group$grouptag $type text]

    set iroster($w,width) [max $iroster($w,width) \
			      [expr {$x + [font measure $::RosterFont $text]}]]


    $c bind jid$tag <Any-Enter> \
	[list $c itemconfig jid$tag&&rect -fill $hlfill]
    $c bind jid$tag <Any-Leave> \
	[list $c itemconfig jid$tag&&rect -fill $rfill]

    set doubledjid  [double% $jid]
    set doubledjids [double% $jids]

    set iroster($w,ypos) [expr {$ly + $config(linepad)}]

    if {[cequal $type jid] || [cequal $type jid2]} {
	$c bind jid$tag <Button-1> \
	    [list [namespace current]::on_singleclick \
		 [double% $iroster($w,singleclick)] $doubledjid]

	$c bind jid$tag <Double-Button-1> \
	    [list [namespace current]::on_doubleclick \
		 [double% $iroster($w,doubleclick)] $doubledjid]

	$c bind jid$tag <Any-Enter> \
	    +[list eval balloon::set_text \
		  \[[namespace current]::jids_popup_info \
		  [list $doubledjid] [list $doubledjids]\]]

	$c bind jid$tag <Any-Motion> \
	    [list eval balloon::on_mouse_move \
		 \[[namespace current]::jids_popup_info \
		 [list $doubledjid] [list $doubledjids]\] %X %Y]

	$c bind jid$tag <Any-Leave> {+ balloon::destroy}
	
	if {![cequal $iroster($w,popup) {}]} {
	    $c bind jid$tag <3> [list [double% $iroster($w,popup)] $doubledjid]
	}
    } else {
	if {$w == ".roster"} {
	    $c bind jid$tag&&group <Button-1> \
		[list [namespace current]::group_click $doubledjid]
	}

	if {![cequal $iroster($w,grouppopup) {}]} {
	    $c bind jid$tag&&group <3> \
		[list $iroster($w,grouppopup) $doubledjid]
	}
    }
}

proc roster::clear {w {updatescroll 1}} {
    variable iroster

    $w.canvas delete rect||icon||text||group

    set iroster($w,ypos) 1
    set iroster($w,width) 0
    if {$updatescroll} {
	update_scrollregion $w
    }
}

proc roster::update_scrollregion {w} {
    variable iroster

    $w.canvas configure \
	-scrollregion [list 0 0 $iroster($w,width) $iroster($w,ypos)]
}

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

proc roster::on_singleclick {command cjid} {
    variable click_afterid

    if {$command == ""} return

    if {![info exists click_afterid]} {
	set click_afterid \
	    [after 300 [list [namespace current]::singleclick_run $command $cjid]]
    } else {
	after cancel $click_afterid
	unset click_afterid
    }
}

proc roster::singleclick_run {command cjid} {
    variable click_afterid

    if {[info exists click_afterid]} {
	unset click_afterid
    }

    eval $command {$cjid}
}

proc roster::on_doubleclick {command cjid} {
    variable click_afterid

    if {[info exists click_afterid]} {
	after cancel $click_afterid
	unset click_afterid
    }

    if {$command == ""} return

    eval $command {$cjid}
}

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

proc roster::jid_doubleclick {id} {
    lassign $id connid jid
    lassign [::roster::get_category_and_subtype $connid $jid] category subtype

    hook::run roster_jid_doubleclick $connid $jid $category $subtype
}

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

proc roster::doubleclick_fallback {connid jid category subtype} {
    variable options

    if {$options(chat_on_doubleclick)} {
	chat::open_to_user $connid $jid
    } else {
	message::send_dialog -to $jid
    }
}

hook::add roster_jid_doubleclick \
    [namespace current]::roster::doubleclick_fallback 100

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

proc roster::group_click {gid} {
    variable roster

    set roster(collapsed,$gid) [expr {!$roster(collapsed,$gid)}]
    redraw_after_idle
}

proc roster::jids_popup_info {id jids} {
    variable use_aliases

    lassign $id connid jid

    if {$jids == {}} {
	if {$use_aliases && [info exists aliases($jid)]} {
	    set jids [concat [list $jid] $aliases($jid)]
	} else {
	    set jids [list $jid]
	}
    }

    set text {}
    set i 0
    foreach j $jids {
	append text "\n[[namespace current]::user_popup_info $connid $j $i]"
	incr i
    }
    set text [string trimleft $text "\n"]
    return $text
}

proc roster::user_popup_info {connid user i} {
    variable options
    variable user_popup_info
    global statusdesc

    lassign [::roster::get_category_and_subtype $connid $user] category subtype
    set bare_user [::roster::find_jid $connid $user]
    lassign [::roster::get_category_and_subtype $connid $bare_user] \
	category1 subtype1

    set name $user
    switch -- $category {
	conference {
	    set status $statusdesc([get_jid_status $connid $user])
	    set desc ""
	}
	user -
	default {
	    set status $statusdesc([get_user_status $connid $user])
	    set desc   [get_user_status_desc $connid $user]
	    if {[cequal $category1 conference] && $i > 0} {
		if {$options(show_conference_user_info)} {
		    set name "     [resource_from_jid $user]"
		} else {
		    set name "\t[resource_from_jid $user]"
		}
	    }
	}
    }

    if {(![string equal -nocase  $status $desc]) && (![cequal $desc ""])} {
	append status " ($desc)"
    }

    set subsc [::roster::itemconfig $connid $bare_user -subsc]
    if {($options(show_subscription) && ![cequal $subsc ""]) &&
	    !([cequal $category1 conference] && [cequal $category user])} {
	set subsc [format "\n\t[::msgcat::mc {Subscription:}] %s" $subsc]
	set ask [::roster::itemconfig $connid $bare_user -ask]
	if {![cequal $ask ""]} {
	    set ask [format "  [::msgcat::mc {Ask:}] %s" $ask]
	}
    } else {
	set subsc ""
	set ask ""
    }

    set user_popup_info "$name: $status$subsc$ask"

    if {!([cequal $category1 conference] && $i > 0) || \
	    $options(show_conference_user_info)} {
	hook::run roster_user_popup_info_hook \
	    [namespace which -variable user_popup_info] $connid $user
    }

    return $user_popup_info
}

proc roster::switch_only_online {args} {
    variable show_only_online

    set show_only_online [expr {!$show_only_online}]
}

proc roster::is_online {connid jid} {
    if {[::roster::itemconfig $connid $jid -isuser]} {
	switch -- [get_user_aliases_status $connid $jid] {
	    unavailable {return 0}
	    default {return 1}
	}
    } else {
	return 1
    }
}

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

proc roster::add_remove_item_menu_item {m connid jid} {
    set rjid [roster::find_jid $connid $jid]
    if {$rjid == ""} {
	set state disabled
    } else {
	set state normal
    }
    $m add command -label [::msgcat::mc "Remove from roster..."] \
	-command [list ifacetk::roster::remove_item_dialog $connid $rjid] \
	-state $state
}

hook::add chat_create_user_menu_hook \
    [namespace current]::roster::add_remove_item_menu_item 90
hook::add roster_conference_popup_menu_hook \
    [namespace current]::roster::add_remove_item_menu_item 90
hook::add roster_service_popup_menu_hook \
    [namespace current]::roster::add_remove_item_menu_item 90
hook::add roster_jid_popup_menu_hook \
    [namespace current]::roster::add_remove_item_menu_item 90

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

proc roster::remove_item_dialog {connid jid} {
    set res [MessageDlg .remove_item -aspect 50000 -icon question -type user \
	-buttons {yes no} -default 0 -cancel 1 \
	-message [format [::msgcat::mc "Are you sure to remove %s from roster?"] $jid]]
    if {$res == 0} {
	::roster::remove_item $connid $jid
    }
}

proc roster::update_chat_activity {args} {
    variable options

    if {$options(chats_group)} {
	redraw_after_idle
    }
}

hook::add open_chat_post_hook [namespace current]::roster::redraw_after_idle
hook::add close_chat_post_hook [namespace current]::roster::redraw_after_idle
hook::add draw_message_hook [namespace current]::roster::update_chat_activity
hook::add raise_chat_tab_hook [namespace current]::roster::update_chat_activity


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

proc roster::dropcmd {target source X Y op type data} {
    variable options

    debugmsg roster "$target $source $X $Y $op $type $data"

    set c .roster.canvas

    set x [expr {$X-[winfo rootx $c]}]
    set y [expr {$Y-[winfo rooty $c]}]
    set xc [$c canvasx $x]
    set yc [$c canvasy $y]

    set tags [$c gettags [lindex [$c find closest $xc $yc] 0]]

    if {$options(free_drop) && ![cequal $tags ""]} {
	lassign [tag_to_jid [crange [lindex $tags 1] 5 end]] connid gr
	if {$connid == "connid"} {
	    set connid $gr
	    set gr {}
	}
    } elseif {[lcontain $tags group]} {
	lassign [tag_to_jid [crange [lindex $tags 0] 3 end]] connid gr
	if {$connid == "connid"} {
	    set connid $gr
	    set gr {}
	}
    } elseif {![cequal $tags ""]} {
	lassign [tag_to_jid [crange [lindex $tags 1] 5 end]] connid
	set gr {}
    } else {
	set connid [lindex [jlib::connections] 0]
	set gr {}
    }
    if {$options(nested)} {
	set gr [join $gr $options(nested_delimiter)]
    } else {
	set gr [lindex $gr 0]
    }

    debugmsg roster "GG: $gr; $tags"

    lassign $data _connid jid category type name version fromgid
    set subsc ""

    if {[info exists fromgid]} {
	lassign $fromgid fromconnid fromgr 
	if {$options(nested)} {
	    set fromgr [join $fromgr $options(nested_delimiter)]
	} else {
	    set fromgr [lindex $fromgr 0]
	}
    }	

    if {![lcontain [::roster::get_jids $connid] $jid]} {
	if {$gr != {}} {
	    set groups [list $gr]
	} else {
	    set groups {}
	}
	::roster::itemconfig $connid $jid -category $category -subtype $type \
	    -name $name -group $groups

	lassign [::roster::get_category_and_subtype $connid $jid] ccategory ctype
	switch -- $ccategory {
	    conference {
		::roster::itemconfig $connid $jid -subsc bookmark
	    }
	    user {
		jlib::send_presence -to $jid -type subscribe -connection $connid
	    }
	}
    } else {
	set groups [::roster::itemconfig $connid $jid -group]

	if {[info exists fromgid] && ($fromconnid == $connid)} {
	    set idx [lsearch -exact $groups $fromgr]
	    if {$idx >= 0} {
		set groups [lreplace $groups $idx $idx]
	    }
	}
	if {$gr != ""} {
	    lappend groups $gr
	    set groups [lrmdups $groups]
	    debugmsg roster $groups
	}

	::roster::itemconfig $connid $jid -category $category -subtype $type \
	    -name $name -group $groups
    }

    ::roster::send_item $connid $jid
}

proc roster::draginitcmd {target x y top} {
    debugmsg roster "$target $x $y $top"

    balloon::destroy
    set c .roster.canvas

    set tags [$c gettags current]
    if {[lcontain $tags jid]} {
	set grouptag [crange [lindex $tags 1] 5 end]
	set gid [tag_to_jid $grouptag]
	set tag [crange [lindex $tags 0] 3 end]
	set cjid [tag_to_jid $tag]
	lassign $cjid connid jid

	set data [list $connid $jid \
		      [::roster::itemconfig $connid $jid -category] \
		      [::roster::itemconfig $connid $jid -subtype] \
		      [::roster::itemconfig $connid $jid -name] {} \
		      $gid]

	debugmsg roster $data
	return [list JID {move} $data]
    } else {
	return {}
    }
}

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

proc roster::user_singleclick {cjid} {
    variable roster

    lassign $cjid connid jid

    if {[roster::itemconfig $connid $jid -isuser] && \
	    [llength [get_jids_of_user $connid $jid]] > 1} {
	set roster(collapsed,$cjid) [expr {!$roster(collapsed,$cjid)}]
	redraw_after_idle
    }
}

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

proc roster::popup_menu {id} {
    global curuser

    lassign $id connid jid
    set curuser $jid

    lassign [::roster::get_category_and_subtype $connid $jid] category subtype

    switch -- $category {
	user       {set menu [create_user_menu $connid $jid]}
	conference {set menu [conference_popup_menu $connid $jid]}
	server  -
	gateway -
	service    {set menu [service_popup_menu $connid $jid]}
	default    {set menu [jid_popup_menu $connid $jid]}
    }

    tk_popup $menu [winfo pointerx .] [winfo pointery .]
}

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

proc roster::group_popup_menu {id} {
    variable options

    lassign $id connid name
    if {$options(nested)} {
	set name [join $name $options(nested_delimiter)]
    } else {
	set name [lindex $name 0]
    }
    if {$connid != "connid"} {
	tk_popup [create_group_popup_menu $connid $name] \
	    [winfo pointerx .] [winfo pointery .]
    }
}

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

proc roster::groupchat_popup_menu {id} {
    lassign $id connid jid
    tk_popup [create_groupchat_user_menu $connid $jid] \
	[winfo pointerx .] [winfo pointery .]
}

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

proc roster::create_user_menu {connid user} {
    set m .jidpopupmenu
    if {[winfo exists $m]} { destroy $m }
    menu $m -tearoff 0

    set jids [get_jids_of_user $connid $user]

    switch -- [llength $jids] {
	0 {
	    hook::run roster_jid_popup_menu_hook $m $connid $user
	    return $m
	}
	1 {
	    hook::run roster_jid_popup_menu_hook $m $connid [lindex $jids 0]
	    return $m
	}
	default {
	    foreach jid $jids {
		set m1 .jidpopupmenu[jid_to_tag $jid]
		if {[winfo exists $m1]} { destroy $m1 }
		menu $m1 -tearoff 0
		hook::run roster_jid_popup_menu_hook $m1 $connid $jid
	    }

	    add_menu_submenu $m .jidpopupmenu "" $jids

	    foreach jid $jids {
		set m1 .jidpopupmenu[jid_to_tag $jid]
		if {[winfo exists $m1]} { destroy $m1 }
	    }
 
	    return $m
	}
    }
}

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

proc roster::add_menu_submenu {m prefix suffix jids} {
    set m1 $prefix[jid_to_tag [lindex $jids 0]]$suffix

    for {set i 0} {[$m1 index $i] == $i} {incr i} {
	if {[catch { $m1 entrycget $i -label } label]} {
	    $m add separator
	} elseif {![catch { $m1 entrycget $i -menu } menu]} {
	    set suffix2 [join [lrange [split $menu .] 2 end] .]
	    set suffix3 [lindex [split $menu .] end]
	    set m2 [menu $m.$suffix3 -tearoff 0]
	    $m add cascade -label $label -menu $m2
	    add_menu_submenu $m2 $prefix .$suffix2 $jids
	} elseif {![catch { $m1 entrycget $i -variable } var]} {
	    # Can't distinguish checkbuttons and radiobuttons
	    # Works only for checkbuttons
	    add_checkbutton_submenu $m $prefix $suffix $i $label $jids
	} else {
	    add_command_submenu $m $prefix $suffix $i $label $jids
	}
    }
}

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

proc roster::add_command_submenu {m prefix suffix i label jids} {
    set command_list {}
    foreach jid $jids {
	set m1 $prefix[jid_to_tag $jid]$suffix
	set idx [$m1 index $label]
	if {$idx != "none"} {
	    set command [$m1 entrycget $idx -command]
	    if {![lcontain $command_list $command]} {
		lappend command_list $command
	    }
	}
    }
    if {[llength $command_list] > 1} {
	set m2 [menu $m.$i -tearoff 0]
	$m add cascade -label $label -menu $m2
	foreach jid $jids {
	    set m1 $prefix[jid_to_tag $jid]$suffix
	    set idx [$m1 index $label]
	    if {$idx != "none"} {
		set command [$m1 entrycget $idx -command]
		$m2 add command -label $jid \
		    -command [string map [list $m1 $m2] $command]
	    }
	}
    } else {
	$m add command -label $label -command [lindex $command_list 0]
    }
}

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

proc roster::add_checkbutton_submenu {m prefix suffix i label jids} {
    set command_list {}
    foreach jid $jids {
	set m1 $prefix[jid_to_tag $jid]$suffix
	set idx [$m1 index $label]
	if {$idx != "none"} {
	    set var [$m1 entrycget $idx -variable]
	    set command [$m1 entrycget $idx -command]
	    if {![lcontain $command_list [list $var $command]]} {
		lappend command_list [list $var $command]
	    }
	}
    }
    if {[llength $command_list] > 1} {
	set m2 [menu $m.$i -tearoff 0]
	$m add cascade -label $label -menu $m2
	foreach jid $jids {
	    set m1 $prefix[jid_to_tag $jid]$suffix
	    set idx [$m1 index $label]
	    if {$idx != "none"} {
		set var [$m1 entrycget $idx -variable]
		set command [$m1 entrycget $idx -command]
		$m2 add checkbutton -label $jid -variable $var -command $command
	    }
	}
    } else {
	lassign [lindex $command_list 0] var command
	$m add checkbutton -label $label -variable $var -command $command
    }
}

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

proc roster::add_separator {m connid jid} {
    $m add separator
}

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

proc roster::jid_popup_menu {connid jid} {
    if {[winfo exists [set m .jidpopupmenu]]} {
	destroy $m
    }
    menu $m -tearoff 0

    hook::run roster_jid_popup_menu_hook $m $connid $jid

    return $m
}

hook::add roster_jid_popup_menu_hook \
    [namespace current]::roster::add_separator 40
hook::add roster_jid_popup_menu_hook \
    [namespace current]::roster::add_separator 50
hook::add roster_jid_popup_menu_hook \
    [namespace current]::roster::add_separator 70
hook::add roster_jid_popup_menu_hook \
    [namespace current]::roster::add_separator 85

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

proc roster::conference_popup_menu {connid jid} {
    if {[winfo exists [set m .confpopupmenu]]} {
	destroy $m
    }
    menu $m -tearoff 0

    hook::run roster_conference_popup_menu_hook $m $connid $jid

    return $m
}

hook::add roster_conference_popup_menu_hook \
    [namespace current]::roster::add_separator 50
hook::add roster_conference_popup_menu_hook \
    [namespace current]::roster::add_separator 70
hook::add roster_conference_popup_menu_hook \
    [namespace current]::roster::add_separator 85

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

proc roster::service_popup_menu {connid jid} {
    if {[winfo exists [set m .servicepopupmenu]]} {
	destroy $m
    }
    menu $m -tearoff 0

    hook::run roster_service_popup_menu_hook $m $connid $jid

    return $m
}

hook::add roster_service_popup_menu_hook \
    [namespace current]::roster::add_separator 50
hook::add roster_service_popup_menu_hook \
    [namespace current]::roster::add_separator 70
hook::add roster_service_popup_menu_hook \
    [namespace current]::roster::add_separator 85

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

proc roster::create_groupchat_user_menu {connid jid} {
    if {[winfo exists [set m .groupchatpopupmenu]]} {
	destroy $m
    }
    menu $m -tearoff 0

    hook::run roster_create_groupchat_user_menu_hook $m $connid $jid

    return $m
}

hook::add roster_create_groupchat_user_menu_hook \
    [namespace current]::roster::add_separator 40
hook::add roster_create_groupchat_user_menu_hook \
    [namespace current]::roster::add_separator 50

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

proc roster::create_group_popup_menu {connid name} {
    variable options
    variable chats_group_name

    if {$name == $chats_group_name} {
	set state disabled
    } else {
	set state normal
    }

    if {[winfo exists [set m .grouppopupmenu]]} {
	destroy $m
    }
    if {$options(nested)} {
	set oname [msplit $name $options(nested_delimiter)]
    } else {
	set oname $name
    }
    menu $m -tearoff 0
    $m add command \
	-label [::msgcat::mc "Send message to all users in group..."] \
	-command [list ::message::send_dialog \
		       -to $name -group 1 -connection $connid]
    $m add command \
	-label [::msgcat::mc "Resubscribe to all users in group..."] \
	-command [list ::roster::resubscribe_group $connid $name]

    add_group_custom_presence_menu $m $connid $name

    $m add checkbutton -label [::msgcat::mc "Show offline users"] \
	-variable [namespace current]::roster(show_offline,[list $connid $oname]) \
	-command [list [namespace current]::redraw_after_idle]
    $m add command -label [::msgcat::mc "Rename group..."] \
	-command [list [namespace current]::rename_group_dialog $connid $name] \
	-state $state
    $m add command -label [::msgcat::mc "Remove group..."] \
	-command [list [namespace current]::remove_group_dialog $connid $name] \
	-state $state
    $m add command -label [::msgcat::mc "Remove all users in group..."] \
	-command [list [namespace current]::remove_users_group_dialog $connid $name]

    set last [$m index end]

    ::hook::run roster_group_popup_menu_hook $m $connid $name

    if {[$m index end] > $last} {
	$m insert [expr $last + 1] separator
    }

    return $m
}

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

proc roster::remove_group_dialog {connid name} {
    set res [MessageDlg .remove_item -aspect 50000 -icon question -type user \
		 -buttons {yes no} -default 0 -cancel 1 \
		 -message [format [::msgcat::mc "Are you sure to remove group '%s' from roster?\
\n(Users which are in this group only, will be in undefined group.)"] $name]]

    if {$res == 0} {
	roster::send_rename_group $connid $name ""
    }
}

proc roster::remove_users_group_dialog {connid name} {
    set res [MessageDlg .remove_item -aspect 50000 -icon question -type user \
		 -buttons {yes no} -default 0 -cancel 1 \
		 -message [format [::msgcat::mc "Are you sure to remove all users in group '%s' from roster?\
\n(Users which are in another groups too, will not be removed from the roster.)"] $name]]

    if {$res == 0} {
	roster::send_remove_users_group $connid $name
    }
}

proc roster::rename_group_dialog {connid name} {
    global new_roster_group_name

    set new_roster_group_name $name

    set w .roster_group_rename
    if {[winfo exists $w]} {
	destroy $w
    }
    
    Dialog $w -title [::msgcat::mc "Rename roster group"] \
	-separator 1 -anchor e -default 0 -cancel 1

    $w add -text [::msgcat::mc "OK"] -command \
	[list [namespace current]::confirm_rename_group $w $connid $name]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]

    set p [$w getframe]
    
    label $p.lgroupname -text [::msgcat::mc "New group name:"]
    ecursor_entry [entry $p.groupname -textvariable new_roster_group_name]

    grid $p.lgroupname  -row 0 -column 0 -sticky e
    grid $p.groupname   -row 0 -column 1 -sticky ew

    focus $p.groupname
    $w draw
}

proc roster::confirm_rename_group {w connid name} {
    global new_roster_group_name
    variable roster

    destroy $w

    ::roster::send_rename_group $connid $name $new_roster_group_name

    set gid [list $connid $name]
    set newgid [list $connid $new_roster_group_name]

    if {[info exists roster(collapsed,$gid)]} {
	set roster(collapsed,$newgid) $roster(collapsed,$gid)
	unset roster(collapsed,$gid)
    }
    if {[info exists roster(show_offline,$gid)]} {
	set roster(show_offline,$newgid) $roster(show_offline,$gid)
	unset roster(show_offline,$gid)
    }
}
	
proc roster::add_group_by_jid_regexp_dialog {} {
    global new_roster_group_rname
    global new_roster_group_regexp

    set w .roster_group_add_by_jid_regexp
    if {[winfo exists $w]} {
	destroy $w
    }
    
    Dialog $w -title [::msgcat::mc "Add roster group by JID regexp"] \
	-separator 1 -anchor e -default 0 -cancel 1

    $w add -text [::msgcat::mc "OK"] -command "
	destroy [list $w]
	roster::add_group_by_jid_regexp \
	    \$new_roster_group_rname \$new_roster_group_regexp
    "
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]

    set p [$w getframe]
    
    label $p.lgroupname -text [::msgcat::mc "New group name:"]
    ecursor_entry [entry $p.groupname -textvariable new_roster_group_rname]
    label $p.lregexp -text [::msgcat::mc "JID regexp:"]
    ecursor_entry [entry $p.regexp -textvariable new_roster_group_regexp]

    grid $p.lgroupname -row 0 -column 0 -sticky e
    grid $p.groupname  -row 0 -column 1 -sticky ew
    grid $p.lregexp    -row 1 -column 0 -sticky e
    grid $p.regexp     -row 1 -column 1 -sticky ew

    focus $p.groupname
    $w draw
}

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

proc roster::add_group_custom_presence_menu {m connid name} {
    set mm [menu $m.custom_presence -tearoff 0]

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

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

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

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