djavu-asus/elpa/jabber-20230715.456/jabber-presence.el

   1 ;; jabber-presence.el - roster and presence bookkeeping  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2003, 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
   4 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
   5
   6 ;; This file is a part of jabber.el.
   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 2 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, write to the Free Software
  20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 (require 'jabber-core)
  23 (require 'jabber-iq)
  24 (require 'jabber-alert)
  25 (require 'jabber-util)
  26 (require 'jabber-menu)
  27 (require 'jabber-muc)
  28
  29 (defvar jabber-presence-element-functions nil
  30   "List of functions returning extra elements for <presence/> stanzas.
  31 Each function takes one argument, the connection, and returns a
  32 possibly empty list of extra child element of the <presence/>
  33 stanza.")
  34
  35 (defvar jabber-presence-history ()
  36   "Keeps track of previously used presence status types.")
  37
  38 (add-to-list 'jabber-iq-set-xmlns-alist
  39              (cons "jabber:iq:roster" (function (lambda (jc x) (jabber-process-roster jc x nil)))))
  40 (defun jabber-process-roster (jc xml-data closure-data)
  41   "Process an incoming roster infoquery result.
  42 CLOSURE-DATA should be 'initial if initial roster push, nil otherwise.
  43 JC is the Jabber connection.
  44 XML-DATA is the parsed tree data from the stream (stanzas)
  45 obtained from `xml-parse-region'."
  46   (let ((roster (plist-get (fsm-get-state-data jc) :roster))
  47         (from (jabber-xml-get-attribute xml-data 'from))
  48         (type (jabber-xml-get-attribute xml-data 'type))
  49         (id (jabber-xml-get-attribute xml-data 'id))
  50         (username (plist-get (fsm-get-state-data jc) :username))
  51         (server (plist-get (fsm-get-state-data jc) :server))
  52         (resource (plist-get (fsm-get-state-data jc) :resource))
  53         new-items changed-items deleted-items)
  54     ;; Perform sanity check on "from" attribute: it should be either absent
  55     ;; match our own JID, or match the server's JID (the latter is what
  56     ;; Facebook does).
  57     (if (not (or (null from)
  58                  (string= from server)
  59                  (string= from (concat username "@" server))
  60                  (string= from (concat username "@" server "/" resource))))
  61         (message "Roster push with invalid \"from\": \"%s\" (expected \"%s\", \"%s@%s\" or \"%s@%s/%s\")"
  62                  from
  63                  server username server username server resource)
  64
  65       (dolist (item (jabber-xml-get-children (car (jabber-xml-get-children xml-data 'query)) 'item))
  66         (let (roster-item
  67               (jid (jabber-jid-symbol (jabber-xml-get-attribute item 'jid))))
  68
  69           ;; If subscripton="remove", contact is to be removed from roster
  70           (if (string= (jabber-xml-get-attribute item 'subscription) "remove")
  71               (progn
  72                 (if (jabber-jid-rostername jid)
  73                     (message "%s (%s) removed from roster" (jabber-jid-rostername jid) jid)
  74                   (message "%s removed from roster" jid))
  75                 (push jid deleted-items))
  76
  77             ;; Find contact if already in roster
  78             (setq roster-item (car (memq jid roster)))
  79
  80             (if roster-item
  81                 (push roster-item changed-items)
  82               ;; If not found, create a new roster item.
  83               (unless (eq closure-data 'initial)
  84                 (if (jabber-xml-get-attribute item 'name)
  85                     (message "%s (%s) added to roster" (jabber-xml-get-attribute item 'name) jid)
  86                   (message "%s added to roster" jid)))
  87               (setq roster-item jid)
  88               (push roster-item new-items))
  89
  90             ;; If this is an initial push, we want to forget
  91             ;; everything we knew about this contact before - e.g. if
  92             ;; the contact was online when we disconnected and offline
  93             ;; when we reconnect, we don't want to see stale presence
  94             ;; information.  This assumes that no contacts are shared
  95             ;; between accounts.
  96             (when (eq closure-data 'initial)
  97               (setplist roster-item nil))
  98
  99             ;; Now, get all data associated with the contact.
 100             (put roster-item 'name (jabber-xml-get-attribute item 'name))
 101             (put roster-item 'subscription (jabber-xml-get-attribute item 'subscription))
 102             (put roster-item 'ask (jabber-xml-get-attribute item 'ask))
 103
 104             ;; Since roster items can't be changed incrementally, we
 105             ;; save the original XML to be able to modify it, instead of
 106             ;; having to reproduce it.  This is for forwards
 107             ;; compatibility.
 108             (put roster-item 'xml item)
 109
 110             (put roster-item 'groups
 111                  (mapcar (lambda (foo) (nth 2 foo))
 112                          (jabber-xml-get-children item 'group)))))))
 113     ;; This is the function that does the actual updating and
 114     ;; redrawing of the roster.
 115     (jabber-roster-update jc new-items changed-items deleted-items)
 116
 117     (if (and id (string= type "set"))
 118         (jabber-send-iq jc nil "result" nil
 119                         nil nil nil nil id)))
 120
 121   ;; After initial roster push, run jabber-post-connect-hooks.  We do
 122   ;; it here and not before since we want to have the entire roster
 123   ;; before we receive any presence stanzas.
 124   (when (eq closure-data 'initial)
 125     (run-hook-with-args 'jabber-post-connect-hooks jc)))
 126
 127 (defun jabber-initial-roster-failure (jc xml-data _closure-data)
 128   "Report the initial roster failure.
 129
 130 JC is the Jabber connection.
 131 XML-DATA is the parsed tree data from the stream (stanzas)
 132 obtained from `xml-parse-region'."
 133   ;; If the initial roster request fails, let's report it, but run
 134   ;; `jabber-post-connect-hooks' anyway. According to the spec, there is
 135   ;; nothing exceptional about the server not returning a roster.
 136   (jabber-report-success jc xml-data "Initial roster retrieval")
 137   (run-hook-with-args 'jabber-post-connect-hooks jc))
 138
 139 (add-to-list 'jabber-presence-chain 'jabber-process-presence)
 140 (defun jabber-process-presence (jc xml-data)
 141   "Process incoming presence tags.
 142
 143 JC is the Jabber connection.
 144 XML-DATA is the parsed tree data from the stream (stanzas)
 145 obtained from `xml-parse-region'."
 146   ;; XXX: use JC argument
 147   (let ((roster (plist-get (fsm-get-state-data jc) :roster))
 148         (from (jabber-xml-get-attribute xml-data 'from))
 149         (to (jabber-xml-get-attribute xml-data 'to))
 150         (type (jabber-xml-get-attribute xml-data 'type))
 151         (presence-show (car (jabber-xml-node-children
 152                              (car (jabber-xml-get-children xml-data 'show)))))
 153         (presence-status (car (jabber-xml-node-children
 154                                (car (jabber-xml-get-children xml-data 'status)))))
 155         (error (car (jabber-xml-get-children xml-data 'error)))
 156         (priority (string-to-number (or (car (jabber-xml-node-children (car (jabber-xml-get-children xml-data 'priority))))
 157                                         "0"))))
 158     (cond
 159      ((string= type "subscribe")
 160       (run-with-idle-timer 0.01 nil #'jabber-process-subscription-request jc from presence-status))
 161
 162      ((jabber-muc-presence-p xml-data)
 163       (jabber-muc-process-presence jc xml-data))
 164
 165      (t
 166       ;; XXX: Think about what to do about out-of-roster presences.
 167       (let ((buddy (jabber-jid-symbol from)))
 168         (if (memq buddy roster)
 169             (let* ((oldstatus (get buddy 'show))
 170                    (resource (or (jabber-jid-resource from) ""))
 171                    (resource-plist (cdr (assoc resource
 172                                                (get buddy 'resources))))
 173                    newstatus)
 174               (cond
 175                ((and (string= resource "") (member type '("unavailable" "error")))
 176                 ;; 'unavailable' or 'error' from bare JID means that all resources
 177                 ;; are offline.
 178                 (setq resource-plist nil)
 179                 (setq newstatus (if (string= type "error") "error" nil))
 180                 (let ((new-message (if error
 181                                        (jabber-parse-error error)
 182                                      presence-status)))
 183                   ;; erase any previous information
 184                   (put buddy 'resources nil)
 185                   (put buddy 'connected nil)
 186                   (put buddy 'show newstatus)
 187                   (put buddy 'status new-message)))
 188
 189                ((string= type "unavailable")
 190                 (setq resource-plist
 191                       (plist-put resource-plist 'connected nil))
 192                 (setq resource-plist
 193                       (plist-put resource-plist 'show nil))
 194                 (setq resource-plist
 195                       (plist-put resource-plist 'status
 196                                  presence-status)))
 197
 198                ((string= type "error")
 199                 (setq newstatus "error")
 200                 (setq resource-plist
 201                       (plist-put resource-plist 'connected nil))
 202                 (setq resource-plist
 203                       (plist-put resource-plist 'show "error"))
 204                 (setq resource-plist
 205                       (plist-put resource-plist 'status
 206                                  (if error
 207                                      (jabber-parse-error error)
 208                                    presence-status))))
 209                ((or
 210                  (string= type "unsubscribe")
 211                  (string= type "subscribed")
 212                  (string= type "unsubscribed"))
 213                 ;; Do nothing, except letting the user know.  The Jabber protocol
 214                 ;; places all this complexity on the server.
 215                 (setq newstatus type))
 216                (t
 217                 (setq resource-plist
 218                       (plist-put resource-plist 'connected t))
 219                 (setq resource-plist
 220                       (plist-put resource-plist 'show (or presence-show "")))
 221                 (setq resource-plist
 222                       (plist-put resource-plist 'status
 223                                  presence-status))
 224                 (setq resource-plist
 225                       (plist-put resource-plist 'priority priority))
 226                 (setq newstatus (or presence-show ""))))
 227
 228               (when resource-plist
 229                 ;; this is for `assoc-set!' in guile
 230                 (if (assoc resource (get buddy 'resources))
 231                     (setcdr (assoc resource (get buddy 'resources)) resource-plist)
 232                   (put buddy 'resources (cons (cons resource resource-plist) (get buddy 'resources))))
 233                 (jabber-prioritize-resources buddy))
 234
 235               (fsm-send jc (cons :roster-update buddy))
 236
 237               (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
 238                 (run-hook-with-args hook
 239                                     buddy
 240                                     oldstatus
 241                                     newstatus
 242                                     (plist-get resource-plist 'status)
 243                                     (funcall jabber-alert-presence-message-function
 244                                              buddy
 245                                              oldstatus
 246                                              newstatus
 247                                              (plist-get resource-plist 'status)))))))))))
 248
 249 (defun jabber-process-subscription-request (jc from presence-status)
 250   "Process an incoming subscription request.
 251 JC is the Jabber connection."
 252   (with-current-buffer (jabber-chat-create-buffer jc from)
 253     (ewoc-enter-last jabber-chat-ewoc (list :subscription-request presence-status :time (current-time)))
 254
 255     (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
 256       (run-hook-with-args hook (jabber-jid-symbol from) nil "subscribe" presence-status (funcall jabber-alert-presence-message-function (jabber-jid-symbol from) nil "subscribe" presence-status)))))
 257
 258 (defun jabber-subscription-accept-mutual (&rest ignored)
 259   (message "Subscription accepted; reciprocal subscription request sent")
 260   (jabber-subscription-reply "subscribed" "subscribe"))
 261
 262 (defun jabber-subscription-accept-one-way (&rest ignored)
 263   (message "Subscription accepted")
 264   (jabber-subscription-reply "subscribed"))
 265
 266 (defun jabber-subscription-decline (&rest ignored)
 267   (message "Subscription declined")
 268   (jabber-subscription-reply "unsubscribed"))
 269
 270 (defun jabber-subscription-reply (&rest types)
 271   (let ((to (jabber-jid-user jabber-chatting-with)))
 272     (dolist (type types)
 273       (jabber-send-sexp jabber-buffer-connection `(presence ((to . ,to) (type . ,type)))))))
 274
 275 (defun jabber-prioritize-resources (buddy)
 276   "Set connected, show and status properties for BUDDY.
 277 Show status properties from highest-priority resource."
 278   (let ((resource-alist (get buddy 'resources))
 279         (highest-priority nil))
 280     ;; Reset to nil at first, for cases (a) resource-alist is nil
 281     ;; and (b) all resources are disconnected.
 282     (put buddy 'connected nil)
 283     (put buddy 'show nil)
 284     (put buddy 'status nil)
 285     (mapc #'(lambda (resource)
 286               (let* ((resource-plist (cdr resource))
 287                      (priority (plist-get resource-plist 'priority)))
 288                 (if (plist-get resource-plist 'connected)
 289                     (when (or (null highest-priority)
 290                               (and priority
 291                                    (> priority highest-priority)))
 292                       ;; if no priority specified, interpret as zero
 293                       (setq highest-priority (or priority 0))
 294                       (put buddy 'connected (plist-get resource-plist 'connected))
 295                       (put buddy 'show (plist-get resource-plist 'show))
 296                       (put buddy 'status (plist-get resource-plist 'status))
 297                       (put buddy 'resource (car resource)))
 298
 299                   ;; if we have not found a connected resource yet, but this
 300                   ;; disconnected resource has a status message, display it.
 301                   (when (not (get buddy 'connected))
 302                     (if (plist-get resource-plist 'status)
 303                         (put buddy 'status (plist-get resource-plist 'status)))
 304                     (if (plist-get resource-plist 'show)
 305                         (put buddy 'show (plist-get resource-plist 'show)))))))
 306           resource-alist)))
 307
 308 (defun jabber-count-connected-resources (buddy)
 309   "Return the number of connected resources for BUDDY."
 310   (let ((resource-alist (get buddy 'resources))
 311         (count 0))
 312     (dolist (resource resource-alist)
 313       (if (plist-get (cdr resource) 'connected)
 314           (setq count (1+ count))))
 315     count))
 316
 317 ;;;###autoload
 318 (defun jabber-send-presence (show status priority)
 319   "Set presence for all accounts."
 320   (interactive
 321    (list
 322     (completing-read "show: " '("" "away" "xa" "dnd" "chat")
 323                      nil t nil 'jabber-presence-history)
 324     (jabber-read-with-input-method "status message: " *jabber-current-status*
 325                                    '*jabber-status-history*)
 326     (read-string "priority: " (int-to-string (if *jabber-current-priority*
 327                                                  *jabber-current-priority*
 328                                                jabber-default-priority)))))
 329
 330   (setq *jabber-current-show* show *jabber-current-status* status)
 331   (setq *jabber-current-priority*
 332         (if (numberp priority) priority (string-to-number priority)))
 333
 334   (let (subelements-map)
 335     ;; For each connection, we use a different set of subelements.  We
 336     ;; cache them, to only generate them once.
 337
 338     ;; Ordinary presence, with no specified recipient
 339     (dolist (jc jabber-connections)
 340       (let ((subelements (jabber-presence-children jc)))
 341         (push (cons jc subelements) subelements-map)
 342         (jabber-send-sexp-if-connected jc `(presence () ,@subelements))))
 343
 344     ;; Then send presence to groupchats
 345     (dolist (gc *jabber-active-groupchats*)
 346       (let* ((buffer (get-buffer (jabber-muc-get-buffer (car gc))))
 347              (jc (when buffer
 348                    (buffer-local-value 'jabber-buffer-connection buffer)))
 349              (subelements (cdr (assq jc subelements-map))))
 350         (when jc
 351           (jabber-send-sexp-if-connected
 352            jc `(presence ((to . ,(concat (car gc) "/" (cdr gc))))
 353                          ,@subelements))))))
 354
 355   (jabber-display-roster))
 356
 357 (defun jabber-presence-children (jc)
 358   "Return the children for a <presence/> stanza.
 359 JC is the Jabber connection."
 360   `(,(when (> (length *jabber-current-status*) 0)
 361        `(status () ,*jabber-current-status*))
 362     ,(when (> (length *jabber-current-show*) 0)
 363          `(show () ,*jabber-current-show*))
 364     ,(when *jabber-current-priority*
 365        `(priority () ,(number-to-string *jabber-current-priority*)))
 366     ,@(apply 'append (mapcar (lambda (f)
 367                                (funcall f jc))
 368                              jabber-presence-element-functions))))
 369
 370 (defun jabber-send-directed-presence (jc jid type)
 371   "Send a directed presence stanza to JID.
 372 TYPE is one of:
 373 \"online\", \"away\", \"xa\", \"dnd\", \"chatty\":
 374   Appear as present with the given status.
 375 \"unavailable\":
 376   Appear as offline.
 377 \"probe\":
 378   Ask the contact's server for updated presence.
 379 \"subscribe\":
 380   Ask for subscription to contact's presence.
 381   (see also `jabber-send-subscription-request')
 382 \"unsubscribe\":
 383   Cancel your subscription to contact's presence.
 384 \"subscribed\":
 385   Accept contact's request for presence subscription.
 386   (this is usually done within a chat buffer)
 387 \"unsubscribed\":
 388   Cancel contact's subscription to your presence.
 389
 390 JC is the Jabber connection."
 391   (interactive
 392    (list (jabber-read-account)
 393          (jabber-read-jid-completing "Send directed presence to: ")
 394          (completing-read "Type (default is online): "
 395                           '(("online")
 396                             ("away")
 397                             ("xa")
 398                             ("dnd")
 399                             ("chatty")
 400                             ("probe")
 401                             ("unavailable")
 402                             ("subscribe")
 403                             ("unsubscribe")
 404                             ("subscribed")
 405                             ("unsubscribed"))
 406                           nil t nil 'jabber-presence-history "online")))
 407   (cond
 408    ((member type '("probe" "unavailable"
 409                    "subscribe" "unsubscribe"
 410                    "subscribed" "unsubscribed"))
 411     (jabber-send-sexp jc `(presence ((to . ,jid)
 412                                      (type . ,type)))))
 413
 414    (t
 415     (let ((*jabber-current-show*
 416            (if (string= type "online")
 417                ""
 418              type))
 419           (*jabber-current-status* nil))
 420       (jabber-send-sexp jc `(presence ((to . ,jid))
 421                                       ,@(jabber-presence-children jc)))))))
 422
 423 (defun jabber-send-away-presence (&optional status)
 424   "Set status to away.
 425 With prefix argument, ask for status message."
 426   (interactive
 427    (list
 428     (when current-prefix-arg
 429       (jabber-read-with-input-method
 430        "status message: " *jabber-current-status* '*jabber-status-history*))))
 431   (jabber-send-presence "away" (if status status *jabber-current-status*)
 432                         *jabber-current-priority*))
 433
 434 ;; XXX code duplication!
 435 (defun jabber-send-xa-presence (&optional status)
 436   "Send extended away presence.
 437 With prefix argument, ask for status message."
 438   (interactive
 439    (list
 440     (when current-prefix-arg
 441       (jabber-read-with-input-method
 442        "status message: " *jabber-current-status* '*jabber-status-history*))))
 443   (jabber-send-presence "xa" (if status status *jabber-current-status*)
 444                         *jabber-current-priority*))
 445
 446 ;;;###autoload
 447 (defun jabber-send-default-presence (&optional _ignore)
 448   "Send default presence.
 449 Default presence is specified by `jabber-default-show',
 450 `jabber-default-status', and `jabber-default-priority'."
 451   (interactive)
 452   (jabber-send-presence
 453    jabber-default-show jabber-default-status jabber-default-priority))
 454
 455 (defun jabber-send-current-presence (&optional _ignore)
 456   "(Re-)send current presence.
 457 That is, if presence has already been sent, use current settings,
 458 otherwise send defaults (see `jabber-send-default-presence')."
 459   (interactive)
 460   (if *jabber-current-show*
 461       (jabber-send-presence *jabber-current-show* *jabber-current-status*
 462                             *jabber-current-priority*)
 463     (jabber-send-default-presence)))
 464
 465 (add-to-list 'jabber-jid-roster-menu (cons "Send subscription request"
 466                                            'jabber-send-subscription-request))
 467 (defun jabber-send-subscription-request (jc to &optional request)
 468   "Send a subscription request to jid.
 469 Show him your request text, if specified.
 470
 471 JC is the Jabber connection."
 472   (interactive (list (jabber-read-account)
 473                      (jabber-read-jid-completing "to: ")
 474                      (jabber-read-with-input-method "request: ")))
 475   (jabber-send-sexp jc
 476                     `(presence
 477                       ((to . ,to)
 478                        (type . "subscribe"))
 479                       ,@(when (and request (> (length request) 0))
 480                           (list `(status () ,request))))))
 481
 482 (defvar jabber-roster-group-history nil
 483   "History of entered roster groups.")
 484
 485 (add-to-list 'jabber-jid-roster-menu
 486              (cons "Add/modify roster entry" 'jabber-roster-change))
 487 (defun jabber-roster-change (jc jid name groups)
 488   "Add or change a roster item.
 489 JC is the Jabber connection."
 490   (interactive (let* ((jid (jabber-jid-symbol
 491                             (jabber-read-jid-completing "Add/change JID: ")))
 492                       (account (jabber-read-account))
 493                       (name (get jid 'name))
 494                       (groups (get jid 'groups))
 495                       (all-groups
 496                        (apply #'append
 497                               (mapcar
 498                                (lambda (j) (get j 'groups))
 499                                (plist-get (fsm-get-state-data account) :roster)))))
 500                  (when (string< emacs-version "22")
 501                    ;; Older emacsen want the completion table to be an alist...
 502                    (setq all-groups (mapcar #'list all-groups)))
 503                  (list account
 504                        jid (jabber-read-with-input-method (format "Name: (default `%s') " name) nil nil name)
 505                        (delete ""
 506                                (completing-read-multiple
 507                                 (format
 508                                  "Groups, comma-separated: (default %s) "
 509                                  (if groups
 510                                      (mapconcat #'identity groups ",")
 511                                    "none"))
 512                                 all-groups
 513                                 nil nil nil
 514                                 'jabber-roster-group-history
 515                                 (mapconcat #'identity groups ",")
 516                                 t)))))
 517   ;; If new fields are added to the roster XML structure in a future standard,
 518   ;; they will be clobbered by this function.
 519   ;; XXX: specify account
 520   (jabber-send-iq jc nil "set"
 521                   (list 'query (list (cons 'xmlns "jabber:iq:roster"))
 522                                 (append
 523                                  (list 'item (append
 524                                      (list (cons 'jid (symbol-name jid)))
 525                                      (if (and name (> (length name) 0))
 526                                          (list (cons 'name name)))))
 527                                  (mapcar #'(lambda (x) `(group () ,x))
 528                                       groups)))
 529                   #'jabber-report-success "Roster item change"
 530                   #'jabber-report-success "Roster item change"))
 531
 532 (add-to-list 'jabber-jid-roster-menu
 533              (cons "Delete roster entry" 'jabber-roster-delete))
 534 (defun jabber-roster-delete (jc jid)
 535   (interactive (list (jabber-read-account)
 536                      (jabber-read-jid-completing "Delete from roster: ")))
 537   (jabber-send-iq jc nil "set"
 538                   `(query ((xmlns . "jabber:iq:roster"))
 539                           (item ((jid . ,jid)
 540                                  (subscription . "remove"))))
 541                   #'jabber-report-success "Roster item removal"
 542                   #'jabber-report-success "Roster item removal"))
 543
 544 (defun jabber-roster-delete-jid-at-point ()
 545   "Delete JID at point from roster.
 546 Signal an error if there is no JID at point."
 547   (interactive)
 548   (let ((jid-at-point (get-text-property (point)
 549                                          'jabber-jid))
 550         (account (get-text-property (point) 'jabber-account)))
 551     (if (and jid-at-point account
 552              (or jabber-silent-mode (yes-or-no-p (format "Really delete %s from roster? " jid-at-point))))
 553         (jabber-roster-delete account jid-at-point)
 554       (error "No contact at point"))))
 555
 556 (defun jabber-roster-delete-group-from-jids (jc jids group)
 557   "Delete group `group' from all JIDs.
 558 JC is the Jabber connection."
 559   (interactive)
 560   (dolist (jid jids)
 561     (jabber-roster-change
 562      jc jid (get jid 'name)
 563      (cl-remove-if-not (lambda (g) (not (string= g group)))
 564                     (get jid 'groups)))))
 565
 566 (defun jabber-roster-edit-group-from-jids (jc jids group)
 567   "Edit group `group' from all JIDs.
 568 JC is the Jabber connection."
 569   (interactive)
 570   (let ((new-group
 571          (jabber-read-with-input-method
 572           (format "New group: (default `%s') " group) nil nil group)))
 573     (dolist (jid jids)
 574       (jabber-roster-change
 575        jc jid (get jid 'name)
 576        (cl-remove-duplicates
 577         (mapcar
 578          (lambda (g) (if (string= g group)
 579                          new-group
 580                        g))
 581          (get jid 'groups))
 582         :test 'string=)))))
 583
 584
 585 (provide 'jabber-presence)
 586
 587 ;;; arch-tag: b8616d4c-dde8-423e-86c7-da7b4928afc3