# $Id$
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
# {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 [::textutil::splitx $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 [::textutil::splitx $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) || \
$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) || \
![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 $w.canvas -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 $w.canvas
if {[info exists draginitcmd]} {
DragSite::register $w.canvas -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 $w.canvas -droptypes {JID}] $args
}
}
proc roster::addline {w type text jid group indent {jids {}} {icon ""} {foreground ""}} {
global font
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 $font -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 $font \
-fill $foreground -tags [list jid$tag group$grouptag $type text]
set iroster($w,width) [max $iroster($w,width) \
[expr {$x + [font measure $font $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} {
if {[cequal $chat::options(default_message_type) chat]} {
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 cascad -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 cascad -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 cascad -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 [::textutil::splitx $name $options(nested_delimiter)]
} else {
set oname $name
}
menu $m -tearoff 0
$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 "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 "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::setup_import_export_menus {args} {
set emenu [.mainframe getmenu export_roster]
set imenu [.mainframe getmenu import_roster]
if {[winfo exists $emenu]} {
destroy $emenu
}
menu $emenu -tearoff 0
if {[winfo exists $imenu]} {
destroy $imenu
}
menu $imenu -tearoff 0
if {[jlib::connections] == {}} {
.mainframe setmenustate export_roster disabled
.mainframe setmenustate import_roster disabled
} else {
.mainframe setmenustate export_roster normal
.mainframe setmenustate import_roster normal
}
foreach c [jlib::connections] {
set jid [jlib::connection_jid $c]
set label [format [::msgcat::mc "Roster of %s"] $jid]
set ecommand [list roster::export_to_file $c]
set icommand [list roster::import_from_file $c]
$emenu add command -label $label -command $ecommand
$imenu add command -label $label -command $icommand
}
}
hook::add connected_hook [namespace current]::roster::setup_import_export_menus
hook::add disconnected_hook [namespace current]::roster::setup_import_export_menus
hook::add finload_hook [namespace current]::roster::setup_import_export_menus
###############################################################################
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 cascad -label [::msgcat::mc "Send custom presence"] -menu $mm
}
###############################################################################
# vim:ts=8:sw=4:sts=4:noet