1# Roster.tcl --- 2# 3# This file is part of The Coccinella application. 4# It implements the Roster GUI part. 5# 6# Copyright (c) 2001-2008 Mats Bengtsson 7# 8# This program is free software: you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation, either version 3 of the License, or 11# (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program. If not, see <http://www.gnu.org/licenses/>. 20# 21# $Id: Roster.tcl,v 1.251 2008-08-09 13:15:04 matben Exp $ 22 23# @@@ TODO: 1) rewrite the popup menu code to use AMenu! 24# 2) abstract all RosterTree calls to allow for any kind of roster 25 26package require ui::openimage 27package require RosterTree 28package require RosterPlain 29package require RosterTwo 30package require RosterAvatar 31package require UI::TSearch 32 33package provide Roster 1.0 34 35namespace eval ::Roster { 36 global this prefs 37 38 # Add all event hooks we need. 39 ::hooks::register earlyInitHook ::Roster::EarlyInitHook 40 ::hooks::register loginHook ::Roster::LoginCmd 41 ::hooks::register logoutHook ::Roster::LogoutHook 42 ::hooks::register jabberInitHook ::Roster::JabberInitHook 43 44 # Define all hooks for preference settings. 45 ::hooks::register prefsInitHook ::Roster::InitPrefsHook 46 ::hooks::register prefsBuildHook ::Roster::BuildPrefsHook 47 ::hooks::register prefsSaveHook ::Roster::SavePrefsHook 48 ::hooks::register prefsCancelHook ::Roster::CancelPrefsHook 49 ::hooks::register prefsUserDefaultsHook ::Roster::UserDefaultsHook 50 51 # Use option database for customization. 52 # Use priority 50 just to override the widgetDefault values! 53 54 # Standard widgets and standard options. 55 option add *Roster.borderWidth 0 50 56 option add *Roster.relief flat 50 57 option add *Roster.padding 0 50 58 59 # Specials. 60 option add *Roster.whiteboard12Image mail-mark-whiteboard widgetDefault 61 62 variable wtree - 63 64 # A unique running identifier. 65 variable uid 0 66 67 # Keep track of when in roster callback. 68 variable inroster 0 69 70 # Keeps track of all registered menu entries. 71 variable regPopMenuDef [list] 72 variable regPopMenuType [list] 73 74 # Mappings from <show> element to displayable text and vice versa. 75 # chat away xa dnd 76 variable mapShowTextToElem 77 variable mapShowElemToText 78 79 # Cache messages for efficiency. 80 array set mapShowTextToElem [list \ 81 [mc "Available"] available \ 82 [mc "Away"] away \ 83 [mc "Free For Chat"] chat \ 84 [mc "Do Not Disturb"] dnd \ 85 [mc "Extended Away"] xa \ 86 [mc "Invisible"] invisible \ 87 [mc "Not Available"] unavailable] 88 array set mapShowElemToText [list \ 89 available [mc "Available"] \ 90 away [mc "Away"] \ 91 chat [mc "Free For Chat"] \ 92 dnd [mc "Do Not Disturb"] \ 93 xa [mc "Extended Away"] \ 94 invisible [mc "Invisible"] \ 95 unavailable [mc "Not Available"]] 96 97 # Various time values. 98 variable timer 99 set timer(msg,ms) 10000 100 set timer(exitroster,secs) 0 101 set timer(pres,secs) 4 102 103 # How to display multiple available resources. 104 # highest-prio : only the one with highest priority 105 # all : all 106 set ::config(roster,multi-resources) "highest-prio" 107 #set ::config(roster,multi-resources) "all" 108} 109 110proc ::Roster::EarlyInitHook {} { 111 InitMenus 112} 113 114proc ::Roster::InitMenus {} { 115 116 # Template for the roster popup menu. 117 variable popMenuDefs 118 119 # Standard popup menu. 120 set mDefs { 121 {command mChat... {[mc "Cha&t"]...} {::Chat::StartThreadJIDList $jidL} } 122 {command mMessage... {[mc "&Message"]...} {::NewMsg::Build -to $jid -tolist $jid2L} } 123 {command mSendFile... {[mc "Send &File"]...} {::FTrans::SendJIDList $jidL} } 124 {separator} 125 {command mHistory... {[mc "&History"]...} {::Chat::HistoryForJIDList $jidL} } 126 {command mBusinessCard... {[mc "View &Business Card"]...} {::UserInfo::GetJIDList $jidL} } 127 {command mAddContact... {[mc "&Add Contact"]...} {::JUser::NewDlg} } 128 {command mEditContact... {[mc "&Edit Contact"]...} {::JUser::EditJIDList $jid2L} } 129 {command mRemoveContact {[mc "&Remove Contact"]...} {::Roster::RemoveJIDList $jidL} } 130 {separator} 131 {cascade mStyle {[mc "Style"]} {@::Roster::StyleMenu} } 132 {cascade mShow {[mc "Show"]} { 133 {check mOffline {[mc "&Offline"]} {::Roster::ShowOffline} {-variable ::jprefs(rost,showOffline)} } 134 {check mDoNotDisturb {[mc "Do Not Disturb"]} {::Roster::ShowDnD} {-variable ::jprefs(rost,show-dnd)} } 135 {check mAway {[mc "Away"]} {::Roster::ShowAway} {-variable ::jprefs(rost,show-away)} } 136 {check mExtendedAway {[mc "Extended Away"]} {::Roster::ShowXAway} {-variable ::jprefs(rost,show-xa)} } 137 {check mTransports {[mc "&Transports"]} {::Roster::ShowTransports} {-variable ::jprefs(rost,showTrpts)} } 138 {command mBackgroundImage... {[mc "&Background Image"]...} {::Roster::BackgroundImage} } 139 } } 140 {cascade mSort {[mc "Sort"]} { 141 {radio mIncreasing {[mc "&Increasing"]} {::Roster::Sort} {-variable ::jprefs(rost,sort) -value -increasing} } 142 {radio mDecreasing {[mc "&Decreasing"]} {::Roster::Sort} {-variable ::jprefs(rost,sort) -value -decreasing} } 143 } } 144 {command mRefresh {[mc "Refresh"]} {::Roster::Refresh} } 145 } 146 set mTypes { 147 {mMessage... {user} } 148 {mChat... {user} } 149 {mWhiteboard {wb available} } 150 {mSendFile... {user available} } 151 {mAddContact... {} } 152 {mEditContact... {user} } 153 {mBusinessCard... {user} } 154 {mHistory... {user always} } 155 {mRemoveContact {user} } 156 {mShow {normal} { 157 {mOffline {normal} } 158 {mDoNotDisturb {normal} } 159 {mAway {normal} } 160 {mExtendedAway {normal} } 161 {mTransports {normal} } 162 {mBackgroundImage... {normal} } 163 }} 164 {mSort {} { 165 {mIncreasing {} } 166 {mDecreasing {} } 167 }} 168 {mStyle {normal} } 169 {mRefresh {} } 170 } 171 if {[::Jabber::HaveWhiteboard]} { 172 set mWBDef {command mWhiteboard {[mc "&Whiteboard"]...} {::JWB::NewWhiteboardTo $jid3}} 173 set mWBType {mWhiteboard {wb available} } 174 175 # Insert whiteboard menu *after* mSendFile. 176 set idx [lsearch -glob $mDefs "* mSendFile... *"] 177 incr idx 178 set mDefs [linsert $mDefs $idx $mWBDef] 179 set mTypes [linsert $mTypes $idx $mWBType] 180 } 181 set popMenuDefs(roster,def) $mDefs 182 set popMenuDefs(roster,type) $mTypes 183 184 # Transports popup menu. 185 set mDefs { 186 {command mLastLogin/Activity {[mc "Last Login/Activity"]} {::Jabber::GetLast $jid} } 187 {command mBusinessCard... {[mc "View &Business Card"]...} {::VCard::Fetch other $jid} } 188 {command mAddContact... {[mc "&Add Contact"]...} {::JUser::NewDlg -transportjid $jid3} } 189 {command mEditContact... {[mc "&Edit Contact"]...} {::JUser::EditDlg $jid} } 190 {command mVersion {[mc "Version"]} {::Jabber::GetVersion $jid3} } 191 {command mLoginTrpt {[mc "Login to Transport"]} {::Roster::LoginTrpt $jid3} } 192 {command mLogoutTrpt {[mc "Logout from Transport"]} {::Roster::LogoutTrpt $jid3} } 193 {separator} 194 {command mUnregister {[mc "&Unregister"]} {::Roster::Unregister $jid3} } 195 {command mRefresh {[mc "Refresh"]} {::Roster::Refresh} } 196 } 197 set mTypes { 198 {mLastLogin/Activity {trpt} } 199 {mBusinessCard... {trpt} } 200 {mAddContact... {trpt} } 201 {mEditContact... {trpt} } 202 {mVersion {trpt} } 203 {mLoginTrpt {trpt unavailable} } 204 {mLogoutTrpt {trpt available} } 205 {mUnregister {trpt} } 206 {mRefresh {} } 207 } 208 set popMenuDefs(roster,trpt,def) $mDefs 209 set popMenuDefs(roster,trpt,type) $mTypes 210} 211 212proc ::Roster::JabberInitHook {jlibname} { 213 214 $jlibname presence_register available [namespace code PresenceEvent] 215 $jlibname presence_register unavailable [namespace code PresenceEvent] 216} 217 218# Roster::GetNameOrJID, GetShortName, GetDisplayName -- 219# 220# Utilities to get JID identifiers for UI display. 221# Priorities: 222# 1) name attribute in roster item 223# 2) user nickname 224# 3) node part if on login server 225# 4) JID 226 227proc ::Roster::GetNameOrJID {jid} { 228 229 set name [::Jabber::Jlib roster getname $jid] 230 if {$name eq ""} { 231 set name $jid 232 } 233 return $name 234} 235 236proc ::Roster::GetShortName {jid} { 237 238 set name [::Jabber::Jlib roster getname $jid] 239 if {$name eq ""} { 240 set name [::Nickname::Get [jlib::barejid $jid]] 241 if {$name eq ""} { 242 jlib::splitjidex $jid node domain res 243 if {$node eq ""} { 244 set name $domain 245 } else { 246 if {[string equal [::Jabber::Jlib getthis server] $domain]} { 247 set name $node 248 } else { 249 set name $jid 250 } 251 } 252 } 253 } 254 return $name 255} 256 257proc ::Roster::GetDisplayName {jid} { 258 259 set name [::Jabber::Jlib roster getname $jid] 260 if {$name eq ""} { 261 set name [::Nickname::Get [jlib::barejid $jid]] 262 if {$name eq ""} { 263 jlib::splitjidex $jid node domain res 264 if {$node eq ""} { 265 set name $domain 266 } else { 267 set name [jlib::unescapestr $node] 268 } 269 } 270 } 271 return $name 272} 273 274proc ::Roster::MapShowToText {show} { 275 variable mapShowElemToText 276 277 if {[info exists mapShowElemToText($show)]} { 278 return $mapShowElemToText($show) 279 } else { 280 return $show 281 } 282} 283 284# Roster::Build -- 285# 286# Makes mega widget to show the roster. 287# 288# Arguments: 289# w frame window with everything. 290# 291# Results: 292# w 293 294proc ::Roster::Build {w} { 295 global this prefs 296 297 variable wtree 298 variable wroster 299 variable wbox 300 variable icons 301 302 # The frame of class Roster. 303 ttk::frame $w -class Roster 304 305 # Tree frame with scrollbars. 306 set wroster $w 307 set wbox $w.box 308 309 # @@@ We shall have a more generic interface here than just a tree. 310 set wtree [::RosterTree::New $wbox] 311 pack $wbox -side top -fill both -expand 1 312 313 # Cache any expensive stuff. 314 set icons(whiteboard12) [::Theme::FindIconSize 12 [option get $w whiteboard12Image {}]] 315 316 return $w 317} 318 319proc ::Roster::GetTree {} { 320 variable wtree 321 return $wtree 322} 323 324proc ::Roster::Find {} { 325 ::RosterTree::Find 326} 327 328proc ::Roster::FindAgain {dir} { 329 ::RosterTree::FindAgain $dir 330} 331 332proc ::Roster::GetRosterWindow {} { 333 variable wroster 334 335 return $wroster 336} 337 338proc ::Roster::BackgroundImage {} { 339 ::RosterTree::BackgroundImageCmd 340} 341 342# Roster::LoginCmd -- 343# 344# The login hook command. 345 346proc ::Roster::LoginCmd {} { 347 348 ::Jabber::Jlib roster send_get 349 350 set server [::Jabber::GetServerJid] 351} 352 353proc ::Roster::LogoutHook {} { 354 global jprefs 355 356 ::RosterTree::GetClosed 357 358 # Here? 359 ::Jabber::Jlib roster reset 360 361 # Clear roster and browse windows. 362 if {$jprefs(rost,clrLogout)} { 363 ::RosterTree::StyleInit 364 ::RosterTree::FreeAllAltImagesCache 365 } 366} 367 368proc ::Roster::Refresh {} { 369 370 ::RosterTree::GetClosed 371 372 # Get my roster. 373 ::Jabber::Jlib roster send_get 374} 375 376proc ::Roster::SortAtIdle {{item root}} { 377 global jprefs 378 379 ::RosterTree::SortAtIdle $item $jprefs(rost,sort) 380} 381 382proc ::Roster::Sort {{item root}} { 383 global jprefs 384 385 ::RosterTree::Sort $item $jprefs(rost,sort) 386} 387 388# Roster::SendRemove -- 389# 390# Method to remove another user from my roster. 391 392proc ::Roster::SendRemove {jid} { 393 394 set ans [::UI::MessageBox -title [mc "Remove Contact"] \ 395 -message [mc "Do you really want to remove this contact? This action cannot be undone."] -icon warning -type yesno -default no] 396 if {[string equal $ans "yes"]} { 397 set jid [::Jabber::Jlib roster getrosterjid $jid] 398 ::Jabber::Jlib roster send_remove $jid 399 } 400} 401 402proc ::Roster::RemoveJIDList {jidL} { 403 404 # @@@ We could use a plural text here. 405 set ans [::UI::MessageBox -title [mc "Remove Contact"] \ 406 -message [mc "Do you really want to remove this contact? This action cannot be undone."] -icon warning -type yesno -default no] 407 if {[string equal $ans "yes"]} { 408 foreach jid $jidL { 409 set jid [::Jabber::Jlib roster getrosterjid $jid] 410 ::Jabber::Jlib roster send_remove $jid 411 } 412 } 413} 414 415proc ::Roster::Unregister {jid} { 416 ::Register::Remove $jid 417 ::Jabber::Jlib roster send_remove [jlib::barejid $jid] 418} 419 420# Roster::RegisterPopupEntry -- 421# 422# Components or plugins can add their own menu entries here. 423# Only for the standard popup menu. 424 425proc ::Roster::RegisterPopupEntry {menuDef menuType} { 426 variable regPopMenuDef 427 variable regPopMenuType 428 429 lappend regPopMenuDef $menuDef 430 lappend regPopMenuType $menuType 431} 432 433proc ::Roster::DeRegisterPopupEntry {mLabel} { 434 variable regPopMenuDef 435 variable regPopMenuType 436 437 set idx [lsearch -glob $regPopMenuDef "* $mLabel *"] 438 if {$idx >= 0} { 439 set regPopMenuDef [lreplace $regPopMenuDef $idx $idx] 440 } 441 set idx [lsearch -glob $regPopMenuType "$mLabel *"] 442 if {$idx >= 0} { 443 set regPopMenuType [lreplace $regPopMenuType $idx $idx] 444 } 445} 446 447# Roster::DoPopup -- 448# 449# Handle popup menu in roster. 450# 451# Arguments: 452# jidL this is a list of actual jid's, can be any form 453# 454# Results: 455# popup menu displayed 456 457proc ::Roster::DoPopup {jidL groupL x y} { 458 global wDlgs 459 variable popMenuDefs 460 variable regPopMenuDef 461 variable regPopMenuType 462 variable wtree 463 464 ::Debug 2 "::Roster::DoPopup jidL=$jidL, groupL=$groupL" 465 466 # We always get a list of jids, often with only one element. 467 set jid3 [lindex $jidL 0] 468 set jid2 [jlib::barejid $jid3] 469 set jid $jid2 470 471 # The jid2L is expected to be with no resource part. 472 # @@@ ??? 473 set jid2L [list] 474 foreach j $jidL { 475 lappend jid2L [jlib::barejid $j] 476 } 477 set clicked [FindClickTypesFromJIDList $jidL] 478 if {[llength $groupL]} { 479 lappend clicked group 480 } 481 set presL [FindPresenceFromJIDList $jidL] 482 483 set specialMenu 0 484 foreach click $clicked { 485 if {[info exists popMenuDefs(roster,$click,def)]} { 486 set mDef $popMenuDefs(roster,$click,def) 487 set mType $popMenuDefs(roster,$click,type) 488 set specialMenu 1 489 break 490 } 491 } 492 if {!$specialMenu} { 493 494 # Insert any registered popup menu entries. 495 set mDef $popMenuDefs(roster,def) 496 set mType $popMenuDefs(roster,type) 497 if {[llength $regPopMenuDef]} { 498 set idx [lindex [lsearch -glob -all $mDef {sep*}] end] 499 if {$idx eq ""} { 500 set idx end 501 } 502 foreach line $regPopMenuDef { 503 set mDef [linsert $mDef $idx $line] 504 } 505 set mDef [linsert $mDef $idx {separator}] 506 } 507 set mType [concat $mType $regPopMenuType] 508 } 509 510 # Trick to handle multiple online resources. 511 if {[llength $jidL] == 1} { 512 set resOnL [::Jabber::Jlib roster getresources $jid2 -type available] 513 set idx [lsearch -glob $mDef *mChat...*] 514 if {$idx >= 0 && [llength $resOnL] > 1} { 515 516 set mSub [list] 517 set str $jid2 518 append str " (" 519 append str [mc "Default"] 520 append str ")" 521 lappend mSub [list command test $str [list ::Chat::StartThread $jid2]] 522 lappend mSub [list separator] 523 foreach res $resOnL { 524 set xjid $jid2/$res 525 lappend mSub [list command $xjid $xjid [list ::Chat::StartThread $xjid]] 526 } 527 set mChatM [list cascade mChat... {[mc "Cha&t"]} $mSub] 528 set mDef [lreplace $mDef $idx $idx $mChatM] 529 } 530 } 531 532 533 # Make the appropriate menu. 534 set m $wDlgs(jpopuproster) 535 set i 0 536 destroy $m 537 menu $m -tearoff 0 \ 538 -postcommand [list ::Roster::PostMenuCmd $m $mType $clicked $jidL $presL] 539 540 ::AMenu::Build $m $mDef \ 541 -varlist [list jid $jid jidL $jidL jid3 $jid3 jid2L $jid2L \ 542 clicked $clicked group $groupL] 543 544 # This one is needed on the mac so the menu is built before it is posted. 545 update idletasks 546 547 # Post popup menu. 548 set X [expr {[winfo rootx $wtree] + $x}] 549 set Y [expr {[winfo rooty $wtree] + $y}] 550 tk_popup $m [expr {int($X) - 10}] [expr {int($Y) - 10}] 551} 552 553proc ::Roster::FindClickTypesFromJIDList {jidL} { 554 555 set clicked [list] 556 foreach jid $jidL { 557 if {[::Roster::IsTransportEx $jid]} { 558 lappend clicked trpt 559 } else { 560 lappend clicked user 561 } 562 if {[::Roster::IsCoccinella $jid]} { 563 lappend clicked wb 564 } 565 } 566 return [lsort -unique $clicked] 567} 568 569proc ::Roster::FindPresenceFromJIDList {jidL} { 570 571 set anyAvail 0 572 set anyUnavail 0 573 set presenceL [list] 574 foreach jid $jidL { 575 if {[::Jabber::Jlib roster isavailable $jid]} { 576 lappend presenceL available 577 set anyAvail 1 578 } else { 579 lappend presenceL unavailable 580 set anyUnavail 1 581 } 582 if {$anyAvail && $anyUnavail} { break } 583 } 584 return [lsort -unique $presenceL] 585} 586 587proc ::Roster::PostMenuCmd {m mType clicked jidL presL} { 588 589 # Special handling of transport login/logout. Hack! 590 if {([llength $jidL] == 1) && ([lsearch $clicked trpt] >= 0)} { 591 set midx [::AMenu::GetMenuIndex $m mLoginTrpt] 592 if {$midx ne ""} { 593 set jid [lindex $jidL 0] 594 set types [::Jabber::Jlib disco types $jid] 595 if {[regexp {gateway/([^ ]+)} $types - trpt]} { 596 if {[HaveNameForTrpt $trpt]} { 597 set tname [GetNameFromTrpt $trpt] 598 $m entryconfigure $midx -label [mc "Login to %s" $tname] 599 600 set midx [::AMenu::GetMenuIndex $m mLogoutTrpt] 601 $m entryconfigure $midx -label [mc "Logout from %s" $tname] 602 } 603 } 604 } 605 } 606 607 foreach mspec $mType { 608 lassign $mspec name type subType 609 610 # State of menu entry. 611 # We use the 'type' and 'clicked' lists to set the state. 612 set state disabled 613 if {$type eq "normal"} { 614 set state normal 615 } elseif {$type eq "disabled"} { 616 set state disabled 617 } elseif {![::Jabber::IsConnected] && ([lsearch $type always] < 0)} { 618 set state disabled 619 } elseif {[listintersectnonempty $type $clicked]} { 620 set state normal 621 } elseif {$type eq ""} { 622 set state normal 623 } 624 625 # If any available/unavailable these must also be fulfilled. 626 if {[lsearch $type available] >= 0} { 627 if {[lsearch $presL "available"] < 0} { 628 set state disabled 629 } 630 } elseif {[lsearch $type unavailable] >= 0} { 631 if {[lsearch $presL "unavailable"] < 0} { 632 set state disabled 633 } 634 } 635 636 set midx [::AMenu::GetMenuIndex $m $name] 637 if {[string equal $state "disabled"]} { 638 $m entryconfigure $midx -state disabled 639 } 640 #I had to remove this as there is a bug that breaks everything if this is enabled...any idea how to solve this? 641 #if {[llength $subType]} { 642 # set mt [$m entrycget $midx -menu] 643 # PostMenuCmd $mt $subType $clicked $jidL $presL 644 #} 645 } 646 ::hooks::run rosterPostCommandHook $m $jidL $clicked $presL 647} 648 649proc ::Roster::StyleMenu {m} { 650 variable styleName 651 652 set styleName [::RosterTree::GetStyle] 653 foreach {name label} [::RosterTree::GetAllStyles] { 654 $m add radiobutton -label $label \ 655 -variable ::Roster::styleName -value $name \ 656 -command [list ::RosterTree::LoadStyle $name] 657 } 658} 659 660# Roster::PushProc -- 661# 662# Our callback procedure for roster pushes. 663# Populate our roster tree. 664# 665# Arguments: 666# jlibname 667# what any of "remove", "set", "enterroster", 668# "exitroster" 669# jid 'user@server' without any /resource usually. 670# Some transports keep a resource part in jid. 671# args list of '-key value' pairs where '-key' can be 672# -resource, -from, -type... 673# 674# Results: 675# updates the roster UI. 676 677proc ::Roster::PushProc {jlibname what {jid {}} args} { 678 global jprefs 679 variable inroster 680 681 ::Debug 2 "---roster-> what=$what, jid=$jid, args='$args'" 682 683 # Extract the args list as an array. 684 array set attrArr $args 685 686 set jlib [::Jabber::GetJlib] 687 688 switch -- $what { 689 remove { 690 691 # Must remove all resources, and jid2 if no resources. 692 set resL [$jlib roster getresources $jid] 693 foreach res $resL { 694 ::RosterTree::StyleDeleteItem $jid/$res 695 } 696 if {$resL eq {}} { 697 ::RosterTree::StyleDeleteItem $jid 698 } 699 } 700 set { 701 eval {SetItem $jid} $args 702 } 703 enterroster { 704 set inroster 1 705 ::RosterTree::StyleInit 706 ::hooks::run rosterEnter 707 } 708 exitroster { 709 set inroster 0 710 ExitRoster 711 ::hooks::run rosterExit 712 } 713 } 714} 715 716# Roster::PresenceEvent -- 717# 718# Registered jlib presence handler for (un)available events only. 719# This is the application main organizer for presence stanzas and 720# takes care of calling functions to update roster, run hooks etc. 721 722proc ::Roster::PresenceEvent {jlibname xmldata} { 723 724 ::Debug 2 "---presence->" 725 726 set from [wrapper::getattribute $xmldata from] 727 set type [wrapper::getattribute $xmldata type] 728 if {$type eq ""} { 729 set type "available" 730 } 731 732 # We don't handle subscription types (remove?). 733 if {$type ne "available" && $type ne "unavailable"} { 734 return 735 } 736 set jlib [::Jabber::GetJlib] 737 738 set jid3 $from 739 jlib::splitjid $from jid2 res 740 set jid $jid2 741 742 # @@@ So far we preprocess the presence element to an option list. 743 # In the future it is better not to. 744 set opts [list -from $from -type $type -resource $res -xmldata $xmldata] 745 set x [list] 746 set extras [list] 747 foreach E [wrapper::getchildren $xmldata] { 748 set tag [wrapper::gettag $E] 749 set chdata [wrapper::getcdata $E] 750 751 switch -- $tag { 752 status - priority { 753 lappend opts -$tag $chdata 754 } 755 show { 756 lappend opts -$tag [string tolower $chdata] 757 } 758 x { 759 lappend x $E 760 } 761 default { 762 lappend extras $E 763 } 764 } 765 } 766 if {[llength $x]} { 767 lappend opts -x $x 768 } 769 if {[llength $extras]} { 770 lappend opts -extras $extras 771 } 772 773 # This 'isroom' gives wrong answer if a gateway also supports 774 # conference (groupchat). 775 if {0} { 776 if {![$jlib service isroom $jid]} { 777 eval {Presence $jid3 $type} $opts 778 } 779 } 780 781 # We get presence also for rooms etc which are not roster items. 782 # Some transports have /registered resource. 783 if {[$jlib roster isitem $jid]} { 784 eval {Presence $jid3 $type} $opts 785 } elseif {[$jlib roster isitem $jid3]} { 786 eval {Presence $jid3 $type} $opts 787 } 788 789 # Specific type presence hooks. 790 eval {::hooks::run presence[string totitle $type]Hook $jid $type} $opts 791 792 # Hook to run only for new presence/show/status. 793 # This is helpful because of some x-elements can be broadcasted. 794 array set oldPres [$jlib roster getoldpresence $jid3] 795 set same [arraysequalnames attrArr oldPres {-type -show -status}] 796 if {!$same} { 797 eval {::hooks::run presenceNewHook $jid $type} $opts 798 } 799 800 # General type presence hooks. 801 eval {::hooks::run presenceHook $jid $type} $opts 802 803 # Make an additional call for delayed presence. 804 # This only happend when type='available'. 805 if {[info exists attrArr(-x)]} { 806 set delayElem [wrapper::getnamespacefromchilds \ 807 $attrArr(-x) x "jabber:x:delay"] 808 if {[llength $delayElem]} { 809 eval {::hooks::run presenceDelayHook $jid $type} $opts 810 } 811 } 812} 813 814proc ::Roster::RepopulateTree {} { 815 816 ::RosterTree::GetClosed 817 ::RosterTree::StyleInit 818 819 foreach jid [::Jabber::Jlib roster getusers] { 820 eval {SetItem $jid} [::Jabber::Jlib roster getrosteritem $jid] 821 } 822 SortAtIdle 823} 824 825proc ::Roster::ExitRoster {} { 826 variable timer 827 828 SortAtIdle 829 ::JUI::SetAppMessage [mc "The roster is up to date"] 830 set timer(exitroster,secs) [clock seconds] 831} 832 833# Roster::SetItem -- 834# 835# Callback from roster pushes when getting <item .../>. 836# Adds a jid item to the tree. 837# 838# Arguments: 839# jid 2-tier jid with no /resource part usually, not icq/reg. 840# args list of '-key value' pairs where '-key' can be 841# -name 842# -groups Note, PLURAL! 843# -ask 844# 845# Results: 846# updates tree. 847 848proc ::Roster::SetItem {jid args} { 849 global jprefs 850 variable inroster 851 852 ::Debug 2 "::Roster::SetItem jid=$jid, args='$args'" 853 854 # Remove any old items first: 855 # 1) If we 'get' the roster, the roster is cleared, so we can be 856 # sure that we don't have any "old" item??? 857 # 2) Must remove all resources for this jid first, and then add back. 858 # Remove also jid2. 859 860 set jlib [::Jabber::GetJlib] 861 862 if {!$inroster} { 863 set resL [$jlib roster getresources $jid] 864 if {[llength $resL]} { 865 foreach res $resL { 866 ::RosterTree::StyleDeleteItem $jid/$res 867 } 868 } else { 869 ::RosterTree::StyleDeleteItem $jid 870 } 871 } 872 873 set add 1 874 if {!$jprefs(rost,showSubNone)} { 875 876 # Do not add items with subscription='none'. 877 if {[set idx [lsearch $args "-subscription"]] >= 0} { 878 if {[string equal [lindex $args [incr idx]] "none"]} { 879 set add 0 880 } 881 } 882 } 883 if {$add} { 884 set rjid $jid 885 set jid2 $rjid 886 set isavailable [$jlib roster isavailable $rjid] 887 if {!$isavailable} { 888 array set presA [$jlib roster getpresence $rjid -resource ""] 889 set items [eval { 890 ::RosterTree::StyleCreateItem $rjid "unavailable" 891 } $args [array get presA]] 892 } else { 893 set items [NewAvailableItem $rjid] 894 } 895 896 if {!$inroster && [llength $items]} { 897 898 # If more than one item pick the parent of the first (group). 899 set pitem [::RosterTree::GetParent [lindex $items 0]] 900 ::RosterTree::SortAtIdle $pitem $jprefs(rost,sort) 901 } 902 } 903} 904 905# Roster::Presence -- 906# 907# Sets the presence of the jid in our UI. 908# 909# Arguments: 910# jid the JID as reported by the presence 'from' attribute. 911# presence "available", "unavailable" 912# args list of '-key value' pairs of presence attributes. 913# 914# Results: 915# roster tree updated. 916 917proc ::Roster::Presence {jid presence args} { 918 global jprefs 919 variable timer 920 variable icons 921 922 ::Debug 2 "::Roster::Presence jid=$jid, presence=$presence" 923 array set argsA $args 924 925 # All presence have a 3-tier jid as 'from' attribute: 926 # presence = 'available' => remove jid2 + jid3, add jid3 927 # presence = 'unavailable' => remove jid2 + jid3, add jid2 928 # if no jid2/* available 929 # Wrong! We may have 2-tier jids from transports: 930 # <presence from='user%hotmail.com@msn.myserver' ... 931 # Or 3-tier (icq) with presence = 'unavailable' ! 932 # 933 # New: For available JID always use the JID as reported in the 934 # presence 'from' attribute. 935 # For unavailable JID always us the roster item JID. 936 937 # Multiple resources: 938 # Need to loop through all resources and see where they should be. 939 # If no available resources then item is unavailable. 940 # If any available resource then put 941 942 set jlib [::Jabber::GetJlib] 943 set rjid [$jlib roster getrosterjid $jid] 944 #set jid2 $rjid 945 set jid2 [jlib::barejid $jid] 946 947 # Must remove all resources, and jid2 if no resources. 948 # NB: this gets us also unavailable presence stanzas. 949 # We MUST have the bare JID else we wont get any resources! 950 951 ::RosterTree::StyleDeleteItem $rjid 952 #set resL [$jlib roster getresources $jid2] 953 set resL [$jlib roster getresources $rjid] 954 foreach res $resL { 955 ::RosterTree::StyleDeleteItem $jid2/$res 956 } 957 958 set items [list] 959 set isavailable [$jlib roster isavailable $rjid] 960 961 if {!$isavailable} { 962 963 # XMPP specifies that an 'unavailable' element is sent *after* 964 # we've got a subscription='remove' element. Skip it! 965 # Problems with transports that have /registered? 966 967 # We free up any cached item alt for unavailable JID. 968 ::RosterTree::FreeItemAlternatives $jid 969 970 # This gets a list '-name ... -groups ...' etc. from our roster. 971 set itemAttr [$jlib roster getrosteritem $rjid] 972 973 # Add only to offline if no other jid2/* available. 974 # If not in roster we don't get 'isavailable'. 975 set isavailable [$jlib roster isavailable $rjid] 976 if {!$isavailable} { 977 set items [eval { 978 ::RosterTree::StyleCreateItem $rjid "unavailable" 979 } $itemAttr $args] 980 } 981 } else { 982 983 if {[IsCoccinella $jid]} { 984 ::RosterTree::StyleCacheAltImage $jid whiteboard $icons(whiteboard12) 985 } 986 set items [NewAvailableItem $rjid] 987 } 988 989 # This minimizes the cost of sorting. 990 if {[llength $items]} { 991 992 # If more than one item pick the parent of the first (group). 993 set pitem [::RosterTree::GetParent [lindex $items 0]] 994 ::RosterTree::SortAtIdle $pitem $jprefs(rost,sort) 995 } 996 return 997} 998 999# Roster::NewAvailableItem -- 1000# 1001# This is a utility function used by both roster items and presence 1002# events to set an available roster item. It handles multiple available 1003# resources and process them according to our settings. 1004# 1005# Arguments: 1006# jid must be the roster JID, typically a bare JID 1007# 1008# Results: 1009# list of item ids added. 1010 1011proc ::Roster::NewAvailableItem {jid} { 1012 global config 1013 1014 ::Debug 4 "::Roster::NewAvailableItem jid=$jid" 1015 1016 set jlib [::Jabber::GetJlib] 1017 1018 # This gets a list '-name ... -groups ...' etc. from our roster. 1019 set itemAttr [$jlib roster getrosteritem $jid] 1020 1021 switch -- $config(roster,multi-resources) { 1022 1023 "highest-prio" { 1024 1025 # Add only the one with highest priority. 1026 set jid2 [jlib::barejid $jid] 1027 set res [$jlib roster gethighestresource $jid2] 1028 array set presA [$jlib roster getpresence $jid2 -resource $res] 1029 1030 # For online users we replace the actual resource with max priority one. 1031 # NB1: do not duplicate resource for jid3 roster items! 1032 # NB2: treat case with available empty resource (transports). 1033 if {$res ne ""} { 1034 set jid $jid2/$res 1035 } 1036 1037 set items [eval { 1038 ::RosterTree::StyleCreateItem $jid "available" 1039 } $itemAttr [array get presA]] 1040 } 1041 "all" { 1042 1043 set items [list] 1044 set resOnL [$jlib roster getresources $jid2 -type available] 1045 foreach res $resOnL { 1046 if {$res ne ""} { 1047 set jid $jid2/$res 1048 } 1049 array unset presA 1050 array set presA [$jlib roster getpresence $jid2 -resource $res] 1051 lappend items [eval { 1052 ::RosterTree::StyleCreateItem $jid "available" 1053 } $itemAttr [array get presA]] 1054 } 1055 } 1056 } 1057 return $items 1058} 1059 1060proc ::Roster::InRoster {} { 1061 variable inroster 1062 return $inroster 1063} 1064 1065# Roster::IsCoccinella -- 1066# 1067# Utility function to figure out if we have evidence that jid3 is a 1068# Coccinella. 1069# NOTE: some entities (transports) return private presence elements 1070# when sending their presence! Workaround! BAD!!! 1071 1072proc ::Roster::IsCoccinella {jid3} { 1073 upvar ::Jabber::coccixmlns coccixmlns 1074 upvar ::Jabber::xmppxmlns xmppxmlns 1075 1076 set ans 0 1077 if {![IsTransportEx $jid3]} { 1078 set node [::Jabber::Jlib roster getcapsattr $jid3 node] 1079 # NB: We must treat both the 1.3 and 1.4 caps XEP! 1080 if {$node eq $coccixmlns(caps)} { 1081 set ans 1 1082 } 1083 # node='http://coccinella.sourceforge.net/#0.96.4' 1084 if {[string match $coccixmlns(caps14)* $node]} { 1085 set ans 1 1086 } 1087 } 1088 return $ans 1089} 1090 1091# Roster::GetPresenceIconFromJid -- 1092# 1093# Returns presence icon from jid, typically a full jid. 1094 1095proc ::Roster::GetPresenceIconFromJid {jid} { 1096 1097 set jlib [::Jabber::GetJlib] 1098 jlib::splitjid $jid jid2 res 1099 if {$res eq ""} { 1100 set pres [lindex [$jlib roster getpresence $jid2] 0] 1101 } else { 1102 set pres [$jlib roster getpresence $jid2 -resource $res] 1103 } 1104 set rost [$jlib roster getrosteritem $jid2] 1105 array set argsA $pres 1106 array set argsA $rost 1107 1108 return [eval {GetPresenceIcon $jid $argsA(-type)} [array get argsA]] 1109} 1110 1111# Roster::GetPresenceIcon -- 1112# 1113# Returns the image appropriate for 'presence', and any 'show' attribute. 1114# If presence is to make sense, the jid shall be a 3-tier jid? 1115 1116proc ::Roster::GetPresenceIcon {jid presence args} { 1117 global jprefs 1118 1119 array set argsA $args 1120 1121 # Construct the 'type/sub' specifying the icon. 1122 set itype status 1123 set itype "user" 1124 set isub $presence 1125 1126 # Then see if any <show/> element 1127 if {$presence eq "available"} { 1128 if {[info exists argsA(-show)]} { 1129 set isub $argsA(-show) 1130 } 1131 } elseif {[info exists argsA(-subscription)] && \ 1132 [string equal $argsA(-subscription) "none"]} { 1133 set isub "ask" 1134 } elseif {[info exists argsA(-ask)] && \ 1135 [string equal $argsA(-ask) "subscribe"]} { 1136 set isub "ask" 1137 } 1138 1139 # Foreign IM systems. 1140 set foreign 0 1141 jlib::splitjidex $jid user host res 1142 set server [::Jabber::Jlib getserver] 1143 if {![jlib::jidequal $host $server]} { 1144 1145 # If empty we have likely not yet browsed etc. 1146 set cattype [lindex [::Disco::AccessTypes $host] 0] 1147 set subtype [lindex [split $cattype /] 1] 1148 if {[lsearch -exact [::Rosticons::ThemeGetTypes] $subtype] >= 0} { 1149 set itype $subtype 1150 set foreign 1 1151 } 1152 } 1153 1154 # If whiteboard: 1155 if {!$foreign && $jprefs(rost,useWBrosticon) && \ 1156 ($presence eq "available") && [IsCoccinella $jid]} { 1157 set itype "whiteboard" 1158 } 1159 1160 return [::Rosticons::ThemeGet $itype/$isub] 1161} 1162 1163proc ::Roster::GetMyPresenceIcon {} { 1164 set status [::Jabber::GetMyStatus] 1165 return [::Rosticons::ThemeGet user/$status] 1166} 1167 1168proc ::Roster::GetPresenceAndStatusText {jid} { 1169 1170 set jlib [::Jabber::GetJlib] 1171 jlib::splitjid $jid jid2 res 1172 if {$res eq ""} { 1173 array set presA [lindex [$jlib roster getpresence $jid2] 0] 1174 } else { 1175 array set presA [$jlib roster getpresence $jid2 -resource $res] 1176 } 1177 if {[info exists presA(-show)]} { 1178 set str [MapShowToText $presA(-show)] 1179 } else { 1180 set str [MapShowToText $presA(-type)] 1181 } 1182 if {[info exists presA(-status)]} { 1183 append str " - " $presA(-status) 1184 } 1185 return $str 1186} 1187 1188proc ::Roster::LoginTrpt {jid3} { 1189 ::Jabber::SetStatus available -to $jid3 1190} 1191 1192proc ::Roster::LogoutTrpt {jid3} { 1193 ::Jabber::SetStatus unavailable -to $jid3 1194} 1195 1196proc ::Roster::ShowOffline {} { 1197 RepopulateTree 1198} 1199 1200proc ::Roster::ShowDnD {} { 1201 RepopulateTree 1202} 1203 1204proc ::Roster::ShowAway {} { 1205 RepopulateTree 1206} 1207 1208proc ::Roster::ShowXAway {} { 1209 RepopulateTree 1210} 1211 1212proc ::Roster::ShowTransports {} { 1213 RepopulateTree 1214} 1215 1216#--- Transport utilities ------------------------------------------------------- 1217 1218# @@@ These should eventually move to Gateway! 1219# TODO 1220namespace eval ::Roster:: { 1221 1222 # name description ... 1223 # Excluding smtp since it works differently. 1224 variable trptToAddressName { 1225 jabber "Jabber ID" 1226 xmpp "Jabber ID" 1227 icq "ICQ (number)" 1228 aim "AIM" 1229 facebook "Facebook IM" 1230 mrim "Mail.ru IM" 1231 msn "MSN" 1232 myspaceim "MySpace IM" 1233 yahoo "Yahoo" 1234 irc "IRC" 1235 x-gadugadu "Gadu-Gadu" 1236 gadu-gadu "Gadu-Gadu" 1237 sametime "Sametime" 1238 tlen "Tlen" 1239 x-tlen "Tlen" 1240 twitter "Twitter" 1241 qq "QQ" 1242 } 1243 variable trptToName { 1244 jabber "XMPP" 1245 xmpp "XMPP" 1246 icq "ICQ" 1247 aim "AIM" 1248 facebook "Facebook IM" 1249 mrim "Mail.ru IM" 1250 msn "MSN" 1251 myspaceim "MySpace IM" 1252 yahoo "Yahoo" 1253 irc "IRC" 1254 gadugadu "Gadu-Gadu" 1255 gadu-gadu "Gadu-Gadu" 1256 x-gadugadu "Gadu-Gadu" 1257 sametime "Sametime" 1258 tlen "Tlen" 1259 x-tlen "Tlen" 1260 twitter "Twitter" 1261 qq "QQ" 1262 } 1263 variable nameToTrpt { 1264 "XMPP" xmpp 1265 "ICQ" icq 1266 "AIM" aim 1267 "Facebook IM" facebook 1268 "Mail.ru Im" mrim 1269 "MSN" msn 1270 "MySpace IM" myspaceim 1271 "Yahoo" yahoo 1272 "IRC" irc 1273 "Gadu-Gadu" x-gadugadu 1274 "Gadu-Gadu" gadu-gadu 1275 "Sametime" sametime 1276 "Tlen" tlen 1277 "Twitter" twitter 1278 "QQ" qq 1279 } 1280 1281 variable trptToNameArr 1282 array set trptToNameArr $trptToName 1283 1284 variable nameToTrptArr 1285 array set nameToTrptArr $nameToTrpt 1286 1287 variable allTransports [list] 1288 foreach {name spec} $trptToName { 1289 lappend allTransports $name 1290 } 1291 set allTransports [lsearch -all -inline -not $allTransports "jabber"] 1292} 1293 1294proc ::Roster::HaveNameForTrpt {type} { 1295 variable trptToNameArr 1296 1297 return [info exists trptToNameArr($type)] 1298} 1299 1300proc ::Roster::GetNameFromTrpt {type} { 1301 variable trptToNameArr 1302 1303 if {[info exists trptToNameArr($type)]} { 1304 return $trptToNameArr($type) 1305 } else { 1306 return $type 1307 } 1308} 1309 1310proc ::Roster::GetTrptFromName {name} { 1311 variable nameToTrptArr 1312 1313 if {[info exists nameToTrptArr($name)]} { 1314 return $nameToTrptArr($name) 1315 } else { 1316 return $name 1317 } 1318} 1319 1320# Roster::GetAllTransportJids -- 1321# 1322# Method to get the jids of all services that are not jabber. 1323 1324proc ::Roster::GetAllTransportJids {} { 1325 1326 set alltrpts [::Jabber::Jlib disco getjidsforcategory "gateway/*"] 1327 set xmppjids [::Jabber::Jlib disco getjidsforcategory "gateway/xmpp"] 1328 1329 # Exclude jabber services and login server. 1330 foreach jid $xmppjids { 1331 set alltrpts [lsearch -all -inline -not $alltrpts $jid] 1332 } 1333 set server [::Jabber::Jlib getserver] 1334 return [lsearch -all -inline -not $alltrpts $server] 1335} 1336 1337# Roster::GetTransportSpec -- 1338# 1339# Utility to get a flat array of 'jid type name' for each transport. 1340# If there are multiple transports for a type they are all listed 1341# but using a specified format. 1342 1343proc ::Roster::GetTransportSpec {{format "%name"}} { 1344 variable allTransports 1345 1346 set trpts [list] 1347 foreach type $allTransports { 1348 if {$type eq "xmpp"} { continue } 1349 set jidL [::Jabber::Jlib disco getjidsforcategory "gateway/$type"] 1350 set count [llength $jidL] 1351 if {$count} { 1352 set name [GetNameFromTrpt $type] 1353 foreach jid $jidL { 1354 set xname $name 1355 if {$count > 1} { 1356 set xname [string map [list %name $name %jid $jid] $format] 1357 #set xname "$name ($jid)" 1358 } 1359 lappend trpts [list $jid $type $xname] 1360 } 1361 } 1362 } 1363 1364 # xmpp: 1365 set xmppSpec [GetTransportSpecXMPP] 1366 return [concat $xmppSpec $trpts] 1367} 1368 1369# Roster::GetTransportSpecSingle -- 1370# 1371# Utility to get a flat array of 'jid type name' for each transport. 1372# If there are multiple transports for a type it's only listed once. 1373 1374proc ::Roster::GetTransportSpecSingle {} { 1375 variable allTransports 1376 1377 set trpts [list] 1378 foreach type $allTransports { 1379 if {$type eq "xmpp"} { continue } 1380 set jidL [::Jabber::Jlib disco getjidsforcategory "gateway/$type"] 1381 if {[llength $jidL]} { 1382 set name [GetNameFromTrpt $type] 1383 set jid [lindex $jidL 0] 1384 lappend trpts [list $jid $type $name] 1385 } 1386 } 1387 1388 # xmpp: 1389 set xmppSpec [GetTransportSpecXMPP] 1390 return [concat $xmppSpec $trpts] 1391} 1392 1393proc ::Roster::GetTransportSpecXMPP {} { 1394 1395 # xmpp: 1396 set jidL [::Jabber::Jlib disco getjidsforcategory "gateway/xmpp"] 1397 set count [llength $jidL] 1398 1399 # Disco doesn't return he server. Make sure it's first. 1400 set name [GetNameFromTrpt xmpp] 1401 set xname "$name (" 1402 append xname [mc "Default"] 1403 append xname ")" 1404 set server [::Jabber::Jlib getserver] 1405 set xmppSpec [list [list $server xmpp $xname]] 1406 1407 foreach jid $jidL { 1408 if {[jlib::jidequal $jid $server]} { continue } 1409 set xname $name 1410 if {$count} { 1411 set xname "$name (" 1412 append xname [mc "Transport"] 1413 append xname ")" 1414 } 1415 lappend xmppSpec [list $jid xmpp $xname] 1416 } 1417 return $xmppSpec 1418} 1419 1420proc ::Roster::IsTransport {jid} { 1421 1422 # Some transports (icq) have a jid = icq.jabber.se/registered 1423 # in the roster, but where we get the 2-tier part. Get 3-tier jid. 1424 set transport 0 1425 if {![catch {jlib::splitjidex $jid node host res}]} { 1426 if {([lsearch [GetAllTransportJids] $host] >= 0) && ($node eq "")} { 1427 set transport 1 1428 } 1429 } 1430 return $transport 1431} 1432 1433# This is a really BAD thing to do but I there seems to be no robust method. 1434# I really hate do do this! 1435# Use 'IsTransport' to get a true answer. 1436 1437proc ::Roster::IsTransportHeuristics {jid} { 1438 1439 # Some transports (icq) have a jid = icq.jabber.se/registered and 1440 # yahoo.jabber.ru/registered 1441 # Others, like MSN, have a jid = msn.jabber.ccc.de. 1442 set transport 0 1443 set server [::Jabber::Jlib getserver] 1444 1445 if {![catch {jlib::splitjidex $jid node host res}]} { 1446 if {$node eq ""} { 1447 if {$res eq "registered"} { 1448 set transport 1 1449 } else { 1450 1451 # Search for matching msn.$server etc. 1452 set idx [string first . $host] 1453 if {$idx > 0} { 1454 set phost [string range $host [expr {$idx+1}] end] 1455 if {$phost eq $server} { 1456 set cname [string range $host 0 [expr {$idx-1}]] 1457 switch -- $cname { 1458 aim - gg - gadugadu - icq - msn - smtp - yahoo { 1459 set transport 1 1460 } 1461 } 1462 } 1463 } 1464 } 1465 } 1466 } 1467 if {!$transport} { 1468 set transport [IsTransport $jid] 1469 } 1470 return $transport 1471} 1472 1473# Roster::IsTransportEx -- 1474# 1475# Figures out if a JID is a transport using cached disco-info results. 1476# NB: This should only be used passively, that is, for detection etc. 1477 1478proc ::Roster::IsTransportEx {jid} { 1479 1480 set transport 0 1481 jlib::splitjidex $jid node host res 1482 set server [::Jabber::Jlib getserver] 1483 if {$node eq ""} { 1484 if {$host ne $server} { 1485 set types [::Disco::AccessTypes $host] 1486 1487 # Strip out any "gateway/xmpp". 1488 set gateways [lsearch -inline -glob $types gateway/*] 1489 set gateways [lsearch -inline -not $gateways gateway/xmpp] 1490 set transport [llength $gateways] 1491 } 1492 } 1493 return $transport 1494} 1495 1496#------------------------------------------------------------------------------- 1497 1498proc ::Roster::GetUsersWithSameHost {jid} { 1499 1500 set jidL [list] 1501 jlib::splitjidex $jid - host - 1502 1503 foreach ujid [::Jabber::Jlib roster getusers] { 1504 jlib::splitjidex $ujid - uhost - 1505 if {$host eq $uhost} { 1506 lappend jidL $ujid 1507 } 1508 } 1509 return $jidL 1510} 1511 1512proc ::Roster::RemoveUsers {jidL} { 1513 1514 foreach jid $jidL { 1515 ::Jabber::Jlib roster send_remove $jid 1516 } 1517} 1518 1519proc ::Roster::ExportRoster {} { 1520 set fileName [tk_getSaveFile -defaultextension .xml -initialfile roster.xml] 1521 if {$fileName ne ""} { 1522 SaveRosterToFile $fileName 1523 } 1524} 1525 1526proc ::Roster::SaveRosterToFile {fileName} { 1527 1528 set jlib [::Jabber::GetJlib] 1529 set fd [open $fileName w] 1530 fconfigure $fd -encoding utf-8 1531 1532 puts $fd "<?xml version='1.0' encoding='UTF-8'?>" 1533 puts $fd "<query xmlns='jabber:iq:roster'>" 1534 foreach jid [$jlib roster getusers] { 1535 set item [$jlib roster getitem $jid] 1536 set xml [wrapper::createxml $item] 1537 puts $fd \t$xml 1538 } 1539 puts $fd "</query>" 1540 close $fd 1541} 1542 1543# Prefs page ................................................................... 1544 1545proc ::Roster::InitPrefsHook {} { 1546 global jprefs 1547 1548 # Defaults... 1549 set jprefs(rost,rmIfUnsub) 1 1550 set jprefs(rost,clrLogout) 1 1551 set jprefs(rost,dblClk) chat 1552 set jprefs(rost,showOffline) 1 1553 set jprefs(rost,showTrpts) 1 1554 set jprefs(rost,show-dnd) 1 1555 set jprefs(rost,show-away) 1 1556 set jprefs(rost,show-xa) 1 1557 set jprefs(rost,showSubNone) 1 1558 set jprefs(rost,sort) -increasing 1559 1560 set jprefs(rost,useWBrosticon) 0 1561 1562 # The rosters background image is partly controlled by option database. 1563 set jprefs(rost,useBgImage) 1 1564 set jprefs(rost,defaultBgImage) 1 1565 1566 # Keep track of all closed tree items. Default is all open. 1567 set jprefs(rost,closedItems) [list] 1568 1569 ::PrefUtils::Add [list \ 1570 [list jprefs(rost,clrLogout) jprefs_rost_clrRostWhenOut $jprefs(rost,clrLogout)] \ 1571 [list jprefs(rost,dblClk) jprefs_rost_dblClk $jprefs(rost,dblClk)] \ 1572 [list jprefs(rost,rmIfUnsub) jprefs_rost_rmIfUnsub $jprefs(rost,rmIfUnsub)] \ 1573 [list jprefs(rost,showSubNone) jprefs_rost_showSubNone $jprefs(rost,showSubNone)] \ 1574 [list jprefs(rost,showOffline) jprefs_rost_showOffline $jprefs(rost,showOffline)] \ 1575 [list jprefs(rost,showTrpts) jprefs_rost_showTrpts $jprefs(rost,showTrpts)] \ 1576 [list jprefs(rost,show-dnd) jprefs_rost_show-dnd $jprefs(rost,show-dnd)] \ 1577 [list jprefs(rost,show-away) jprefs_rost_show-away $jprefs(rost,show-away)] \ 1578 [list jprefs(rost,show-xa) jprefs_rost_show-xa $jprefs(rost,show-xa)] \ 1579 [list jprefs(rost,closedItems) jprefs_rost_closedItems $jprefs(rost,closedItems)] \ 1580 [list jprefs(rost,sort) jprefs_rost_sort $jprefs(rost,sort)] \ 1581 [list jprefs(rost,useBgImage) jprefs_rost_useBgImage $jprefs(rost,useBgImage)] \ 1582 [list jprefs(rost,defaultBgImage) jprefs_rost_defaultBgImage $jprefs(rost,defaultBgImage)] \ 1583 ] 1584 1585} 1586 1587proc ::Roster::BuildPrefsHook {wtree nbframe} { 1588 1589 ::Preferences::NewTableItem {Jabber Roster} [mc "Contacts"] 1590 1591 # Roster page ---------------------------------------------------------- 1592 set wpage [$nbframe page {Roster}] 1593 BuildPageRoster $wpage 1594} 1595 1596proc ::Roster::BuildPageRoster {page} { 1597 global jprefs 1598 variable tmpJPrefs 1599 1600 foreach key { 1601 rmIfUnsub showSubNone clrLogout dblClk showOffline showTrpts 1602 } { 1603 set tmpJPrefs(rost,$key) $jprefs(rost,$key) 1604 } 1605 1606 set wc $page.c 1607 ttk::frame $wc -padding [option get . notebookPageSmallPadding {}] 1608 pack $wc -side top -anchor [option get . dialogAnchor {}] 1609 1610 ttk::checkbutton $wc.rmifunsub -text [mc "Remove contact without presence subscription"] \ 1611 -variable [namespace current]::tmpJPrefs(rost,rmIfUnsub) 1612 ttk::checkbutton $wc.clrout -text [mc "Clear list of contacts on logout"] \ 1613 -variable [namespace current]::tmpJPrefs(rost,clrLogout) 1614 ttk::checkbutton $wc.dblclk -text [mc "Chat on double-click instead of message"] \ 1615 -variable [namespace current]::tmpJPrefs(rost,dblClk) \ 1616 -onvalue chat -offvalue normal 1617 ttk::checkbutton $wc.showoff -text [mc "Show offline users"] \ 1618 -variable [namespace current]::tmpJPrefs(rost,showOffline) 1619 ttk::checkbutton $wc.showtrpt -text [mc "Show transports"] \ 1620 -variable [namespace current]::tmpJPrefs(rost,showTrpts) 1621 ttk::checkbutton $wc.showsubno -text [mc "Show contacts without any subscription"] \ 1622 -variable [namespace current]::tmpJPrefs(rost,showSubNone) 1623 1624 grid $wc.rmifunsub -sticky w 1625 grid $wc.clrout -sticky w 1626 grid $wc.dblclk -sticky w 1627 grid $wc.rmifunsub -sticky w 1628 grid $wc.showoff -sticky w 1629 grid $wc.showtrpt -sticky w 1630 grid $wc.showsubno -sticky w 1631 1632 ::balloonhelp::balloonforwindow $wc.rmifunsub [mc "You can see your contact's presence, but your contact can't see yours."] 1633} 1634 1635proc ::Roster::SavePrefsHook {} { 1636 global jprefs 1637 variable tmpJPrefs 1638 1639 #::Avatar::PrefsSave 1640 set repopulatetree 0 1641 # Need to repopulate the roster? 1642 if {$jprefs(rost,showOffline) != $tmpJPrefs(rost,showOffline)} { 1643 set jprefs(rost,showOffline) $tmpJPrefs(rost,showOffline) 1644 set repopulatetree 1 1645 } 1646 if {$jprefs(rost,showTrpts) != $tmpJPrefs(rost,showTrpts)} { 1647 set jprefs(rost,showTrpts) $tmpJPrefs(rost,showTrpts) 1648 set repopulatetree 1 1649 } 1650 if {$jprefs(rost,showSubNone) != $tmpJPrefs(rost,showSubNone)} { 1651 set jprefs(rost,showSubNone) $tmpJPrefs(rost,showSubNone) 1652 set repopulatetree 1 1653 } 1654 if {$repopulatetree eq 1} { 1655 RepopulateTree 1656 } 1657 array set jprefs [array get tmpJPrefs] 1658 unset tmpJPrefs 1659} 1660 1661proc ::Roster::CancelPrefsHook {} { 1662 global jprefs 1663 variable tmpJPrefs 1664 1665 foreach key [array names tmpJPrefs] { 1666 if {![string equal $jprefs($key) $tmpJPrefs($key)]} { 1667 ::Preferences::HasChanged 1668 break 1669 } 1670 } 1671 1672 #::Avatar::PrefsCancel 1673} 1674 1675proc ::Roster::UserDefaultsHook {} { 1676 global jprefs 1677 variable tmpJPrefs 1678 1679 foreach key [array names tmpJPrefs] { 1680 set tmpJPrefs($key) $jprefs($key) 1681 } 1682} 1683 1684#------------------------------------------------------------------------------- 1685