jabber-muc.el

   1 ;; jabber-muc.el - advanced MUC functions
   2
   3 ;; Copyright (C) 2010 - Kirill A. Korinskiy - catap@catap.ru
   4 ;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 - Magnus Henoch - mange@freemail.hu
   5 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
   6
   7 ;; This file is a part of jabber.el.
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program; if not, write to the Free Software
  21 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 (require 'jabber-chat)
  24 (require 'jabber-widget)
  25 (require 'jabber-newdisco)
  26 (require 'jabber-autoloads)
  27 (require 'jabber-muc-nick-coloring)
  28
  29 (require 'cl)
  30
  31 ;;;###autoload
  32 (defvar *jabber-active-groupchats* nil
  33   "alist of groupchats and nicknames
  34 Keys are strings, the bare JID of the room.
  35 Values are strings.")
  36
  37 (defvar jabber-pending-groupchats (make-hash-table)
  38   "Hash table of groupchats and nicknames.
  39 Keys are JID symbols; values are strings.
  40 This table records the last nickname used to join the particular
  41 chat room.  Items are thus never removed.")
  42
  43 (defvar jabber-muc-participants nil
  44   "alist of groupchats and participants
  45 Keys are strings, the bare JID of the room.
  46 Values are lists of nickname strings.")
  47
  48 (defvar jabber-group nil
  49   "the groupchat you are participating in")
  50
  51 (defvar jabber-muc-topic ""
  52   "The topic of the current MUC room.")
  53
  54 (defvar jabber-role-history ()
  55   "Keeps track of previously used roles")
  56
  57 (defvar jabber-affiliation-history ()
  58   "Keeps track of previously used affiliations")
  59
  60 (defvar jabber-muc-nickname-history ()
  61   "Keeps track of previously referred-to nicknames")
  62
  63 ;;;###autoload
  64 (defcustom jabber-muc-default-nicknames nil
  65   "Default nickname for specific MUC rooms."
  66   :group 'jabber-chat
  67   :type '(repeat
  68           (cons :format "%v"
  69                 (string :tag "JID of room")
  70                 (string :tag "Nickname"))))
  71
  72 ;;;###autoload
  73 (defcustom jabber-muc-autojoin nil
  74   "List of MUC rooms to automatically join on connection.
  75 This list is saved in your Emacs customizations.  You can also store
  76 such a list on the Jabber server, where it is available to every
  77 client; see `jabber-edit-bookmarks'."
  78   :group 'jabber-chat
  79   :type '(repeat (string :tag "JID of room")))
  80
  81 (defcustom jabber-muc-disable-disco-check nil
  82   "If non-nil, disable checking disco#info of rooms before joining them.
  83 Disco information can tell whether the room exists and whether it is
  84 password protected, but some servers do not support it.  If you want
  85 to join chat rooms on such servers, set this variable to t."
  86   :group 'jabber-chat
  87   :type 'boolean)
  88
  89 (defcustom jabber-groupchat-buffer-format "*-jabber-groupchat-%n-*"
  90   "The format specification for the name of groupchat buffers.
  91
  92 These fields are available (all are about the group you are chatting
  93 in):
  94
  95 %n   Roster name of group, or JID if no nickname set
  96 %b   Name of group from bookmarks or roster name or JID if none set
  97 %j   Bare JID (without resource)"
  98   :type 'string
  99   :group 'jabber-chat)
 100
 101 (defcustom jabber-groupchat-prompt-format "[%t] %n> "
 102   "The format specification for lines in groupchat.
 103
 104 These fields are available:
 105
 106 %t   Time, formatted according to `jabber-chat-time-format'
 107 %n, %u, %r
 108      Nickname in groupchat
 109 %j   Full JID (room@server/nick)"
 110   :type 'string
 111   :group 'jabber-chat)
 112
 113 (defcustom jabber-muc-header-line-format
 114   '(" " (:eval (jabber-jid-displayname jabber-group))
 115     "\t" jabber-muc-topic)
 116   "The specification for the header line of MUC buffers.
 117
 118 The format is that of `mode-line-format' and `header-line-format'."
 119   :type 'sexp
 120   :group 'jabber-chat)
 121
 122 (defcustom jabber-muc-private-buffer-format "*-jabber-muc-priv-%g-%n-*"
 123   "The format specification for the buffer name for private MUC messages.
 124
 125 These fields are available:
 126
 127 %g   Roster name of group, or JID if no nickname set
 128 %n   Nickname of the group member you're chatting with"
 129   :type 'string
 130   :group 'jabber-chat)
 131
 132 (defcustom jabber-muc-private-foreign-prompt-format "[%t] %g/%n> "
 133   "The format specification for lines others type in a private MUC buffer.
 134
 135 These fields are available:
 136
 137 %t  Time, formatted according to `jabber-chat-time-format'
 138 %n  Nickname in room
 139 %g  Short room name (either roster name or username part of JID)"
 140   :type 'string
 141   :group 'jabber-chat)
 142
 143 (defcustom jabber-muc-print-names-format "      %n      %a      %j\n"
 144   "The format specification for MUC list lines.
 145
 146 Fields available:
 147
 148 %n  Nickname in room
 149 %a  Affiliation status
 150 %j  Full JID (room@server/nick)"
 151   :type 'string
 152   :group 'jabber-chat)
 153
 154 (defcustom jabber-muc-private-header-line-format
 155   '(" " (:eval (jabber-jid-resource jabber-chatting-with))
 156     " in " (:eval (jabber-jid-displayname (jabber-jid-user jabber-chatting-with)))
 157     "\t" jabber-events-message
 158     "\t" jabber-chatstates-message)
 159   "The specification for the header line of private MUC chat buffers.
 160
 161 The format is that of `mode-line-format' and `header-line-format'."
 162   :type 'sexp
 163   :group 'jabber-chat)
 164
 165 ;;;###autoload
 166 (defvar jabber-muc-printers '()
 167   "List of functions that may be able to print part of a MUC message.
 168 This gets prepended to `jabber-chat-printers', which see.")
 169
 170 ;;;###autoload
 171 (defun jabber-muc-get-buffer (group)
 172   "Return the chat buffer for chatroom GROUP.
 173 Either a string or a buffer is returned, so use `get-buffer' or
 174 `get-buffer-create'."
 175   (format-spec jabber-groupchat-buffer-format
 176                (list
 177                 (cons ?n (jabber-jid-displayname group))
 178                 (cons ?b (jabber-jid-bookmarkname group))
 179                 (cons ?j (jabber-jid-user group)))))
 180
 181 (defun jabber-muc-create-buffer (jc group)
 182   "Prepare a buffer for chatroom GROUP.
 183 This function is idempotent."
 184   (with-current-buffer (get-buffer-create (jabber-muc-get-buffer group))
 185     (unless (eq major-mode 'jabber-chat-mode)
 186       (jabber-chat-mode jc #'jabber-chat-pp))
 187     ;; Make sure the connection variable is up to date.
 188     (setq jabber-buffer-connection jc)
 189
 190     (set (make-local-variable 'jabber-group) group)
 191     (make-local-variable 'jabber-muc-topic)
 192     (setq jabber-send-function 'jabber-muc-send)
 193     (setq header-line-format jabber-muc-header-line-format)
 194     (current-buffer)))
 195
 196 ;;;###autoload
 197 (defun jabber-muc-private-get-buffer (group nickname)
 198   "Return the chat buffer for private chat with NICKNAME in GROUP.
 199 Either a string or a buffer is returned, so use `get-buffer' or
 200 `get-buffer-create'."
 201   (format-spec jabber-muc-private-buffer-format
 202                (list
 203                 (cons ?g (jabber-jid-displayname group))
 204                 (cons ?n nickname))))
 205
 206 (defun jabber-muc-private-create-buffer (jc group nickname)
 207   "Prepare a buffer for chatting with NICKNAME in GROUP.
 208 This function is idempotent."
 209   (with-current-buffer (get-buffer-create (jabber-muc-private-get-buffer group nickname))
 210     (unless (eq major-mode 'jabber-chat-mode)
 211       (jabber-chat-mode jc #'jabber-chat-pp))
 212
 213     (set (make-local-variable 'jabber-chatting-with) (concat group "/" nickname))
 214     (setq jabber-send-function 'jabber-chat-send)
 215     (setq header-line-format jabber-muc-private-header-line-format)
 216
 217     (current-buffer)))
 218
 219 (defun jabber-muc-send (jc body)
 220   "Send BODY to MUC room in current buffer."
 221   ;; There is no need to display the sent message in the buffer, as
 222   ;; we will get it back from the MUC server.
 223   (jabber-send-sexp jc
 224                     `(message
 225                       ((to . ,jabber-group)
 226                        (type . "groupchat"))
 227                       (body () ,body))))
 228
 229 (defun jabber-muc-add-groupchat (group nickname)
 230   "Remember participating in GROUP under NICKNAME."
 231   (let ((whichgroup (assoc group *jabber-active-groupchats*)))
 232     (if whichgroup
 233         (setcdr whichgroup nickname)
 234       (add-to-list '*jabber-active-groupchats* (cons group nickname)))))
 235
 236 (defun jabber-muc-remove-groupchat (group)
 237   "Remove GROUP from internal bookkeeping."
 238   (let ((whichgroup (assoc group *jabber-active-groupchats*))
 239         (whichparticipants (assoc group jabber-muc-participants)))
 240     (setq *jabber-active-groupchats*
 241           (delq whichgroup *jabber-active-groupchats*))
 242     (setq jabber-muc-participants
 243           (delq whichparticipants jabber-muc-participants))))
 244
 245 (defun jabber-muc-participant-plist (group nickname)
 246   "Return plist associated with NICKNAME in GROUP.
 247 Return nil if nothing known about that combination."
 248   (let ((whichparticipants (assoc group jabber-muc-participants)))
 249     (when whichparticipants
 250       (cdr (assoc nickname whichparticipants)))))
 251
 252 (defun jabber-muc-modify-participant (group nickname new-plist)
 253   "Assign properties in NEW-PLIST to NICKNAME in GROUP."
 254   (let ((participants (assoc group jabber-muc-participants)))
 255     ;; either we have a list of participants already...
 256     (if participants
 257         (let ((participant (assoc nickname participants)))
 258           ;; and maybe this participant is already in the list
 259           (if participant
 260               ;; if so, just update role, affiliation, etc.
 261               (setf (cdr participant) new-plist)
 262             (push (cons nickname new-plist) (cdr participants))))
 263       ;; or we don't
 264       (push (cons group (list (cons nickname new-plist))) jabber-muc-participants))))
 265
 266 (defun jabber-muc-report-delta (nickname old-plist new-plist reason actor)
 267   "Compare OLD-PLIST and NEW-PLIST, and return a string explaining the change.
 268 Return nil if nothing noteworthy has happened.
 269 NICKNAME is the user experiencing the change.  REASON and ACTOR, if non-nil,
 270 are the corresponding presence fields.
 271
 272 This function is only concerned with presence stanzas resulting
 273 in the user entering/staying in the room."
 274   ;; The keys in the plist are affiliation, role and jid.
 275   (when (plist-get new-plist 'jid)
 276     ;; nickname is only used for displaying, so we can modify it if we
 277     ;; want to.
 278     (setq nickname (concat nickname " <"
 279                            (jabber-jid-user (plist-get new-plist 'jid))
 280                            ">")))
 281   (cond
 282    ((null old-plist)
 283     ;; User enters the room
 284     (concat nickname " enters the room ("
 285             (plist-get new-plist 'role)
 286             (unless (string= (plist-get new-plist 'affiliation) "none")
 287               (concat ", " (plist-get new-plist 'affiliation)))
 288             ")"))
 289
 290    ;; If affiliation changes, the role change is usually the logical
 291    ;; one, so don't report it separately.
 292    ((not (string= (plist-get old-plist 'affiliation)
 293                   (plist-get new-plist 'affiliation)))
 294     (let ((actor-reason (concat (when actor
 295                                   (concat " by " actor))
 296                                 (when reason
 297                                   (concat ": " reason))))
 298           (from (plist-get old-plist 'affiliation))
 299           (to (plist-get new-plist 'affiliation)))
 300       ;; There are many ways to express these transitions in English.
 301       ;; This one favors eloquence over regularity and consistency.
 302       (cond
 303        ;; Higher affiliation
 304        ((or (and (member from '("outcast" "none" "member"))
 305                  (member to '("admin" "owner")))
 306             (and (string= from "admin") (string= to "owner")))
 307         (concat nickname " has been promoted to " to actor-reason))
 308        ;; Lower affiliation
 309        ((or (and (member from '("owner" "admin"))
 310                  (string= to "member"))
 311             (and (string= from "owner") (string= to "admin")))
 312         (concat nickname " has been demoted to " to actor-reason))
 313        ;; Become member
 314        ((string= to "member")
 315         (concat nickname " has been granted membership" actor-reason))
 316        ;; Lose membership
 317        ((string= to "none")
 318         (concat nickname " has been deprived of membership" actor-reason)))))
 319
 320    ;; Role changes
 321    ((not (string= (plist-get old-plist 'role)
 322                   (plist-get new-plist 'role)))
 323     (let ((actor-reason (concat (when actor
 324                                   (concat " by " actor))
 325                                 (when reason
 326                                   (concat ": " reason))))
 327           (from (plist-get old-plist 'role))
 328           (to (plist-get new-plist 'role)))
 329       ;; Possible roles are "none" (not in room, hence not of interest
 330       ;; in this function), "visitor" (no voice), "participant" (has
 331       ;; voice), and "moderator".
 332       (cond
 333        ((string= to "moderator")
 334         (concat nickname " has been granted moderator privileges" actor-reason))
 335        ((and (string= from "moderator")
 336              (string= to "participant"))
 337         (concat nickname " had moderator privileges revoked" actor-reason))
 338        ((string= to "participant")
 339         (concat nickname " has been granted voice" actor-reason))
 340        ((string= to "visitor")
 341         (concat nickname " has been denied voice" actor-reason)))))))
 342
 343 (defun jabber-muc-remove-participant (group nickname)
 344   "Forget everything about NICKNAME in GROUP."
 345   (let ((participants (assoc group jabber-muc-participants)))
 346     (when participants
 347       (let ((participant (assoc nickname (cdr participants))))
 348         (setf (cdr participants) (delq participant (cdr participants)))))))
 349
 350 (defmacro jabber-muc-argument-list (&optional args)
 351   "Prepend connection and group name to ARGS.
 352 If the current buffer is not an MUC buffer, signal an error.
 353 This macro is meant for use as an argument to `interactive'."
 354   `(if (null jabber-group)
 355        (error "Not in MUC buffer")
 356      (nconc (list jabber-buffer-connection jabber-group) ,args)))
 357
 358 (defun jabber-muc-read-completing (prompt &optional allow-not-joined)
 359   "Read the name of a joined chatroom, or use chatroom of current buffer, if any.
 360 If ALLOW-NOT-JOINED is provided and true, permit choosing any
 361 JID; only provide completion as a guide."
 362   (or jabber-group
 363       (jabber-read-jid-completing prompt
 364                                   (if (null *jabber-active-groupchats*)
 365                                       (error "You haven't joined any group")
 366                                     (mapcar (lambda (x) (jabber-jid-symbol (car x)))
 367                                             *jabber-active-groupchats*))
 368                                   (not allow-not-joined)
 369                                   jabber-group)))
 370
 371 (defun jabber-muc-read-nickname (group prompt)
 372   "Read the nickname of a participant in GROUP."
 373   (let ((nicknames (cdr (assoc group jabber-muc-participants))))
 374     (unless nicknames
 375       (error "Unknown group: %s" group))
 376     (completing-read prompt nicknames nil t nil 'jabber-muc-nickname-history)))
 377
 378 (add-to-list 'jabber-jid-muc-menu
 379              (cons "Request vcard" 'jabber-muc-vcard-get))
 380
 381 ;;;###autoload
 382 (defun jabber-muc-vcard-get (jc group nickname)
 383   "Request vcard from chat with NICKNAME in GROUP."
 384   (interactive
 385    (jabber-muc-argument-list
 386     (list (jabber-muc-read-nickname jabber-group "Nickname: "))))
 387     (let ((muc-name (format "%s/%s" group nickname)))
 388         (jabber-vcard-get jc muc-name)))
 389
 390 (add-to-list 'jabber-jid-muc-menu
 391    (cons "Configure groupchat" 'jabber-muc-get-config))
 392
 393 (defun jabber-muc-get-config (jc group)
 394   "Ask for MUC configuration form"
 395   (interactive (jabber-muc-argument-list))
 396   (jabber-send-iq jc group
 397                   "get"
 398                   '(query ((xmlns . "http://jabber.org/protocol/muc#owner")))
 399                   #'jabber-process-data #'jabber-muc-render-config
 400                   #'jabber-process-data "MUC configuration request failed"))
 401
 402 (defalias 'jabber-groupchat-get-config 'jabber-muc-get-config
 403   "Deprecated. See `jabber-muc-get-config' instead.")
 404
 405 (defun jabber-muc-render-config (jc xml-data)
 406   "Render MUC configuration form"
 407
 408   (let ((query (jabber-iq-query xml-data))
 409         xdata)
 410     (dolist (x (jabber-xml-get-children query 'x))
 411       (if (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:data")
 412           (setq xdata x)))
 413     (if (not xdata)
 414         (insert "No configuration possible.\n")
 415
 416     (jabber-init-widget-buffer (jabber-xml-get-attribute xml-data 'from))
 417     (setq jabber-buffer-connection jc)
 418
 419     (jabber-render-xdata-form xdata)
 420
 421     (widget-create 'push-button :notify #'jabber-muc-submit-config "Submit")
 422     (widget-insert "\t")
 423     (widget-create 'push-button :notify #'jabber-muc-cancel-config "Cancel")
 424     (widget-insert "\n")
 425
 426     (widget-setup)
 427     (widget-minor-mode 1))))
 428
 429 (defalias 'jabber-groupchat-render-config 'jabber-muc-render-config
 430   "Deprecated. See `jabber-muc-render-config' instead.")
 431
 432 (defun jabber-muc-submit-config (&rest ignore)
 433   "Submit MUC configuration form."
 434
 435   (jabber-send-iq jabber-buffer-connection jabber-submit-to
 436                   "set"
 437                   `(query ((xmlns . "http://jabber.org/protocol/muc#owner"))
 438                           ,(jabber-parse-xdata-form))
 439                   #'jabber-report-success "MUC configuration"
 440                   #'jabber-report-success "MUC configuration"))
 441
 442 (defalias 'jabber-groupchat-submit-config 'jabber-muc-submit-config
 443   "Deprecated. See `jabber-muc-submit-config' instead.")
 444
 445 (defun jabber-muc-cancel-config (&rest ignore)
 446   "Cancel MUC configuration form."
 447
 448   (jabber-send-iq jabber-buffer-connection jabber-submit-to
 449                   "set"
 450                   '(query ((xmlns . "http://jabber.org/protocol/muc#owner"))
 451                           (x ((xmlns . "jabber:x:data") (type . "cancel"))))
 452                   nil nil nil nil))
 453
 454 (defalias 'jabber-groupchat-cancel-config 'jabber-muc-cancel-config
 455   "Deprecated. See `jabber-muc-cancel-config' instead.")
 456
 457 (add-to-list 'jabber-jid-muc-menu
 458              (cons "Join groupchat" 'jabber-muc-join))
 459
 460 (defun jabber-muc-join (jc group nickname &optional popup)
 461   "join a groupchat, or change nick.
 462 In interactive calls, or if POPUP is true, switch to the
 463 groupchat buffer."
 464   (interactive
 465    (let ((account (jabber-read-account))
 466          (group (jabber-read-jid-completing "group: ")))
 467      (list account group (jabber-muc-read-my-nickname account group) t)))
 468
 469   ;; If the user is already in the room, we don't need as many checks.
 470   (if (or (assoc group *jabber-active-groupchats*)
 471           ;; Or if the users asked us not to check disco info.
 472           jabber-muc-disable-disco-check)
 473       (jabber-muc-join-3 jc group nickname nil popup)
 474     ;; Else, send a disco request to find out what we are connecting
 475     ;; to.
 476     (jabber-disco-get-info jc group nil #'jabber-muc-join-2
 477                            (list group nickname popup))))
 478
 479 (defalias 'jabber-groupchat-join 'jabber-muc-join
 480   "Deprecated. Use `jabber-muc-join' instead.")
 481
 482 (defun jabber-muc-join-2 (jc closure result)
 483   (destructuring-bind (group nickname popup) closure
 484     (let* ( ;; Either success...
 485           (identities (car result))
 486           (features (cadr result))
 487           ;; ...or error
 488           (condition (when (eq identities 'error) (jabber-error-condition result))))
 489       (cond
 490        ;; Maybe the room doesn't exist yet.
 491        ((eq condition 'item-not-found)
 492         (unless (or jabber-silent-mode
 493                     (y-or-n-p (format "%s doesn't exist.  Create it? "
 494                                       (jabber-jid-displayname group))))
 495           (error "Non-existent groupchat")))
 496
 497        ;; Maybe the room doesn't support disco.
 498        ((eq condition 'feature-not-implemented)
 499         t                               ;whatever... we will ignore it later
 500         )
 501        ;; Maybe another error occurred. Report it to user
 502        (condition
 503         (message "Couldn't query groupchat: %s" (jabber-parse-error result)))
 504
 505        ;; Bad stanza? Without NS, for example
 506        ((and (eq identities 'error) (not condition))
 507         (message "Bad error stanza received")))
 508
 509       ;; Continue only if it is really chat room.  If there was an
 510       ;; error, give the chat room the benefit of the doubt.  (Needed
 511       ;; for ejabberd's mod_irc, for example)
 512       (when (or condition
 513                 (find "conference" (if (sequencep identities) identities nil)
 514                       :key (lambda (i) (aref i 1))
 515                       :test #'string=))
 516         (let ((password
 517              ;; Is the room password-protected?
 518              (when (member "muc_passwordprotected" features)
 519                (or
 520                 (jabber-get-conference-data jc group nil :password)
 521                 (read-passwd (format "Password for %s: " (jabber-jid-displayname group)))))))
 522
 523         (jabber-muc-join-3 jc group nickname password popup))))))
 524
 525 (defalias 'jabber-groupchat-join-2 'jabber-muc-join-2
 526   "Deprecated. See `jabber-muc-join-2' instead.")
 527
 528 (defun jabber-muc-join-3 (jc group nickname password popup)
 529
 530   ;; Remember that this is a groupchat _before_ sending the stanza.
 531   ;; The response might come quicker than you think.
 532
 533   (puthash (jabber-jid-symbol group) nickname jabber-pending-groupchats)
 534
 535   (jabber-send-sexp jc
 536                     `(presence ((to . ,(format "%s/%s" group nickname)))
 537                                (x ((xmlns . "http://jabber.org/protocol/muc"))
 538                                   ,@(when password
 539                                       `((password () ,password))))
 540                                ,@(jabber-presence-children jc)))
 541
 542   ;; There, stanza sent.  Now we just wait for the MUC service to
 543   ;; mirror the stanza.  This is handled in
 544   ;; `jabber-muc-process-presence', where a buffer will be created for
 545   ;; the room.
 546
 547   ;; But if the user interactively asked to join, he/she probably
 548   ;; wants the buffer to pop up right now.
 549   (when popup
 550     (let ((buffer (jabber-muc-create-buffer jc group)))
 551       (switch-to-buffer buffer))))
 552
 553 (defalias 'jabber-groupchat-join-3 'jabber-muc-join-3
 554   "Deprecated. See `jabber-muc-join-3' instead.")
 555
 556 (defun jabber-muc-read-my-nickname (jc group &optional default)
 557   "Read nickname for joining GROUP. If DEFAULT is non-nil, return default nick without prompting."
 558   (let ((default-nickname (or
 559                            (jabber-get-conference-data jc group nil :nick)
 560                            (cdr (assoc group jabber-muc-default-nicknames))
 561                            (plist-get (fsm-get-state-data jc) :username))))
 562     (if default
 563         default-nickname
 564         (jabber-read-with-input-method (format "Nickname: (default %s) "
 565                                            default-nickname)
 566                                    nil nil default-nickname))))
 567
 568 (add-to-list 'jabber-jid-muc-menu
 569              (cons "Change nickname" 'jabber-muc-nick))
 570
 571 (defalias 'jabber-muc-nick 'jabber-muc-join)
 572
 573 (add-to-list 'jabber-jid-muc-menu
 574              (cons "Leave groupchat" 'jabber-muc-leave))
 575
 576 (defun jabber-muc-leave (jc group)
 577   "leave a groupchat"
 578   (interactive (jabber-muc-argument-list))
 579   (let ((whichgroup (assoc group *jabber-active-groupchats*)))
 580     ;; send unavailable presence to our own nick in room
 581     (jabber-send-sexp jc
 582                       `(presence ((to . ,(format "%s/%s" group (cdr whichgroup)))
 583                                   (type . "unavailable"))))))
 584
 585 (defalias 'jabber-groupchat-leave 'jabber-muc-leave
 586   "Deprecated. Use `jabber-muc-leave' instead.")
 587
 588 (add-to-list 'jabber-jid-muc-menu
 589              (cons "List participants" 'jabber-muc-names))
 590
 591 (defun jabber-muc-names ()
 592   "Print names, affiliations, and roles of participants in current buffer."
 593   (interactive)
 594   (ewoc-enter-last jabber-chat-ewoc (list :notice
 595                                           (jabber-muc-print-names
 596                                            (cdr (assoc jabber-group jabber-muc-participants)))
 597                                           :time (current-time))))
 598
 599 (defun jabber-muc-format-names (participant)
 600   "Format one participant name"
 601   (format-spec jabber-muc-print-names-format
 602                (list
 603                 (cons ?n (car participant))
 604                 (cons ?a (plist-get (cdr participant) 'affiliation))
 605                 (cons ?j (or (plist-get (cdr participant) 'jid) "")))))
 606
 607 (defun jabber-muc-print-names (participants)
 608   "Format and return data in PARTICIPANTS."
 609   (let ((mlist) (plist) (vlist) (nlist))
 610     (mapcar (lambda (x)
 611               (let ((role (plist-get (cdr x) 'role)))
 612                 (cond ((string= role "moderator")
 613                        (add-to-list 'mlist x))
 614                       ((string= role "participant")
 615                        (add-to-list 'plist x))
 616                       ((string= role "visitor")
 617                        (add-to-list 'vlist x))
 618                       ((string= role "none")
 619                        (add-to-list 'nlist x)))))
 620             participants)
 621     (concat
 622      (apply 'concat "\nModerators:\n" (mapcar 'jabber-muc-format-names mlist))
 623      (apply 'concat "\nParticipants:\n" (mapcar 'jabber-muc-format-names plist))
 624      (apply 'concat "\nVisitors:\n" (mapcar 'jabber-muc-format-names vlist))
 625      (apply 'concat "\nNones:\n" (mapcar 'jabber-muc-format-names nlist)))
 626     ))
 627
 628 (add-to-list 'jabber-jid-muc-menu
 629              (cons "Set topic" 'jabber-muc-set-topic))
 630
 631 (defun jabber-muc-set-topic (jc group topic)
 632   "Set topic of GROUP to TOPIC."
 633   (interactive
 634    (jabber-muc-argument-list
 635     (list (jabber-read-with-input-method "New topic: " jabber-muc-topic))))
 636   (jabber-send-message jc group topic nil "groupchat"))
 637
 638 (defun jabber-muc-snarf-topic (xml-data)
 639   "Record subject (topic) of the given <message/>, if any."
 640   (let ((new-topic (jabber-xml-path xml-data '(subject ""))))
 641     (when new-topic
 642       (setq jabber-muc-topic new-topic))))
 643
 644 (add-to-list 'jabber-jid-muc-menu
 645              (cons "Set role (kick, voice, op)" 'jabber-muc-set-role))
 646
 647 (defun jabber-muc-set-role (jc group nickname role reason)
 648   "Set role of NICKNAME in GROUP to ROLE, specifying REASON."
 649   (interactive
 650    (jabber-muc-argument-list
 651     (let ((nickname (jabber-muc-read-nickname jabber-group "Nickname: ")))
 652       (list nickname
 653             (completing-read "New role: " '(("none") ("visitor") ("participant") ("moderator")) nil t nil 'jabber-role-history)
 654             (read-string "Reason: ")))))
 655   (unless (or (zerop (length nickname)) (zerop (length role)))
 656     (jabber-send-iq jc group "set"
 657                     `(query ((xmlns . "http://jabber.org/protocol/muc#admin"))
 658                             (item ((nick . ,nickname)
 659                                    (role . ,role))
 660                                   ,(unless (zerop (length reason))
 661                                      `(reason () ,reason))))
 662                     'jabber-report-success "Role change"
 663                     'jabber-report-success "Role change")))
 664
 665 (add-to-list 'jabber-jid-muc-menu
 666              (cons "Set affiliation (ban, member, admin)" 'jabber-muc-set-affiliation))
 667
 668 (defun jabber-muc-set-affiliation (jc group nickname-or-jid nickname-p affiliation reason)
 669   "Set affiliation of NICKNAME-OR-JID in GROUP to AFFILIATION.
 670 If NICKNAME-P is non-nil, NICKNAME-OR-JID is a nickname in the
 671 group, else it is a JID."
 672   (interactive
 673    (jabber-muc-argument-list
 674     (let ((nickname-p (y-or-n-p "Specify user by room nickname? ")))
 675       (list
 676        (if nickname-p
 677            (jabber-muc-read-nickname jabber-group "Nickname: ")
 678          (jabber-read-jid-completing "User: "))
 679        nickname-p
 680        (completing-read "New affiliation: "
 681                         '(("none") ("outcast") ("member") ("admin") ("owner")) nil t nil 'jabber-affiliation-history)
 682        (read-string "Reason: ")))))
 683   (let ((jid
 684          (if nickname-p
 685              (let ((participants (cdr (assoc group jabber-muc-participants))))
 686                (unless participants
 687                  (error "Couldn't find group %s" group))
 688                (let ((participant (cdr (assoc nickname-or-jid participants))))
 689                  (unless participant
 690                    (error "Couldn't find %s in group %s" nickname-or-jid group))
 691                  (or (plist-get participant 'jid)
 692                      (error "JID of %s in group %s is unknown" nickname-or-jid group))))
 693            nickname-or-jid)))
 694     (jabber-send-iq jc group "set"
 695                     `(query ((xmlns . "http://jabber.org/protocol/muc#admin"))
 696                             (item ((jid . ,jid)
 697                                    (affiliation . ,affiliation))
 698                                   ,(unless (zerop (length reason))
 699                                      `(reason () ,reason))))
 700                     'jabber-report-success "Affiliation change"
 701                     'jabber-report-success "Affiliation change")))
 702
 703 (add-to-list 'jabber-jid-muc-menu
 704              (cons "Invite someone to chatroom" 'jabber-muc-invite))
 705
 706 (defun jabber-muc-invite (jc jid group reason)
 707   "Invite JID to GROUP, stating REASON."
 708   (interactive
 709    (list (jabber-read-account)
 710          (jabber-read-jid-completing
 711           "Invite whom: "
 712           ;; The current room is _not_ a good default for whom to invite.
 713           (remq (jabber-jid-symbol jabber-group) (jabber-concat-rosters)))
 714          (jabber-muc-read-completing "To group: ")
 715          (jabber-read-with-input-method "Reason: ")))
 716   (jabber-send-sexp
 717    jc
 718    `(message ((to . ,group))
 719              (x ((xmlns . "http://jabber.org/protocol/muc#user"))
 720                 (invite ((to . ,jid))
 721                         ,(unless (zerop (length reason))
 722                            `(reason nil ,reason)))))))
 723
 724 (add-to-list 'jabber-body-printers 'jabber-muc-print-invite)
 725
 726 (defun jabber-muc-print-invite (xml-data who mode)
 727   "Print MUC invitation"
 728   (dolist (x (jabber-xml-get-children xml-data 'x))
 729     (when (string= (jabber-xml-get-attribute x 'xmlns) "http://jabber.org/protocol/muc#user")
 730       (let ((invitation (car (jabber-xml-get-children x 'invite))))
 731         (when invitation
 732           (when (eql mode :insert)
 733             (let ((group (jabber-xml-get-attribute xml-data 'from))
 734                   (inviter (jabber-xml-get-attribute invitation 'from))
 735                   (reason (car (jabber-xml-node-children (car (jabber-xml-get-children invitation 'reason))))))
 736               ;; XXX: password
 737               (insert "You have been invited to MUC room " (jabber-jid-displayname group))
 738               (when inviter
 739                 (insert " by " (jabber-jid-displayname inviter)))
 740               (insert ".")
 741               (when reason
 742                 (insert "  Reason: " reason))
 743               (insert "\n\n")
 744
 745               (let ((action
 746                      `(lambda (&rest ignore) (interactive)
 747                         (jabber-muc-join jabber-buffer-connection ,group
 748                                                (jabber-muc-read-my-nickname jabber-buffer-connection ,group)))))
 749                 (if (fboundp 'insert-button)
 750                     (insert-button "Accept"
 751                                    'action action)
 752                   ;; Simple button replacement
 753                   (let ((keymap (make-keymap)))
 754                     (define-key keymap "\r" action)
 755                     (insert (jabber-propertize "Accept"
 756                                                'keymap keymap
 757                                                'face 'highlight))))
 758
 759                 (insert "\t")
 760
 761                 (let ((action
 762                        `(lambda (&rest ignore) (interactive)
 763                           (let ((reason
 764                                  (jabber-read-with-input-method
 765                                   "Reason: ")))
 766                             (jabber-send-sexp
 767                              jabber-buffer-connection
 768                              (list 'message
 769                                    (list (cons 'to ,group))
 770                                    (list 'x
 771                                          (list (cons 'xmlns "http://jabber.org/protocol/muc#user"))
 772                                          (list 'decline
 773                                                (list (cons 'to ,inviter))
 774                                                (unless (zerop (length reason))
 775                                                  (list 'reason nil reason))))))))))
 776                   (if (fboundp 'insert-button)
 777                       (insert-button "Decline"
 778                                      'action action)
 779                     ;; Simple button replacement
 780                     (let ((keymap (make-keymap)))
 781                       (define-key keymap "\r" action)
 782                       (insert (jabber-propertize "Decline"
 783                                                  'keymap keymap
 784                                                  'face 'highlight))))))))
 785           (return t))))))
 786
 787 (defun jabber-muc-autojoin (jc)
 788   "Join rooms specified in account bookmarks and global `jabber-muc-autojoin'."
 789   (interactive (list (jabber-read-account)))
 790   (let ((nickname (plist-get (fsm-get-state-data jc) :username)))
 791     (when (bound-and-true-p jabber-muc-autojoin)
 792       (dolist (group jabber-muc-autojoin)
 793         (jabber-muc-join jc group (or
 794                                          (cdr (assoc group jabber-muc-default-nicknames))
 795                                          (plist-get (fsm-get-state-data jc) :username)))))
 796     (jabber-get-bookmarks
 797      jc
 798      (lambda (jc bookmarks)
 799        (dolist (bookmark bookmarks)
 800          (setq bookmark (jabber-parse-conference-bookmark bookmark))
 801          (when (and bookmark (plist-get bookmark :autojoin))
 802            (jabber-muc-join jc (plist-get bookmark :jid)
 803                                   (or (plist-get bookmark :nick)
 804                                       (plist-get (fsm-get-state-data jc) :username)))))))))
 805
 806 ;;;###autoload
 807 (defun jabber-muc-message-p (message)
 808   "Return non-nil if MESSAGE is a groupchat message.
 809 That does not include private messages in a groupchat, but does
 810 include groupchat invites."
 811   ;; Public groupchat messages have type "groupchat" and are from
 812   ;; room@server/nick.  Public groupchat errors have type "error" and
 813   ;; are from room@server.
 814   (let ((from (jabber-xml-get-attribute message 'from))
 815         (type (jabber-xml-get-attribute message 'type)))
 816     (or
 817      (string= type "groupchat")
 818      (and (string= type "error")
 819           (gethash (jabber-jid-symbol from) jabber-pending-groupchats))
 820      (jabber-xml-path message '(("http://jabber.org/protocol/muc#user" . "x") invite)))))
 821
 822 ;;;###autoload
 823 (defun jabber-muc-sender-p (jid)
 824   "Return non-nil if JID is a full JID of an MUC participant."
 825   (and (assoc (jabber-jid-user jid) *jabber-active-groupchats*)
 826        (jabber-jid-resource jid)))
 827
 828 ;;;###autoload
 829 (defun jabber-muc-private-message-p (message)
 830   "Return non-nil if MESSAGE is a private message in a groupchat."
 831   (let ((from (jabber-xml-get-attribute message 'from))
 832         (type (jabber-xml-get-attribute message 'type)))
 833     (and
 834      (not (string= type "groupchat"))
 835      (jabber-muc-sender-p from))))
 836
 837 (add-to-list 'jabber-jid-muc-menu
 838              (cons "Open private chat" 'jabber-muc-private))
 839
 840 (defun jabber-muc-private (jc group nickname)
 841   "Open private chat with NICKNAME in GROUP."
 842   (interactive
 843    (jabber-muc-argument-list
 844     (list (jabber-muc-read-nickname jabber-group "Nickname: "))))
 845   (switch-to-buffer (jabber-muc-private-create-buffer jabber-buffer-connection group nickname)))
 846
 847 (defun jabber-muc-presence-p (presence)
 848   "Return non-nil if PRESENCE is presence from groupchat."
 849   (let ((from (jabber-xml-get-attribute presence 'from))
 850         (type (jabber-xml-get-attribute presence 'type))
 851         (muc-marker (find-if
 852                      (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns)
 853                                    "http://jabber.org/protocol/muc#user"))
 854                      (jabber-xml-get-children presence 'x))))
 855     ;; This is MUC presence if it has an MUC-namespaced tag...
 856     (or muc-marker
 857         ;; ...or if it is error presence from a room we tried to join.
 858         (and (string= type "error")
 859              (gethash (jabber-jid-symbol from) jabber-pending-groupchats)))))
 860
 861 (defun jabber-muc-parse-affiliation (x-muc)
 862   "Parse X-MUC in the muc#user namespace and return a plist.
 863 Return nil if X-MUC is nil."
 864   ;; XXX: parse <actor/> and <reason/> tags?  or maybe elsewhere?
 865   (apply 'nconc (mapcar (lambda (prop) (list (car prop) (cdr prop)))
 866                         (jabber-xml-node-attributes
 867                          (car (jabber-xml-get-children x-muc 'item))))))
 868
 869 (defun jabber-muc-print-prompt (xml-data &optional local dont-print-nick-p)
 870   "Print MUC prompt for message in XML-DATA."
 871   (let ((nick (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
 872         (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
 873     (if (stringp nick)
 874         (insert (jabber-propertize
 875                  (format-spec jabber-groupchat-prompt-format
 876                               (list
 877                                (cons ?t (format-time-string
 878                                          (if timestamp
 879                                              jabber-chat-delayed-time-format
 880                                            jabber-chat-time-format)
 881                                          timestamp))
 882                                (cons ?n (if dont-print-nick-p "" nick))
 883                                (cons ?u nick)
 884                                (cons ?r nick)
 885                                (cons ?j (concat jabber-group "/" nick))))
 886                  'face (if local        ;Message from you.
 887                            (if jabber-muc-colorize-local ;; If colorization enable...
 888                                ;; ...colorize nick
 889                                (list ':foreground (jabber-muc-nick-get-color nick))
 890                              ;; otherwise, use default face.
 891                              'jabber-chat-prompt-local)
 892                          ;; Message from other participant.
 893                          (if jabber-muc-colorize-foreign ;If colorization enable...
 894                              ;; ... colorize nick
 895                              (list ':foreground (jabber-muc-nick-get-color nick))
 896                            ;; otherwise, use default face.
 897                            'jabber-chat-prompt-foreign))
 898                  'help-echo (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from " nick " in " jabber-group)))
 899       (jabber-muc-system-prompt))))
 900
 901 (defun jabber-muc-private-print-prompt (xml-data)
 902   "Print prompt for private MUC message in XML-DATA."
 903   (let ((nick (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
 904         (group (jabber-jid-user (jabber-xml-get-attribute xml-data 'from)))
 905         (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
 906     (insert (jabber-propertize
 907              (format-spec jabber-muc-private-foreign-prompt-format
 908                           (list
 909                            (cons ?t (format-time-string
 910                                      (if timestamp
 911                                          jabber-chat-delayed-time-format
 912                                        jabber-chat-time-format)
 913                                      timestamp))
 914                            (cons ?n nick)
 915                            (cons ?g (or (jabber-jid-rostername group)
 916                                         (jabber-jid-username group)))))
 917              'face 'jabber-chat-prompt-foreign
 918              'help-echo (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from " nick " in " jabber-group)))))
 919
 920 (defun jabber-muc-system-prompt (&rest ignore)
 921   "Print system prompt for MUC."
 922   (insert (jabber-propertize
 923            (format-spec jabber-groupchat-prompt-format
 924                         (list
 925                          (cons ?t (format-time-string jabber-chat-time-format))
 926                          (cons ?n "")
 927                          (cons ?u "")
 928                          (cons ?r "")
 929                          (cons ?j jabber-group)))
 930            'face 'jabber-chat-prompt-system
 931            'help-echo (format-time-string "System message on %Y-%m-%d %H:%M:%S"))))
 932
 933 (add-to-list 'jabber-message-chain 'jabber-muc-process-message)
 934
 935 (defun jabber-muc-process-message (jc xml-data)
 936   "If XML-DATA is a groupchat message, handle it as such."
 937   (when (jabber-muc-message-p xml-data)
 938     (let* ((from (jabber-xml-get-attribute xml-data 'from))
 939            (group (jabber-jid-user from))
 940            (nick (jabber-jid-resource from))
 941            (error-p (jabber-xml-get-children xml-data 'error))
 942            (type (cond
 943                   (error-p :muc-error)
 944                   ((string= nick (cdr (assoc group *jabber-active-groupchats*)))
 945                    :muc-local)
 946                   (t :muc-foreign)))
 947            (body-text (car (jabber-xml-node-children
 948                            (car (jabber-xml-get-children
 949                                  xml-data 'body)))))
 950
 951            (printers (append jabber-muc-printers jabber-chat-printers)))
 952
 953       (with-current-buffer (jabber-muc-create-buffer jc group)
 954         (jabber-muc-snarf-topic xml-data)
 955         ;; Call alert hooks only when something is output
 956         (when (or error-p
 957                   (run-hook-with-args-until-success 'printers xml-data type :printp))
 958           (jabber-maybe-print-rare-time
 959            (ewoc-enter-last jabber-chat-ewoc (list type xml-data :time (current-time))))
 960
 961           ;; ...except if the message is part of history, in which
 962           ;; case we don't want an alert.
 963           (let ((children-namespaces (mapcar (lambda (x) (when (listp x) (jabber-xml-get-attribute x 'xmlns)))
 964                                              (jabber-xml-node-children xml-data))))
 965             (unless (or (member "urn:xmpp:delay" children-namespaces)
 966                         (member "jabber:x:delay" children-namespaces))
 967               (dolist (hook '(jabber-muc-hooks jabber-alert-muc-hooks))
 968                 (run-hook-with-args hook
 969                                     nick group (current-buffer) body-text
 970                                     (funcall jabber-alert-muc-function
 971                                              nick group (current-buffer) body-text))))))))))
 972
 973 (defun jabber-muc-process-presence (jc presence)
 974   (let* ((from (jabber-xml-get-attribute presence 'from))
 975          (type (jabber-xml-get-attribute presence 'type))
 976          (x-muc (find-if
 977                  (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns)
 978                                "http://jabber.org/protocol/muc#user"))
 979                  (jabber-xml-get-children presence 'x)))
 980          (group (jabber-jid-user from))
 981          (nickname (jabber-jid-resource from))
 982          (symbol (jabber-jid-symbol from))
 983          (item (car (jabber-xml-get-children x-muc 'item)))
 984          (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid))
 985          (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason)))))
 986          (error-node (car (jabber-xml-get-children presence 'error)))
 987          (status-code (if error-node
 988                           (jabber-xml-get-attribute error-node 'code)
 989                         (jabber-xml-get-attribute (car (jabber-xml-get-children x-muc 'status)) 'code))))
 990     ;; handle leaving a room
 991     (cond
 992      ((or (string= type "unavailable") (string= type "error"))
 993       ;; error from room itself? or are we leaving?
 994       (if (or (null nickname)
 995               (string= nickname (gethash (jabber-jid-symbol group) jabber-pending-groupchats)))
 996           ;; Assume that an error means that we were thrown out of the
 997           ;; room...
 998           (let* ((leavingp t)
 999                  (message (cond
1000                            ((string= type "error")
1001                             (cond
1002                              ;; ...except for certain cases.
1003                              ((or (equal status-code "406")
1004                                   (equal status-code "409"))
1005                               (setq leavingp nil)
1006                               (concat "Nickname change not allowed"
1007                                       (when error-node
1008                                         (concat ": " (jabber-parse-error error-node)))))
1009                              (t
1010                               (concat "Error entering room"
1011                                       (when error-node
1012                                         (concat ": " (jabber-parse-error error-node)))))))
1013                            ((equal status-code "301")
1014                             (concat "You have been banned"
1015                                     (when actor (concat " by " actor))
1016                                     (when reason (concat " - '" reason "'"))))
1017                            ((equal status-code "307")
1018                             (concat "You have been kicked"
1019                                     (when actor (concat " by " actor))
1020                                     (when reason (concat " - '" reason "'"))))
1021                            (t
1022                             "You have left the chatroom"))))
1023             (when leavingp
1024               (jabber-muc-remove-groupchat group))
1025             ;; If there is no buffer for this groupchat, don't bother
1026             ;; creating one just to tell that user left the room.
1027             (let ((buffer (get-buffer (jabber-muc-get-buffer group))))
1028               (if buffer
1029                   (with-current-buffer buffer
1030                     (jabber-maybe-print-rare-time
1031                      (ewoc-enter-last jabber-chat-ewoc
1032                                       (list (if (string= type "error")
1033                                                 :muc-error
1034                                               :muc-notice)
1035                                             message
1036                                             :time (current-time)))))
1037                 (message "%s: %s" (jabber-jid-displayname group) message))))
1038         ;; or someone else?
1039         (let* ((plist (jabber-muc-participant-plist group nickname))
1040                (jid (plist-get plist 'jid))
1041                (name (concat nickname
1042                              (when jid
1043                                (concat " <"
1044                                        (jabber-jid-user jid)
1045                                        ">")))))
1046           (jabber-muc-remove-participant group nickname)
1047           (with-current-buffer (jabber-muc-create-buffer jc group)
1048             (jabber-maybe-print-rare-time
1049              (ewoc-enter-last
1050               jabber-chat-ewoc
1051               (list :muc-notice
1052                     (cond
1053                      ((equal status-code "301")
1054                       (concat name " has been banned"
1055                               (when actor (concat " by " actor))
1056                               (when reason (concat " - '" reason "'"))))
1057                      ((equal status-code "307")
1058                       (concat name " has been kicked"
1059                               (when actor (concat " by " actor))
1060                               (when reason (concat " - '" reason "'"))))
1061                      ((equal status-code "303")
1062                       (concat name " changes nickname to "
1063                               (jabber-xml-get-attribute item 'nick)))
1064                      (t
1065                       (concat name " has left the chatroom")))
1066                     :time (current-time))))))))
1067      (t
1068       ;; someone is entering
1069
1070       (when (string= nickname (gethash (jabber-jid-symbol group) jabber-pending-groupchats))
1071         ;; Our own nick?  We just succeeded in entering the room.
1072         (let ((whichgroup (assoc group *jabber-active-groupchats*)))
1073           (if whichgroup
1074               (setcdr whichgroup nickname)
1075             (add-to-list '*jabber-active-groupchats* (cons group nickname)))))
1076
1077       ;; Whoever enters, we create a buffer (if it didn't already
1078       ;; exist), and print a notice.  This is where autojoined MUC
1079       ;; rooms have buffers created for them.  We also remember some
1080       ;; metadata.
1081       (let ((old-plist (jabber-muc-participant-plist group nickname))
1082             (new-plist (jabber-muc-parse-affiliation x-muc)))
1083         (jabber-muc-modify-participant group nickname new-plist)
1084         (let ((report (jabber-muc-report-delta nickname old-plist new-plist
1085                                                reason actor)))
1086           (when report
1087             (with-current-buffer (jabber-muc-create-buffer jc group)
1088               (jabber-maybe-print-rare-time
1089                (ewoc-enter-last
1090                 jabber-chat-ewoc
1091                 (list :muc-notice report
1092                       :time (current-time))))))))))))
1093
1094 (provide 'jabber-muc)
1095
1096 ;;; arch-tag: 1ff7ab35-1717-46ae-b803-6f5b3fb2cd7d