1# JUser.tcl --- 2# 3# This file is part of The Coccinella application. 4# It implements the UI for adding and editing users. 5# 6# Copyright (c) 2004-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: JUser.tcl,v 1.69 2008-08-12 12:40:00 matben Exp $ 22 23package provide JUser 1.0 24 25namespace eval ::JUser { 26 27 option add *JUser.adduserImage list-add-user widgetDefault 28 option add *JUser.adduserDisImage list-add-user-Dis widgetDefault 29 option add *JUser.vcardImage vcard widgetDefault 30 31 # A unique running identifier. 32 variable uid 0 33 34 # Hooks for add user dialog. 35 ::hooks::register quitAppHook ::JUser::QuitAppHook 36 37 # Configurations: 38 # Details of how to handle menubutton selection for non-xmpp systems. 39 set ::config(adduser,warn-non-xmpp-onselect) 0 40 set ::config(adduser,add-non-xmpp-onselect) 1 41 set ::config(adduser,dlg-type-ask-register) yesnocancel 42 43 # How transports are listed and handled in menubutton. 44 set ::config(adduser,trpt-spec-type) single ;# multi|single 45 46 # Show head label in dialog. 47 set ::config(adduser,show-head) 1 48 49 # Use name and group in dialog? 50 set ::config(adduser,show-nick-group) 0 51} 52 53proc ::JUser::QuitAppHook {} { 54 global wDlgs 55 56 ::UI::SaveWinGeom $wDlgs(jrostadduser) 57} 58 59proc ::JUser::OnMenu {} { 60 if {[llength [grab current]]} { return } 61 if {[::JUI::GetConnectState] eq "connectfin"} { 62 NewDlg 63 } 64} 65 66proc ::JUser::MultiAdd {jidL} { 67 foreach jid $jidL { 68 NewDlg -jid $jid 69 } 70} 71 72# JUser::NewDlg -- 73# 74# Add new user dialog. 75# 76# Arguments: 77# args: -jid JID to add 78# -transportjid JID 79# 80# 81 82proc ::JUser::NewDlg {args} { 83 global this prefs wDlgs config 84 85 variable uid 86 87 # Initialize the state variable, an array. 88 set token [namespace current]::dlg[incr uid] 89 variable $token 90 upvar 0 $token state 91 92 array set argsA $args 93 94 set w $wDlgs(jrostadduser)$uid 95 set state(w) $w 96 set state(finished) -1 97 98 ::UI::Toplevel $w -class JUser \ 99 -usemacmainmenu 1 -macstyle documentProc \ 100 -macclass {document closeBox} -closecommand [namespace current]::CloseCmd 101 wm title $w [mc "Add Contact"] 102 103 set nwin [llength [::UI::GetPrefixedToplevels $wDlgs(jrostadduser)]] 104 if {$nwin == 1} { 105 ::UI::SetWindowPosition $w $wDlgs(jrostadduser) 106 } 107 108 # Find all our groups for any jid. 109 set allGroups [::Jabber::Jlib roster getgroups] 110 set groupValues [concat [list [mc "None"]] $allGroups] 111 112 # Design the menu. 113 set menuDef [list] 114 if {$config(adduser,trpt-spec-type) eq "multi"} { 115 set trpts [::Roster::GetTransportSpec "%name (%jid)"] 116 foreach spec $trpts { 117 lassign $spec jid type name 118 set state(servicejid,$type) $jid 119 set state(servicetype,$jid) $type 120 set imtrpt [::Theme::FindIconSize 16 protocol-$type] 121 lappend menuDef [list $name -value $jid -image $imtrpt] 122 } 123 } else { 124 set trpts [::Roster::GetTransportSpec "%name"] 125 foreach spec $trpts { 126 lassign $spec jid type name 127 set state(servicejid,$type) $jid 128 set state(servicetype,$jid) $type 129 130 # We only list one of each. 131 if {($type ne "xmpp") && [info exists added($type)]} { 132 continue 133 } 134 set imtrpt [::Theme::FindIconSize 16 protocol-$type] 135 lappend menuDef [list $name -value $jid -image $imtrpt] 136 set added($type) 1 137 } 138 unset -nocomplain added 139 } 140 set defaultJID [lindex $trpts 0 0] 141 142 # Global frame. 143 set wall $w.fr 144 ttk::frame $wall 145 pack $wall -fill both -expand 1 146 147 if {$config(adduser,show-head)} { 148 set im [::Theme::Find32Icon $w adduserImage] 149 set imd [::Theme::Find32Icon $w adduserDisImage] 150 151 ttk::label $wall.head -style Headlabel \ 152 -text [mc "Add Contact"] -compound left \ 153 -image [list $im background $imd] 154 pack $wall.head -side top -fill both -expand 1 155 156 ttk::separator $wall.s -orient horizontal 157 pack $wall.s -side top -fill x 158 } 159 set wbox $wall.f 160 ttk::frame $wbox -padding [option get . dialogPadding {}] 161 pack $wbox -fill both -expand 1 162 163 set str [mc "Select the chat system and contact ID of the contact you would like to add."] 164 if {$config(adduser,show-nick-group)} { 165 append str " " [mc "Nickname and group are optional and can be set or changed later."] 166 } 167 ttk::label $wbox.msg -style Small.TLabel \ 168 -padding {0 0 0 6} -wraplength 280 -justify left -text $str 169 pack $wbox.msg -side top -anchor w 170 171 set frmid $wbox.frmid 172 ttk::frame $frmid 173 pack $frmid -side top -fill both -expand 1 174 175 # NB: the state(jid) is actually the prompt which is a real JID 176 # on xmpp systems and the native ID on foreign IM systems. 177 ttk::label $frmid.ltype -text [mc "Chat system"]: 178 ui::optionmenu $frmid.type -menulist $menuDef -direction flush \ 179 -variable $token\(gjid) -command [namespace code [list TrptCmd $token]] 180 ttk::label $frmid.ljid -text [mc "Contact ID"]: -anchor e 181 ttk::entry $frmid.ejid -textvariable $token\(jid) 182 ttk::label $frmid.lnick -text [mc "Nickname"]: -anchor e 183 ttk::entry $frmid.enick -textvariable $token\(name) 184 ttk::label $frmid.lgroup -text [mc "Group"]: -anchor e 185 ttk::combobox $frmid.egroup \ 186 -textvariable $token\(group) -values $groupValues 187 188 grid $frmid.ltype $frmid.type -sticky e -pady 2 189 grid $frmid.ljid $frmid.ejid -sticky e -pady 2 190 grid $frmid.type $frmid.ejid -sticky ew 191 grid columnconfigure $frmid 1 -minsize [$frmid.type maxwidth] 192 193 ::balloonhelp::balloonforwindow $frmid.ejid [mc "Chat address"] 194 195 if {$config(adduser,show-nick-group)} { 196 grid $frmid.lnick $frmid.enick -sticky e -pady 2 197 grid $frmid.lgroup $frmid.egroup -sticky e -pady 2 198 grid $frmid.enick $frmid.egroup -sticky ew 199 200 ::balloonhelp::balloonforwindow $frmid.enick [mc "Familiar name"] 201 ::balloonhelp::balloonforwindow $frmid.egroup [mc "Group to which this contact should belong to"] 202 } 203 204 set state(gjid) $defaultJID 205 set state(jid) "" 206 set state(name) "" 207 set state(group) "" 208 if {[info exists argsA(-jid)]} { 209 set state(jid) [jlib::unescapejid $argsA(-jid)] 210 } 211 if {[info exists argsA(-transportjid)]} { 212 set trptjid $argsA(-transportjid) 213 if {[info exists state(servicetype,$trptjid)]} { 214 set type $state(servicetype,$trptjid) 215 set state(gjid) $trptjid 216 set state(jid) [::Gateway::GetPrompt $type] 217 } 218 } 219 220 # Cache state variables for the dialog. 221 set state(wjid) $frmid.ejid 222 set state(wnick) $frmid.enick 223 set state(wgroup) $frmid.egroup 224 225 # Button part. 226 set frbot $wbox.b 227 ttk::frame $frbot -padding [option get . okcancelTopPadding {}] 228 ttk::button $frbot.btok -text [mc "Add"] -default active \ 229 -command [list [namespace current]::DoAdd $token] 230 ttk::button $frbot.btcancel -text [mc "Cancel"] \ 231 -command [list [namespace current]::CancelAdd $token] 232 set padx [option get . buttonPadX {}] 233 if {[option get . okcancelButtonOrder {}] eq "cancelok"} { 234 pack $frbot.btok -side right 235 pack $frbot.btcancel -side right -padx $padx 236 } else { 237 pack $frbot.btcancel -side right 238 pack $frbot.btok -side right -padx $padx 239 } 240 pack $frbot -side top -fill x 241 242 bind $frmid.ejid <Map> { focus %W } 243 244 wm resizable $w 0 0 245 bind $w <Return> [list $frbot.btok invoke] 246 bind $state(wjid) <Map> { focus %W } 247 bind $w <Destroy> \ 248 +[subst { if {"%W" eq "$w"} { [namespace code [list Free $token]] } }] 249 250 # Trick to resize the labels wraplength. 251 set script [format { 252 update idletasks 253 %s configure -wraplength [expr {[winfo reqwidth %s] - 30}] 254 } $wbox.msg $w] 255 after idle $script 256 257 return $token 258} 259 260proc ::JUser::CancelAdd {token} { 261 global wDlgs 262 variable $token 263 upvar 0 $token state 264 265 ::UI::SaveWinPrefixGeom $wDlgs(jrostadduser) 266 set state(finished) 0 267 destroy $state(w) 268} 269 270proc ::JUser::DoAdd {token} { 271 global wDlgs config 272 variable $token 273 upvar 0 $token state 274 275 set jlib [::Jabber::GetJlib] 276 277 # We MUST use the bare JID else hell breaks lose. 278 set state(jid) [jlib::barejid $state(jid)] 279 set gjid $state(gjid) 280 set type $state(servicetype,$gjid) 281 282 283 # The user inputs the chat systems native ID typically. Get JID. 284 # If multiple transports of the same type, 'gjid' is just any of them. 285 # If we actually have a transport registered we must use that. 286 set jid [::Gateway::GetJIDFromPromptHeuristics $state(jid) $type] 287 set name $state(name) 288 set group $state(group) 289 290 Debug 2 "::JUser::DoAdd type=$type, jid=$state(jid), gjid=$state(gjid), jid=$jid" 291 292 # In any case the jid should be well formed. 293 if {![jlib::jidvalidate $jid]} { 294 set ans [::UI::MessageBox -message [mc "Invalid Contact ID." $jid] \ 295 -icon error -title [mc "Error"] -parent $state(w)] 296 return 297 } 298 299 # Warn if already in our roster. 300 set users [$jlib roster getusers] 301 if {[$jlib roster isitem $jid]} { 302 set ans [::UI::MessageBox -message [mc "%s is already in your list. Do you want to continue anyway?" $jid] \ 303 -icon error -title [mc "Error"] -type yesno] 304 if {[string equal $ans "no"]} { 305 return 306 } 307 } 308 309 # Check the jid we are trying to add. 310 if {![catch {jlib::splitjidex $jid node host res}]} { 311 312 # Exclude jabber services. 313 if {[lsearch [::Roster::GetAllTransportJids] $host] >= 0} { 314 315 # If this requires a transport component we must be registered. 316 set transport [lsearch -inline -regexp $users "^${host}.*"] 317 if {![llength $transport]} { 318 319 # Seems we are not registered. 320 set ans [::UI::MessageBox \ 321 -type $config(adduser,dlg-type-ask-register) -icon error \ 322 -title [mc "Error"] \ 323 -parent $state(w) -message [mc "To add a contact from a chat system without open federation, you need an account on this closed system, plus you need to register this account with the corresponding transport (%s). Do you want to do this now?" $host]] 324 325 if {$ans eq "yes"} { 326 ::GenRegister::NewDlg -server $host -autoget 1 327 return 328 } elseif {$ans eq "cancel"} { 329 # Destroy also add dialog? 330 return 331 } 332 } 333 } 334 } 335 336 # If 'name' not set then set it to the foreign system ID. 337 if {($type ne "xmpp") && ($name eq "")} { 338 set name $state(jid) 339 } 340 341 set opts [list] 342 if {[string length $name]} { 343 lappend opts -name $name 344 } 345 if {($group ne [mc "None"]) && ($group ne "")} { 346 lappend opts -groups [list $group] 347 } 348 349 # This is the only (?) situation when a client "sets" a roster item. 350 # The actual roster item is pushed back to us, and not set from here. 351 set cb [list [namespace code SetCB] $jid] 352 eval {$jlib roster send_set $jid -command $cb} $opts 353 354 # Send subscribe request. 355 set opts [list] 356 set nickname [::Profiles::GetSelected -nickname] 357 if {$nickname ne ""} { 358 lappend opts -xlist [list [::Nickname::Element $nickname]] 359 } 360 eval {$jlib send_presence -to $jid -type "subscribe" \ 361 -command [namespace current]::PresError} $opts 362 363 ::UI::SaveWinPrefixGeom $wDlgs(jrostadduser) 364 set state(finished) 1 365 destroy $state(w) 366} 367 368# JUser::SetCB -- 369# 370# This is our callback procedure to the roster set command. 371# 372# Arguments: 373# jid 374# type "result" or "error" 375# args 376 377proc ::JUser::SetCB {jid type queryE} { 378 379 if {[string equal $type "error"]} { 380 foreach {errcode errmsg} $queryE break 381 set ujid [jlib::unescapejid $jid] 382 set str [mc "Cannot set %s's nickname or group." $ujid] 383 append str "\n" 384 append str [mc "Error code"] 385 append str ": $errcode\n" 386 append str [mc "Message"] 387 append str ": $errmsg" 388 ::UI::MessageBox -icon error -title [mc "Error"] -type ok -message $str 389 } 390} 391 392# JUser::PresError -- 393# 394# Callback when sending presence to user for (un)subscription requests. 395 396proc ::JUser::PresError {jlibname xmldata} { 397 398 set from [wrapper::getattribute $xmldata from] 399 set type [wrapper::getattribute $xmldata type] 400 if {$type eq ""} { 401 set type "available" 402 } 403 if {[string equal $type "error"]} { 404 set errspec [jlib::getstanzaerrorspec $xmldata] 405 if {[llength $errspec]} { 406 set errcode [lindex $errspec 0] 407 set errmsg [lindex $errspec 1] 408 set ujid [jlib::unescapejid $from] 409 set str "We received an error when (un)subscribing to $ujid.\ 410 The error is: $errmsg ($errcode).\ 411 Do you want to remove it from your roster?" 412 set ans [::UI::MessageBox -icon error -title [mc "Error"] -type yesno \ 413 -message $str] 414 if {$ans eq "yes"} { 415 ::Jabber::Jlib roster send_remove $from 416 } 417 } 418 } 419} 420 421# JUser::TrptCmd -- 422# 423# Callback from the transports menu button. 424 425proc ::JUser::TrptCmd {token gjid} { 426 global config 427 428 if {$config(adduser,trpt-spec-type) eq "multi"} { 429 TrptMultiCmd $token $gjid 430 } else { 431 TrptSingleCmd $token $gjid 432 } 433} 434 435proc ::JUser::TrptMultiCmd {token gjid} { 436 global config 437 variable $token 438 upvar 0 $token state 439 440 set wjid $state(wjid) 441 set type $state(servicetype,$gjid) 442 443 # Seems to be necessary to achive any selection. 444 focus $wjid 445 #set state(jid) [format [::Gateway::GetTemplateJID $type] $gjid] 446 set state(jid) [::Gateway::GetPrompt $type] 447 set ind [string first @ $state(jid)] 448 if {$ind > 0} { 449 #$wjid selection range 0 $ind 450 } 451 $wjid selection range 0 end 452 453 # @@@ NB: While the service JID is a bare JID any roster item may 454 # have a resource part: icq.jabber.cz/registered 455 # Must find any matches! 456 457 set rjid [::Jabber::Jlib roster getrosterjid $gjid] 458 set isitem [string length $rjid] 459 460 set alert 0 461 if {$type eq "xmpp"} { 462 set server [::Jabber::Jlib getserver] 463 if {![jlib::jidequal $gjid $server]} { 464 set alert 1 465 } 466 } elseif {!$isitem} { 467 set alert 1 468 } 469 470 # If this requires a transport component we must be registered. 471 if {$alert} { 472 if {$config(adduser,warn-non-xmpp-onselect)} { 473 set str "You are currently not registered with this transport and if you proceed you will be asked to register with your own account on this system." 474 tk_messageBox -icon warning -parent $state(w) -message $str 475 } elseif {$config(adduser,add-non-xmpp-onselect)} { 476 set ans [::UI::MessageBox -type yesno -icon warning \ 477 -parent $state(w) -message [mc "To add a contact from a chat system without open federation, you need an account on this closed system, plus you need to register this account with the corresponding transport (%s). Do you want to do this now?" $gjid]] 478 if {$ans eq "yes"} { 479 ::GenRegister::NewDlg -server $gjid -autoget 1 480 } 481 } 482 } 483} 484 485# JUser::TrptSingleCmd -- 486# 487# Since each transport, except xmpp, is listed only once 'gjid' is just 488# any JID of that type. For 'xmpp' it is the true JID. 489 490proc ::JUser::TrptSingleCmd {token gjid} { 491 global config 492 variable $token 493 upvar 0 $token state 494 495 set wjid $state(wjid) 496 set type $state(servicetype,$gjid) 497 498 # Seems to be necessary to achive any selection. 499 focus $wjid 500 set state(jid) [::Gateway::GetPrompt $type] 501 $wjid selection range 0 end 502 503 set jidL [::Jabber::Jlib disco getjidsforcategory "gateway/$type"] 504 505 set alert 0 506 if {$type eq "xmpp"} { 507 set server [::Jabber::Jlib getserver] 508 if {![jlib::jidequal $gjid $server]} { 509 set alert 1 510 } 511 } else { 512 set count [llength $jidL] 513 set isregistered 0 514 foreach j $jidL { 515 set rjid [::Jabber::Jlib roster getrosterjid $j] 516 set isitem [string length $rjid] 517 if {$isitem} { 518 set isregistered 1 519 set regJID $j 520 break 521 } 522 } 523 if {!$isregistered} { 524 set alert 1 525 } 526 } 527 528 if {$alert} { 529 if {$config(adduser,warn-non-xmpp-onselect)} { 530 set str "You are currently not registered with this transport and if you proceed you will be asked to register with your own account on this system." 531 tk_messageBox -icon warning -parent $state(w) -message $str 532 } elseif {$config(adduser,add-non-xmpp-onselect)} { 533 set ans [::UI::MessageBox -type yesno -icon warning \ 534 -parent $state(w) -message [mc "To add a contact from a chat system without open federation, you need an account on this closed system, plus you need to register this account with the corresponding transport (%s). Do you want to do this now?" $gjid]] 535 if {$ans eq "yes"} { 536 537 if {[llength $jidL] > 1} { 538 ::GenRegister::NewDlg -serverlist $jidL 539 } else { 540 ::GenRegister::NewDlg -server $gjid -autoget 1 541 } 542 } 543 } 544 } 545} 546 547proc ::JUser::CloseCmd {wclose} { 548 global wDlgs 549 550 ::UI::SaveWinPrefixGeom $wDlgs(jrostadduser) 551} 552 553#--- The Edit section ---------------------------------------------------------- 554 555proc ::JUser::EditJIDList {jidL} { 556 foreach jid $jidL { 557 EditDlg $jid 558 } 559} 560 561# JUser::EditDlg -- 562# 563# Dispatcher for edit dialog. 564 565proc ::JUser::EditDlg {jid} { 566 567 if {[::Roster::IsTransportHeuristics $jid]} { 568 EditTransportDlg $jid 569 } else { 570 EditUserDlg $jid 571 } 572} 573 574proc ::JUser::EditTransportDlg {jid} { 575 576 set jlib [::Jabber::GetJlib] 577 578 # We get jid2 here. For transports we need the full jid! 579 set res [lindex [$jlib roster getresources $jid] 0] 580 if {$res eq ""} { 581 set jid3 $jid 582 } else { 583 set jid3 $jid/$res 584 } 585 set subscription [$jlib roster getsubscription $jid3] 586 jlib::splitjidex $jid node host x 587 set trpttype [lindex [$jlib disco types $host] 0] 588 set subtype [lindex [split $trpttype /] 1] 589 set typename [::Roster::GetNameFromTrpt $subtype] 590 set ujid [jlib::unescapejid $jid3] 591 set msg [mc "This is your own account at %s that acts as a service that transports messages to that IM system. It needs to be in your list. You have a subscription for %s: %s." $typename $ujid $subscription] 592 593 ::ui::dialog -title [mc "Info"] -type ok -message $msg -icon info 594} 595 596proc ::JUser::EditGetAllTokens {} { 597 return [info vars [namespace current]::dlg*] 598} 599 600proc ::JUser::EditHaveDlgForJID {jid} { 601 return [llength [EditGetTokenForJID $jid]] 602} 603 604proc ::JUser::EditGetTokenForJID {jid} { 605 foreach token [EditGetAllTokens] { 606 variable $token 607 upvar 0 $token state 608 if {[info exists state(jid)] && [jlib::jidequal $jid $state(jid)]} { 609 return $token 610 } 611 } 612 return 613} 614 615# JUser::EditUserDlg -- 616# 617# Edit user dialog. 618 619proc ::JUser::EditUserDlg {jid} { 620 global this prefs wDlgs 621 622 variable uid 623 624 # Guarantee only single dialog per JID. 625 if {[llength [set token [EditGetTokenForJID $jid]]]} { 626 variable $token 627 upvar 0 $token state 628 raise $state(w) 629 focus $state(w) 630 return 631 } 632 633 # Initialize the state variable, an array. 634 set token [namespace current]::dlg[incr uid] 635 variable $token 636 upvar 0 $token state 637 638 set w $wDlgs(jrostedituser)$uid 639 set state(w) $w 640 set state(finished) -1 641 642 set istransport [::Roster::IsTransport $jid] 643 if {$istransport} { 644 set title [mc "Transport Details"] 645 } else { 646 set title [mc "Edit Contact"] 647 } 648 649 ::UI::Toplevel $w -class JUser \ 650 -usemacmainmenu 1 -macstyle documentProc \ 651 -macclass {document closeBox} -closecommand [namespace current]::CloseCmd 652 wm title $w $title 653 654 set nwin [llength [::UI::GetPrefixedToplevels $wDlgs(jrostedituser)]] 655 if {$nwin == 1} { 656 ::UI::SetWindowPosition $w $wDlgs(jrostedituser) 657 } 658 set im [::Theme::Find32Icon $w adduserImage] 659 set imd [::Theme::Find32Icon $w adduserDisImage] 660 661 set jlib [::Jabber::GetJlib] 662 663 # Find all our groups for any jid. 664 set allGroups [list] 665 set allGroups [$jlib roster getgroups] 666 667 # Get 'name' and 'group(s)'. 668 set name "" 669 set groups [list] 670 set subscribe 0 671 set unsubscribe 0 672 set subscription "none" 673 foreach {key value} [$jlib roster getrosteritem $jid] { 674 675 # 'groups', 'subscription',... 676 set keym [string trimleft $key "-"] 677 set $keym $value 678 } 679 set groups [lsort -unique $groups] 680 set group [lindex $groups 0] 681 682 set state(jid) $jid 683 set state(name) $name 684 set state(group) $group 685 set state(origname) $name 686 set state(origgroup) $group 687 set state(origgroups) $groups 688 set state(newgroups) $groups 689 set state(subscribe) $subscribe 690 set state(unsubscribe) $unsubscribe 691 set ujid [jlib::unescapejid $jid] 692 if {$istransport} { 693 jlib::splitjidex $jid node host res 694 set trpttype [lindex [$jlib disco types $host] 0] 695 set subtype [lindex [split $trpttype /] 1] 696 set msg [mc "This is your own account at %s that acts as a service that transports messages to that IM system. It needs to be in your list. You have a subscription for %s: %s." $subtype $ujid $subscription] 697 } else { 698 set msg [mc "Edit nickname and group of %s. You also can request or remove presence subscription." $ujid] 699 } 700 701 # Global frame. 702 set wall $w.fr 703 ttk::frame $wall 704 pack $wall -fill both -expand 1 705 706 ttk::label $wall.head -style Headlabel \ 707 -text $title -compound left \ 708 -image [list $im background $imd] 709 pack $wall.head -side top -fill both -expand 1 710 711 ttk::separator $wall.s -orient horizontal 712 pack $wall.s -side top -fill x 713 714 set wbox $wall.f 715 ttk::frame $wbox -padding [option get . dialogPadding {}] 716 pack $wbox -fill both -expand 1 717 718 ttk::label $wbox.msg -style Small.TLabel \ 719 -padding {0 0 0 6} -wraplength 280 -justify left -text $msg 720 pack $wbox.msg -side top -anchor w 721 722 set frmid $wbox.frmid 723 ttk::frame $frmid 724 pack $frmid -side top -fill both -expand 1 725 726 ttk::label $frmid.lnick -text [mc "Nickname"]: -anchor e 727 ttk::entry $frmid.enick -textvariable $token\(name) 728 grid $frmid.lnick $frmid.enick -pady 2 729 grid $frmid.lnick -sticky e 730 grid $frmid.enick -sticky ew 731 ttk::separator $wall.s2 -orient horizontal 732 pack $wall.s2 -side top -fill x 733 734 # the group editor frame 735 set gf $wall.gf 736 ttk::frame $gf 737 pack $gf -side top -fill both -expand yes 738 # available groups 739 ttk::frame $gf.ga 740 pack $gf.ga -side left -expand yes -fill both 741 ttk::label $gf.ga.title -text [mc "Available groups"] 742 pack $gf.ga.title -side top -anchor w 743 ttk::frame $gf.ga.gr 744 ttk::label $gf.ga.gr.lab -text [mc "Group:"] 745 ttk::entry $gf.ga.gr.oup 746 pack $gf.ga.gr.lab -side left 747 pack $gf.ga.gr.oup -side left -fill x -expand yes 748 pack $gf.ga.gr -side top -fill x 749 # available groups listbox 750 set gal [listbox $gf.ga.gal] 751 pack $gal -side top -expand yes -fill both 752 753 # current groups 754 ttk::frame $gf.gc 755 pack $gf.gc -side right -expand yes -fill both 756 ttk::label $gf.gc.title -text [mc "Current groups"] 757 pack $gf.gc.title -side top -anchor w 758 # current groups listbox 759 set gcl [listbox $gf.gc.gcl] 760 pack $gcl -side top -expand yes -fill both 761 762 763 foreach group $allGroups { 764 $gal insert end $group 765 } 766 foreach group $groups { 767 $gcl insert end $group 768 } 769 # add remove button frame 770 ttk::frame $gf.bf 771 ttk::button $gf.bf.add -text [mc "Add ->"] \ 772 -command "[namespace current]::AddAvailableGroup $token $gcl \[$gf.ga.gr.oup get\]" 773 ttk::button $gf.bf.remove -text [mc "<- Remove"] \ 774 -command [list [namespace current]::RemoveCurrentGroup $token $gcl] 775 pack $gf.bf.add $gf.bf.remove -side top -fill x -anchor c 776 pack $gf.bf -side left 777 778 if {!$istransport} { 779 780 # Give user an opportunity to subscribe/unsubscribe other jid. 781 switch -- $subscription { 782 from - none { 783 ttk::checkbutton $frmid.csubs -style Small.TCheckbutton \ 784 -text [mc "Request presence subscription"] \ 785 -variable $token\(subscribe) 786 } 787 both - to { 788 ttk::checkbutton $frmid.csubs -style Small.TCheckbutton \ 789 -text [mc "Remove presence subscription"] \ 790 -variable $token\(unsubscribe) 791 } 792 } 793 794 # Presence subscription. 795 set subDescr [dict create] 796 # TRANSLATORS; these strings are balloon mouse over tooltips in the edit contact dialog 797 dict set subDescr both [mc "Both you and your contact can see eachother's presence."] 798 dict set subDescr from [mc "You cannot see your contact's presence, but your contact can see yours."] 799 dict set subDescr none [mc "Both you and your contact cannot see eachother's presence."] 800 dict set subDescr to [mc "You can see your contact's presence, but your contact can't see yours."] 801 802 set str [dict get $subDescr $subscription] 803 ttk::label $frmid.lsub -style Small.TLabel -text $str -anchor e 804 805 # Presence presence subscription in a userfriendly way. Not sure if this is a good idea, but what about using $frmid.lsub in a balloon help string for $frmid.csubs instead of a label? 806 # Other idea to improve this dialog: change checkbox item in a button that do not close the dialog, but just update the string $frmid.lsub. So, maybe: 807 # $frmid.lsub2 = what will happen when the user clicks in this button, in the same terms as $frmid.lsub 808 # Nickname: <field> 809 # Group: <field> 810 # Presence: $frmid.lsub <button balloon="$frmid.lsub2">Remove Subscription</button> 811 # When people click on this button, they get an "are you sure? dialog" first, if yes, $frmid.lsub and $frmid.lsub2 are updated in the dialog, but the dialog is not closed 812 813 # last related idea: maybe move annotation tab from the business card dialog to the edit contact dialog. Add to the edit contact dialog 3 tabs in this order: General, Annotations, Presence. In the future you also can move buddy pouncing to this edit contact dialog. Also, you can add a feature to the presence dialog to allow people to synchronise global presence with this specific contact, enabled by default for all contacts (and then add a presence icon button in all chat dialogs, similar to how you did in the groupchat dialog) 814 } 815 816 if {!$istransport} { 817 grid x $frmid.csubs -sticky w -pady 2 818 grid x $frmid.lsub -sticky w -pady 2 819 } 820 821 # Cache state variables for the dialog. 822 set state(wjid) $frmid.ejid 823 set state(wnick) $frmid.enick 824 set state(wgroup) $frmid.egroup 825 826 # Button part. 827 set frbot $wall.b 828 ttk::frame $frbot -padding [option get . okcancelTopPadding {}] 829 ttk::button $frbot.btok -text [mc "Save"] -default active \ 830 -command [list [namespace current]::DoEdit $token] 831 ttk::button $frbot.btcancel -text [mc "Cancel"] \ 832 -command [list [namespace current]::CancelEdit $token] 833 set padx [option get . buttonPadX {}] 834 if {[option get . okcancelButtonOrder {}] eq "cancelok"} { 835 pack $frbot.btok -side right 836 pack $frbot.btcancel -side right -padx $padx 837 } else { 838 pack $frbot.btcancel -side right 839 pack $frbot.btok -side right -padx $padx 840 } 841 if {!$istransport} { 842 set imvcard [::Theme::Find32Icon $w vcardImage] 843 ttk::button $frbot.bvcard -style Plain \ 844 -compound image -image $imvcard \ 845 -command [list ::VCard::Fetch other $jid] 846 pack $frbot.bvcard -side left 847 ::balloonhelp::balloonforwindow $frbot.bvcard [mc "View business card"] 848 } 849 pack $frbot -side top -fill x 850 851 wm resizable $w 0 0 852 bind $w <Return> [list $frbot.btok invoke] 853 854 # Trick to resize the labels wraplength. 855 set script [format { 856 update idletasks 857 %s configure -wraplength [expr {[winfo reqwidth %s] - 40}] 858 } $wbox.msg $w] 859 after idle $script 860 861 bind $frmid.enick <Map> { focus %W } 862 bind $w <Destroy> \ 863 +[subst { if {"%W" eq "$w"} { [namespace code [list Free $token]] } }] 864 bindtags $gal [list Listbox $gal . all] 865 bind $gal <1> [list [namespace current]::SelectAvailableGroup $gal $gf.ga.gr.oup] 866 867 return $token 868} 869 870proc JUser::AddAvailableGroup {token grlist group} { 871 variable $token 872 upvar 0 $token state 873 set group [string trim $group] 874 if {$group ne ""} { 875 set groups [$grlist get 0 end] 876 lappend groups $group 877 set groups [lsort -unique $groups] 878 $grlist delete 0 end 879 eval $grlist insert end $groups 880 set state(newgroups) $groups 881 } 882} 883 884proc JUser::RemoveCurrentGroup {token grlist} { 885 variable $token 886 upvar 0 $token state 887 if {[$grlist curselection] ne ""} { 888 $grlist delete [$grlist curselection] 889 set state(newgroups) [$grlist get 0 end] 890 } 891} 892 893proc JUser::SelectAvailableGroup {grlist grentry} { 894 if {[$grlist curselection] ne ""} { 895 set group [$grlist get [$grlist curselection]] 896 $grentry delete 0 end 897 $grentry insert 0 $group 898 } 899} 900 901proc ::JUser::CancelEdit {token} { 902 global wDlgs 903 variable $token 904 upvar 0 $token state 905 906 ::UI::SaveWinPrefixGeom $wDlgs(jrostedituser) 907 set state(finished) 0 908 destroy $state(w) 909} 910 911proc ::JUser::DoEdit {token} { 912 global wDlgs 913 variable $token 914 upvar 0 $token state 915 916 set jid $state(jid) 917 set name $state(name) 918 set group $state(group) 919 set origname $state(origname) 920 set origgroup $state(origgroup) 921 set origgroups $state(origgroups) 922 set subscribe $state(subscribe) 923 set unsubscribe $state(unsubscribe) 924 set newgroups $state(newgroups) 925 set changedName 0 926 set haveGroup 0 927 928 # This is the only situation when a client "sets" a roster item. 929 # The actual roster item is pushed back to us, and not set from here. 930 set opts [list] 931 if {[string length $name]} { 932 lappend opts -name $name 933 } 934 if {[string compare $name $origname]} { 935 set changedName 1 936 } 937 set groups [lsort -unique $newgroups] 938 set ogroups [lsort -unique $origgroups] 939 set l1 [llength $groups] 940 set l2 [llength $ogroups] 941 if { $l1 ne $l2 } { 942 set haveGroup 1 943 } else { 944 set i 0 945 set j 0 946 while {($i < $l1) && ($j < $l2)} { 947 if {[set w [string compare [lindex $groups $i] [lindex $ogroups $j]]] == 0} { 948 # equal 949 incr i 950 incr j 951 } else { 952 # not equal 953 set haveGroup 1 954 break 955 } 956 } 957 } 958 959 if {$haveGroup == 1} { 960 lappend opts -groups $groups 961 } 962 set jlib [::Jabber::GetJlib] 963 if {$changedName || $haveGroup} { 964 set cb [list [namespace code SetCB] $jid] 965 eval {$jlib roster send_set $jid -command $cb} $opts 966 } 967 968 # Send (un)subscribe request. 969 if {$subscribe} { 970 set opts [list] 971 set nickname [::Profiles::GetSelected -nickname] 972 if {$nickname ne ""} { 973 lappend opts -xlist [list [::Nickname::Element $nickname]] 974 } 975 eval {$jlib send_presence -to $jid -type "subscribe" \ 976 -command [namespace current]::PresError} $opts 977 } elseif {$unsubscribe} { 978 $jlib send_presence -type "unsubscribe" -to $jid \ 979 -command [namespace current]::PresError 980 } 981 982 ::UI::SaveWinPrefixGeom $wDlgs(jrostedituser) 983 set state(finished) 1 984 destroy $state(w) 985} 986 987proc ::JUser::Free {token} { 988 variable $token 989 upvar 0 $token state 990 991 unset -nocomplain state 992} 993 994#------------------------------------------------------------------------------- 995