You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
wgreenhouse ba9418579f Bring back `flet' to restore MUC nick completion. 8 months ago
debian Replace jabber(.org) which xmpp(.org) 7 years ago
gconf * emacs-jabber-uri-handler: Renamed from xmppuri.sh. 13 years ago
jabber-fallback-lib hexrgb.el should not load cl. 10 months ago
m4 Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-481 14 years ago
tests Extract jabber-xml-parse-next-stanza, and test it 6 years ago
.gitignore Ignore backup files and generated files. 12 years ago
.travis.yml Use Automake 1.12 for Travis 7 years ago
Makefile.am Use srv.el from package repository 3 years ago
NEWS Use auth-source to read passwords from .netrc/.authinfo files 9 years ago
README.org Add README symlink to main project file. 10 months ago
configure.ac configure.ac to read version number from jabber-ourversion.el 9 years ago
deprecated.org Deprecate XEP-0065, XEP-0095, and XEP-0096 support. 10 months ago
emacs-jabber-uri-handler * emacs-jabber-uri-handler: Renamed from xmppuri.sh. 13 years ago
jabber-autoloads.stub Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-535 14 years ago
jabber-awesome.el Remove external notifiers from main file 10 months ago
jabber-festival.el Remove external notifiers from main file 10 months ago
jabber-gmail.el Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-455 14 years ago
jabber-httpupload.org First explanations. Commentary and some functions to implement. 10 months ago
jabber-libnotify.el Remove external notifiers from main file 10 months ago
jabber-notifications.el Remove external notifiers from main file 10 months ago
jabber-ourversion.el configure.ac to read version number from jabber-ourversion.el 9 years ago
jabber-pkg.el.in Use srv.el from package repository 3 years ago
jabber-ratpoison.el Remove external notifiers from main file 10 months ago
jabber-sawfish.el Remove external notifiers from main file 10 months ago
jabber-screen.el Remove external notifiers from main file 10 months ago
jabber-tmux.el Remove external notifiers from main file 10 months ago
jabber-wmii.el Remove external notifiers from main file 10 months ago
jabber-xmessage.el Remove external notifiers from main file 10 months ago
jabber.el Bring back `flet' to restore MUC nick completion. 8 months ago
jabber.org Bring back `flet' to restore MUC nick completion. 8 months ago
jabber.texi Replace jabber(.org) which xmpp(.org) 7 years ago

README.org

jabber.el

README

This is jabber.el 0.8.92, an XMPP client for Emacs. XMPP (also known as 'Jabber') is an instant messaging system; see http://xmpp.org for more information.

New resources

Old resources

GNU Emacs

jabber.el runs on GNU Emacs 23.1 or later.

The file hexrgb.el (http://www.emacswiki.org/emacs/hexrgb.el) is needed for MUC nick coloring feature. A copy is located in the compat directory, and used if the configure script doesn't find another copy already installed.

XEmacs

You need an XEmacs with Mule support, and recent versions of the gnus, net-utils and mule-ucs packages. jabber.el basically works on XEmacs, but some features are missing (in particular mouse support). Testing and patches are very welcome.

Encrypted connections

Many Jabber servers require encrypted connections, and even if yours doesn't it may be good idea. To get an encrypted connection, the most convenient option is to use GNU Emacs 24 with GnuTLS support compiled in. You can check whether you have that by typing:

M-: (gnutls-available-p)

If that commands shows t in the echo area, then you have working GnuTLS support. If it shows nil or signals an error, then you don't.

Failing that, jabber.el will use the starttls.el library, which requires that the GnuTLS command line tool "gnutls-cli" is installed.

In Debian-based distributions, "gnutls-cli" is in the "gnutls-bin" package.

The above applies to STARTTLS connections, the most common way to encrypt a Jabber connection and the only one specified in the standards. STARTTLS connections start out unencrypted, but switch to encrypted after negotiation. jabber.el also supports connections that are encrypted from start. For this it uses the tls.el library, which requires either "gnutls-cli" or the OpenSSL command line tool "openssl" to be installed.

To use the latter form of encryption, customize jabber-account-list.

Note that only the connection from you to the server is encrypted; there is no guarantee of connections from your server to your contacts' server being encrypted.

Installation

jabber.el can be installed using the commands:

./configure
make
make install

You can specify which emacs you want to use:

./configure EMACS=emacs-or-xemacs-21.4

You can also install jabber.el by hand. Put all .el files somewhere in your load-path, or have your load-path include the directory they're in. To install the Info documentation, copy jabber.info to /usr/local/info and run "install-info /usr/local/info/jabber.info".

After installation by either method, add (load "jabber-autoloads") to your .emacs file. (If you got the code from GIT, you still need the makefile to generate jabber-autoloads.el.)

If you are upgrading from 0.7-0.7.x, you need to update your configuration. See the section "Account settings" in the manual.

Special notes for Git version

If you are running jabber.el from Git, you need to generate the jabber-autoloads.el file yourself. The simplest way to do this is by using the ./configure && make process.

To generate the configure script, make sure that autoconf and automake are installed and run autoreconf -i.

Usage

To connect to a Jabber server, type C-x C-j C-c (or equivalently M-x jabber-connect-all) and enter your JID. With prefix argument, register a new account. You can set your JID permanently with M-x jabber-customize.

Your roster is displayed in a buffer called -jabber-. To disconnect, type C-x C-j C-d or M-x jabber-disconnect.

You may want to use the menu bar to execute Jabber commands. To enable the Jabber menu, type M-x jabber-menu.

For a less terse description, read the enclosed manual.

For bug reports, help requests and other feedback, use the trackers and forums at the project page mentioned above.

Configuration

All available configuration options are described in the manual. This section only serves to point out the most important ones.

To change how you are notified about incoming events, type M-x customize-group RET jabber-alerts.

To activate logging of all chats, set jabber-history-enabled to t. By default, history will be saved in ~/.jabber_global_message_log; make sure that this file has appropriate permissions. Type M-x customize-group RET jabber-history for more options.

By default, jabber.el will send a confirmation when messages sent to you are delivered and displayed, and also send "contact is typing" notifications. To change this, type M-x customize-group RET jabber-events, and set the three jabber-events-confirm-* variables to nil.

File transfer

This release of jabber.el contains support for file transfer. You may need to configure some variables to make it work; see the manual for details.

XMPP URIs

It is possible to make various web browsers pass links starting with "xmpp:" to jabber.el. In the ideal case, this works right after running "make install". Otherwise, see the manual, section "XMPP URIs".

Credits

Developers

  • Tom Berger

  • Magnus Henoch

  • Kirill A. Korinskiy

  • Detlev Zundel

    • wmii support

  • Evgenii Terechkov

Contributors

  • Georg Lehner

    • network transport functions

  • Anthony Chaumas-Pellet

  • Jérémy Compostella

  • Mathias Dahl

    • history logging

    • watch functionality

  • Mario Domenech Goulart

    • sawfish support

    • xmessage support

  • Nolan Eakins

  • Ami Fischman

    • Chat State Notifications

  • François Fleuret

  • David Hansen

  • Adam Sjøgren

    • notifications.el support

  • Rodrigo Lazo

    • notifications.el support

    • libnotify.el support

  • Justin Kirby

  • Carl Henrik Lunde

    • network transport functions

    • activity tracking

  • Olivier Ramonat

  • Andrey Slusar

  • Valery V. Vorotyntsev

    • GMail notifications

  • Milan Zamazal

  • Xavier Maillard

  • Vitaly Mayatskikh

  • Alexander Solovyov

  • Demyan Rogozhin

    • XML console mode

  • Michael Cardell Widerkrantz

    • tmux support

Maintainers

  • wgreenhouse

    • 2021 resurrection

  • contrapunctus

    • literate Org migration

TODO maintenance [0%]

  1. Satisfy M-x checkdoc

  2. Use rx where regular expressions get hairy

  3. hexrgb.el is not available on MELPA

About this file

jabber.el is an Org literate program. We use literate-elisp to directly load/compile this Org file. The former is exactly what the file jabber.el does - this approach is also compatible with use-package and others. The advantages -

  1. links to the source (e.g. describe-* buffers, byte-compilation messages) take the user directly to the Org file rather than to the tangled source

  2. no waiting for org-babel-tangle (which takes ages)

  3. no need to track tangled files files in VCS, nor ensure they are kept in sync with the Org file

  4. no VCS hooks/CI required to automatically tangle the file

Note that some tools, like checkdoc, still require a tangled file as of the time of this writing.

If a source block does not have syntax highlighting, press M-o M-o (font-lock-fontify-block) in it.

TODO literate/organizational tasks [25%]

  1. (maybe) make dependencies optional and tangle them to separate files, reducing load time for users.

  2. contemplate distribution strategies

  3. make headings for remaining definitions - some FSM-related definitions remain.

  4. move tests to this file (probably migrate them to ert or buttercup first), in sub-headings of their concerned components.

  5. move dependencies to the Dependencies heading; also make library headers for them

  6. move per-file author information and copyright notice here, and delete the empty .el files

    • But it will cease to remain applicable as soon as we move anything around…

  7. "Code" has a lot of direct sub-headings, making it somewhat cumbersome to navigate; someone with a better understanding of the program could organize these better

  8. The tangled file currently does not list all the other authors (currently listed in :COPYRIGHT: drawers). We could add them all at once in the library headers section…or something else. 🤔

Library headers and commentary

;;; jabber.el --- a minimal jabber client  -*- lexical-binding: t; -*-

;; Copyright (C) 2003-2010, 2013 - Magnus Henoch - mange@freemail.hu
;; Copyright (C) 2002-2004 - Tom Berger - object@intelectronica.net
;; Copyright (C) 2005 - Georg Lehner - jorge@magma.com.ni
;; Copyright (C) 2008-2010, 2012-2013 - Terechkov Evgenii - evg@altlinux.org
;; Copyright (C) 2006-2010 - Kirill A. Korinskiy - catap@catap.ru
;; Copyright (C) 2004-2005 - Carl Henrik Lunde - chlunde+jabber+@ping.uio.no
;; Copyright (C) 2009-2010 - Demyan Rogozhin <demyan.rogozhin@gmail.com>
;; Copyright (C) 2004 - Mathias Dahl
;; Copyright (C) 2007 - Serguei Jidkov - jsv@e-mail.ru

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;; Commentary:
;;

;;; History:
;;

;;; Code:

Dependencies

(require 'cl-lib)
(require 'goto-addr)

Code

lexical binding test

The lexical-binding variable is setted to t evaluating the code to ensure that literate-elisp-load works using lexical bindings. The prop-line is also used just in case the code is tangled and byte-compiled, but literate-elisp-tangle discards all comments, thus the eval-when-compile sentence below.

  (defmacro lexical-p ()
    "Return non-nil in buffers with lexical binding."
    '(let* ((ret t)
            (code (lambda ()
                    ret)))
       (let ((ret nil))
         (funcall code))))

  (unless (lexical-p)
    (message "jabber.org: Lexical binding is off, trying to turn it on.")
    (setq lexical-binding t))

  (eval-when-compile
    (unless (lexical-p)
      (message "jabber.org: Lexical binding is off, trying to turn it on.")
      (setq lexical-binding t)))

  (unless (lexical-p)
    (message "jabber.org: It seems that lexical binding is still off... 
  Consider adding the file-local variable prop-line to the tangled jabber.el file
  or try to byte-compile the code."))

custom variables

  (defvar jabber-enable-legacy-features-p nil)

XML functions

    (require 'xml)
jabber-escape-xml   function
(defun jabber-escape-xml (str)
  "Escape strings for XML.
STR the string to escape."
  (if (stringp str)
      (let ((newstr (concat str)))
	;; Form feeds might appear in code you copy, etc.  Nevertheless,
	;; it's invalid XML.
	(setq newstr (jabber-replace-in-string newstr "\f" "\n"))
	;; Other control characters are also illegal, except for
	;; tab, CR, and LF.
	(setq newstr (jabber-replace-in-string newstr "[\000-\010\013\014\016-\037]" " "))
	(setq newstr (jabber-replace-in-string newstr "&" "&amp;"))
	(setq newstr (jabber-replace-in-string newstr "<" "&lt;"))
	(setq newstr (jabber-replace-in-string newstr ">" "&gt;"))
	(setq newstr (jabber-replace-in-string newstr "'" "&apos;"))
	(setq newstr (jabber-replace-in-string newstr "\"" "&quot;"))
	newstr)
    str))
jabber-unescape-xml   function
(defun jabber-unescape-xml (str)
  "Unescape xml strings.
STR the string to remove escaped characters."
  ;; Eventually this can be done with `xml-substitute-special', but the
  ;; version in xml.el of GNU Emacs 21.3 is buggy.
  (if (stringp str)
      (let ((newstr str))
	(setq newstr (jabber-replace-in-string newstr "&quot;" "\""))
	(setq newstr (jabber-replace-in-string newstr "&apos;" "'"))
	(setq newstr (jabber-replace-in-string newstr "&gt;" ">"))
	(setq newstr (jabber-replace-in-string newstr "&lt;" "<"))
	(setq newstr (jabber-replace-in-string newstr "&amp;" "&"))
	newstr)
    str))
jabber-sexp2xml   function
(defun jabber-sexp2xml (sexp)
  "Return SEXP as well-formatted XML.
SEXP should be in the form (tagname ((attribute-name . attribute-value)...) children...)"
  (cond
   ((stringp sexp)
    (jabber-escape-xml sexp))
   ((listp (car sexp))
    (let ((xml ""))
      (dolist (tag sexp)
	(setq xml (concat xml (jabber-sexp2xml tag))))
      xml))
   ;; work around bug in old versions of xml.el, where ("") can appear
   ;; as children of a node
   ((and (consp sexp)
	 (stringp (car sexp))
	 (zerop (length (car sexp))))
    "")
   (t
    (let ((xml ""))
      (setq xml (concat "<"
			(symbol-name (car sexp))))
      (dolist (attr (cadr sexp))
	(if (consp attr)
	    (setq xml (concat xml
			      (format " %s='%s'"
				      (symbol-name (car attr))
				      (jabber-escape-xml (cdr attr)))))))
      (if (cddr sexp)
	  (progn
	    (setq xml (concat xml ">"))
	    (dolist (child (cddr sexp))
	      (setq xml (concat xml
				(jabber-sexp2xml child))))
	    (setq xml (concat xml
			      "</"
			      (symbol-name (car sexp))
			      ">")))
	(setq xml (concat xml
			  "/>")))
      xml))))
jabber-xml-skip-tag-forward   function
(defun jabber-xml-skip-tag-forward (&optional dont-recurse-into-stream)
  "Skip to end of tag or matching closing tag if present.
Return t iff after a closing tag, otherwise throws an 'unfinished
tag with value nil.
If DONT-RECURSE-INTO-STREAM is non-nil, stop after an opening
<stream:stream> tag.

The version of `sgml-skip-tag-forward' in Emacs 21 isn't good
enough for us."
  (skip-chars-forward "^<")
  (cond
   ((looking-at "<!\\[CDATA\\[")
    (if (search-forward "]]>" nil t)
	(goto-char (match-end 0))
      (throw 'unfinished nil)))
   ((looking-at "<\\([^[:space:]/>]+\\)\\([[:space:]]+[^=>]+=[[:space:]]*'[^']*'\\|[[:space:]]+[^=>]+=[[:space:]]*\"[^\"]*\"\\)*")
    (let ((node-name (match-string 1)))
      (goto-char (match-end 0))
      (skip-syntax-forward "\s-") ; Skip over trailing white space.
      (cond
       ((looking-at "/>")
	(goto-char (match-end 0))
	t)
       ((looking-at ">")
	(goto-char (match-end 0))
	(unless (and dont-recurse-into-stream (equal node-name "stream:stream"))
	  (cl-loop
	   do (skip-chars-forward "^<")
	   until (looking-at (regexp-quote (concat "</" node-name ">")))
	   do (jabber-xml-skip-tag-forward))
	  (goto-char (match-end 0)))
	t)
       (t
	(throw 'unfinished nil)))))
   (t
    (throw 'unfinished nil))))
jabber-xml-parse-next-stanza   function
(defun jabber-xml-parse-next-stanza ()
  "Parse the first XML stanza in the current buffer.
Parse and return the first complete XML element in the buffer,
leaving point at the end of it.  If there is no complete XML
element, return nil."
  (and (catch 'unfinished
	 (goto-char (point-min))
	 (jabber-xml-skip-tag-forward)
	 (> (point) (point-min)))
       (xml-parse-region (point-min) (point))))
jabber-xml-node-name   inline function
(defsubst jabber-xml-node-name (node)
  "Return the tag associated with NODE.
The tag is a lower-case symbol."
  (if (listp node) (car node)))
jabber-xml-node-attributes   inline function
(defsubst jabber-xml-node-attributes (node)
  "Return the list of attributes of NODE.
The list can be nil."
  (if (listp node) (nth 1 node)))
jabber-xml-node-children   inline function
(defsubst jabber-xml-node-children (node)
  "Return the list of children of NODE.
This is a list of nodes, and it can be nil."
  (let ((children (cddr node)))
    ;; Work around a bug in early versions of xml.el
    (if (equal children '(("")))
	nil
      children)))
jabber-xml-get-children   function
(defun jabber-xml-get-children (node child-name)
  "Return the children of NODE whose tag is CHILD-NAME.
CHILD-NAME should be a lower case symbol."
  (let ((match ()))
    (dolist (child (jabber-xml-node-children node))
      (if child
	  (if (equal (jabber-xml-node-name child) child-name)
	      (push child match))))
    (nreverse match)))
jabber-xml-get-attribute   inline function

xml-get-attribute returns "" if the attribute is not found, which is not very useful. Therefore, we use xml-get-attribute-or-nil if present, or emulate its behavior.

(defsubst jabber-xml-get-attribute (node attribute)
  "Get from NODE the value of ATTRIBUTE.
Return nil if the attribute was not found."
  (when (consp node)
    (xml-get-attribute-or-nil node attribute)))
jabber-xml-get-xmlns   inline function
(defsubst jabber-xml-get-xmlns (node)
  "Get \"xmlns\" attribute of NODE, or nil if not present."
  (jabber-xml-get-attribute node 'xmlns))
jabber-xml-path   function
  (defun jabber-xml-path (xml-data path)
    "Find sub-node of XML-DATA according to PATH.
  PATH is a vaguely XPath-inspired list.  Each element can be:
  a symbol     go to first child node with this node name
  cons cell    car is string containing namespace URI,
               cdr is string containing node name.  Find
               first matching child node.
  any string   character data of this node."
    (let ((node xml-data))
      (while (and path node)
        (let ((step (car path)))
          (cond
           ((symbolp step)
            (setq node (car (jabber-xml-get-children node step))))
           ((consp step)
            ;; This will be easier with namespace-aware use
            ;; of xml.el.  It will also be more correct.
            ;; Now, it only matches explicit namespace declarations.
            (setq node
                  (cl-block dolist-loop
                  (dolist (x (jabber-xml-get-children node (intern (cdr step))))
                    (when (string= (jabber-xml-get-attribute x 'xmlns)
                                   (car step))
                      (cl-return-from dolist-loop  x))))))
           ((stringp step)
            (setq node (car (jabber-xml-node-children node)))
            (unless (stringp node)
              (setq node nil)))
           (t
            (error "Unknown path step: %s" step))))
        (setq path (cdr path)))
      node))
jabber-xml-let-attributes   macro
(defmacro jabber-xml-let-attributes (attributes xml-data &rest body)
  "Bind variables to the same-name attribute values in XML-DATA.
ATTRIBUTES is a list of attribute names."
  `(let ,(mapcar #'(lambda (attr)
		     (list attr `(jabber-xml-get-attribute ,xml-data ',attr)))
		 attributes)
     ,@body))
(put 'jabber-xml-let-attributes 'lisp-indent-function 2)
jabber-xml-resolve-namespace-prefixes   function
(defun jabber-xml-resolve-namespace-prefixes (xml-data &optional default-ns prefixes)
  (let ((node-name (jabber-xml-node-name xml-data))
	(attrs (jabber-xml-node-attributes xml-data)))
    (setq prefixes (jabber-xml-merge-namespace-declarations attrs prefixes))

    ;; If there is an xmlns attribute, it is the new default
    ;; namespace.
    (let ((xmlns (jabber-xml-get-xmlns xml-data)))
      (when xmlns
	(setq default-ns xmlns)))
    ;; Now, if the node name has a prefix, replace it and add an
    ;; "xmlns" attribute.  Slightly ugly, but avoids the need to
    ;; change all the rest of jabber.el at once.
    (let ((node-name-string (symbol-name node-name)))
      (when (string-match "\\(.*\\):\\(.*\\)" node-name-string)
	(let* ((prefix (match-string 1 node-name-string))
	       (unprefixed (match-string 2 node-name-string))
	       (ns (assoc prefix prefixes)))
	  (if (null ns)
	      ;; This is not supposed to happen...
	      (message "jabber-xml-resolve-namespace-prefixes: Unknown prefix in %s" node-name-string)
	    (setf (car xml-data) (intern unprefixed))
	    (setf (cadr xml-data) (cons (cons 'xmlns (cdr ns)) (delq 'xmlns attrs)))))))
    ;; And iterate through all child elements.
    (mapc (lambda (x)
	    (when (listp x)
	      (jabber-xml-resolve-namespace-prefixes x default-ns prefixes)))
	  (jabber-xml-node-children xml-data))
    xml-data))
jabber-xml-merge-namespace-declarations   function
(defun jabber-xml-merge-namespace-declarations (attrs prefixes)
  ;; First find any xmlns:foo attributes..
  (dolist (attr attrs)
    (let ((attr-name (symbol-name (car attr))))
      (when (string-match "xmlns:" attr-name)
	(let ((prefix (substring attr-name (match-end 0)))
	      (ns-uri (cdr attr)))
	  ;; A slightly complicated dance to never change the
	  ;; original value of prefixes (since the caller depends on
	  ;; it), but also to avoid excessive copying (which remove
	  ;; always does).  Might need to profile and tweak this for
	  ;; performance.
	  (setq prefixes
		(cons (cons prefix ns-uri)
			(if (assoc prefix prefixes)
			    (remove (assoc prefix prefixes) prefixes)
			  prefixes)))))))
  prefixes)

various utility functions

(require 'password-cache)
(condition-case nil
    (require 'auth-source)
  (error nil))
jabber-jid-history   variable
(defvar jabber-jid-history nil
  "History of entered JIDs.")
jabber-replace-in-string   inline function
(defsubst jabber-replace-in-string (str regexp newtext)
  (replace-regexp-in-string regexp newtext str t t))
jabber-propertize   function
(defalias 'jabber-propertize 'propertize)
bound-and-true-p   macro
(unless (fboundp 'bound-and-true-p)
  (defmacro bound-and-true-p (var)
    "Return the value of symbol VAR if it is bound, else nil."
    `(and (boundp (quote ,var)) ,var)))
jabber-read-with-input-method   inline function

Preserve input method when entering a minibuffer.

(defsubst jabber-read-with-input-method (prompt &optional initial-contents history default-value)
  (read-string prompt initial-contents history default-value t))
delete-and-extract-region   inline function
(unless (fboundp 'delete-and-extract-region)
  (defsubst delete-and-extract-region (start end)
    (prog1
	(buffer-substring start end)
      (delete-region start end))))
access-file   inline function
(unless (fboundp 'access-file)
  (defsubst access-file (filename error-message)
    (unless (file-readable-p filename)
      (error error-message))))
jabber-float-time   function
  (defalias 'jabber-float-time 'float-time)
jabber-cancel-timer   function
(defalias 'jabber-cancel-timer 'cancel-timer)
jabber-concat-rosters   function
(defun jabber-concat-rosters ()
  "Concatenate the rosters of all connected accounts."
  (apply #'append
	 (mapcar
	  (lambda (jc)
	    (plist-get (fsm-get-state-data jc) :roster))
	  jabber-connections)))
jabber-concat-rosters-full   function
(defun jabber-concat-rosters-full ()
  "Concatenate the rosters of all connected accounts.
Show full JIDs, with resources."
  (let ((jids (apply #'append
                     (mapcar
                      (lambda (jc)
                        (plist-get (fsm-get-state-data jc) :roster))
                      jabber-connections))))
    (apply #'append
           (mapcar (lambda (jid)
                     (mapcar (lambda (res) (intern (format "%s/%s" jid (car res))))
                             (get (jabber-jid-symbol jid) 'resources)))
                   jids))))
jabber-connection-jid   function
(defun jabber-connection-jid (jc)
  "Return the full JID of connection JC."
  (let ((sd (fsm-get-state-data jc)))
    (concat (plist-get sd :username) "@"
	    (plist-get sd :server) "/"
	    (plist-get sd :resource))))
jabber-connection-bare-jid   function
(defun jabber-connection-bare-jid (jc)
  "Return the bare JID of connection JC."
  (let ((sd (fsm-get-state-data jc)))
    (concat (plist-get sd :username) "@"
	    (plist-get sd :server))))
jabber-connection-original-jid   function
(defun jabber-connection-original-jid (jc)
  "Return the original JID of connection JC.
The \"original JID\" is the JID we authenticated with.  The
server might subsequently assign us a different JID at resource
binding."
  (plist-get (fsm-get-state-data jc) :original-jid))
jabber-find-connection   function
(defun jabber-find-connection (bare-jid)
  "Find the connection to the account named by BARE-JID.
Return nil if none found."
  (dolist (jc jabber-connections)
    (when (string= bare-jid (jabber-connection-bare-jid jc))
      (cl-return jc))))
jabber-find-active-connection   function
(defun jabber-find-active-connection (dead-jc)
  "Find an active connection for dead connection DEAD-JC.
Return nil if none found."
  (let ((jid (jabber-connection-bare-jid dead-jc)))
    (jabber-find-connection jid)))
jabber-jid-username   function
(defun jabber-jid-username (jid)
  "Return the username portion of JID, or nil if none found.
JID must be a string."
  (when (string-match "\\(.*\\)@.*\\(/.*\\)?" jid)
    (match-string 1 jid)))
jabber-jid-user   function
(defun jabber-jid-user (jid)
  "Return the user portion (username@server) of JID.
JID must be a string."
  ;;transports don't have @, so don't require it
  ;;(string-match ".*@[^/]*" jid)
  (string-match "[^/]*" jid)
  (match-string 0 jid))
jabber-jid-server   function
(defun jabber-jid-server (jid)
  "Return the server portion of JID."
  (string-match "^\\(.*@\\)?\\([^@/]+\\)\\(/.*\\)?$" jid)
  (match-string 2 jid))
jabber-jid-rostername   function
(defun jabber-jid-rostername (string)
  "Return the name of the user from STRING as in roster, else nil."
  (let ((user (jabber-jid-symbol string)))
    (if (> (length (get user 'name)) 0)
	(get user 'name))))
jabber-jid-displayname   function
(defun jabber-jid-displayname (string)
  "Return the name of the user from STRING as in roster, else username@server."
  (or (jabber-jid-rostername string)
      (jabber-jid-user (if (symbolp string)
			   (symbol-name string)
			 string))))
jabber-jid-bookmarkname   function
(defun jabber-jid-bookmarkname (string)
  "Return from STRING the conference name from boomarks or displayname.
Use the name according to roster or else the JID if none set."
  (or (cl-loop for conference in (cl-first (cl-loop for value being the hash-values of jabber-bookmarks
                                           collect value))
            do (let ((ls (cadr conference)))
                 (if (string= (cdr (assoc 'jid ls)) string)
                     (cl-return (cdr (assoc 'name ls))))))
      (jabber-jid-displayname string)))
jabber-jid-resource   function
(defun jabber-jid-resource (jid)
  "Return the resource portion of a JID, or nil if there is none.
JID must be a string."
  (when (string-match "^\\(\\([^/]*@\\)?[^/]*\\)/\\(.*\\)" jid)
    (match-string 3 jid)))
jabber-jid-symbol   function
(defun jabber-jid-symbol (jid)
  "Return the symbol for the given JID.
JID must be a string."
  ;; If it's already a symbol, just return it.
  (if (symbolp jid)
      jid
    ;; XXX: "downcase" is poor man's nodeprep.  See XMPP CORE.
    (intern (downcase (jabber-jid-user jid)) jabber-jid-obarray)))
jabber-my-jid-p   function
(defun jabber-my-jid-p (jc jid)
  "Return non-nil if the specified JID is in the `jabber-account-list'.
Comment: (modulo resource).
Also return non-nil if JID matches JC, modulo resource."
  (or
   (equal (jabber-jid-user jid)
	  (jabber-connection-bare-jid jc))
   (member (jabber-jid-user jid) (mapcar (lambda (x) (jabber-jid-user (car x))) jabber-account-list))))
jabber-read-jid-completing   function
(defun jabber-read-jid-completing (prompt &optional subset require-match default resource fulljids)
  "Read a jid out of the current roster from the minibuffer.
If SUBSET is non-nil, it should be a list of symbols from which
the JID is to be selected, instead of using the entire roster.
If REQUIRE-MATCH is non-nil, the JID must be in the list used.
If DEFAULT is non-nil, it's used as the default value, otherwise
the default is inferred from context.
RESOURCE is one of the following:

nil         Accept full or bare JID, as entered
full        Turn bare JIDs to full ones with highest-priority resource
bare-or-muc Turn full JIDs to bare ones, except for in MUC

If FULLJIDS is non-nil, complete jids with resources."
  (let ((jid-at-point (or
		       (and default
			    ;; default can be either a symbol or a string
			    (if (symbolp default)
				(symbol-name default)
			      default))
                       (let* ((jid (get-text-property (point) 'jabber-jid))
                              (res (get (jabber-jid-symbol jid) 'resource)))
                         (when jid
                           (if (and fulljids res (not (jabber-jid-resource jid)))
                               (format "%s/%s" jid res)
                             jid)))
		       (bound-and-true-p jabber-chatting-with)
		       (bound-and-true-p jabber-group)))
	(completion-ignore-case t)
	(jid-completion-table (mapcar #'(lambda (item)
					  (cons (symbol-name item) item))
				      (or subset (funcall (if fulljids
                                                              'jabber-concat-rosters-full
                                                            'jabber-concat-rosters)))))
	chosen)
    (dolist (item (or subset (jabber-concat-rosters)))
      (if (get item 'name)
	  (push (cons (get item 'name) item) jid-completion-table)))
    ;; if the default is not in the allowed subset, it's not a good default
    (if (and subset (not (assoc jid-at-point jid-completion-table)))
	(setq jid-at-point nil))
    (let ((input
	   (completing-read (concat prompt
				    (if jid-at-point
					(format "(default %s) " jid-at-point)))
			    jid-completion-table
			    nil require-match nil 'jabber-jid-history jid-at-point)))
      (setq chosen
	    (if (and input (assoc-string input jid-completion-table t))
		(symbol-name (cdr (assoc-string input jid-completion-table t)))
	      (and (not (zerop (length input)))
		   input))))

    (when chosen
      (cl-case resource
	(full
	 ;; If JID is bare, add the highest-priority resource.
	 (if (jabber-jid-resource chosen)
	     chosen
	   (let ((highest-resource (get (jabber-jid-symbol chosen) 'resource)))
	     (if highest-resource
		 (concat chosen "/" highest-resource)
	       chosen))))
	(bare-or-muc
	 ;; If JID is full and non-MUC, remove resource.
	 (if (null (jabber-jid-resource chosen))
	     chosen
	   (let ((bare (jabber-jid-user chosen)))
	     (if (assoc bare *jabber-active-groupchats*)
		 chosen
	       bare))))
	(t
	 chosen)))))
jabber-read-node   function
(defun jabber-read-node (prompt)
  "Read node name, taking default from disco item at point."
  (let ((node-at-point (get-text-property (point) 'jabber-node)))
    (read-string (concat prompt
			 (if node-at-point
			     (format "(default %s) " node-at-point)))
		 node-at-point)))
jabber-password-key   function
(defun jabber-password-key (bare-jid)
  "Construct key for `password' library from BARE-JID."
  (concat "xmpp:" bare-jid))
jabber-read-password   function
(defun jabber-read-password (bare-jid)
  "Read Jabber password from minibuffer."
  (let ((found
	 (and (fboundp 'auth-source-search)
	      (nth 0 (auth-source-search
		      :user (jabber-jid-username bare-jid)
		      :host (jabber-jid-server bare-jid)
		      :port "xmpp"
		      :max 1
		      :require '(:secret))))))
    (if found
	(let ((secret (plist-get found :secret)))
	  (copy-sequence
	   (if (functionp secret)
	       (funcall secret)
	     secret)))
      (let ((prompt (format "Jabber password for %s: " bare-jid)))
	;; Need to copy the password, as sasl.el wants to erase it.
	(copy-sequence
	 (password-read prompt (jabber-password-key bare-jid)))))))
jabber-cache-password   function
(defun jabber-cache-password (bare-jid password)
  "Cache PASSWORD for BARE-JID."
  (password-cache-add (jabber-password-key bare-jid) password))
jabber-uncache-password   command
(defun jabber-uncache-password (bare-jid)
  "Uncache cached password for BARE-JID.
Useful if the password proved to be wrong."
  (interactive (list (jabber-jid-user
		      (completing-read "Forget password of account: " jabber-account-list nil nil nil 'jabber-account-history))))
  (password-cache-remove (jabber-password-key bare-jid)))
jabber-read-account   function
(defun jabber-read-account (&optional always-ask contact-hint)
  "Ask for which connected account to use.
If ALWAYS-ASK is nil and there is only one account, return that
account.
If CONTACT-HINT is a string or a JID symbol, default to an account
that has that contact in its roster."
  (let ((completions
         (mapcar (lambda (c)
                   (cons
                    (jabber-connection-bare-jid c)
                    c))
                 jabber-connections)))
    (cond
     ((null jabber-connections)
      (error "Not connected to Jabber"))
     ((and (null (cdr jabber-connections)) (not always-ask))
      ;; only one account
      (car jabber-connections))
     (t
      (or
       ;; if there is a jabber-account property at point,
       ;; present it as default value
       (cdr (assoc (let ((at-point (get-text-property (point) 'jabber-account)))
                     (when (and at-point
                                (memq at-point jabber-connections))
                       (jabber-connection-bare-jid at-point))) completions))
       (let* ((default
                (or
		 (and contact-hint
		      (setq contact-hint (jabber-jid-symbol contact-hint))
		      (let ((matching
			     (cl-find-if
			      (lambda (jc)
				(memq contact-hint (plist-get (fsm-get-state-data jc) :roster)))
			      jabber-connections)))
			(when matching
			  (jabber-connection-bare-jid matching))))
                 ;; if the buffer is associated with a connection, use it
                 (when (and jabber-buffer-connection
			    (jabber-find-active-connection jabber-buffer-connection))
                   (jabber-connection-bare-jid jabber-buffer-connection))
                 ;; else, use the first connection in the list
                 (caar completions)))
              (input (completing-read
                      (concat "Select Jabber account (default "
                              default
                              "): ")
                      completions nil t nil 'jabber-account-history
                      default)))
         (cdr (assoc input completions))))))))
jabber-iq-query   function
(defun jabber-iq-query (xml-data)
  "Return the query part of an IQ stanza.
An IQ stanza may have zero or one query child, and zero or one <error/> child.
The query child is often but not always <query/>.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let (query)
    (dolist (x (jabber-xml-node-children xml-data))
      (if (and
	   (listp x)
	   (not (eq (jabber-xml-node-name x) 'error)))
	  (setq query x)))
    query))
jabber-iq-error   function
(defun jabber-iq-error (xml-data)
  "Return the <error/> part of an IQ stanza, if any.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (car (jabber-xml-get-children xml-data 'error)))
jabber-iq-xmlns   function
(defun jabber-iq-xmlns (xml-data)
  "Return the namespace of an IQ stanza, i.e. the namespace of its query part.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (jabber-xml-get-attribute (jabber-iq-query xml-data) 'xmlns))
jabber-message-timestamp   function
(defun jabber-message-timestamp (xml-data)
  "Given a <message/> element, return its timestamp, or nil if none.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (jabber-x-delay
   (or
    (jabber-xml-path xml-data '(("urn:xmpp:delay" . "delay")))
    (jabber-xml-path xml-data '(("jabber:x:delay" . "x"))))))
jabber-x-delay   function
(defun jabber-x-delay (xml-data)
  "Return timestamp given a delayed delivery element.
This can be either a <delay/> tag in namespace urn:xmpp:delay (XEP-0203), or
a <x/> tag in namespace jabber:x:delay (XEP-0091).
Return nil if no such data available.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (cond
   ((and (eq (jabber-xml-node-name xml-data) 'x)
	 (string= (jabber-xml-get-attribute xml-data 'xmlns) "jabber:x:delay"))
    (let ((stamp (jabber-xml-get-attribute xml-data 'stamp)))
      (if (and (stringp stamp)
	       (= (length stamp) 17))
	  (jabber-parse-legacy-time stamp))))
   ((and (eq (jabber-xml-node-name xml-data) 'delay)
	 (string= (jabber-xml-get-attribute xml-data 'xmlns) "urn:xmpp:delay"))
    (let ((stamp (jabber-xml-get-attribute xml-data 'stamp)))
      (when (stringp stamp)
	(jabber-parse-time stamp))))))
jabber-parse-legacy-time   function
(defun jabber-parse-legacy-time (timestamp)
  "Parse timestamp in ccyymmddThh:mm:ss format (UTC) and return as internal time value."
  (let ((year (string-to-number (substring timestamp 0 4)))
	(month (string-to-number (substring timestamp 4 6)))
	(day (string-to-number (substring timestamp 6 8)))
	(hour (string-to-number (substring timestamp 9 11)))
	(minute (string-to-number (substring timestamp 12 14)))
	(second (string-to-number (substring timestamp 15 17))))
    (encode-time second minute hour day month year 0)))
jabber-encode-legacy-time   function
(defun jabber-encode-legacy-time (timestamp)
  "Parse TIMESTAMP as internal time value and encode as ccyymmddThh:mm:ss (UTC)."
  (if (featurep 'xemacs)
      ;; XEmacs doesn't have `universal' argument to format-time-string,
      ;; so we have to do it ourselves.
      (format-time-string "%Y%m%dT%H:%M:%S"
			  (time-subtract timestamp
					 (list 0 (car (current-time-zone)))))
    (format-time-string "%Y%m%dT%H:%M:%S" timestamp t)))
jabber-encode-time   function
(defun jabber-encode-time (time)
  "Convert TIME to a string by XEP-0082.
TIME is in a format accepted by `format-time-string'."
  (format-time-string "%Y-%m-%dT%H:%M:%SZ" time t))
jabber-encode-timezone   function
(defun jabber-encode-timezone ()
  (let ((time-zone-offset (nth 0 (current-time-zone))))
    (if (null time-zone-offset)
        "Z"
      (let* ((positivep (>= time-zone-offset 0))
             (hours (/ (abs time-zone-offset) 3600))
             (minutes (/ (% (abs time-zone-offset) 3600) 60)))
        (format "%s%02d:%02d"(if positivep "+" "-") hours minutes)))))
jabber-parse-time   function
(defun jabber-parse-time (raw-time)
  "Parse the DateTime encoded in TIME according to XEP-0082."
  (let* ((time (if (string= (substring raw-time 4 5) "-")
                   raw-time
                 (concat
                  (substring raw-time 0 4) "-"
                  (substring raw-time 4 6) "-"
                  (substring raw-time 6 (length raw-time)))))
         (year (string-to-number (substring time 0 4)))
	 (month (string-to-number (substring time 5 7)))
	 (day (string-to-number (substring time 8 10)))
	 (hour (string-to-number (substring time 11 13)))
	 (minute (string-to-number (substring time 14 16)))
	 (second (string-to-number (substring time 17 19)))
         (timezone (if (eq (aref time 19) ?.)
                       ;; fractions are optional
                       (let ((timezone (cadr
                                        (split-string (substring time 20)
                                                      "[-+Z]"))))
                         (if (string= "" timezone)
                             "Z"
                           timezone))
                     (substring time 19))))
    ;; timezone is either Z (UTC) or [+-]HH:MM
    (let ((timezone-seconds
	   (if (string= timezone "Z")
	       0
	     (* (if (eq (aref timezone 0) ?+) 1 -1)
		(* 60 (+ (* 60 (string-to-number (substring timezone 1 3)))
			 (string-to-number (substring timezone 4 6))))))))
      (encode-time second minute hour day month year timezone-seconds))))
jabber-report-success   function
(defun jabber-report-success (jc xml-data context)
  "IQ callback reporting success or failure of the operation.
CONTEXT is a string describing the action.
\"CONTEXT succeeded\" or \"CONTEXT failed: REASON\" is displayed in
the echo area.
JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((type (jabber-xml-get-attribute xml-data 'type)))
    (message (concat context
		     (if (string= type "result")
			 " succeeded"
		       (concat
			" failed: "
			(let ((the-error (jabber-iq-error xml-data)))
			  (if the-error
			      (jabber-parse-error the-error)
			    "No error message given"))))))))
jabber-error-messages   constant
(defconst jabber-error-messages
  (list
   (cons 'bad-request "Bad request")
   (cons 'conflict "Conflict")
   (cons 'feature-not-implemented "Feature not implemented")
   (cons 'forbidden "Forbidden")
   (cons 'gone "Gone")
   (cons 'internal-server-error "Internal server error")
   (cons 'item-not-found "Item not found")
   (cons 'jid-malformed "JID malformed")
   (cons 'not-acceptable "Not acceptable")
   (cons 'not-allowed "Not allowed")
   (cons 'not-authorized "Not authorized")
   (cons 'payment-required "Payment required")
   (cons 'recipient-unavailable "Recipient unavailable")
   (cons 'redirect "Redirect")
   (cons 'registration-required "Registration required")
   (cons 'remote-server-not-found "Remote server not found")
   (cons 'remote-server-timeout "Remote server timeout")
   (cons 'resource-constraint "Resource constraint")
   (cons 'service-unavailable "Service unavailable")
   (cons 'subscription-required "Subscription required")
   (cons 'undefined-condition "Undefined condition")
   (cons 'unexpected-request "Unexpected request"))
  "String descriptions of XMPP stanza errors.")
jabber-legacy-error-messages   constant
(defconst jabber-legacy-error-messages
  (list
   (cons 302 "Redirect")
   (cons 400 "Bad request")
   (cons 401 "Unauthorized")
   (cons 402 "Payment required")
   (cons 403 "Forbidden")
   (cons 404 "Not found")
   (cons 405 "Not allowed")
   (cons 406 "Not acceptable")
   (cons 407 "Registration required")
   (cons 408 "Request timeout")
   (cons 409 "Conflict")
   (cons 500 "Internal server error")
   (cons 501 "Not implemented")
   (cons 502 "Remote server error")
   (cons 503 "Service unavailable")
   (cons 504 "Remote server timeout")
   (cons 510 "Disconnected"))
  "String descriptions of legacy errors (XEP-0086).")
jabber-parse-error   function
(defun jabber-parse-error (error-xml)
  "Parse the given <error/> tag and return a string fit for human consumption.
See secton 9.3, Stanza Errors, of XMPP Core, and XEP-0086, Legacy Errors."
  (let ((error-type (jabber-xml-get-attribute error-xml 'type))
	(error-code (jabber-xml-get-attribute error-xml 'code))
	condition text)
    (if error-type
	;; If the <error/> tag has a type element, it is new-school.
	(dolist (child (jabber-xml-node-children error-xml))
	  (when (string=
		 (jabber-xml-get-attribute child 'xmlns)
		 "urn:ietf:params:xml:ns:xmpp-stanzas")
	    (if (eq (jabber-xml-node-name child) 'text)
		(setq text (car (jabber-xml-node-children child)))
	      (setq condition
		    (or (cdr (assq (jabber-xml-node-name child) jabber-error-messages))
			(symbol-name (jabber-xml-node-name child)))))))
      (setq condition (or (cdr (assq (string-to-number error-code) jabber-legacy-error-messages))
			  error-code))
      (setq text (car (jabber-xml-node-children error-xml))))
    (concat condition
	    (if text (format ": %s" text)))))
jabber-error-condition   function
(defun jabber-error-condition (error-xml)
  "Parse the given <error/> tag and return the condition symbol."
  (catch 'condition
    (dolist (child (jabber-xml-node-children error-xml))
      (when (string=
		 (jabber-xml-get-attribute child 'xmlns)
		 "urn:ietf:params:xml:ns:xmpp-stanzas")
	(throw 'condition (jabber-xml-node-name child))))))
jabber-stream-error-messages   variable
(defvar jabber-stream-error-messages
  (list
   (cons 'bad-format "Bad XML format")
   (cons 'bad-namespace-prefix "Bad namespace prefix")
   (cons 'conflict "Conflict")
   (cons 'connection-timeout "Connection timeout")
   (cons 'host-gone "Host gone")
   (cons 'host-unknown "Host unknown")
   (cons 'improper-addressing "Improper addressing") ; actually only s2s
   (cons 'internal-server-error "Internal server error")
   (cons 'invalid-from "Invalid from")
   (cons 'invalid-id "Invalid id")
   (cons 'invalid-namespace "Invalid namespace")
   (cons 'invalid-xml "Invalid XML")
   (cons 'not-authorized "Not authorized")
   (cons 'policy-violation "Policy violation")
   (cons 'remote-connection-failed "Remote connection failed")
   (cons 'resource-constraint "Resource constraint")
   (cons 'restricted-xml "Restricted XML")
   (cons 'see-other-host "See other host")
   (cons 'system-shutdown "System shutdown")
   (cons 'undefined-condition "Undefined condition")
   (cons 'unsupported-encoding "Unsupported encoding")
   (cons 'unsupported-stanza-type "Unsupported stanza type")
   (cons 'unsupported-version "Unsupported version")
   (cons 'xml-not-well-formed "XML not well formed"))
  "String descriptions of XMPP stream errors.")
jabber-stream-error-condition   function
(defun jabber-stream-error-condition (error-xml)
  "Return the condition of a <stream:error/> tag."
  ;; as we don't know the node name of the condition, we have to
  ;; search for it.
  (dolist (node (jabber-xml-node-children error-xml))
    (when (and (string= (jabber-xml-get-attribute node 'xmlns)
			"urn:ietf:params:xml:ns:xmpp-streams")
	       (assq (jabber-xml-node-name node)
		     jabber-stream-error-messages))
      (cl-return (jabber-xml-node-name node)))))
jabber-parse-stream-error   function
(defun jabber-parse-stream-error (error-xml)
  "Parse the given <stream:error/> tag and return a sting fit for human consumption."
  (let ((text-node (car (jabber-xml-get-children error-xml 'text)))
	(condition (jabber-stream-error-condition error-xml)))
    (concat (if condition (cdr (assq condition jabber-stream-error-messages))
	      "Unknown stream error")
	    (if (and text-node (stringp (car (jabber-xml-node-children text-node))))
		(concat ": " (car (jabber-xml-node-children text-node)))))))
(put 'jabber-error
     'error-conditions
     '(error jabber-error))
(put 'jabber-error
     'error-message
     "Jabber error")
jabber-signal-error   function

Section 8.3 of RFC 6120 explains that there are stanza errors, which are recoverable and do not terminate the stream.

Each stanza has a type which are the one explained at the ERROR-TYPE parameter. When executing checkdoc, it throws warnings stating that errors messages should start with capital letters, thus the downcase function is used as a work around to avoid this.

(defun jabber-signal-error (error-type condition &optional text app-specific)
  "Signal an error to be sent by Jabber.
ERROR-TYPE is one of \"Cancel\", \"Continue\", \"Mmodify\", \"Auth\"
and \"Wait\" (lowercase versions make `checkdoc' to throw errors).
CONDITION is a symbol denoting a defined XMPP condition.
TEXT is a string to be sent in the error message, or nil for no text.
APP-SPECIFIC is a list of extra XML tags.

See section 9.3 of XMPP Core (RFC 3920).
See section 8.3 of XMPP Core (RFC 6120)."
  (signal 'jabber-error
	  (list (downcase error-type) condition text app-specific)))
jabber-unhex   function
(defun jabber-unhex (string)
  "Convert a hex-encoded UTF-8 string to Emacs representation.
For example, \"ji%C5%99i@%C4%8Dechy.example/v%20Praze\" becomes
\"jiři@čechy.example/v Praze\"."
  (decode-coding-string (url-unhex-string string) 'utf-8))
jabber-handle-uri   command
(defun jabber-handle-uri (uri &rest ignored-args)
  "Handle XMPP links according to draft-saintandre-xmpp-iri-04.
See Info node `(jabber)XMPP URIs'."
  (interactive "sEnter XMPP URI: ")

  (when (string-match "//" uri)
    (error "URIs with authority part are not supported"))

  ;; This regexp handles three cases:
  ;; xmpp:romeo@montague.net
  ;; xmpp:romeo@montague.net?roster
  ;; xmpp:romeo@montague.net?roster;name=Romeo%20Montague;group=Lovers
  (unless (string-match "^xmpp:\\([^?]+\\)\\(\\?\\([a-z]+\\)\\(;\\(.*\\)\\)?\\)?" uri)
    (error "Invalid XMPP URI '%s'" uri))

  ;; We start by raising the Emacs frame.
  (raise-frame)

  (let ((jid (jabber-unhex (match-string 1 uri)))
	(method (match-string 3 uri))
	(args (let ((text (match-string 5 uri)))
		;; If there are arguments...
		(when text
		  ;; ...split the pairs by ';'...
		  (let ((pairs (split-string text ";")))
		    (mapcar (lambda (pair)
			      ;; ...and split keys from values by '='.
			      (cl-destructuring-bind (key value)
				  (split-string pair "=")
				;; Values can be hex-coded.
				(cons key (jabber-unhex value))))
			    pairs))))))
    ;; The full list of methods is at
    ;; <URL:http://www.jabber.org/registrar/querytypes.html>.
    (cond
     ;; Join an MUC.
     ((string= method "join")
      (let ((account (jabber-read-account)))
	(jabber-muc-join
	 account jid (jabber-muc-read-my-nickname account jid) t)))
     ;; Register with a service.
     ((string= method "register")
      (jabber-get-register (jabber-read-account) jid))
     ;; Run an ad-hoc command
     ((string= method "command")
      ;; XXX: does the 'action' attribute make sense?
      (jabber-ahc-execute-command
       (jabber-read-account) jid (cdr (assoc "node" args))))
     ;; Everything else: open a chat buffer.
     (t
      (jabber-chat-with (jabber-read-account) jid)))))
url-xmpp   function
(defun url-xmpp (url)
  "Handle XMPP URLs from internal Emacs functions."
  ;; XXX: This parsing roundtrip is redundant, and the parser of the
  ;; url package might lose information.
  (jabber-handle-uri (url-recreate-url url)))
string>-numerical   function
(defun string>-numerical (s1 s2)
  "Return t if first arg string is more than second in numerical order."
  (cond ((string= s1 s2) nil)
	((> (length s1) (length s2)) t)
	((< (length s1) (length s2)) nil)
	((< (string-to-number (substring s1 0 1)) (string-to-number (substring s2 0 1))) nil)
	((> (string-to-number (substring s1 0 1)) (string-to-number (substring s2 0 1))) t)
	(t (string>-numerical (substring s1 1) (substring s2 1)))))
jabber-append-string-to-file   function
(defun jabber-append-string-to-file (string file &optional func &rest args)
  "Append STRING (may be nil) to FILE.  Create FILE if needed.
If FUNC is non-nil, then call FUNC with ARGS at beginning of
temporaly buffer _before_ inserting STRING."
  (when (or (stringp string) (functionp func))
    (with-temp-buffer
      (when (functionp func) (apply func args))
      (when (stringp string) (insert string))
      (write-region (point-min) (point-max) file t (list t)))))
jabber-tree-map   function
(defun jabber-tree-map (fn tree)
  "Apply FN to all nodes in the TREE starting with root.
FN is applied to the node and not to the data itself."
  (let ((result (cons nil nil)))
    (cl-do ((tail tree (cdr tail))
	 (prev result end)
	 (end result (let* ((x (car tail))
			    (val (if (atom x)
				     (funcall fn x)
                                   (jabber-tree-map fn x))))
		       (setf (car end) val (cdr end) (cons nil
                                                           nil)))))
	((atom tail)
	 (progn
	   (setf (cdr prev) (if tail (funcall fn tail) nil))
	   result)))))

menu

jabber-menu   variable
;;;###autoload
(defvar jabber-menu
  (let ((map (make-sparse-keymap "jabber-menu")))
    (define-key-after map
      [jabber-menu-connect]
      '("Connect" . jabber-connect-all))

    (define-key-after map
      [jabber-menu-disconnect]
      '(menu-item "Disconnect" jabber-disconnect
		  :enable (bound-and-true-p jabber-connections)))

    (define-key-after map
      [jabber-menu-status]
      `(menu-item "Set Status" ,(make-sparse-keymap "set-status")
		  :enable (bound-and-true-p jabber-connections)))

    (define-key map
      [jabber-menu-status jabber-menu-status-chat]
      '(menu-item
	"Chatty"
	(lambda ()
	  (interactive)
	  (jabber-send-presence "chat"
				(jabber-read-with-input-method "status message: " *jabber-current-status* '*jabber-status-history*)
				*jabber-current-priority*))
	:button (:radio . (and (boundp '*jabber-current-show*)
			       (equal *jabber-current-show* "chat")))))
    (define-key map
      [jabber-menu-status jabber-menu-status-dnd]
      '(menu-item
	"Do not Disturb"
	(lambda ()
	  (interactive)
	  (jabber-send-presence "dnd"
				(jabber-read-with-input-method "status message: " *jabber-current-status* '*jabber-status-history*)
				*jabber-current-priority*))
	:button (:radio . (and (boundp '*jabber-current-show*)
			       (equal *jabber-current-show* "dnd")))))
    (define-key map
      [jabber-menu-status jabber-menu-status-xa]
      '(menu-item "Extended Away" jabber-send-xa-presence
		  :button (:radio . (and (boundp '*jabber-current-show*)
					 (equal *jabber-current-show* "xa")))))
    (define-key map
      [jabber-menu-status jabber-menu-status-away]
      '(menu-item "Away" jabber-send-away-presence
		  :button (:radio . (and (boundp '*jabber-current-show*)
					 (equal *jabber-current-show* "away")))))
    (define-key map
      [jabber-menu-status jabber-menu-status-online]
      '(menu-item "Online" jabber-send-default-presence
		  :button (:radio . (and (boundp '*jabber-current-show*)
					 (equal *jabber-current-show* "")))))

    (define-key-after map
      [separator]
      '(menu-item "--"))

    (define-key-after map
      [jabber-menu-chat-with]
      '(menu-item "Chat with..." jabber-chat-with
		  :enable (bound-and-true-p jabber-connections)))

    (define-key-after map
      [jabber-menu-nextmsg]
      '(menu-item "Next unread message" jabber-activity-switch-to
		  :enable (bound-and-true-p jabber-activity-jids)))

    (define-key-after map
      [jabber-menu-send-subscription-request]
      '(menu-item "Send subscription request" jabber-send-subscription-request
		  :enable (bound-and-true-p jabber-connections)))

    (define-key-after map
      [jabber-menu-roster]
      '("Switch to roster" . jabber-switch-to-roster-buffer))

    (define-key-after map
      [separator2]
      '(menu-item "--"))


    (define-key-after map
      [jabber-menu-customize]
      '("Customize" . jabber-customize))

    (define-key-after map
      [jabber-menu-info]
      '("Help" . jabber-info))

    map))
jabber-display-menu   custom variable
;;;###autoload
(defcustom jabber-display-menu 'maybe
  "Decide whether the \"Jabber\" menu is displayed in the menu bar.
If t, always display.
If nil, never display.
If maybe, display if jabber.el is installed under `package-user-dir', or
if any of `jabber-account-list' or `jabber-connections' is non-nil."
  :group 'jabber
  :type '(choice (const :tag "Never" nil)
		 (const :tag "Always" t)
		 (const :tag "When installed by user, or when any accounts have been configured or connected" maybe)))
jabber-menu   command
  (defun jabber-menu (&optional remove)
    "Put \"Jabber\" menu on menubar.
  With prefix argument, remove it."
    (interactive "P")
    (setq jabber-display-menu (if remove nil t))
    (force-mode-line-update))
  (make-obsolete 'jabber-menu "set the variable `jabber-display-menu' instead." "27.2")

This used to be: (define-key-after global-map [menu-bar jabber-menu] ...) but that doesn't work in Emacs 21.

;;;###autoload
(define-key-after (lookup-key global-map [menu-bar])
  [jabber-menu]
  (list 'menu-item "Jabber" jabber-menu
	:visible
        '(or (eq jabber-display-menu t)
             (and (eq jabber-display-menu 'maybe)
                  (or (bound-and-true-p jabber-account-list)
                      (bound-and-true-p jabber-connections))))))
jabber-jid-chat-menu   variable
(defvar jabber-jid-chat-menu nil
  "Menu items for chat menu.")
jabber-jid-info-menu   variable
(defvar jabber-jid-info-menu nil
  "Menu item for info menu.")
jabber-jid-roster-menu   variable
(defvar jabber-jid-roster-menu nil
  "Menu items for roster menu.")
jabber-jid-muc-menu   variable
(defvar jabber-jid-muc-menu nil
  "Menu items for MUC menu.")
jabber-jid-service-menu   variable
(defvar jabber-jid-service-menu nil
  "Menu items for service menu.")
jabber-popup-menu   function
(defun jabber-popup-menu (which-menu)
  "Popup specified menu."
  (let* ((mouse-event (and (listp last-input-event) last-input-event))
	 (choice (widget-choose "Actions" which-menu mouse-event)))
    (if mouse-event
	(mouse-set-point mouse-event))
    (if choice
	(call-interactively choice))))
jabber-popup-chat-menu   command
(defun jabber-popup-chat-menu ()
  "Popup chat menu."
  (interactive)
  (jabber-popup-menu jabber-jid-chat-menu))
jabber-popup-info-menu   command
(defun jabber-popup-info-menu ()
  "Popup info menu."
  (interactive)
  (jabber-popup-menu jabber-jid-info-menu))
jabber-popup-roster-menu   command
(defun jabber-popup-roster-menu ()
  "Popup roster menu."
  (interactive)
  (jabber-popup-menu jabber-jid-roster-menu))
jabber-popup-muc-menu   command
(defun jabber-popup-muc-menu ()
  "Popup MUC menu."
  (interactive)
  (jabber-popup-menu jabber-jid-muc-menu))
jabber-popup-service-menu   command
(defun jabber-popup-service-menu ()
  "Popup service menu."
  (interactive)
  (jabber-popup-menu jabber-jid-service-menu))
jabber-popup-combined-menu   command
(defun jabber-popup-combined-menu ()
  "Popup combined menu."
  (interactive)
  (jabber-popup-menu (append jabber-jid-chat-menu jabber-jid-info-menu jabber-jid-roster-menu jabber-jid-muc-menu)))

Network transport functions

A collection of functions, that hide the details of transmitting to and fro a Jabber Server. Mostly inspired by Gnus.

;; Emacs 24 can be linked with GnuTLS
(ignore-errors (require 'gnutls))

;; Try two different TLS/SSL libraries, but don't fail if none available.
(or (ignore-errors (require 'tls))
    (ignore-errors (require 'ssl)))

(ignore-errors (require 'starttls))

(eval-and-compile
  (or (ignore-errors (require 'srv))
      (ignore-errors
        (let ((load-path (cons (expand-file-name
                                "jabber-fallback-lib"
                                (file-name-directory (locate-library "jabber")))
                               load-path)))
          (require 'srv)))
      (error
       "The srv library was not found in `load-path' or jabber-fallback-lib/ directory")))
jabber-conn   custom group
(defgroup jabber-conn nil "Jabber Connection Settings."
  :group 'jabber)
jabber-have-starttls   function
(defun jabber-have-starttls ()
  "Return non-nil if we can use STARTTLS."
  (or (and (fboundp 'gnutls-available-p)
	   (gnutls-available-p))
      (and (featurep 'starttls)
	   (or (and (bound-and-true-p starttls-gnutls-program)
		    (executable-find starttls-gnutls-program))
	       (and (bound-and-true-p starttls-program)
		    (executable-find starttls-program))))))
jabber-default-connection-type   constant
(defconst jabber-default-connection-type
  (cond
   ;; Use STARTTLS if we can...
   ((jabber-have-starttls)
    'starttls)
   ;; ...else default to unencrypted connection.
   (t
    'network))
  "Default connection type.
See `jabber-connect-methods'.")
jabber-connection-ssl-program   custom variable
(defcustom jabber-connection-ssl-program nil
  "Program used for SSL/TLS connections.
nil means prefer gnutls but fall back to openssl.
'gnutls' means use gnutls (through `open-tls-stream').
'openssl means use openssl (through `open-ssl-stream')."
  :type '(choice (const :tag "Prefer gnutls, fall back to openssl" nil)
		 (const :tag "Use gnutls" gnutls)
		 (const :tag "Use openssl" openssl))
  :group 'jabber-conn)
jabber-invalid-certificate-servers   custom variable
(defcustom jabber-invalid-certificate-servers ()
  "Jabber servers for which we accept invalid TLS certificates.
This is a list of server names, each matching the hostname part
of your JID.

This option has effect only when using native GnuTLS in Emacs 24
or later."
  :type '(repeat string)
  :group 'jabber-conn)
jabber-connect-methods   variable
(defvar jabber-connect-methods
  `((network jabber-network-connect jabber-network-send)
    (starttls
     ,(if (and (fboundp 'gnutls-available-p)
	       (gnutls-available-p))
	  ;; With "native" TLS, we can use a normal connection.
	  'jabber-network-connect
	'jabber-starttls-connect)
     jabber-network-send)
    (ssl jabber-ssl-connect jabber-ssl-send)
    (virtual jabber-virtual-connect jabber-virtual-send))
  "Alist of connection methods and functions.
First item is the symbol naming the method.
Second item is the connect function.
Third item is the send function.")
jabber-get-connect-function   function
(defun jabber-get-connect-function (type)
  "Get the connect function associated with TYPE.
TYPE is a symbol; see `jabber-connection-type'."
  (let ((entry (assq type jabber-connect-methods)))
    (nth 1 entry)))
jabber-get-send-function   function
(defun jabber-get-send-function (type)
  "Get the send function associated with TYPE.
TYPE is a symbol; see `jabber-connection-type'."
  (let ((entry (assq type jabber-connect-methods)))
    (nth 2 entry)))
jabber-srv-targets   function
(defun jabber-srv-targets (server network-server port)
  "Find host and port to connect to.
If NETWORK-SERVER and/or PORT are specified, use them.
If we can't find SRV records, use standard defaults."
  ;; If the user has specified a host or a port, obey that.
  (if (or network-server port)
      (list (cons (or network-server server)
		  (or port 5222)))
    (or (condition-case nil
	    (srv-lookup (concat "_xmpp-client._tcp." server))
	  (error nil))
	(list (cons server 5222)))))
jabber-network-connect   function
;; Plain TCP/IP connection
(defun jabber-network-connect (fsm server network-server port)
  "Connect to a Jabber server with a plain network connection.
Send a message of the form (:connected CONNECTION) to FSM if
connection succeeds.  Send a message (:connection-failed ERRORS) if
connection fails."
  (cond
   ((featurep 'make-network-process '(:nowait t))
    ;; We can connect asynchronously!
    (jabber-network-connect-async fsm server network-server port))
   (t
    ;; Connecting to the server will block Emacs.
    (jabber-network-connect-sync fsm server network-server port))))
jabber-network-connect-async   function
(defun jabber-network-connect-async (fsm server network-server port)
  ;; Get all potential targets...
  (let ((targets (jabber-srv-targets server network-server port))
		errors
		(fsm fsm))
    ;; ...and connect to them one after another, asynchronously, until
    ;; connection succeeds.
    (cl-labels
	((connect
	  (target remaining-targets)
	  (let ((target target) (remaining-targets remaining-targets))
	    (cl-labels ((connection-successful
		      (c)
		      ;; This mustn't be `fsm-send-sync', because the FSM
		      ;; needs to change the sentinel, which cannot be done
		      ;; from inside the sentinel.
		      (fsm-send fsm (list :connected c)))
		     (connection-failed
		      (c status)
		      (when (and (> (length status) 0)
				 (eq (aref status (1- (length status))) ?\n))
			(setq status (substring status 0 -1)))
		      (let ((err
			     (format "Couldn't connect to %s:%s: %s"
				     (car target) (cdr target) status)))
			(message "%s" err)
			(push err errors))
		      (when c (delete-process c))
		      (if remaining-targets
			  (progn
			    (message
			     "Connecting to %s:%s..."
			     (caar remaining-targets) (cdar remaining-targets))
			    (connect (car remaining-targets) (cdr remaining-targets)))
			(fsm-send fsm (list :connection-failed (nreverse errors))))))
	      (condition-case e
		  (make-network-process
		   :name "jabber"
		   :buffer (generate-new-buffer jabber-process-buffer)
		   :host (car target) :service (cdr target)
		   :coding 'utf-8
		   :nowait t
		   :sentinel
		   (let ((target target) (remaining-targets remaining-targets))
		     (lambda (connection status)
		       (cond
			((string-match "^open" status)
			 (connection-successful connection))
			((string-match "^failed" status)
			 (connection-failed connection status))
			((string-match "^deleted" status)
			 ;; This happens when we delete a process in the
			 ;; "failed" case above.
			 nil)
			(t
			 (message "Unknown sentinel status `%s'" status))))))
		(file-error
		 ;; A file-error has the error message in the third list
		 ;; element.
		 (connection-failed nil (car (cddr e))))
		(error
		 ;; Not sure if we ever get anything but file-errors,
		 ;; but let's make sure we report them:
		 (connection-failed nil (error-message-string e))))))))
      (message "Connecting to %s:%s..." (caar targets) (cdar targets))
      (connect (car targets) (cdr targets)))))
jabber-network-connect-sync   function
(defun jabber-network-connect-sync (fsm server network-server port)
  ;; This code will AFAIK only be used on Windows.  Apologies in
  ;; advance for any bit rot...
  (let ((coding-system-for-read 'utf-8)
	(coding-system-for-write 'utf-8)
	(targets (jabber-srv-targets server network-server port))
	errors)
    (catch 'connected
      (dolist (target targets)
	(condition-case e
	    (let ((process-buffer (generate-new-buffer jabber-process-buffer))
		  connection)
	      (unwind-protect
		  (setq connection (open-network-stream
				    "jabber"
				    process-buffer
				    (car target)
				    (cdr target)))

		(unless (or connection jabber-debug-keep-process-buffers)
		  (kill-buffer process-buffer)))

	      (when connection
		(fsm-send fsm (list :connected connection))
		(throw 'connected connection)))
	  (file-error
	   ;; A file-error has the error message in the third list
	   ;; element.
	   (let ((err (format "Couldn't connect to %s:%s: %s"
			      (car target) (cdr target)
			      (car (cddr e)))))
	     (message "%s" err)
	     (push err errors)))
	  (error
	   ;; Not sure if we ever get anything but file-errors,
	   ;; but let's make sure we report them:
	   (let ((err (format "Couldn't connect to %s:%s: %s"
			      (car target) (cdr target)
			      (error-message-string e))))
	     (message "%s" err)
	     (push err errors)))))
      (fsm-send fsm (list :connection-failed (nreverse errors))))))
jabber-network-send   function
(defun jabber-network-send (connection string)
  "Send a string via a plain TCP/IP connection to the Jabber Server."
  (process-send-string connection string))
jabber-ssl-connect   function
;; SSL connection, we use openssl's s_client function for encryption
;; of the link
;; TODO: make this configurable
(defun jabber-ssl-connect (fsm server network-server port)
  "Connect via OpenSSL or GnuTLS to a Jabber Server.
Send a message of the form (:connected CONNECTION) to FSM if
connection succeeds.  Send a message (:connection-failed ERRORS) if
connection fails."
  (let ((coding-system-for-read 'utf-8)
	(coding-system-for-write 'utf-8)
	(connect-function
	 (cond
	  ((and (memq jabber-connection-ssl-program '(nil gnutls))
		(fboundp 'open-tls-stream))
	   'open-tls-stream)
	  ((and (memq jabber-connection-ssl-program '(nil openssl))
		(fboundp 'open-ssl-stream))
	   'open-ssl-stream)
	  (t
	   (error "Neither TLS nor SSL connect functions available"))))
	error-msg)
    (let ((process-buffer (generate-new-buffer jabber-process-buffer))
	  connection)
      (setq network-server (or network-server server))
      (setq port (or port 5223))
      (condition-case e
	  (setq connection (funcall connect-function
				    "jabber"
				    process-buffer
				    network-server
				    port))
	(error
	 (setq error-msg
	       (format "Couldn't connect to %s:%d: %s" network-server port
		       (error-message-string e)))
	 (message "%s" error-msg)))
      (unless (or connection jabber-debug-keep-process-buffers)
	(kill-buffer process-buffer))
      (if connection
	  (fsm-send fsm (list :connected connection))
	(fsm-send fsm (list :connection-failed
			    (when error-msg (list error-msg))))))))
jabber-ssl-send   function
(defun jabber-ssl-send (connection string)
  "Send a string via an SSL-encrypted connection to the Jabber Server."
  ;; It seems we need to send a linefeed afterwards.
  (process-send-string connection string)
  (process-send-string connection "\n"))
jabber-starttls-connect   function
(defun jabber-starttls-connect (fsm server network-server port)
  "Connect via an external GnuTLS process to a Jabber Server.
Send a message of the form (:connected CONNECTION) to FSM if
connection succeeds.  Send a message (:connection-failed ERRORS) if
connection fails."
  (let ((coding-system-for-read 'utf-8)
	(coding-system-for-write 'utf-8)
	(targets (jabber-srv-targets server network-server port))
	errors)
    (unless (fboundp 'starttls-open-stream)
      (error "The starttls.el library is not available"))
    (catch 'connected
      (dolist (target targets)
	(condition-case e
	    (let ((process-buffer (generate-new-buffer jabber-process-buffer))
		  connection)
	      (unwind-protect
		  (setq connection
			(starttls-open-stream
			 "jabber"
			 process-buffer
			 (car target)
			 (cdr target)))
		(unless (or connection jabber-debug-keep-process-buffers)
		  (kill-buffer process-buffer)))
	      (if (null connection)
		  ;; It seems we don't actually get an error if we
		  ;; can't connect.  Let's try to convey some useful
		  ;; information to the user at least.
		  (let ((err (format "Couldn't connect to %s:%s"
				     (car target) (cdr target))))
		    (message "%s" err)
		    (push err errors))
		(fsm-send fsm (list :connected connection))
		(throw 'connected connection)))
	  (error
	   (let ((err (format "Couldn't connect to %s: %s" target
			      (error-message-string e))))
	     (message "%s" err)
	     (push err errors)))))
	(fsm-send fsm (list :connection-failed (nreverse errors))))))
jabber-starttls-initiate   function
(defun jabber-starttls-initiate (fsm)
  "Initiate a starttls connection."
  (jabber-send-sexp fsm
   '(starttls ((xmlns . "urn:ietf:params:xml:ns:xmpp-tls")))))
jabber-starttls-process-input   function
(defun jabber-starttls-process-input (fsm xml-data)
  "Process result of starttls request.
On failure, signal error.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (cond
   ((eq (car xml-data) 'proceed)
    (let* ((state-data (fsm-get-state-data fsm))
	   (connection (plist-get state-data :connection)))
      ;; Did we use open-network-stream or starttls-open-stream?  We
      ;; can tell by process-type.
      (cl-case (process-type connection)
	(network
	 (let* ((hostname (plist-get state-data :server))
		(verifyp (not (member hostname jabber-invalid-certificate-servers))))
	   ;; gnutls-negotiate might signal an error, which is caught
	   ;; by our caller
	   (gnutls-negotiate
	    :process connection
	    ;; This is the hostname that the certificate should be valid for:
	    :hostname hostname
	    :verify-hostname-error verifyp
	    :verify-error verifyp)))
	(real
	 (or
	  (starttls-negotiate connection)
	  (error "Negotiation failure"))))))
   ((eq (car xml-data) 'failure)
    (error "Command rejected by server"))))
jabber-virtual-server-function   variable
(defvar *jabber-virtual-server-function* nil
  "Function to use for sending stanzas on a virtual connection.
The function should accept two arguments, the connection object
and a string that the connection wants to send.")
jabber-virtual-connect   function
(defun jabber-virtual-connect (fsm server network-server port)
  "Connect to a virtual \"server\".
Use `*jabber-virtual-server-function*' as send function."
  (unless (functionp *jabber-virtual-server-function*)
    (error "No virtual server function specified"))
  ;; We pass the fsm itself as "connection object", as that is what a
  ;; virtual server needs to send stanzas.
  (fsm-send fsm (list :connected fsm)))
jabber-virtual-send   function
(defun jabber-virtual-send (connection string)
  (funcall *jabber-virtual-server-function* connection string))

SASL authentication

;;; This file uses sasl.el from FLIM or Gnus.  If it can't be found,
;;; jabber-core.el won't use the SASL functions.
(eval-and-compile
  (condition-case nil
      (require 'sasl)
    (error nil)))

;;; Alternatives to FLIM would be the command line utility of GNU SASL,
;;; or anything the Gnus people decide to use.

;;; See XMPP-CORE and XMPP-IM for details about the protocol.
jabber-sasl-start-auth   function
(defun jabber-sasl-start-auth (jc stream-features)
"Start the SASL authentication mechanism.
JC is The Jabber Connection.
STREAM-FEATURES the XML parsed \"stream features\" answer (it is used
with `jabber-xml-get-chidlren')."
  ;; Find a suitable common mechanism.
  (let* ((mechanism-elements (car (jabber-xml-get-children stream-features 'mechanisms)))
	 (mechanisms (mapcar
		      (lambda (tag)
			(car (jabber-xml-node-children tag)))
		      (jabber-xml-get-children mechanism-elements 'mechanism)))
	 (mechanism
	  (if (and (member "ANONYMOUS" mechanisms)
		   (or jabber-silent-mode (yes-or-no-p "Use anonymous authentication? ")))
	      (sasl-find-mechanism '("ANONYMOUS"))
	    (sasl-find-mechanism mechanisms))))

    ;; No suitable mechanism?
    (if (null mechanism)
	;; Maybe we can use legacy authentication
	(let ((iq-auth (cl-find "http://jabber.org/features/iq-auth"
			  (jabber-xml-get-children stream-features 'auth)
			  :key #'jabber-xml-get-xmlns
			  :test #'string=))
	      ;; Or maybe we have to use STARTTLS, but can't
	      (starttls (cl-find "urn:ietf:params:xml:ns:xmpp-tls"
			      (jabber-xml-get-children stream-features 'starttls)
			      :key #'jabber-xml-get-xmlns
			      :test #'string=)))
	  (cond
	   (iq-auth
	    (fsm-send jc :use-legacy-auth-instead))
	   (starttls
	    (message "STARTTLS encryption required, but disabled/non-functional at our end")
	    (fsm-send jc :authentication-failure))
	   (t
	    (message "Authentication failure: no suitable SASL mechanism found")
	    (fsm-send jc :authentication-failure))))

      ;; Watch for plaintext logins over unencrypted connections
      (if (and (not (plist-get (fsm-get-state-data jc) :encrypted))
	       (member (sasl-mechanism-name mechanism)
		       '("PLAIN" "LOGIN"))
	       (not (yes-or-no-p "Jabber server only allows cleartext password transmission!  Continue? ")))
	  (fsm-send jc :authentication-failure)

	;; Start authentication.
	(let* (passphrase
	       (client (sasl-make-client mechanism
					 (plist-get (fsm-get-state-data jc) :username)
					 "xmpp"
					 (plist-get (fsm-get-state-data jc) :server)))
	       (sasl-read-passphrase (jabber-sasl-read-passphrase-closure
				      jc
				      (lambda (p) (setq passphrase (copy-sequence p)) p)))
	       (step (sasl-next-step client nil)))
	  (jabber-send-sexp
	   jc
	   `(auth ((xmlns . "urn:ietf:params:xml:ns:xmpp-sasl")
		   (mechanism . ,(sasl-mechanism-name mechanism)))
		  ,(when (sasl-step-data step)
		     (base64-encode-string (sasl-step-data step) t))))
	  (list client step passphrase))))))
jabber-sasl-read-passphrase-closure   function
(defun jabber-sasl-read-passphrase-closure (jc remember)
  "Return a lambda function suitable for `sasl-read-passphrase' for JC.
Call REMEMBER with the password.  REMEMBER is expected to return it as well."
  (let ((password (plist-get (fsm-get-state-data jc) :password))
		(bare-jid (jabber-connection-bare-jid jc))
		(remember remember))
    (if password
	(lambda (prompt) (funcall remember (copy-sequence password)))
      (lambda (prompt) (funcall remember (jabber-read-password bare-jid))))))
jabber-sasl-process-input   function
(defun jabber-sasl-process-input (jc xml-data sasl-data)
"SASL protocol input processing.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let* ((client (cl-first sasl-data))
	 (step (cl-second sasl-data))
	 (passphrase (cl-third sasl-data))
	 (sasl-read-passphrase (jabber-sasl-read-passphrase-closure
				jc
				(lambda (p) (setq passphrase (copy-sequence p)) p))))
    (cond
     ((eq (car xml-data) 'challenge)
      (sasl-step-set-data step (base64-decode-string (car (jabber-xml-node-children xml-data))))
      (setq step (sasl-next-step client step))
      (jabber-send-sexp
       jc
       `(response ((xmlns . "urn:ietf:params:xml:ns:xmpp-sasl"))
		  ,(when (sasl-step-data step)
		     (base64-encode-string (sasl-step-data step) t)))))

     ((eq (car xml-data) 'failure)
      (message "%s: authentication failure: %s"
	       (jabber-connection-bare-jid jc)
	       (jabber-xml-node-name (car (jabber-xml-node-children xml-data))))
      (fsm-send jc :authentication-failure))

     ((eq (car xml-data) 'success)
      ;; The server might, depending on the mechanism, send
      ;; "additional data" (see RFC 4422) with the <success/> element.
      ;; Since some SASL mechanisms perform mutual authentication, we
      ;; need to pass this data to sasl.el - we're not necessarily
      ;; done just because the server says we're done.
      (let* ((data (car (jabber-xml-node-children xml-data)))
	     (decoded (if data
			  (base64-decode-string data)
			"")))
	(sasl-step-set-data step decoded)
	(condition-case e
	    (progn
	      ;; Check that sasl-next-step doesn't signal an error.
	      ;; TODO: once sasl.el allows it, check that all steps have
	      ;; been completed.
	      (sasl-next-step client step)
	      (message "Authentication succeeded for %s" (jabber-connection-bare-jid jc))
	      (fsm-send jc (cons :authentication-success passphrase)))
	  (sasl-error
	   (message "%s: authentication failure: %s"
		    (jabber-connection-bare-jid jc)
		    (error-message-string e))
	   (fsm-send jc :authentication-failure))))))
    (list client step passphrase)))

common keymap for many modes

;; button.el was introduced in Emacs 22
(condition-case e
    (require 'button)
  (error nil))
jabber-common-keymap   variable
(defvar jabber-common-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'jabber-popup-chat-menu)
    (define-key map "\C-c\C-r" 'jabber-popup-roster-menu)
    (define-key map "\C-c\C-i" 'jabber-popup-info-menu)
    (define-key map "\C-c\C-m" 'jabber-popup-muc-menu)
    (define-key map "\C-c\C-s" 'jabber-popup-service-menu)
    ;; note that {forward,backward}-button are not autoloaded.
    ;; thus the `require' above.
    (when (fboundp 'forward-button)
      (define-key map [?\t] 'forward-button)
      (define-key map [backtab] 'backward-button))
    map))
jabber-global-keymap   variable
;;;###autoload
(defvar jabber-global-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c" 'jabber-connect-all)
    (define-key map "\C-d" 'jabber-disconnect)
    (define-key map "\C-r" 'jabber-switch-to-roster-buffer)
    (define-key map "\C-j" 'jabber-chat-with)
    (define-key map "\C-l" 'jabber-activity-switch-to)
    (define-key map "\C-a" 'jabber-send-away-presence)
    (define-key map "\C-o" 'jabber-send-default-presence)
    (define-key map "\C-x" 'jabber-send-xa-presence)
    (define-key map "\C-p" 'jabber-send-presence)
    map)
  "Global Jabber keymap (usually under C-x C-j).")
;;;###autoload
(define-key ctl-x-map "\C-j" jabber-global-keymap)

XML Console mode

(require 'ewoc)
(require 'sgml-mode) ;we base on this mode to hightlight XML
jabber-console-name-format   custom variable
(defcustom jabber-console-name-format "*-jabber-console-%s-*"
  "Format for console buffer name.  %s mean connection jid."
  :type 'string
  :group 'jabber-debug)
jabber-console-truncate-lines   custom variable
(defcustom jabber-console-truncate-lines 3000
  "Maximum number of lines in console buffer.
Not truncate if set to 0."
  :type 'integer
  :group 'jabber-debug)
jabber-point-insert   variable
(defvar jabber-point-insert nil
  "Position where the message being composed starts.")
jabber-send-function   variable
(defvar jabber-send-function nil
  "Function for sending a message from a chat buffer.")
jabber-console-mode-hook   variable
(defvar jabber-console-mode-hook nil
  "Hook called at the end of `jabber-console-mode'.
Note that functions in this hook have no way of knowing
what kind of chat buffer is being created.")
jabber-console-ewoc   variable
(defvar jabber-console-ewoc nil
  "The ewoc showing the XML elements of this stream buffer.")
jabber-console-mode-map   variable
(defvar jabber-console-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map jabber-common-keymap)
    (define-key map "\r" 'jabber-chat-buffer-send)
    map))
jabber-console-create-buffer   function
(defun jabber-console-create-buffer (jc)
  (with-current-buffer
	  (get-buffer-create (format jabber-console-name-format (jabber-connection-bare-jid jc)))
    (unless (eq major-mode 'jabber-console-mode)
      (jabber-console-mode))
    ;; Make sure the connection variable is up to date.
    (setq jabber-buffer-connection jc)
    (current-buffer)))
jabber-console-send   function
(defun jabber-console-send (jc data)
  ;; Put manual string into buffers ewoc
  (jabber-process-console jc "raw" data)
  ;; ...than sent it to server
  (jabber-send-string jc data))
jabber-console-comment   function
(defun jabber-console-comment (str)
  "Insert comment into console buffer."
  (let ((string (concat
                 comment-start str "@" (jabber-encode-time (current-time)) ":"
                 comment-end "\n")))
    (when (stringp jabber-debug-log-xml)
      (jabber-append-string-to-file string jabber-debug-log-xml))
    (insert string)))
jabber-console-pp   function
(defun jabber-console-pp (data)
  "Pretty Printer for XML-sexp and raw data."
  (let ((direction (car data))
        (xml-list (cdr data))
        (raw (cadr data)))
    (jabber-console-comment direction)
    (if (stringp raw)
        ;; raw code input
        (progn
          (insert raw)
          (when (stringp jabber-debug-log-xml)
            (jabber-append-string-to-file raw jabber-debug-log-xml)))
      ;; receive/sending
      (progn
        (xml-print xml-list)
        (when (stringp jabber-debug-log-xml)
          (jabber-append-string-to-file
           "\n" jabber-debug-log-xml 'xml-print xml-list))))))
jabber-console-mode   major mode
(define-derived-mode jabber-console-mode sgml-mode "Jabber Console"
  "Major mode for debug XMPP protocol."
  ;; Make sure to set this variable somewhere
  (make-local-variable 'jabber-send-function)
  (make-local-variable 'jabber-point-insert)
  (make-local-variable 'jabber-console-ewoc)

  (setq jabber-send-function 'jabber-console-send)

  (unless jabber-console-ewoc
    (setq jabber-console-ewoc
	  (ewoc-create #'jabber-console-pp nil "<!-- + -->"))
    (goto-char (point-max))
    (put-text-property (point-min) (point) 'read-only t)
    (let ((inhibit-read-only t))
      (put-text-property (point-min) (point) 'front-sticky t)
      (put-text-property (point-min) (point) 'rear-nonsticky t))
    (setq jabber-point-insert (point-marker))))
(put 'jabber-console-mode 'mode-class 'special)
jabber-console-sanitize   function
(defun jabber-console-sanitize (xml-data)
  "Sanitize XML-DATA for `jabber-process-console'."
  (if (listp xml-data)
      (jabber-tree-map (lambda (x) (if (numberp x) (format "%s" x) x)) xml-data)
    xml-data))
jabber-process-console   function
;;;###autoload
(defun jabber-process-console (jc direction xml-data)
  "Log XML-DATA i/o as XML in \"*-jabber-console-JID-*\" buffer."
  (let ((buffer (get-buffer-create (jabber-console-create-buffer jc))))
    (with-current-buffer buffer
      (progn
        (ewoc-enter-last jabber-console-ewoc (list direction (jabber-console-sanitize xml-data)))
		(when (< 1  jabber-console-truncate-lines)
		  (let ((jabber-log-lines-to-keep jabber-console-truncate-lines))
			(jabber-truncate-top buffer jabber-console-ewoc)))))))

core

Standards (probably) involved -

  1. [RFC 6120] Extensible Messaging and Presence Protocol (XMPP): Core

  2. [RFC 7950] Use of Transport Layer Security (TLS) in the Extensible Messaging and Presence Protocol (XMPP)

  3. [RFC 6121] Extensible Messaging and Presence Protocol (XMPP): Instant Messaging and Presence

  4. [RFC 7622] Extensible Messaging and Presence Protocol (XMPP): Address Format

(eval-and-compile
  (or (ignore-errors (require 'fsm))
      (ignore-errors
        (let ((load-path (cons (expand-file-name
                                "jabber-fallback-lib"
                                (file-name-directory (locate-library "jabber")))
                               load-path)))
          (require 'fsm)))
      (error
       "The fsm library was not found in `load-path' or jabber-fallback-lib/ directory")))
jabber-connections   variable
(defvar jabber-connections nil
  "List of jabber-connection FSMs.")
jabber-roster   variable
(defvar *jabber-roster* nil
  "The roster list.")
jabber-jid-obarray   variable
(defvar jabber-jid-obarray (make-vector 127 0)
  "Obarray for keeping JIDs.")
jabber-disconnecting   variable
(defvar *jabber-disconnecting* nil
  "Boolean - are we in the process of disconnecting by free will.")
jabber-message-chain   variable
(defvar jabber-message-chain nil
  "Incoming messages are sent to these functions, in order.")
jabber-iq-chain   variable
(defvar jabber-iq-chain nil
  "Incoming infoqueries are sent to these functions, in order.")
jabber-presence-chain   variable
(defvar jabber-presence-chain nil
  "Incoming presence notifications are sent to these functions, in order.")
jabber-namespace-prefixes   variable
(defvar jabber-namespace-prefixes nil
  "XML namespace prefixes used for the current connection.")
(make-variable-buffer-local 'jabber-namespace-prefixes)
jabber-core   custom group
(defgroup jabber-core nil "customize core functionality."
  :group 'jabber)
jabber-post-connect-hooks   custom variable
(defcustom jabber-post-connect-hooks '(jabber-send-current-presence
				       jabber-muc-autojoin
				       jabber-whitespace-ping-start
				       jabber-vcard-avatars-find-current)
  "*Hooks run after successful connection and authentication.
The functions should accept one argument, the connection object."
  :type 'hook
  :options '(jabber-send-current-presence
	     jabber-muc-autojoin
	     jabber-whitespace-ping-start
	     jabber-keepalive-start
	     jabber-vcard-avatars-find-current
	     jabber-autoaway-start)
  :group 'jabber-core)
jabber-pre-disconnect-hook   custom variable
(defcustom jabber-pre-disconnect-hook nil
  "*Hooks run just before voluntary disconnection.
This might be due to failed authentication."
  :type 'hook
  :group 'jabber-core)
jabber-lost-connection-hooks   custom variable
(defcustom jabber-lost-connection-hooks nil
  "*Hooks run after involuntary disconnection.
The functions are called with one argument: the connection object."
  :type 'hook
  :group 'jabber-core)
jabber-post-disconnect-hook   custom variable
(defcustom jabber-post-disconnect-hook nil
  "*Hooks run after disconnection."
  :type 'hook
  :group 'jabber-core)
jabber-auto-reconnect   custom variable
(defcustom jabber-auto-reconnect nil
  "Reconnect automatically after losing connection?
This will be of limited use unless you have the password library
installed, and have configured it to cache your password
indefinitely.  See `password-cache' and `password-cache-expiry'."
  :type 'boolean
  :group 'jabber-core)
jabber-reconnect-delay   custom variable
(defcustom jabber-reconnect-delay 5
  "Seconds to wait before reconnecting."
  :type 'integer
  :group 'jabber-core)
jabber-roster-buffer   custom variable
(defcustom jabber-roster-buffer "*-jabber-roster-*"
  "The name of the roster buffer."
  :type 'string
  :group 'jabber-core)
jabber-process-buffer   variable
(defvar jabber-process-buffer " *-jabber-process-*"
  "The name of the process buffer.")
jabber-use-sasl   custom variable
(defcustom jabber-use-sasl t
  "If non-nil, use SASL if possible.
SASL will still not be used if the library for it is missing or
if the server doesn't support it.

Disabling this shouldn't be necessary, but it may solve certain
problems."
  :type 'boolean
  :group 'jabber-core)
jabber-have-sasl-p   inline function
(defsubst jabber-have-sasl-p ()
  "Return non-nil if SASL functions are available."
  (featurep 'sasl))
jabber-account-history   variable
(defvar jabber-account-history ()
  "Keeps track of previously used jabber accounts.")
jabber-connection-type-history   variable
(defvar jabber-connection-type-history ()
  "Keeps track of previously used connection types.")
jabber-connect-all   command
;;;###autoload (autoload 'jabber-connect-all "jabber" "Connect to all configured Jabber accounts.\nSee `jabber-account-list'.\nIf no accounts are configured (or ARG supplied), call `jabber-connect' interactively." t)
(defun jabber-connect-all (&optional arg)
  "Connect to all configured Jabber accounts.
See `jabber-account-list'.
If no accounts are configured (or with prefix argument), call `jabber-connect'
interactively.
With many prefix arguments, one less is passed to `jabber-connect'."
  (interactive "P")
  (let ((accounts
	 (cl-remove-if (lambda (account)
		      (cdr (assq :disabled (cdr account))))
		    jabber-account-list)))
    (if (or (null accounts) arg)
	(let ((current-prefix-arg
	       (cond
		;; A number of C-u's; remove one, so to speak.
		((consp arg)
		 (if (> (car arg) 4)
		     (list (/ (car arg) 4))
		   nil))
		;; Otherwise, we just don't care.
		(t
		 arg))))
	  (call-interactively 'jabber-connect))
      ;; Only connect those accounts that are not yet connected.
      (let ((already-connected (mapcar #'jabber-connection-original-jid jabber-connections))
	    (connected-one nil))
	(dolist (account accounts)
	  (unless (member (jabber-jid-user (car account)) already-connected)
	    (let* ((jid (car account))
		   (alist (cdr account))
		   (password (cdr (assq :password alist)))
		   (network-server (cdr (assq :network-server alist)))
		   (port (cdr (assq :port alist)))
		   (connection-type (cdr (assq :connection-type alist))))
	      (jabber-connect
	       (jabber-jid-username jid)
	       (jabber-jid-server jid)
	       (jabber-jid-resource jid)
	       nil password network-server
	       port connection-type)
	      (setq connected-one t))))
	(unless connected-one
	  (message "All configured Jabber accounts are already connected"))))))
jabber-connect   command
;;;###autoload (autoload 'jabber-connect "jabber" "Connect to the Jabber server and start a Jabber XML stream.\nWith prefix argument, register a new account.\nWith double prefix argument, specify more connection details." t)
(defun jabber-connect (username server resource &optional
				registerp password network-server
				port connection-type)
  "Connect to the Jabber server and start a Jabber XML stream.
With prefix argument, register a new account.
With double prefix argument, specify more connection details."
  (interactive
   (let* ((jid (completing-read "Enter your JID: " jabber-account-list nil nil nil 'jabber-account-history))
	  (entry (assoc jid jabber-account-list))
	  (alist (cdr entry))
	  password network-server port connection-type registerp)
     (when (zerop (length jid))
       (error "No JID specified"))
     (unless (jabber-jid-username jid)
       (error "Missing username part in JID"))
     (when entry
       ;; If the user entered the JID of one of the preconfigured
       ;; accounts, use that data.
       (setq password (cdr (assq :password alist)))
       (setq network-server (cdr (assq :network-server alist)))
       (setq port (cdr (assq :port alist)))
       (setq connection-type (cdr (assq :connection-type alist))))
     (when (equal current-prefix-arg '(16))
       ;; Double prefix arg: ask about everything.
       ;; (except password, which is asked about later anyway)
       (setq password nil)
       (setq network-server
	     (read-string (format "Network server: (default `%s') " network-server)
			  nil nil network-server))
       (when (zerop (length network-server))
	 (setq network-server nil))
       (setq port
	     (car
	      (read-from-string
	       (read-string (format "Port: (default `%s') " port)
			    nil nil (if port (number-to-string port) "nil")))))
       (setq connection-type
	     (car
	      (read-from-string
	       (let ((default (symbol-name (or connection-type jabber-default-connection-type))))
		 (completing-read
		  (format "Connection type: (default `%s') " default)
		  (mapcar (lambda (type)
			    (cons (symbol-name (car type)) nil))
			  jabber-connect-methods)
		  nil t nil 'jabber-connection-type-history default)))))
       (setq registerp (or jabber-silent-mode (yes-or-no-p "Register new account? "))))
     (when (equal current-prefix-arg '(4))
       (setq registerp t))

     (list (jabber-jid-username jid)
	   (jabber-jid-server jid)
	   (jabber-jid-resource jid)
	   registerp password network-server port connection-type)))

  (if (member (list username
		    server)
	      (mapcar
	       (lambda (c)
		 (let ((data (fsm-get-state-data c)))
		   (list (plist-get data :username)
			 (plist-get data :server))))
	       jabber-connections))
      (message "Already connected to %s@%s"
	       username server)
    ;;(jabber-clear-roster)

    (push (start-jabber-connection username server resource
				   registerp password
				   network-server port connection-type)
	  jabber-connections)))
jabber-connection   fsm
(define-state-machine jabber-connection
  :start ((username server resource registerp password network-server port connection-type)
	  "Start a Jabber connection."
	  (let* ((connection-type
		  (or connection-type jabber-default-connection-type))
		 (send-function
		  (jabber-get-send-function connection-type)))

	    (list :connecting
		  (list :send-function send-function
			;; Save the JID we originally connected with.
			:original-jid (concat username "@" server)
			:username username
			:server server
			:resource resource
			:password password
			:registerp registerp
			:connection-type connection-type
			:encrypted (eq connection-type 'ssl)
			:network-server network-server
			:port port)))))
(define-enter-state jabber-connection nil
  (fsm state-data)
  ;; `nil' is the error state.

  ;; Close the network connection.
  (let ((connection (plist-get state-data :connection)))
    (when (processp connection)
      (let ((process-buffer (process-buffer connection)))
	(delete-process connection)
	(when (and (bufferp process-buffer)
		   (not jabber-debug-keep-process-buffers))
	  (kill-buffer process-buffer)))))
  (setq state-data (plist-put state-data :connection nil))
  ;; Clear MUC data
  (jabber-muc-connection-closed (jabber-connection-bare-jid fsm))
  ;; Remove lost connections from the roster buffer.
  (jabber-display-roster)
  (let ((expected (plist-get state-data :disconnection-expected))
	(reason (plist-get state-data :disconnection-reason))
	(ever-session-established (plist-get state-data :ever-session-established)))
    (unless expected
      (run-hook-with-args 'jabber-lost-connection-hooks fsm)
      (message "%s@%s%s: connection lost: `%s'"
	       (plist-get state-data :username)
	       (plist-get state-data :server)
	       (if (plist-get state-data :resource)
		   (concat "/" (plist-get state-data :resource))
		 "")
	       reason))

    (if (and jabber-auto-reconnect (not expected) ever-session-established)
	;; Reconnect after a short delay?
	(list state-data jabber-reconnect-delay)
      ;; Else the connection is really dead.  Remove it from the list
      ;; of connections.
      (setq jabber-connections
	    (delq fsm jabber-connections))
      (when jabber-mode-line-mode
        (jabber-mode-line-presence-update))
      (jabber-display-roster)
      ;; And let the FSM sleep...
      (list state-data nil))))
(define-state jabber-connection nil
  (fsm state-data event callback)
  ;; In the `nil' state, the connection is dead.  We wait for a
  ;; :timeout message, meaning to reconnect, or :do-disconnect,
  ;; meaning to cancel reconnection.
  (cl-case event
    (:timeout
     (list :connecting state-data))
    (:do-disconnect
     (setq jabber-connections
	    (delq fsm jabber-connections))
     (list nil state-data nil))))
(define-enter-state jabber-connection :connecting
  (fsm state-data)
  (let* ((connection-type (plist-get state-data :connection-type))
	 (connect-function (jabber-get-connect-function connection-type))
	 (server (plist-get state-data :server))
	 (network-server (plist-get state-data :network-server))
	 (port (plist-get state-data :port)))
    (funcall connect-function fsm server network-server port))
  (list state-data nil))
(define-state jabber-connection :connecting
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:connected
     (let ((connection (cadr event))
	   (registerp (plist-get state-data :registerp)))

       (setq state-data (plist-put state-data :connection connection))

       (when (processp connection)
	 ;; TLS connections leave data in the process buffer, which
	 ;; the XML parser will choke on.
	 (with-current-buffer (process-buffer connection)
	   (erase-buffer))

	 (set-process-filter connection (fsm-make-filter fsm))
	 (set-process-sentinel connection (fsm-make-sentinel fsm)))

       (list :connected state-data)))

    (:connection-failed
     (message "Jabber connection failed")
     (plist-put state-data :disconnection-reason
		(mapconcat #'identity (cadr event) "; "))
     (list nil state-data))

    (:do-disconnect
     ;; We don't have the connection object, so defer the disconnection.
     :defer)))
jabber-fsm-handle-sentinel   inline function
(defsubst jabber-fsm-handle-sentinel (state-data event)
  "Handle sentinel event for jabber fsm."
  ;; We do the same thing for every state, so avoid code duplication.
  (let* ((string (car (cddr event)))
	 ;; The event string sometimes (always?) has a trailing
	 ;; newline, that we don't care for.
	 (trimmed-string
	  (if (eq ?\n (aref string (1- (length string))))
	      (substring string 0 -1)
	    string))
	 (new-state-data
	  ;; If we already know the reason (e.g. a stream error), don't
	  ;; overwrite it.
	  (if (plist-get state-data :disconnection-reason)
	      state-data
	    (plist-put state-data :disconnection-reason trimmed-string))))
    (list nil new-state-data)))
(define-enter-state jabber-connection :connected
  (fsm state-data)

  (jabber-send-stream-header fsm)

  ;; Next thing happening is the server sending its own <stream:stream> start tag.

  (list state-data nil))
(define-state jabber-connection :connected
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :connected state-data)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stream-start
     (let ((session-id (cadr event))
	   (stream-version (car (cddr event))))
       (setq state-data
	     (plist-put state-data :session-id session-id))
       ;; the stream feature is only sent if the initiating entity has
       ;; sent 1.0 in the stream header. if sasl is not supported then
       ;; we don't send 1.0 in the header and therefore we shouldn't wait
       ;; even if 1.0 is present in the receiving stream.
       (cond
	;; Wait for stream features?
	((and stream-version
	      (>= (string-to-number stream-version) 1.0)
	      jabber-use-sasl
	      (jabber-have-sasl-p))
	 ;; Stay in same state...
	 (list :connected state-data))
	;; Register account?
	((plist-get state-data :registerp)
	 ;; XXX: require encryption for registration?
	 (list :register-account state-data))
	;; Legacy authentication?
	(t
	 (list :legacy-auth state-data)))))

    (:stanza
     (let ((stanza (cadr event)))
       (cond
	;; At this stage, we only expect a stream:features stanza.
	((not (eq (jabber-xml-node-name stanza) 'features))
	 (list nil (plist-put state-data
			      :disconnection-reason
			      (format "Unexpected stanza %s" stanza))))
	((and (jabber-xml-get-children stanza 'starttls)
	      (eq (plist-get state-data :connection-type) 'starttls))
	 (list :starttls state-data))
	;; XXX: require encryption for registration?
	((plist-get state-data :registerp)
	 ;; We could check for the <register/> element in stream
	 ;; features, but as a client we would only lose by doing
	 ;; that.
	 (list :register-account state-data))
	(t
	 (list :sasl-auth (plist-put state-data :stream-features stanza))))))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
(define-enter-state jabber-connection :starttls
  (fsm state-data)
  (jabber-starttls-initiate fsm)
  (list state-data nil))
(define-state jabber-connection :starttls
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :starttls state-data)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stanza
     (condition-case e
	 (progn
	   (jabber-starttls-process-input fsm (cadr event))
	   ;; Connection is encrypted.  Send a stream tag again.
	   (list :connected (plist-put state-data :encrypted t)))
       (error
	(let* ((msg (concat "STARTTLS negotiation failed: "
			    (error-message-string e)))
	       (new-state-data (plist-put state-data :disconnection-reason msg)))
	  (list nil new-state-data)))))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
(define-enter-state jabber-connection :register-account
  (fsm state-data)
  (jabber-get-register fsm nil)
  (list state-data nil))
(define-state jabber-connection :register-account
  (fsm state-data event callback)
  ;; The connection will be closed in jabber-register
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :register-account state-data)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stanza
     (or
      (jabber-process-stream-error (cadr event) state-data)
      (progn
	(jabber-process-input fsm (cadr event))
	(list :register-account state-data))))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
(define-enter-state jabber-connection :legacy-auth
  (fsm state-data)
  (jabber-get-auth fsm (plist-get state-data :server)
		   (plist-get state-data :session-id))
  (list state-data nil))
(define-state jabber-connection :legacy-auth
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :legacy-auth state-data)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stanza
     (or
      (jabber-process-stream-error (cadr event) state-data)
      (progn
	(jabber-process-input fsm (cadr event))
	(list :legacy-auth state-data))))

    (:authentication-success
     (jabber-cache-password (jabber-connection-bare-jid fsm) (cdr event))
     (list :session-established state-data))

    (:authentication-failure
     (jabber-uncache-password (jabber-connection-bare-jid fsm))
     ;; jabber-logon has already displayed a message
     (list nil (plist-put state-data
			  :disconnection-expected t)))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
(define-enter-state jabber-connection :sasl-auth
  (fsm state-data)
  (let ((new-state-data
	 (plist-put state-data
		    :sasl-data
		    (jabber-sasl-start-auth
		     fsm
		     (plist-get state-data
				:stream-features)))))
    (list new-state-data nil)))
(define-state jabber-connection :sasl-auth
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :sasl-auth state-data)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stanza
     (let ((new-sasl-data
	    (jabber-sasl-process-input
	     fsm (cadr event)
	     (plist-get state-data :sasl-data))))
       (list :sasl-auth (plist-put state-data :sasl-data new-sasl-data))))

    (:use-legacy-auth-instead
     (list :legacy-auth (plist-put state-data :sasl-data nil)))

    (:authentication-success
     (jabber-cache-password (jabber-connection-bare-jid fsm) (cdr event))
     (list :bind (plist-put state-data :sasl-data nil)))

    (:authentication-failure
     (jabber-uncache-password (jabber-connection-bare-jid fsm))
     ;; jabber-sasl has already displayed a message
     (list nil (plist-put state-data
			  :disconnection-expected t)))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
(define-enter-state jabber-connection :bind
  (fsm state-data)
  (jabber-send-stream-header fsm)
  (list state-data nil))
(define-state jabber-connection :bind
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :bind state-data)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stream-start
     ;; we wait for stream features...
     (list :bind state-data))

    (:stanza
     (let ((stanza (cadr event)))
       (cond
	((eq (jabber-xml-node-name stanza) 'features)
	 ;; Record stream features, discarding earlier data:
	 (setq state-data (plist-put state-data :stream-features stanza))
	 (if (jabber-xml-get-children stanza 'bind)
	     (let ((handle-bind
		    (lambda (jc xml-data success)
		      (fsm-send jc (list
				    (if success :bind-success :bind-failure)
				    xml-data))))
		   ;; So let's bind a resource.  We can either pick a resource ourselves,
		   ;; or have the server pick one for us.
		   (resource (plist-get state-data :resource)))
	       (jabber-send-iq fsm nil "set"
			       `(bind ((xmlns . "urn:ietf:params:xml:ns:xmpp-bind"))
				      ,@(when resource
					  `((resource () ,resource))))
			       handle-bind t
			       handle-bind nil)
	       (list :bind state-data))
	   (message "Server doesn't permit resource binding")
	   (list nil state-data)))
	(t
	 (or
	  (jabber-process-stream-error (cadr event) state-data)
	  (progn
	    (jabber-process-input fsm (cadr event))
	    (list :bind state-data)))))))

    (:bind-success
     (let ((jid (jabber-xml-path (cadr event) '(bind jid ""))))
       ;; Maybe this isn't the JID we asked for.
       (plist-put state-data :username (jabber-jid-username jid))
       (plist-put state-data :server (jabber-jid-server jid))
       (plist-put state-data :resource (jabber-jid-resource jid)))

     ;; If the server follows the older RFCs 3920 and 3921, it may
     ;; offer session initiation here.  If it follows RFCs 6120 and
     ;; 6121, it might not offer it, and we should just skip it.
     (if (jabber-xml-get-children (plist-get state-data :stream-features) 'session)
	 (let ((handle-session
		(lambda (jc xml-data success)
		  (fsm-send jc (list
				(if success :session-success :session-failure)
				xml-data)))))
	   (jabber-send-iq fsm nil "set"
			   '(session ((xmlns . "urn:ietf:params:xml:ns:xmpp-session")))
			   handle-session t
			   handle-session nil)
	   (list :bind state-data))
       ;; Session establishment not offered - assume not necessary.
       (list :session-established state-data)))

    (:session-success
     ;; We have a session
     (list :session-established state-data))

    (:bind-failure
     (message "Resource binding failed: %s"
	      (jabber-parse-error
	       (jabber-iq-error (cadr event))))
     (list nil state-data))

    (:session-failure
     (message "Session establishing failed: %s"
	      (jabber-parse-error
	       (jabber-iq-error (cadr event))))
     (list nil state-data))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
(define-enter-state jabber-connection :session-established
  (fsm state-data)
  (jabber-send-iq fsm nil
		  "get"
		  '(query ((xmlns . "jabber:iq:roster")))
		  #'jabber-process-roster 'initial
		  #'jabber-initial-roster-failure nil)
  (list (plist-put state-data :ever-session-established t) nil))
jabber-pending-presence-timeout   variable
(defvar jabber-pending-presence-timeout 0.5
  "Wait this long before doing presence packet batch processing.")
(define-state jabber-connection :session-established
  (fsm state-data event callback)
  (cl-case (or (car-safe event) event)
    (:filter
     (let ((process (cadr event))
	   (string (car (cddr event))))
       (jabber-pre-filter process string fsm)
       (list :session-established state-data :keep)))

    (:sentinel
     (jabber-fsm-handle-sentinel state-data event))

    (:stanza
     (or
      (jabber-process-stream-error (cadr event) state-data)
      (progn
	(jabber-process-input fsm (cadr event))
	(list :session-established state-data :keep))))

    (:roster-update
     ;; Batch up roster updates
     (let* ((jid-symbol-to-update (cdr event))
	    (pending-updates (plist-get state-data :roster-pending-updates)))
       ;; If there are pending updates, there is a timer running
       ;; already; just add the new symbol and wait.
       (if pending-updates
	   (progn
	     (unless (memq jid-symbol-to-update pending-updates)
	       (nconc pending-updates (list jid-symbol-to-update)))
	     (list :session-established state-data :keep))
	 ;; Otherwise, we need to create the list and start the timer.
	 (setq state-data
	       (plist-put state-data
			  :roster-pending-updates
			  (list jid-symbol-to-update)))
	 (list :session-established state-data jabber-pending-presence-timeout))))

    (:timeout
     ;; Update roster
     (let ((pending-updates (plist-get state-data :roster-pending-updates)))
       (setq state-data (plist-put state-data :roster-pending-updates nil))
       (jabber-roster-update fsm nil pending-updates nil)
       (list :session-established state-data)))

    (:send-if-connected
     ;; This is the only state in which we respond to such messages.
     ;; This is to make sure we don't send anything inappropriate
     ;; during authentication etc.
     (jabber-send-sexp fsm (cdr event))
     (list :session-established state-data :keep))

    (:do-disconnect
     (jabber-send-string fsm "</stream:stream>")
     (list nil (plist-put state-data
			  :disconnection-expected t)))))
jabber-disconnect   command
(defun jabber-disconnect (&optional arg)
  "Disconnect from all Jabber servers.  If ARG supplied, disconnect one account."
  (interactive "P")
  (if arg
      (jabber-disconnect-one (jabber-read-account))
    (unless *jabber-disconnecting*	; avoid reentry
      (let ((*jabber-disconnecting* t))
	(if (null jabber-connections)
	    (message "Already disconnected")
	  (run-hooks 'jabber-pre-disconnect-hook)
	  (dolist (c jabber-connections)
	    (jabber-disconnect-one c t))
	  (setq jabber-connections nil)

	  (jabber-disconnected)
	  (when (called-interactively-p 'interactive)
	    (message "Disconnected from Jabber server(s)")))))))
jabber-disconnect-one   command
(defun jabber-disconnect-one (jc &optional dont-redisplay)
  "Disconnect from one Jabber server.
If DONT-REDISPLAY is non-nil, don't update roster buffer.
JC is the Jabber connection."
  (interactive (list (jabber-read-account)))
  (fsm-send-sync jc :do-disconnect)
  (when (called-interactively-p 'interactive)
    (message "Disconnected from %s"
	     (jabber-connection-jid jc)))
  (unless dont-redisplay
    (jabber-display-roster)))
jabber-disconnected   function
(defun jabber-disconnected ()
  "Re-initialise jabber package variables.
Call this function after disconnection."
  (when (get-buffer jabber-roster-buffer)
    (with-current-buffer (get-buffer jabber-roster-buffer)
      (let ((inhibit-read-only t))
	(erase-buffer))))

  (jabber-clear-roster)
  (run-hooks 'jabber-post-disconnect-hook))
jabber-log-xml   function
(defun jabber-log-xml (fsm direction data)
  "Print DATA to XML console (and, optionally, in file).
If `jabber-debug-log-xml' is nil, do nothing.
FSM is the connection that is sending/receiving.
DIRECTION is a string, either \"sending\" or \"receive\".
DATA is any sexp."
  (when jabber-debug-log-xml
      (jabber-process-console fsm direction data)))
jabber-pre-filter   function
(defun jabber-pre-filter (process string fsm)
  (with-current-buffer (process-buffer process)
    ;; Append new data
    (goto-char (point-max))
    (insert string)

    (unless (boundp 'jabber-filtering)
      (let (jabber-filtering)
	(jabber-filter process fsm)))))
jabber-filter   function
(defun jabber-filter (process fsm)
  "The filter function for the jabber process."
  (with-current-buffer (process-buffer process)
    ;; Start from the beginning
    (goto-char (point-min))
    (let (xml-data)
      (cl-loop
       do
       ;; Skip whitespace
       (unless (zerop (skip-chars-forward " \t\r\n"))
	 (delete-region (point-min) (point)))
       ;; Skip processing directive
       (when (looking-at "<\\?xml[^?]*\\?>")
	 (delete-region (match-beginning 0) (match-end 0)))

       ;; Stream end?
       (when (looking-at "</stream:stream>")
	 (cl-return (fsm-send fsm :stream-end)))

       ;; Stream header?
       (when (looking-at "<stream:stream[^>]*\\(>\\)")
	 ;; Let's pretend that the stream header is a closed tag,
	 ;; and parse it as such.
	 (replace-match "/>" t t nil 1)
	 (let* ((ending-at (point))
		(stream-header (car (xml-parse-region (point-min) ending-at)))
		(session-id (jabber-xml-get-attribute stream-header 'id))
		(stream-version (jabber-xml-get-attribute stream-header 'version)))

	   ;; Need to keep any namespace attributes on the stream
	   ;; header, as they can affect any stanza in the
	   ;; stream...
	   (setq jabber-namespace-prefixes
		 (jabber-xml-merge-namespace-declarations
		  (jabber-xml-node-attributes stream-header)
		  nil))
	   (jabber-log-xml fsm "receive" stream-header)
	   (fsm-send fsm (list :stream-start session-id stream-version))
	   (delete-region (point-min) ending-at)))

       ;; Normal tag

       ;; XXX: do these checks make sense?  If so, reinstate them.
       ;;(if (active-minibuffer-window)
       ;;    (run-with-idle-timer 0.01 nil #'jabber-filter process string)

       ;; This check is needed for xml.el of Emacs 21, as it chokes on
       ;; empty attribute values.
       (save-excursion
	 (while (search-forward-regexp " \\w+=''" nil t)
           (replace-match "")))

       (setq xml-data (jabber-xml-parse-next-stanza))

       while xml-data
       do
       ;; If there's a problem with writing the XML log,
       ;; make sure the stanza is delivered, at least.
       (condition-case e
	   (jabber-log-xml fsm "receive" (car xml-data))
	 (error
	  (ding)
	  (message "Couldn't write XML log: %s" (error-message-string e))
	  (sit-for 2)))
       (delete-region (point-min) (point))

       (fsm-send fsm (list :stanza
			   (jabber-xml-resolve-namespace-prefixes
			    (car xml-data) nil jabber-namespace-prefixes)))
       ;; XXX: move this logic elsewhere
       ;; We explicitly don't catch errors in jabber-process-input,
       ;; to facilitate debugging.
       ;; (jabber-process-input (car xml-data))
       ))))
jabber-process-input   function
(defun jabber-process-input (jc xml-data)
  "Process an incoming parsed tag.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let* ((tag (jabber-xml-node-name xml-data))
	 (functions (eval (cdr (assq tag '((iq . jabber-iq-chain)
					   (presence . jabber-presence-chain)
					   (message . jabber-message-chain)))))))
    (dolist (f functions)
      (condition-case e
	  (funcall f jc xml-data)
	((debug error)
	 (fsm-debug-output "Error %S while processing %S with function %s" e xml-data f))))))
jabber-process-stream-error   function
(defun jabber-process-stream-error (xml-data state-data)
  "Process an incoming stream error.
Return nil if XML-DATA is not a stream:error stanza.
Return an fsm result list if it is."
  (when (and (eq (jabber-xml-node-name xml-data) 'error)
	     (equal (jabber-xml-get-xmlns xml-data) "http://etherx.jabber.org/streams"))
    (let ((condition (jabber-stream-error-condition xml-data))
	  (text (jabber-parse-stream-error xml-data)))
      (setq state-data (plist-put state-data :disconnection-reason
				  (format "Stream error: %s" text)))
      ;; Special case: when the error is `conflict', we have been
      ;; forcibly disconnected by the same user.  Don't reconnect
      ;; automatically.
      (when (eq condition 'conflict)
	(setq state-data (plist-put state-data :disconnection-expected t)))
      (list nil state-data))))
jabber-clear-roster   function
;; XXX: This function should probably die.  The roster is stored
;; inside the connection plists, and the obarray shouldn't be so big
;; that we need to clean it.
(defun jabber-clear-roster ()
  "Clean up the roster."
  ;; This is made complicated by the fact that the JIDs are symbols with properties.
  (mapatoms #'(lambda (x)
		(unintern x jabber-jid-obarray))
	    jabber-jid-obarray)
  (setq *jabber-roster* nil))
jabber-send-sexp   function
(defun jabber-send-sexp (jc sexp)
  "Send the xml corresponding to SEXP to connection JC."
  (condition-case e
      (jabber-log-xml jc "sending" sexp)
    (error
     (ding)
     (message "Couldn't write XML log: %s" (error-message-string e))
     (sit-for 2)))
  (jabber-send-string jc (jabber-sexp2xml sexp)))
jabber-send-sexp-if-connected   function
(defun jabber-send-sexp-if-connected (jc sexp)
  "Send the stanza SEXP only if JC has established a session."
  (fsm-send-sync jc (cons :send-if-connected sexp)))
jabber-send-stream-header   function
(defun jabber-send-stream-header (jc)
  "Send stream header to connection JC."
  (let ((stream-header
	 (concat "<?xml version='1.0'?><stream:stream to='"
		 (plist-get (fsm-get-state-data jc) :server)
		 "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams'"
		 ;; Not supporting SASL is not XMPP compliant,
		 ;; so don't pretend we are.
		 (if (and (jabber-have-sasl-p) jabber-use-sasl)
		     " version='1.0'"
		   "")
		 ">
")))
    (jabber-log-xml jc "sending" stream-header)
    (jabber-send-string jc stream-header)))
jabber-send-string   function
(defun jabber-send-string (jc string)
  "Send STRING through the connection JC."
  (let* ((state-data (fsm-get-state-data jc))
	 (connection (plist-get state-data :connection))
	 (send-function (plist-get state-data :send-function)))
    (unless connection
      (error "%s has no connection" (jabber-connection-jid jc)))
    (funcall send-function connection string)))

logon

In Emacs 24, sha1 is built in, so this require is only needed for earlier versions. It's supposed to be a noop in Emacs 24, but sometimes, for some people, it isn't, and fails with (file-error "Cannot open load file" "sha1").

(unless (fboundp 'sha1)
  (require 'sha1))
jabber-get-auth   function
(defun jabber-get-auth (jc to session-id)
  "Send IQ get request in namespace \"jabber:iq:auth\".
JC is the Jabber connection."
  (jabber-send-iq jc to
		  "get"
		  `(query ((xmlns . "jabber:iq:auth"))
			  (username () ,(plist-get (fsm-get-state-data jc) :username)))
		  #'jabber-do-logon session-id
		  #'jabber-report-success "Impossible error - auth field request"))
jabber-do-logon   function
(defun jabber-do-logon (jc xml-data session-id)
  "Send username and password in logon attempt.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let* ((digest-allowed (jabber-xml-get-children (jabber-iq-query xml-data) 'digest))
	 (passwd (when
		     (or digest-allowed
			 (plist-get (fsm-get-state-data jc) :encrypted)
			 (yes-or-no-p "Jabber server only allows cleartext password transmission!  Continue? "))
		   (or (plist-get (fsm-get-state-data jc) :password)
		       (jabber-read-password (jabber-connection-bare-jid jc)))))
	 auth)
    (if (null passwd)
	(fsm-send jc :authentication-failure)
      (if digest-allowed
	  (setq auth `(digest () ,(sha1 (concat session-id passwd))))
	(setq auth `(password () ,passwd)))

      ;; For legacy authentication we must specify a resource.
      (unless (plist-get (fsm-get-state-data jc) :resource)
	;; Yes, this is ugly.  Where is my encapsulation?
	(plist-put (fsm-get-state-data jc) :resource "emacs-jabber"))

      (jabber-send-iq jc (plist-get (fsm-get-state-data jc) :server)
		      "set"
		      `(query ((xmlns . "jabber:iq:auth"))
			      (username () ,(plist-get (fsm-get-state-data jc) :username))
			      ,auth
			      (resource () ,(plist-get (fsm-get-state-data jc) :resource)))
		      #'jabber-process-logon passwd
		      #'jabber-process-logon nil))))
jabber-process-logon   function
(defun jabber-process-logon (jc xml-data closure-data)
  "Receive login success or failure, and request roster.
CLOSURE-DATA should be the password on success and nil on failure.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (if closure-data
      ;; Logon success
      (fsm-send jc (cons :authentication-success closure-data))

    ;; Logon failure
    (jabber-report-success jc xml-data "Logon")
    (fsm-send jc :authentication-failure)))

Displaying the roster

(require 'format-spec)
jabber-roster   custom group
(defgroup jabber-roster nil "roster display options"
  :group 'jabber)
jabber-roster-line-format   custom variable
(defcustom jabber-roster-line-format " %a %c %-25n %u %-8s  %S"
  "The format specification of the lines in the roster display.

These fields are available:

%a   Avatar, if any
%c   \"*\" if the contact is connected, or \" \" if not
%u   sUbscription state - see below
%n   Nickname of contact, or JID if no nickname
%j   Bare JID of contact (without resource)
%r   Highest-priority resource of contact
%s   Availability of contact as string (\"Online\", \"Away\" etc)
%S   Status string specified by contact

%u is replaced by one of the strings given by
`jabber-roster-subscription-display'."
  :type 'string
  :group 'jabber-roster)
jabber-roster-subscription-display   custom variable
(defcustom jabber-roster-subscription-display '(("none" . "   ")
						("from" . "<  ")
						("to" . "  >")
						("both" . "<->"))
  "Strings used for indicating subscription status of contacts.
\"none\" means that there is no subscription between you and the
contact.
\"from\" means that the contact has a subscription to you, but you
have no subscription to the contact.
\"to\" means that you have a subscription to the contact, but the
contact has no subscription to you.
\"both\" means a mutual subscription.

Having a \"presence subscription\" means being able to see the
other person's presence.

Some fancy arrows you might want to use, if your system can
display them: ← → ⇄ ↔."
  :type '(list (cons :format "%v" (const :format "" "none") (string :tag "None"))
	       (cons :format "%v" (const :format "" "from") (string :tag "From"))
	       (cons :format "%v" (const :format "" "to") (string :tag "To"))
	       (cons :format "%v" (const :format "" "both") (string :tag "Both")))
  :group 'jabber-roster)
jabber-resource-line-format   custom variable
(defcustom jabber-resource-line-format "     %r - %s (%S), priority %p"
  "The format specification of resource lines in the roster display.
These are displayed when `jabber-show-resources' permits it.

These fields are available:

%c   \"*\" if the contact is connected, or \" \" if not
%n   Nickname of contact, or JID if no nickname
%j   Bare JID of contact (without resource)
%p   Priority of this resource
%r   Name of this resource
%s   Availability of resource as string (\"Online\", \"Away\" etc)
%S   Status string specified by resource."
  :type 'string
  :group 'jabber-roster)
jabber-roster-sort-functions   custom variable
(defcustom jabber-roster-sort-functions
  '(jabber-roster-sort-by-status jabber-roster-sort-by-displayname)
  "Sort roster according to these criteria.

These functions should take two roster items A and B, and return:
<0 if A < B
0  if A = B
>0 if A > B."
  :type 'hook
  :options '(jabber-roster-sort-by-status
	     jabber-roster-sort-by-displayname
	     jabber-roster-sort-by-group)
  :group 'jabber-roster)
jabber-sort-order   custom variable
(defcustom jabber-sort-order '("chat" "" "away" "dnd" "xa")
  "Sort by status in this order.  Anything not in list goes last.
Offline is represented as nil."
  :type '(repeat (restricted-sexp :match-alternatives (stringp nil)))
  :group 'jabber-roster)
jabber-show-resources   custom variable
(defcustom jabber-show-resources 'sometimes
  "Show contacts' resources in roster?
This can be one of the following symbols:

nil       Never show resources
sometimes Show resources when there are more than one
always    Always show resources."
  :type '(radio (const :tag "Never" nil)
		(const :tag "When more than one connected resource" sometimes)
		(const :tag "Always" always))
  :group 'jabber-roster)
jabber-show-offline-contacts   custom variable
(defcustom jabber-show-offline-contacts t
  "Show offline contacts in roster when non-nil."
  :type 'boolean
  :group 'jabber-roster)
jabber-remove-newlines   custom variable
(defcustom jabber-remove-newlines t
  "Remove newlines in status messages?
Newlines in status messages mess up the roster display.  However,
they are essential to status message poets.  Therefore, you get to
choose the behaviour.

Trailing newlines are always removed, regardless of this variable."
  :type 'boolean
  :group 'jabber-roster)
jabber-roster-show-bindings   custom variable
(defcustom jabber-roster-show-bindings t
  "Show keybindings in roster buffer?."
  :type 'boolean
  :group 'jabber-roster)
jabber-roster-show-title   custom variable
(defcustom jabber-roster-show-title t
  "Show title in roster buffer?."
  :type 'boolean
  :group 'jabber-roster)
jabber-roster-mode-hook   custom variable
(defcustom jabber-roster-mode-hook nil
  "Hook run when entering Roster mode."
  :group 'jabber-roster
  :type 'hook)
jabber-roster-default-group-name   custom variable
(defcustom jabber-roster-default-group-name "other"
  "Default group name for buddies without groups."
  :group 'jabber-roster
  :type 'string
  :get '(lambda (var)
	  (let ((val (symbol-value var)))
	    (when (stringp val)
	      (set-text-properties 0 (length val) nil val))
	    val))
  :set '(lambda (var val)
          (when (stringp val)
	    (set-text-properties 0 (length val) nil val))
          (custom-set-default var val))
  )
jabber-roster-show-empty-group   custom variable
(defcustom jabber-roster-show-empty-group nil
  "Show empty groups in roster?."
  :group 'jabber-roster
  :type 'boolean)
jabber-roster-roll-up-group   custom variable
(defcustom jabber-roster-roll-up-group nil
  "Show empty groups in roster?."
  :group 'jabber-roster
  :type 'boolean)
jabber-roster-user-online   face
(defface jabber-roster-user-online
  '((t (:foreground "blue" :weight bold :slant normal)))
  "face for displaying online users."
  :group 'jabber-roster)
jabber-roster-user-xa   face
(defface jabber-roster-user-xa
  '((((background dark)) (:foreground "magenta" :weight normal :slant italic))
    (t (:foreground "black" :weight normal :slant italic)))
  "face for displaying extended away users."
  :group 'jabber-roster)
jabber-roster-user-dnd   face
(defface jabber-roster-user-dnd
  '((t (:foreground "red" :weight normal :slant italic)))
  "face for displaying do not disturb users."
  :group 'jabber-roster)
jabber-roster-user-away   face
(defface jabber-roster-user-away
  '((t (:foreground "dark green" :weight normal :slant italic)))
  "face for displaying away users."
  :group 'jabber-roster)
jabber-roster-user-chatty   face
(defface jabber-roster-user-chatty
  '((t (:foreground "dark orange" :weight bold :slant normal)))
  "face for displaying chatty users."
  :group 'jabber-roster)
jabber-roster-user-error   face
(defface jabber-roster-user-error
  '((t (:foreground "red" :weight light :slant italic)))
  "face for displaying users sending presence errors."
  :group 'jabber-roster)
jabber-roster-user-offline   face
(defface jabber-roster-user-offline
  '((t (:foreground "dark grey" :weight light :slant italic)))
  "face for displaying offline users."
  :group 'jabber-roster)
jabber-roster-debug   variable
(defvar jabber-roster-debug nil
  "Debug roster draw.")
jabber-roster-mode-map   variable
(defvar jabber-roster-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (set-keymap-parent map jabber-common-keymap)
    (define-key map [mouse-2] 'jabber-roster-mouse-2-action-at-point)
    (define-key map (kbd "TAB") 'jabber-go-to-next-roster-item)
    (define-key map (kbd "S-TAB") 'jabber-go-to-previous-roster-item)
    (define-key map (kbd "M-TAB") 'jabber-go-to-previous-roster-item)
    (define-key map (kbd "<backtab>") 'jabber-go-to-previous-roster-item)
    (define-key map (kbd "RET") 'jabber-roster-ret-action-at-point)
    (define-key map (kbd "C-k") 'jabber-roster-delete-at-point)

    (define-key map "e" 'jabber-roster-edit-action-at-point)
    (define-key map "s" 'jabber-send-subscription-request)
    (define-key map "q" 'bury-buffer)
    (define-key map "i" 'jabber-get-disco-items)
    (define-key map "j" 'jabber-muc-join)
    (define-key map "I" 'jabber-get-disco-info)
    (define-key map "b" 'jabber-get-browse)
    (define-key map "v" 'jabber-get-version)
    (define-key map "a" 'jabber-send-presence)
    (define-key map "g" 'jabber-display-roster)
    (define-key map "S" 'jabber-ft-send)
    (define-key map "o" 'jabber-roster-toggle-offline-display)
    (define-key map "H" 'jabber-roster-toggle-binding-display)
    ;;(define-key map "D" 'jabber-disconnect)
    map))
jabber-roster-ret-action-at-point   command
(defun jabber-roster-ret-action-at-point ()
  "Action for ret.
Before try to roll up/down group.  Eval `chat-with-jid-at-point' is no group at
point."
  (interactive)
  (let ((group-at-point (get-text-property (point)
					   'jabber-group))
	(account-at-point (get-text-property (point)
					     'jabber-account))
        (jid-at-point (get-text-property (point)
					 'jabber-jid)))
    (if (and group-at-point account-at-point)
	(jabber-roster-roll-group account-at-point group-at-point)
      ;; Is this a normal contact, or a groupchat?  Let's ask it.
      (jabber-disco-get-info
       account-at-point (jabber-jid-user jid-at-point) nil
       #'jabber-roster-ret-action-at-point-1
       jid-at-point))))
jabber-roster-ret-action-at-point-1   function
(defun jabber-roster-ret-action-at-point-1 (jc jid result)
  ;; If we get an error, assume it's a normal contact.
  (if (eq (car result) 'error)
      (jabber-chat-with jc jid)
    ;; Otherwise, let's check whether it has a groupchat identity.
    (let ((identities (car result)))
      (if (cl-find "conference" (if (sequencep identities) identities nil)
		:key (lambda (i) (aref i 1))
		:test #'string=)
	  ;; Yes!  Let's join it.
	  (jabber-muc-join jc jid
			   (jabber-muc-read-my-nickname jc jid t)
			   t)
	;; No.  Let's open a normal chat buffer.
	(jabber-chat-with jc jid)))))
jabber-roster-mouse-2-action-at-point   command
(defun jabber-roster-mouse-2-action-at-point (e)
  "Action for mouse 2.
Before try to roll up/down group.  Eval `chat-with-jid-at-point' is no group
at point."
  (interactive "e")
  (mouse-set-point e)
  (let ((group-at-point (get-text-property (point)
					   'jabber-group))
	(account-at-point (get-text-property (point)
					     'jabber-account)))
    (if (and group-at-point account-at-point)
	(jabber-roster-roll-group account-at-point group-at-point)
      (jabber-popup-combined-menu))))
jabber-roster-delete-at-point   command
(defun jabber-roster-delete-at-point ()
  "Delete at point from roster.
Try to delete the group from all contaacs.
Delete a jid if there is no group at point."
  (interactive)
  (let ((group-at-point (get-text-property (point)
					   'jabber-group))
	(account-at-point (get-text-property (point)
					     'jabber-account)))
    (if (and group-at-point account-at-point)
	(let ((jids-with-group
	       (gethash group-at-point
			(plist-get
			 (fsm-get-state-data account-at-point)
			 :roster-hash))))
	  (jabber-roster-delete-group-from-jids account-at-point
						jids-with-group
						group-at-point))
      (jabber-roster-delete-jid-at-point))))
jabber-roster-edit-action-at-point   command
(defun jabber-roster-edit-action-at-point ()
  "Action for e.  Before try to edit group name.
Eval `jabber-roster-change' is no group at point."
  (interactive)
  (let ((group-at-point (get-text-property (point)
					   'jabber-group))
	(account-at-point (get-text-property (point)
					     'jabber-account)))
    (if (and group-at-point account-at-point)
	(let ((jids-with-group
	       (gethash group-at-point
			(plist-get
			 (fsm-get-state-data account-at-point)
			 :roster-hash))))
	  (jabber-roster-edit-group-from-jids account-at-point
					      jids-with-group
					      group-at-point))
      (call-interactively 'jabber-roster-change))))
jabber-roster-roll-group   function
(defun jabber-roster-roll-group (jc group-name &optional set)
  "Roll up/down group in roster.
If optional SET is t, roll up group.
If SET is nor t or nil, roll down group."
  (let* ((state-data (fsm-get-state-data jc))
	 (roll-groups (plist-get state-data :roster-roll-groups))
         (new-roll-groups (if (cl-find group-name roll-groups :test 'string=)
                              ;; group is rolled up, roll it down if needed
                              (if (or (not set) (and set (not (eq set t))))
                                  (cl-remove-if-not (lambda (group-name-in-list)
                                                   (not (string= group-name
                                                                 group-name-in-list)))
                                                 roll-groups)
                                roll-groups)
                            ;; group is rolled down, roll it up if needed
                            (if (or (not set) (and set (eq set t)))
                                (append roll-groups (list group-name))
                              roll-groups))) )
    (unless (equal roll-groups new-roll-groups)
      (plist-put
       state-data :roster-roll-groups
       new-roll-groups)
      (jabber-display-roster))))
jabber-roster-mode   function
(defun jabber-roster-mode ()
  "Major mode for Jabber roster display.
Use the keybindings (mnemonic as Chat, Roster, Info, MUC, Service) to
bring up menus of actions.
\\{jabber-roster-mode-map}"
  (kill-all-local-variables)
  (setq major-mode 'jabber-roster-mode
	mode-name "jabber-roster")
  (use-local-map jabber-roster-mode-map)
  (setq buffer-read-only t)
  (if (fboundp 'run-mode-hooks)
      (run-mode-hooks 'jabber-roster-mode-hook)
    (run-hooks 'jabber-roster-mode-hook)))
(put 'jabber-roster-mode 'mode-class 'special)
jabber-switch-to-roster-buffer   command
;;;###autoload
(defun jabber-switch-to-roster-buffer (&optional jc)
  "Switch to roster buffer.
Optional JC argument is ignored; it's there so this function can
be used in `jabber-post-connection-hooks'."
  (interactive)
  (if (not (get-buffer jabber-roster-buffer))
      (jabber-display-roster)
    (switch-to-buffer jabber-roster-buffer)))
jabber-sort-roster   function
(defun jabber-sort-roster (jc)
  "Sort roster according to online status.
JC is the Jabber connection."
  (let ((state-data (fsm-get-state-data jc)))
    (dolist (group (plist-get state-data :roster-groups))
      (let ((group-name (car group)))
	(puthash group-name
		 (sort
		  (gethash group-name
			   (plist-get state-data :roster-hash))
		  #'jabber-roster-sort-items)
		 (plist-get state-data :roster-hash))))))
jabber-roster-prepare-roster   function
(defun jabber-roster-prepare-roster (jc)
  "Make a hash based roster.
JC is the Jabber connection."
  (let* ((state-data (fsm-get-state-data jc))
	 (hash (make-hash-table :test 'equal))
	 (buddies (plist-get state-data :roster))
	 (all-groups '()))
    (dolist (buddy buddies)
      (let ((groups (get buddy 'groups)))
	(if groups
	    (progn
	      (dolist (group groups)
		(progn
		  (setq all-groups (append all-groups (list group)))
		  (puthash group
			   (append (gethash group hash)
				   (list buddy))
			   hash))))
	  (progn
	    (setq all-groups (append all-groups
				     (list jabber-roster-default-group-name)))
	    (puthash jabber-roster-default-group-name
		     (append (gethash jabber-roster-default-group-name hash)
			     (list buddy))
		     hash)))))

    ;; remove duplicates name of group
    (setq all-groups (sort
		      (cl-remove-duplicates all-groups
					 :test 'string=)
		      'string<))

    ;; put to state-data all-groups as list of list
    (plist-put state-data :roster-groups
	       (mapcar #'list all-groups))

    ;; put to state-data hash-roster
    (plist-put state-data :roster-hash
	       hash)))
jabber-roster-sort-items   function
  (defun jabber-roster-sort-items (a b)
    "Sort roster items A and B according to `jabber-roster-sort-functions'.
  Return t if A is less than B."
    (dolist (fn jabber-roster-sort-functions)
      (let ((comparison (funcall fn a b)))
        (cond
         ((< comparison 0)
          t)
         ((> comparison 0)
          nil)))))
jabber-roster-sort-by-status   function
(defun jabber-roster-sort-by-status (a b)
  "Sort roster items by online status.
See `jabber-sort-order' for order used."
  (cl-flet ((order (item) (length (member (get item 'show) jabber-sort-order))))
    (let ((a-order (order a))
	  (b-order (order b)))
      ;; Note reversed test.  Items with longer X-order go first.
      (cond
       ((< a-order b-order)
	1)
       ((> a-order b-order)
	-1)
       (t
	0)))))
jabber-roster-sort-by-displayname   function
(defun jabber-roster-sort-by-displayname (a b)
  "Sort roster items by displayed name."
  (let ((a-name (jabber-jid-displayname a))
	(b-name (jabber-jid-displayname b)))
    (cond
     ((string-lessp a-name b-name) -1)
     ((string= a-name b-name) 0)
     (t 1))))
jabber-roster-sort-by-group   function
(defun jabber-roster-sort-by-group (a b)
  "Sort roster items by group membership."
  (cl-flet ((first-group (item) (or (car (get item 'groups)) "")))
    (let ((a-group (first-group a))
	  (b-group (first-group b)))
      (cond
       ((string-lessp a-group b-group) -1)
       ((string= a-group b-group) 0)
       (t 1)))))
jabber-fix-status   function
(defun jabber-fix-status (status)
  "Make status strings more readable."
  (when status
    (when (string-match "\n+$" status)
      (setq status (replace-match "" t t status)))
    (when jabber-remove-newlines
      (while (string-match "\n" status)
	(setq status (replace-match " " t t status))))
    status))
jabber-roster-ewoc   variable
(defvar jabber-roster-ewoc nil
  "Ewoc displaying the roster.
There is only one; we don't rely on buffer-local variables or
such.")
jabber-roster-filter-display   function
(defun jabber-roster-filter-display (buddies)
  "Filter BUDDIES for items to be displayed in the roster."
  (cl-remove-if-not (lambda (buddy) (or jabber-show-offline-contacts
				     (get buddy 'connected)))
		 buddies))
jabber-roster-toggle-offline-display   command
(defun jabber-roster-toggle-offline-display ()
  "Toggle display of offline contacts.
To change this permanently, customize the `jabber-show-offline-contacts'."
  (interactive)
  (setq jabber-show-offline-contacts
	(not jabber-show-offline-contacts))
  (jabber-display-roster))
jabber-roster-toggle-binding-display   command
(defun jabber-roster-toggle-binding-display ()
  "Toggle display of the roster binding text."
  (interactive)
  (setq jabber-roster-show-bindings
	(not jabber-roster-show-bindings))
  (jabber-display-roster))
jabber-display-roster   command
(defun jabber-display-roster ()
  "Switch to the main jabber buffer and refresh the roster display to reflect the current information."
  (interactive)
  (with-current-buffer (get-buffer-create jabber-roster-buffer)
    (if (not (eq major-mode 'jabber-roster-mode))
	(jabber-roster-mode))
    (setq buffer-read-only nil)
    ;; line-number-at-pos is in Emacs >= 21.4.  Only used to avoid
    ;; excessive scrolling when updating roster, so not absolutely
    ;; necessary.
    (let ((current-line (and (fboundp 'line-number-at-pos) (line-number-at-pos)))
	  (current-column (current-column)))
      (erase-buffer)
      (setq jabber-roster-ewoc nil)
      (when jabber-roster-show-title
	(insert (jabber-propertize "Jabber roster" 'face 'jabber-title-large) "\n"))
      (when jabber-roster-show-bindings
	(insert "RET      Open chat buffer        C-k      Delete roster item
e        Edit item               s        Send subscription request
q        Bury buffer             i        Get disco items
I        Get disco info          b        Browse
j        Join groupchat (MUC)    v        Get client version
a        Send presence           o        Show offline contacts on/off
C-c C-c  Chat menu               C-c C-m  Multi-User Chat menu
C-c C-i  Info menu               C-c C-r  Roster menu
C-c C-s  Service menu

H        Toggle displaying this text
"))
      (insert "__________________________________\n\n")
      (if (null jabber-connections)
	  (insert "Not connected\n")
	(let ((map (make-sparse-keymap)))
	  (define-key map [mouse-2] #'jabber-send-presence)
	  (insert (jabber-propertize (concat (format " - %s"
						     (cdr (assoc *jabber-current-show* jabber-presence-strings)))
					     (if (not (zerop (length *jabber-current-status*)))
						 (format " (%s)"
							 (jabber-fix-status *jabber-current-status*)))
					     " -")
				     'face (or (cdr (assoc *jabber-current-show* jabber-presence-faces))
					       'jabber-roster-user-online)
				     ;;'mouse-face (cons 'background-color "light grey")
				     'keymap map)
		  "\n")))

      (dolist (jc jabber-connections)
	;; use a hash-based roster
	(when (not (plist-get (fsm-get-state-data jc) :roster-hash))
	  (jabber-roster-prepare-roster jc))
	;; We sort everything before putting it in the ewoc
	(jabber-sort-roster jc)
	(let ((before-ewoc (point))
	      (ewoc (ewoc-create
		       (let ((jc jc))
			 (lambda (data)
			   (let* ((group (car data))
				  (group-name (car group))
				  (buddy (car (cdr data))))
			     (jabber-display-roster-entry jc group-name buddy))))
		     (concat
		      (jabber-propertize (concat
					  (plist-get (fsm-get-state-data jc) :username)
					  "@"
					  (plist-get (fsm-get-state-data jc) :server))
					 'face 'jabber-title-medium)
		      "\n__________________________________\n")
		     "__________________________________"))
	      (new-groups '()))
	  (plist-put(fsm-get-state-data jc) :roster-ewoc ewoc)
	  (dolist (group (plist-get (fsm-get-state-data jc) :roster-groups))
	    (let* ((group-name (car group))
		   (buddies (jabber-roster-filter-display
			    (gethash group-name
				     (plist-get (fsm-get-state-data jc) :roster-hash)))))
	      (when (or jabber-roster-show-empty-group
			(> (length buddies) 0))
		(let ((group-node (ewoc-enter-last ewoc (list group nil))))
		  (if (not (cl-find
			    group-name
			    (plist-get (fsm-get-state-data jc) :roster-roll-groups)
			    :test 'string=))
		      (dolist (buddy (reverse buddies))
			(ewoc-enter-after ewoc group-node (list group buddy))))))))
	  (goto-char (point-max))
	  (insert "\n")
	  (put-text-property before-ewoc (point)
			     'jabber-account jc)))

      (goto-char (point-min))
      (setq buffer-read-only t)
      (if (called-interactively-p 'interactive)
	  (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks))
	    (run-hook-with-args hook 'roster (current-buffer) (funcall jabber-alert-info-message-function 'roster (current-buffer)))))
      (when current-line
	;; Go back to previous line - don't use goto-line, since it
	;; sets the mark.
	(goto-char (point-min))
	(forward-line (1- current-line))
	;; ...and go back to previous column
	(move-to-column current-column)))))
jabber-display-roster-entry   function
(defun jabber-display-roster-entry (jc group-name buddy)
  "Format and insert a roster entry for BUDDY at point.
BUDDY is a JID symbol.
JC is the Jabber connection."
  (if buddy
      (let ((buddy-str (format-spec
			jabber-roster-line-format
			(list
			 (cons ?a (jabber-propertize
				   " "
				   'display (get buddy 'avatar)))
			 (cons ?c (if (get buddy 'connected) "*" " "))
			 (cons ?u (cdr (assoc
					(or
					 (get buddy 'subscription) "none")
					jabber-roster-subscription-display)))
			 (cons ?n (if (> (length (get buddy 'name)) 0)
				      (get buddy 'name)
				    (symbol-name buddy)))
			 (cons ?j (symbol-name buddy))
			 (cons ?r (or (get buddy 'resource) ""))
			 (cons ?s (or
				   (cdr (assoc (get buddy 'show)
					       jabber-presence-strings))
				   (get buddy 'show)))
			 (cons ?S (if (get buddy 'status)
				      (jabber-fix-status (get buddy 'status))
				    ""))
			 ))))
	(add-text-properties 0
			     (length buddy-str)
			     (list
			      'face
			      (or (cdr (assoc (get buddy 'show) jabber-presence-faces))
				  'jabber-roster-user-online)
			      ;;'mouse-face
			      ;;(cons 'background-color "light grey")
			      'help-echo
			      (symbol-name buddy)
			      'jabber-jid
			      (symbol-name buddy)
			      'jabber-account
			      jc)
			     buddy-str)
	(insert buddy-str)

	(when (or (eq jabber-show-resources 'always)
		  (and (eq jabber-show-resources 'sometimes)
		       (> (jabber-count-connected-resources buddy) 1)))
	  (dolist (resource (get buddy 'resources))
	    (when (plist-get (cdr resource) 'connected)
	      (let ((resource-str (format-spec jabber-resource-line-format
					       (list
						(cons ?c "*")
						(cons ?n (if (>
							      (length
							       (get buddy 'name)) 0)
							     (get buddy 'name)
							   (symbol-name buddy)))
						(cons ?j (symbol-name buddy))
						(cons ?r (if (>
							      (length
							       (car resource)) 0)
							     (car resource)
							   "empty"))
						(cons ?s (or
							  (cdr (assoc
								(plist-get
								 (cdr resource) 'show)
								jabber-presence-strings))
							  (plist-get
							   (cdr resource) 'show)))
						(cons ?S (if (plist-get
							      (cdr resource) 'status)
							     (jabber-fix-status
							      (plist-get (cdr resource)
									 'status))
							   ""))
						(cons ?p (number-to-string
							  (plist-get (cdr resource)
								     'priority)))))))
		(add-text-properties 0
				     (length resource-str)
				     (list
				      'face
				      (or (cdr (assoc (plist-get
						       (cdr resource)
						       'show)
						      jabber-presence-faces))
					  'jabber-roster-user-online)
				      'jabber-jid
				      (format "%s/%s" (symbol-name buddy) (car resource))
				      'jabber-account
				      jc)
				     resource-str)
		(insert "\n" resource-str))))))
    (let ((group-name (or group-name
			  jabber-roster-default-group-name)))
      (add-text-properties 0
			   (length group-name)
			   (list
			    'face 'jabber-title-small
			    'jabber-group group-name
			    'jabber-account jc)
			   group-name)
      (insert group-name))))
jabber-roster-update   function
;;;###autoload
(defun jabber-roster-update (jc new-items changed-items deleted-items)
  "Update roster, in memory and on display.
Add NEW-ITEMS, update CHANGED-ITEMS and remove DELETED-ITEMS, all
three being lists of JID symbols.
JC is the Jabber connection."
  (let* ((roster (plist-get (fsm-get-state-data jc) :roster))
	 (hash (plist-get (fsm-get-state-data jc) :roster-hash))
	 (ewoc (plist-get (fsm-get-state-data jc) :roster-ewoc))
	 (all-groups (plist-get (fsm-get-state-data jc) :roster-groups))
	 (terminator
	  (lambda (deleted-items)
	    (dolist (delete-this deleted-items)
	      (let ((groups (get delete-this 'groups))
		    (terminator
		     (lambda (g)
		       (let*
			   ((group (or g jabber-roster-default-group-name))
			    (buddies (gethash group hash)))
			 (when (not buddies)
			   (setq new-groups (append new-groups (list group))))
			 (puthash group
				  (delq delete-this buddies)
				  hash)))))
		(if groups
		    (dolist (group groups)
		      (terminator group))
		  (terminator groups)))))))

    ;; fix a old-roster
    (dolist (delete-this deleted-items)
      (setq roster (delq delete-this roster)))
    (setq roster (append new-items roster))
    (plist-put (fsm-get-state-data jc) :roster roster)

    ;; update a hash-roster
    (if (not hash)
	(jabber-roster-prepare-roster jc)

      (when jabber-roster-debug
	(message "update hash-based roster"))

      ;; delete items
      (dolist (delete-this (append deleted-items changed-items))
	(let ((jid (symbol-name delete-this)))
	  (when jabber-roster-debug
	    (message (concat "delete jid: " jid)))
	  (dolist (group (mapcar (lambda (g) (car g)) all-groups))
	    (when jabber-roster-debug
	      (message (concat "try to delete jid: " jid " from group " group)))
	    (puthash group
		     (delq delete-this (gethash group hash))
		     hash))))

      ;; insert changed-items
      (dolist (insert-this (append changed-items new-items))
	(let ((jid (symbol-name insert-this)))
	  (when jabber-roster-debug
	    (message (concat "insert jid: " jid)))
	  (dolist (group (or (get insert-this 'groups)
			     (list jabber-roster-default-group-name)))
	    (when jabber-roster-debug
	      (message (concat "insert jid: " jid " to group " group)))
	    (puthash group
		     (append (gethash group hash)
			     (list insert-this))
		     hash)
	    (setq all-groups (append all-groups (list (list group)))))))


      (when jabber-roster-debug
	(message "remove duplicates from new group"))
      (setq all-groups (sort
			(cl-remove-duplicates all-groups
					   :test (lambda (g1 g2)
						   (let ((g1-name (car g1))
							 (g2-name (car g2)))
						     (string= g1-name
							      g2-name))))
			(lambda (g1 g2)
			  (let ((g1-name (car g1))
				(g2-name (car g2)))
			    (string< g1-name
				     g2-name)))))

      (plist-put (fsm-get-state-data jc) :roster-groups all-groups))


    (when jabber-roster-debug
      (message "re display roster"))

    ;; recreate roster buffer
    (jabber-display-roster)))
(defalias 'jabber-presence-update-roster 'ignore)
;;jabber-presence-update-roster is not needed anymore.
;;Its work is done in `jabber-process-presence'."
(make-obsolete 'jabber-presence-update-roster 'ignore "27.2")
jabber-next-property   function
(defun jabber-next-property (&optional prev)
  "Return position of next property appearence or nil if there is none.
If optional PREV is non-nil, return position of previous property appearence."
  (let ((pos (point))
        (found nil)
        (nextprev (if prev 'previous-single-property-change
                    'next-single-property-change)))
    (while (not found)
      (setq pos
            (let ((jid (funcall nextprev pos 'jabber-jid))
                  (group (funcall nextprev pos 'jabber-group)))
              (cond
               ((not jid) group)
               ((not group) jid)
               (t (funcall (if prev 'max 'min) jid group)))))
      (if (not pos)
          (setq found t)
        (setq found (or (get-text-property pos 'jabber-jid)
                        (get-text-property pos 'jabber-group)))))
    pos))
jabber-go-to-next-roster-item   command
(defun jabber-go-to-next-roster-item ()
  "Move the cursor to the next jid/group in the buffer."
  (interactive)
  (let* ((next (jabber-next-property))
         (next (if (not next)
                   (progn (goto-char (point-min))
                          (jabber-next-property)) next)))
    (if next (goto-char next)
      (goto-char (point-min)))))
jabber-go-to-previous-roster-item   command
(defun jabber-go-to-previous-roster-item ()
  "Move the cursor to the previous jid/group in the buffer."
  (interactive)
  (let* ((previous (jabber-next-property 'prev))
         (previous (if (not previous)
                       (progn (goto-char (point-max))
                              (jabber-next-property 'prev)) previous)))
    (if previous (goto-char previous)
      (goto-char (point-max)))))
jabber-roster-restore-groups   command
(defun jabber-roster-restore-groups (jc)
  "Restore roster's groups rolling state from private storage.
JC is the Jabber connection."
  (interactive (list (jabber-read-account)))
  (jabber-private-get jc 'roster "emacs-jabber"
                      'jabber-roster-restore-groups-1 'ignore))
jabber-roster-restore-groups-1   function
(defun jabber-roster-restore-groups-1 (jc xml-data)
  "Parse roster groups and restore rolling state.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (when (string= (jabber-xml-get-xmlns xml-data) "emacs-jabber")
    (let* ((data (car (last xml-data)))
           (groups (if (stringp data) (split-string data "\n") nil)))
      (dolist (group groups)
        (jabber-roster-roll-group jc group t)))))
jabber-roster-save-groups   command
(defun jabber-roster-save-groups ()
  "Save roster's groups rolling state in private storage."
  (interactive)
  (dolist (jc jabber-connections)
    (let* ((groups (plist-get (fsm-get-state-data jc) :roster-roll-groups))
           (roll-groups
            (if groups
                (mapconcat (lambda (a) (substring-no-properties a)) groups "\n")
              "")))
      (jabber-private-set jc
                          `(roster ((xmlns . "emacs-jabber"))
                                   ,roll-groups)
                          'jabber-report-success "Roster groups saved"
                          'jabber-report-success "Failed to save roster groups"))))

export Jabber roster to file

jabber-export-roster-widget   variable
(defvar jabber-export-roster-widget nil)
jabber-import-subscription-p-widget   variable
(defvar jabber-import-subscription-p-widget nil)
jabber-export-roster   command
;;;###autoload
(defun jabber-export-roster (jc)
  "Export roster for connection JC."
  (interactive (list (jabber-read-account)))
  (let ((state-data (fsm-get-state-data jc)))
    (jabber-export-roster-do-it
     (jabber-roster-to-sexp (plist-get state-data :roster)))))
jabber-export-roster-do-it   command
(defun jabber-export-roster-do-it (roster)
  "Create buffer from which ROSTER can be exported to a file."
  (interactive)
  (with-current-buffer (get-buffer-create "Export roster")
    (jabber-init-widget-buffer nil)

    (widget-insert (jabber-propertize "Export roster\n"
				      'face 'jabber-title-large))
    (widget-insert "You are about to save your roster to a file.  Here
you can edit it before saving.  Changes done here will
not affect your actual roster.

")

    (widget-create 'push-button :notify #'jabber-export-save "Save to file")
    (widget-insert " ")
    (widget-create 'push-button :notify #'jabber-export-remove-regexp "Remove by regexp")
    (widget-insert "\n\n")
    (make-local-variable 'jabber-export-roster-widget)

    (jabber-export-display roster)

    (widget-setup)
    (widget-minor-mode 1)
    (goto-char (point-min))
    (switch-to-buffer (current-buffer))))
jabber-import-roster   command
;;;###autoload
(defun jabber-import-roster (jc file)
  "Create buffer for roster import for connection JC from FILE."
  (interactive (list (jabber-read-account)
		     (read-file-name "Import roster from file: ")))
  (let ((roster
	 (with-temp-buffer
	   (let ((coding-system-for-read 'utf-8))
	     (jabber-roster-xml-to-sexp
	      (car (xml-parse-file file)))))))
    (with-current-buffer (get-buffer-create "Import roster")
      (setq jabber-buffer-connection jc)

      (jabber-init-widget-buffer nil)

      (widget-insert (jabber-propertize "Import roster\n"
					'face 'jabber-title-large))
      (widget-insert "You are about to import the contacts below to your roster.

")

      (make-local-variable 'jabber-import-subscription-p-widget)
      (setq jabber-import-subscription-p-widget
	    (widget-create 'checkbox))
      (widget-insert " Adjust subscriptions\n")

      (widget-create 'push-button :notify #'jabber-import-doit "Import to roster")
      (widget-insert " ")
      (widget-create 'push-button :notify #'jabber-export-remove-regexp "Remove by regexp")
      (widget-insert "\n\n")
      (make-local-variable 'jabber-export-roster-widget)

      (jabber-export-display roster)

      (widget-setup)
      (widget-minor-mode 1)
      (goto-char (point-min))
      (switch-to-buffer (current-buffer)))))
jabber-export-remove-regexp   function
(defun jabber-export-remove-regexp (&rest ignore)
  (let* ((value (widget-value jabber-export-roster-widget))
	 (length-before (length value))
	 (regexp (read-string "Remove JIDs matching regexp: ")))
    (setq value (cl-delete-if
		 #'(lambda (a)
		     (string-match regexp (nth 0 a)))
		 value))
    (widget-value-set jabber-export-roster-widget value)
    (widget-setup)
    (message "%d items removed" (- length-before (length value)))))
jabber-export-save   function
(defun jabber-export-save (&rest ignore)
  "Export roster to file."
  (let ((items (mapcar #'jabber-roster-sexp-to-xml (widget-value jabber-export-roster-widget)))
	(coding-system-for-write 'utf-8))
    (with-temp-file (read-file-name "Export roster to file: ")
      (insert "<iq xmlns='jabber:client'><query xmlns='jabber:iq:roster'>\n")
      (dolist (item items)
	(insert (jabber-sexp2xml item) "\n"))
      (insert "</query></iq>\n"))
    (message "Roster saved")))
jabber-import-doit   function
(defun jabber-import-doit (&rest ignore)
  "Import roster being edited in widget."
  (let* ((state-data (fsm-get-state-data jabber-buffer-connection))
	 (jabber-roster (plist-get state-data :roster))
	 roster-delta)

    (dolist (n (widget-value jabber-export-roster-widget))
      (let* ((jid (nth 0 n))
	     (name (and (not (zerop (length (nth 1 n))))
			(nth 1 n)))
	     (subscription (nth 2 n))
	     (groups (nth 3 n))
	     (jid-symbol (jabber-jid-symbol jid))
	     (in-roster-p (memq jid-symbol jabber-roster))
	     (jid-name (and in-roster-p (get jid-symbol 'name)))
	     (jid-subscription (and in-roster-p (get jid-symbol 'subscription)))
	     (jid-groups (and in-roster-p (get jid-symbol 'groups))))
	;; Do we need to change the roster?
	(when (or
	       ;; If the contact is not in the roster already,
	       (not in-roster-p)
	       ;; or if the import introduces a name,
	       (and name (not jid-name))
	       ;; or changes a name,
	       (and name jid-name (not (string= name jid-name)))
	       ;; or introduces new groups.
	       (cl-set-difference groups jid-groups :test #'string=))
	  (push (jabber-roster-sexp-to-xml
		 (list jid (or name jid-name) nil (cl-union groups jid-groups :test #'string=))
		 t)
		roster-delta))
	;; And adujst subscription.
	(when (widget-value jabber-import-subscription-p-widget)
	  (let ((want-to (member subscription '("to" "both")))
		(want-from (member subscription '("from" "both")))
		(have-to (member jid-subscription '("to" "both")))
		(have-from (member jid-subscription '("from" "both"))))
	    (cl-flet ((request-subscription
		    (type)
		    (jabber-send-sexp jabber-buffer-connection
				      `(presence ((to . ,jid)
						  (type . ,type))))))
	      (cond
	       ((and want-to (not have-to))
		(request-subscription "subscribe"))
	       ((and have-to (not want-to))
		(request-subscription "unsubscribe")))
	      (cond
	       ((and want-from (not have-from))
		;; not much to do here
		)
	       ((and have-from (not want-from))
		(request-subscription "unsubscribed"))))))))
    (when roster-delta
      (jabber-send-iq jabber-buffer-connection
		      nil "set"
		      `(query ((xmlns . "jabber:iq:roster")) ,@roster-delta)
		      #'jabber-report-success "Roster import"
		      #'jabber-report-success "Roster import"))))
jabber-roster-to-sexp   function
(defun jabber-roster-to-sexp (roster)
  "Convert ROSTER to simpler sexp format.
Return a list, where each item is a vector:
\[jid name subscription groups]
where groups is a list of strings."
  (mapcar
   #'(lambda (n)
       (list
	(symbol-name n)
	(or (get n 'name) "")
	(get n 'subscription)
	(get n 'groups)))
   roster))
jabber-roster-sexp-to-xml   function
(defun jabber-roster-sexp-to-xml (sexp &optional omit-subscription)
  "Convert SEXP to XML format.
Return an XML node."
  `(item ((jid . ,(nth 0 sexp))
	  ,@(let ((name (nth 1 sexp)))
	      (unless (zerop (length name))
		`((name . ,name))))
	  ,@(unless omit-subscription
	      `((subscription . ,(nth 2 sexp)))))
	 ,@(mapcar
	    #'(lambda (g)
		(list 'group nil g))
	    (nth 3 sexp))))
jabber-roster-xml-to-sexp   function
(defun jabber-roster-xml-to-sexp (xml-data)
  "Convert XML-DATA to simpler sexp format.
XML-DATA is an <iq> node with a <query xmlns='jabber:iq:roster'> child.
See `jabber-roster-to-sexp' for description of output format."
  (cl-assert (eq (jabber-xml-node-name xml-data) 'iq))
  (let ((query (car (jabber-xml-get-children xml-data 'query))))
    (cl-assert query)
    (mapcar
     #'(lambda (n)
	 (list
	  (jabber-xml-get-attribute n 'jid)
	  (or (jabber-xml-get-attribute n 'name) "")
	  (jabber-xml-get-attribute n 'subscription)
	  (mapcar
	   #'(lambda (g)
	       (car (jabber-xml-node-children g)))
	   (jabber-xml-get-children n 'group))))
     (jabber-xml-get-children query 'item))))
jabber-export-display   function
(defun jabber-export-display (roster)
  (setq jabber-export-roster-widget
	(widget-create
	 '(repeat
	   :tag "Roster"
	   (list :format "%v"
		   (string :tag "JID")
		   (string :tag "Name")
		   (choice :tag "Subscription"
			   (const "none")
			   (const "both")
			   (const "to")
			   (const "from"))
		   (repeat :tag "Groups"
			   (string :tag "Group"))))
	 :value roster)))

infoquery (IQ) functions

jabber-open-info-queries   variable
(defvar *jabber-open-info-queries* nil
  "An alist of open query id and their callback functions.")
jabber-iq-get-xmlns-alist   variable
(defvar jabber-iq-get-xmlns-alist nil
  "Mapping from XML namespace to handler for IQ GET requests.")
jabber-iq-set-xmlns-alist   variable
(defvar jabber-iq-set-xmlns-alist nil
  "Mapping from XML namespace to handler for IQ SET requests.")
jabber-browse-mode-map   variable
(defvar jabber-browse-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map jabber-common-keymap)
    (define-key map [mouse-2] 'jabber-popup-combined-menu)
    map))
jabber-browse-mode-hook   custom variable
(defcustom jabber-browse-mode-hook nil
  "Hook run when entering Browse mode."
  :group 'jabber
  :type 'hook)
jabber-browse   custom group
(defgroup jabber-browse nil "browse display options"
  :group 'jabber)
jabber-browse-buffer-format   custom variable
(defcustom jabber-browse-buffer-format "*-jabber-browse:-%n-*"
  "The format specification for the name of browse buffers.

These fields are available at this moment:

%n   JID to browse"
  :type 'string
  :group 'jabber-browse)
jabber-browse-mode   function
(defun jabber-browse-mode ()
"Jabber browse mode.
\\{jabber-browse-mode-map}"
  (kill-all-local-variables)
  (setq major-mode 'jabber-browse-mode
        mode-name "jabber-browse")
  (use-local-map jabber-browse-mode-map)
  (setq buffer-read-only t)
  (if (fboundp 'run-mode-hooks)
      (run-mode-hooks 'jabber-browse-mode-hook)
    (run-hooks 'jabber-browse-mode-hook)))
(put 'jabber-browse-mode 'mode-class 'special)
jabber-process-iq   function
(add-to-list 'jabber-iq-chain 'jabber-process-iq)
(defun jabber-process-iq (jc xml-data)
  "Process an incoming iq stanza.

JC is the Jabber Connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let* ((id (jabber-xml-get-attribute xml-data 'id))
         (type (jabber-xml-get-attribute xml-data 'type))
         (from (jabber-xml-get-attribute xml-data 'from))
	 (query (jabber-iq-query xml-data))
         (callback (assoc id *jabber-open-info-queries*)))
    (cond
     ;; if type is "result" or "error", this is a response to a query we sent.
     ((or (string= type "result")
	  (string= type "error"))
      (let ((callback-cons (nth (cdr (assoc type '(("result" . 0)
						   ("error" . 1)))) (cdr callback))))
	(if (consp callback-cons)
	    (funcall (car callback-cons) jc xml-data (cdr callback-cons))))
      (setq *jabber-open-info-queries* (delq callback *jabber-open-info-queries*)))

     ;; if type is "get" or "set", correct action depends on namespace of request.
     ((and (listp query)
	   (or (string= type "get")
	       (string= type "set")))
      (let* ((which-alist (eval (cdr (assoc type
					    (list
					     (cons "get" 'jabber-iq-get-xmlns-alist)
					     (cons "set" 'jabber-iq-set-xmlns-alist))))))
	     (handler (cdr (assoc (jabber-xml-get-attribute query 'xmlns) which-alist))))
	(if handler
	    (condition-case error-var
		(funcall handler jc xml-data)
	      (jabber-error
	       (apply 'jabber-send-iq-error jc from id query (cdr error-var)))
	      (error (jabber-send-iq-error jc from id query "wait" 'internal-server-error (error-message-string error-var))))
	  (jabber-send-iq-error jc from id query "cancel" 'feature-not-implemented)))))))
jabber-send-iq   function
(defun jabber-send-iq (jc to type query success-callback success-closure-data
			  error-callback error-closure-data &optional result-id)
  "Send an iq stanza to the specified entity, and optionally set up a callback.
JC is the Jabber connection.
TO is the addressee.
TYPE is one of \"get\", \"set\", \"result\" or \"error\".
QUERY is a list containing the child of the iq node in the format
`jabber-sexp2xml' accepts.
SUCCESS-CALLBACK is the function to be called when a successful result arrives.
SUCCESS-CLOSURE-DATA is an extra argument to SUCCESS-CALLBACK.
ERROR-CALLBACK is the function to be called when an error arrives.
ERROR-CLOSURE-DATA is an extra argument to ERROR-CALLBACK.
RESULT-ID is the id to be used for a response to a received iq message.
`jabber-report-success' and `jabber-process-data' are common callbacks.

The callback functions are called like this:
\(funcall CALLBACK JC XML-DATA CLOSURE-DATA)
with XML-DATA being the IQ stanza received in response."
  (let ((id (or result-id (apply 'format "emacs-iq-%d.%d.%d" (current-time)))))
    (if (or success-callback error-callback)
	(setq *jabber-open-info-queries* (cons (list id
						     (cons success-callback success-closure-data)
						     (cons error-callback error-closure-data))

					       *jabber-open-info-queries*)))
    (jabber-send-sexp jc
		      (list 'iq (append
				 (if to (list (cons 'to to)))
				 (list (cons 'type type))
				 (list (cons 'id id)))
			    query))))
jabber-send-iq-error   function
(defun jabber-send-iq-error (jc to id original-query error-type condition
				&optional text app-specific)
  "Send an error iq stanza in response to a previously sent iq stanza.
Send an error iq stanza to the specified entity in response to a
previously sent iq stanza.
TO is the addressee.
ID is the id of the iq stanza that caused the error.
ORIGINAL-QUERY is the original query, which should be included in the
error, or nil.
ERROR-TYPE is one of \"cancel\", \"continue\", \"modify\", \"auth\"
and \"wait\".
CONDITION is a symbol denoting a defined XMPP condition.
TEXT is a string to be sent in the error message, or nil for no text.
APP-SPECIFIC is a list of extra XML tags.
JC is the Jabber connection.

See section 9.3 of XMPP Core."
  (jabber-send-sexp
   jc
   `(iq (,@(when to `((to . ,to)))
	 (type . "error")
	 (id . ,(or id "")))
	,original-query
	(error ((type . ,error-type))
	       (,condition ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas")))
	       ,(if text
		    `(text ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas"))
			   ,text))
	       ,@app-specific))))
jabber-process-data   function
(defun jabber-process-data (jc xml-data closure-data)
  "Process random results from various requests.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((from (or (jabber-xml-get-attribute xml-data 'from) (plist-get (fsm-get-state-data jc) :server)))
	(xmlns (jabber-iq-xmlns xml-data))
	(type (jabber-xml-get-attribute xml-data 'type)))
    (with-current-buffer (get-buffer-create (format-spec jabber-browse-buffer-format
                                                         (list (cons ?n from))))
      (if (not (eq major-mode 'jabber-browse-mode))
	  (jabber-browse-mode))

      (setq buffer-read-only nil)
      (goto-char (point-max))

      (insert (jabber-propertize from
			  'face 'jabber-title-large) "\n\n")

      ;; Put point at beginning of data
      (save-excursion
	;; If closure-data is a function, call it.  If it is a string,
	;; output it along with a description of the error.  For other
	;; values (e.g. nil), just dump the XML.
	(cond
	 ((functionp closure-data)
	  (funcall closure-data jc xml-data))
	 ((stringp closure-data)
	  (insert closure-data ": " (jabber-parse-error (jabber-iq-error xml-data)) "\n\n"))
	 (t
	  (insert (format "%S\n\n" xml-data))))

	(dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks))
	  (run-hook-with-args hook 'browse (current-buffer) (funcall jabber-alert-info-message-function 'browse (current-buffer))))))))
jabber-silent-process-data   function
(defun jabber-silent-process-data (jc xml-data closure-data)
  "Process random results from various requests to only alert hooks.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((text (cond
               ((functionp closure-data)
                (funcall closure-data jc xml-data))
               ((stringp closure-data)
                (concat closure-data ": " (jabber-parse-error (jabber-iq-error xml-data))))
               (t
                (format "%S" xml-data)))))
    (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks))
      (run-hook-with-args hook 'browse (current-buffer)
                          text))))

Alert hooks

jabber-alerts   custom group
(defgroup jabber-alerts nil "auditory and visual alerts for jabber events"
  :group 'jabber)
jabber-alert-message-hooks   custom variable
(defcustom jabber-alert-message-hooks '(jabber-message-echo
					jabber-message-scroll)
  "Hooks run when a new message arrives.

Arguments are FROM, BUFFER, TEXT and TITLE.  FROM is the JID of
the sender, BUFFER is the the buffer where the message can be
read, and TEXT is the text of the message.  TITLE is the string
returned by `jabber-alert-message-function' for these arguments,
so that hooks do not have to call it themselves.

This hook is meant for user customization of message alerts.  For
other uses, see `jabber-message-hooks'."
  :type 'hook
  :options '(jabber-message-beep
	     jabber-message-wave
	     jabber-message-echo
	     jabber-message-switch
	     jabber-message-display
	     jabber-message-scroll)
  :group 'jabber-alerts)
jabber-message-hooks   variable
(defvar jabber-message-hooks nil
  "Internal hooks run when a new message arrives.

This hook works just like `jabber-alert-message-hooks', except that
it's not meant to be customized by the user.")
jabber-alert-message-function   custom variable
(defcustom jabber-alert-message-function
  'jabber-message-default-message
  "Function for constructing short message alert messages.

Arguments are FROM, BUFFER, and TEXT.  This function should return a
string containing an appropriate text message, or nil if no message
should be displayed.

The provided hooks displaying a text message get it from this function,
and show no message if it returns nil.  Other hooks do what they do
every time."
  :type 'function
  :group 'jabber-alerts)
jabber-alert-muc-hooks   custom variable
(defcustom jabber-alert-muc-hooks '(jabber-muc-echo jabber-muc-scroll)
  "Hooks run when a new MUC message arrives.

Arguments are NICK, GROUP, BUFFER, TEXT and TITLE.  NICK is the
nickname of the sender.  GROUP is the JID of the group.  BUFFER
is the the buffer where the message can be read, and TEXT is the
text of the message.  TITLE is the string returned by
`jabber-alert-muc-function' for these arguments, so that hooks do
not have to call it themselves."
  :type 'hook
  :options '(jabber-muc-beep
	     jabber-muc-wave
	     jabber-muc-echo
	     jabber-muc-switch
	     jabber-muc-display
	     jabber-muc-scroll)
  :group 'jabber-alerts)
jabber-muc-hooks   variable
(defvar jabber-muc-hooks '()
  "Internal hooks run when a new MUC message arrives.

This hook works just like `jabber-alert-muc-hooks', except that
it's not meant to be customized by the user.")
jabber-alert-muc-function   custom variable
(defcustom jabber-alert-muc-function
  'jabber-muc-default-message
  "Function for constructing short message alert messages.

Arguments are NICK, GROUP, BUFFER, and TEXT.  This function
should return a string containing an appropriate text message, or
nil if no message should be displayed.

The provided hooks displaying a text message get it from this function,
and show no message if it returns nil.  Other hooks do what they do
every time."
  :type 'function
  :group 'jabber-alerts)
jabber-alert-presence-hooks   custom variable
(defcustom jabber-alert-presence-hooks
  '(jabber-presence-echo)
  "Hooks run when a user's presence changes.

Arguments are WHO, OLDSTATUS, NEWSTATUS, STATUSTEXT and
PROPOSED-ALERT.  WHO is a symbol whose text is the JID of the contact,
and which has various interesting properties.  OLDSTATUS is the old
presence or nil if disconnected.  NEWSTATUS is the new presence, or
one of \"subscribe\", \"unsubscribe\", \"subscribed\" and
\"unsubscribed\".  TITLE is the string returned by
`jabber-alert-presence-message-function' for these arguments."
  :type 'hook
  :options '(jabber-presence-beep
	     jabber-presence-wave
	     jabber-presence-switch
	     jabber-presence-display
	     jabber-presence-echo)
  :group 'jabber-alerts)
jabber-presence-hooks   variable
(defvar jabber-presence-hooks '(jabber-presence-watch)
  "Internal hooks run when a user's presence changes.

This hook works just like `jabber-alert-presence-hooks', except that
it's not meant to be customized by the user.")
jabber-alert-presence-message-function   custom variable
(defcustom jabber-alert-presence-message-function
  'jabber-presence-default-message
  "Function for constructing title of presence alert messages.

Arguments are WHO, OLDSTATUS, NEWSTATUS and STATUSTEXT.  See
`jabber-alert-presence-hooks' for documentation.  This function
should return a string containing an appropriate text message, or nil
if no message should be displayed.

The provided hooks displaying a text message get it from this function.
All hooks refrain from action if this function returns nil."
  :type 'function
  :group 'jabber-alerts)
jabber-alert-info-message-hooks   custom variable
(defcustom jabber-alert-info-message-hooks '(jabber-info-display jabber-info-echo)
  "Hooks run when an info request is completed.

First argument is WHAT, a symbol telling the kind of info request completed.
That might be 'roster, for requested roster updates, and 'browse, for
browse requests.  Second argument in BUFFER, a buffer containing the result.
Third argument is PROPOSED-ALERT, containing the string returned by
`jabber-alert-info-message-function' for these arguments."
  :type 'hook
  :options '(jabber-info-beep
	     jabber-info-wave
	     jabber-info-echo
	     jabber-info-switch
	     jabber-info-display)
  :group 'jabber-alerts)
jabber-info-message-hooks   variable
(defvar jabber-info-message-hooks '()
  "Internal hooks run when an info request is completed.

This hook works just like `jabber-alert-info-message-hooks',
except that it's not meant to be customized by the user.")
jabber-alert-info-message-function   custom variable
(defcustom jabber-alert-info-message-function
  'jabber-info-default-message
  "Function for constructing info alert messages.

Arguments are WHAT, a symbol telling the kind of info request completed,
and BUFFER, a buffer containing the result."
  :type 'function
  :group 'jabber-alerts)
jabber-info-message-alist   custom variable
(defcustom jabber-info-message-alist
  '((roster . "Roster display updated")
    (browse . "Browse request completed"))
  "Alist for info alert messages, used by `jabber-info-default-message'."
  :type '(alist :key-type symbol :value-type string
		:options (roster browse))
  :group 'jabber-alerts)
jabber-alert-message-wave   custom variable
(defcustom jabber-alert-message-wave ""
  "A sound file to play when a message arrived.
See `jabber-alert-message-wave-alist' if you want other sounds
for specific contacts."
  :type 'file
  :group 'jabber-alerts)
jabber-alert-message-wave-alist   custom variable
(defcustom jabber-alert-message-wave-alist nil
  "Specific sound files for messages from specific contacts.
The keys are regexps matching the JID, and the values are sound
files."
  :type '(alist :key-type regexp :value-type file)
  :group 'jabber-alerts)
jabber-alert-muc-wave   custom variable
(defcustom jabber-alert-muc-wave ""
  "A sound file to play when a MUC message arrived."
  :type 'file
  :group 'jabber-alerts)
jabber-alert-presence-wave   custom variable
(defcustom jabber-alert-presence-wave ""
  "A sound file to play when a presence arrived."
  :type 'file
  :group 'jabber-alerts)
jabber-alert-presence-wave-alist   custom variable
(defcustom jabber-alert-presence-wave-alist nil
  "Specific sound files for presence from specific contacts.
The keys are regexps matching the JID, and the values are sound
files."
  :type '(alist :key-type regexp :value-type file)
  :group 'jabber-alerts)
jabber-alert-info-wave   custom variable
(defcustom jabber-alert-info-wave ""
  "A sound file to play when an info query result arrived."
  :type 'file
  :group 'jabber-alerts)
jabber-play-sound-file   custom variable
(defcustom jabber-play-sound-file 'play-sound-file
  "A function to call to play alert sound files."
  :type 'function
  :group 'jabber-alerts)
define-jabber-alert   macro
(defmacro define-jabber-alert (name docstring function)
  "Define a new family of external alert hooks.
Use this macro when your hooks do nothing except displaying a string
in some new innovative way.  You write a string display function, and
this macro does all the boring and repetitive work.

NAME is the name of the alert family.  The resulting hooks will be
called jabber-{message,muc,presence,info}-NAME.
DOCSTRING is the docstring to use for those hooks.
FUNCTION is a function that takes one argument, a string,
and displays it in some meaningful way.  It can be either a
lambda form or a quoted function name.
The created functions are inserted as options in Customize.

Examples:
\(define-jabber-alert foo \"Send foo alert\" 'foo-message)
\(define-jabber-alert bar \"Send bar alert\"
  (lambda (msg) (bar msg 42)))"
  (let ((sn (symbol-name name)))
    (let ((msg (intern (format "jabber-message-%s" sn)))
	  (muc (intern (format "jabber-muc-%s" sn)))
	  (pres (intern (format "jabber-presence-%s" sn)))
	  (info (intern (format "jabber-info-%s" sn))))
      `(progn
	 (defun ,msg (from buffer text title)
	   ,docstring
	   (when title
	     (funcall ,function text title)))
	 (cl-pushnew (quote ,msg) (get 'jabber-alert-message-hooks 'custom-options))
	 (defun ,muc (nick group buffer text title)
	   ,docstring
	   (when title
	     (funcall ,function text title)))
	 (cl-pushnew (quote ,muc) (get 'jabber-alert-muc-hooks 'custom-options))
	 (defun ,pres (who oldstatus newstatus statustext title)
	   ,docstring
	   (when title
	     (funcall ,function statustext title)))
	 (cl-pushnew (quote ,pres) (get 'jabber-alert-presence-hooks 'custom-options))
	 (defun ,info (infotype buffer text)
	   ,docstring
	   (when text
	     (funcall ,function text)))
	 (cl-pushnew (quote ,info) (get 'jabber-alert-info-message-hooks 'custom-options))))))
;; Alert hooks
(define-jabber-alert echo "Show a message in the echo area"
  (lambda (text &optional title) (message "%s" (or title text))))
(define-jabber-alert beep "Beep on event"
  (lambda (&rest ignore) (beep)))
jabber-message-default-message   function
;; Message alert hooks
(defun jabber-message-default-message (from buffer text)
  (when (or jabber-message-alert-same-buffer
	    (not (memq (selected-window) (get-buffer-window-list buffer))))
    (if (jabber-muc-sender-p from)
	(format "Private message from %s in %s"
		(jabber-jid-resource from)
		(jabber-jid-displayname (jabber-jid-user from)))
      (format "Message from %s" (jabber-jid-displayname from)))))
jabber-message-alert-same-buffer   custom variable
(defcustom jabber-message-alert-same-buffer t
  "If nil, don't display message alerts for the current buffer."
  :type 'boolean
  :group 'jabber-alerts)
jabber-muc-alert-self   custom variable
(defcustom jabber-muc-alert-self nil
  "If nil, don't display MUC alerts for your own messages."
  :type 'boolean
  :group 'jabber-alerts)
jabber-message-wave   function
(defun jabber-message-wave (from buffer text title)
  "Play the wave file specified in `jabber-alert-message-wave'."
  (when title
    (let* ((case-fold-search t)
	   (bare-jid (jabber-jid-user from))
	   (sound-file (or (dolist (entry jabber-alert-message-wave-alist)
			     (when (string-match (car entry) bare-jid)
			       (cl-return (cdr entry))))
			   jabber-alert-message-wave)))
      (unless (equal sound-file "")
	(funcall jabber-play-sound-file sound-file)))))
jabber-message-display   function
(defun jabber-message-display (from buffer text title)
  "Display the buffer where a new message has arrived."
  (when title
    (display-buffer buffer)))
jabber-message-switch   function
(defun jabber-message-switch (from buffer text title)
  "Switch to the buffer where a new message has arrived."
  (when title
    (switch-to-buffer buffer)))
jabber-message-scroll   function
(defun jabber-message-scroll (from buffer text title)
  "Scroll all nonselected windows where the chat buffer is displayed."
  ;; jabber-chat-buffer-display will DTRT with point in the buffer.
  ;; But this change will not take effect in nonselected windows.
  ;; Therefore we do that manually here.
  ;;
  ;; There are three cases:
  ;; 1. The user started typing a message in this window.  Point is
  ;;    greater than jabber-point-insert.  In that case, we don't
  ;;    want to move point.
  ;; 2. Point was at the end of the buffer, but no message was being
  ;;    typed.  After displaying the message, point is now close to
  ;;    the end of the buffer.  We advance it to the end.
  ;; 3. The user was perusing history in this window.  There is no
  ;;    simple way to distinguish this from 2, so the user loses.
  (let ((windows (get-buffer-window-list buffer nil t))
	(new-point-max (with-current-buffer buffer (point-max))))
    (dolist (w windows)
      (unless (eq w (selected-window))
	(set-window-point w new-point-max)))))
jabber-muc-default-message   function
;; MUC alert hooks
(defun jabber-muc-default-message (nick group buffer text)
  (when (or jabber-message-alert-same-buffer
	    (not (memq (selected-window) (get-buffer-window-list buffer))))
    (if nick
	(when (or jabber-muc-alert-self
		  (not (string= nick (cdr (assoc group *jabber-active-groupchats*)))))
	  (format "Message from %s in %s" nick (jabber-jid-displayname
						group)))
      (format "Message in %s" (jabber-jid-displayname group)))))
jabber-muc-wave   function
(defun jabber-muc-wave (nick group buffer text title)
  "Play the wave file specified in `jabber-alert-muc-wave'."
  (when title
    (funcall jabber-play-sound-file jabber-alert-muc-wave)))
jabber-muc-display   function
(defun jabber-muc-display (nick group buffer text title)
  "Display the buffer where a new message has arrived."
  (when title
    (display-buffer buffer)))
jabber-muc-switch   function
(defun jabber-muc-switch (nick group buffer text title)
  "Switch to the buffer where a new message has arrived."
  (when title
    (switch-to-buffer buffer)))
jabber-muc-scroll   function
(defun jabber-muc-scroll (nick group buffer text title)
  "Scroll buffer even if it is in an unselected window."
  (jabber-message-scroll nil buffer nil nil))
jabber-presence-default-message   function
;; Presence alert hooks
(defun jabber-presence-default-message (who oldstatus newstatus statustext)
  "Return a string with the status change if OLDSTATUS and NEWSTATUS differs.

Return nil if OLDSTATUS and NEWSTATUS are equal, and in other
cases a string of the form \"'name' (jid) is now NEWSTATUS (STATUSTEXT)\".

This function is not called directly, but is the default for
`jabber-alert-presence-message-function'."
  (cond
   ((equal oldstatus newstatus)
      nil)
   (t
    (let ((formattedname
	   (if (> (length (get who 'name)) 0)
	       (get who 'name)
	     (symbol-name who)))
	  (formattedstatus
	   (or
	    (cdr (assoc newstatus
			'(("subscribe" . " requests subscription to your presence")
			  ("subscribed" . " has granted presence subscription to you")
			  ("unsubscribe" . " no longer subscribes to your presence")
			  ("unsubscribed" . " cancels your presence subscription"))))
	    (concat " is now "
		    (or
		     (cdr (assoc newstatus jabber-presence-strings))
		     newstatus)))))
      (concat formattedname formattedstatus)))))
jabber-presence-only-chat-open-message   function
(defun jabber-presence-only-chat-open-message (who oldstatus newstatus statustext)
  "Same as `jabber-presence-default-message' but managing the presence messages.

Return the same as `jabber-presence-default-message' but only
if there is a chat buffer open for WHO, keeping the amount of presence messages
at a more manageable level when there are lots of users.

This function is not called directly, but can be used as the value for
`jabber-alert-presence-message-function'."
  (when (get-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from)))
    (jabber-presence-default-message who oldstatus newstatus statustext)))
jabber-presence-wave   function
(defun jabber-presence-wave (who oldstatus newstatus statustext proposed-alert)
  "Play the wave file specified in `jabber-alert-presence-wave'."
  (when proposed-alert
    (let* ((case-fold-search t)
	   (bare-jid (symbol-name who))
	   (sound-file (or (dolist (entry jabber-alert-presence-wave-alist)
			     (when (string-match (car entry) bare-jid)
			       (cl-return (cdr entry))))
			   jabber-alert-presence-wave)))
      (unless (equal sound-file "")
	(funcall jabber-play-sound-file sound-file)))))
jabber-presence-update-roster   function
;; This is now defined in jabber-roster.el.
;; (defun jabber-presence-update-roster (who oldstatus newstatus statustext proposed-alert)
;;   "Update the roster display by calling `jabber-display-roster'"
;;   (jabber-display-roster))
jabber-presence-display   function
(defun jabber-presence-display (who oldstatus newstatus statustext proposed-alert)
  "Display the roster buffer."
  (when proposed-alert
    (display-buffer jabber-roster-buffer)))
jabber-presence-switch   function
(defun jabber-presence-switch (who oldstatus newstatus statustext proposed-alert)
  "Switch to the roster buffer."
  (when proposed-alert
    (switch-to-buffer jabber-roster-buffer)))
info alert hooks
jabber-info-default-message   function
(defun jabber-info-default-message (infotype buffer)
  "Function for constructing info alert messages.

The argument is INFOTYPE, a symbol telling the kind of info request completed.
This function uses `jabber-info-message-alist' to find a message."
  (concat (cdr (assq infotype jabber-info-message-alist))
	  " (buffer "(buffer-name buffer) ")"))
jabber-info-wave   function
(defun jabber-info-wave (infotype buffer proposed-alert)
  "Play the wave file specified in `jabber-alert-info-wave'."
  (if proposed-alert
      (funcall jabber-play-sound-file jabber-alert-info-wave)))
jabber-info-display   function
(defun jabber-info-display (infotype buffer proposed-alert)
  "Display buffer of completed request."
  (when proposed-alert
    (display-buffer buffer)))
jabber-info-switch   function
(defun jabber-info-switch (infotype buffer proposed-alert)
  "Switch to buffer of completed request."
  (when proposed-alert
    (switch-to-buffer buffer)))
define-personal-jabber-alert   macro
;;; Personal alert hooks
(defmacro define-personal-jabber-alert (name)
  "From ALERT function, make ALERT-personal function.

This makes sense only for MUC.

NAME: the name of the sender."
  (let ((sn (symbol-name name)))
    (let ((func (intern (format "%s-personal" sn))))
    `(progn
       (defun ,func (nick group buffer text title)
         (if (jabber-muc-looks-like-personal-p text group)
             (,name nick group buffer text title)))
       (cl-pushnew (quote ,func) (get 'jabber-alert-muc-hooks 'custom-options)))))
  )
(define-personal-jabber-alert jabber-muc-beep)
(define-personal-jabber-alert jabber-muc-wave)
(define-personal-jabber-alert jabber-muc-echo)
(define-personal-jabber-alert jabber-muc-switch)
(define-personal-jabber-alert jabber-muc-display)
jabber-autoanswer-alist   custom variable
(defcustom jabber-autoanswer-alist nil
  "Specific phrases to autoanswer on specific message.
The keys are regexps matching the incoming message text, and the values are
autoanswer phrase."
  :type '(alist :key-type regexp :value-type string)
  :group 'jabber-alerts)
jabber-autoanswer-answer   function
(defun jabber-autoanswer-answer (from buffer text proposed-alert)
  "Answer automaticaly when incoming text is in `jabber-autoanswer-alist'.
Answer automaticaly when incoming text match the first element of
`jabber-autoanswer-alist'"
  (when (and from buffer text proposed-alert jabber-autoanswer-alist)
    (let ((message
           (dolist (entry jabber-autoanswer-alist)
             (when (string-match (car entry) text)
               (cl-return (cdr entry))))))
      (if message
          (jabber-chat-send jabber-buffer-connection message)))
    ))
(cl-pushnew 'jabber-autoanswer-answer (get 'jabber-alert-message-hooks 'custom-options))
jabber-autoanswer-answer-muc   function
(defun jabber-autoanswer-answer-muc (nick group buffer text proposed-alert)
  "Answer automaticaly when incoming text is in `jabber-autoanswer-alist'.
Answer automaticaly when incoming text match first element
of `jabber-autoanswer-alist'."
  (when (and nick group buffer text proposed-alert jabber-autoanswer-alist)
    (let ((message
           (dolist (entry jabber-autoanswer-alist)
             (when (string-match (car entry) text)
               (cl-return (cdr entry))))))
      (if message
          (jabber-chat-send jabber-buffer-connection message)))
    ))
(cl-pushnew 'jabber-autoanswer-answer-muc (get 'jabber-alert-muc-hooks 'custom-options))

FIXME Recording message history

  1. when rotation is enabled, jabber-history-query won't look for older history files if the current history file doesn't contain enough backlog entries.

Log format

Each message is on one separate line, represented as a vector with five elements. The first element is time encoded according to XEP-0082. The second element is direction, "in" or "out". The third element is the sender, "me" or a JID. The fourth element is the recipient. The fifth element is the text of the message.

jabber-history   custom group
(defgroup jabber-history nil "Customization options for Emacs
Jabber history files."
  :group 'jabber)
jabber-history-enabled   custom variable
(defcustom jabber-history-enabled nil
  "Non-nil means message logging is enabled."
  :type 'boolean
  :group 'jabber-history)
jabber-history-muc-enabled   custom variable
(defcustom jabber-history-muc-enabled nil
  "Non-nil means MUC logging is enabled.
Default is nil, cause MUC logging may be i/o-intensive."
  :type 'boolean
  :group 'jabber-history)
jabber-history-dir   custom variable
(defcustom jabber-history-dir
  (locate-user-emacs-file "jabber-history" ".emacs-jabber")
  "Base directory where per-contact history files are stored.
Used only when `jabber-use-global-history' is nil."
  :type 'directory
  :group 'jabber-history)
jabber-global-history-filename   custom variable
(defcustom jabber-global-history-filename
  (locate-user-emacs-file "jabber-global-message-log" ".jabber_global_message_log")
  "Global file where all messages are logged.
Used when `jabber-use-global-history' is non-nil."
  :type 'file
  :group 'jabber-history)
jabber-use-global-history   custom variable
(defcustom jabber-use-global-history
  ;; Using a global history file by default was a bad idea.  Let's
  ;; default to per-user files unless the global history file already
  ;; exists, to avoid breaking existing installations.
  (file-exists-p jabber-global-history-filename)
  "Whether to use a global file for message history.
If non-nil, `jabber-global-history-filename' is used, otherwise,
messages are stored in per-user files under the
`jabber-history-dir' directory."
  :type 'boolean
  :group 'jabber-history)
jabber-history-enable-rotation   custom variable
(defcustom jabber-history-enable-rotation nil
  "Whether history files should be renamed when reach certain kilobytes.
Whether history files should be renamed when reach
`jabber-history-size-limit' kilobytes.  If nil, history files
will grow indefinitely, otherwise they'll be renamed to
<history-file>-<number>, where <number> is 1 or the smallest
number after the last rotation."
  :type 'boolean
  :group 'jabber-history)
jabber-history-size-limit   custom variable
(defcustom jabber-history-size-limit 1024
  "Maximum history file size in kilobytes.
When history file reaches this limit, it is renamed to
<history-file>-<number>, where <number> is 1 or the smallest
number after the last rotation."
  :type 'integer
  :group 'jabber-history)
jabber-history-inhibit-received-message-functions   variable
(defvar jabber-history-inhibit-received-message-functions nil
  "Functions determining whether to log an incoming message stanza.
The functions in this list are called with two arguments,
the connection and the full message stanza.
If any of the functions returns non-nil, the stanza is not logged
in the message history.")
jabber-rotate-history-p   function
(defun jabber-rotate-history-p (history-file)
  "Return non-nil if HISTORY-FILE should be rotated."
  (when (and jabber-history-enable-rotation
	     (file-exists-p history-file))
    (> (/ (nth 7 (file-attributes history-file)) 1024)
       jabber-history-size-limit)))
jabber-history-rotate   function
(defun jabber-history-rotate (history-file &optional try)
  "Rename HISTORY-FILE to HISTORY-FILE-TRY."
  (let ((suffix (number-to-string (or try 1))))
    (if (file-exists-p (concat history-file "-"  suffix))
	(jabber-history-rotate history-file (if try (1+ try) 1))
      (rename-file history-file (concat history-file "-" suffix)))))
jabber-message-history   function
(add-to-list 'jabber-message-chain 'jabber-message-history)
(defun jabber-message-history (jc xml-data)
  "Log message to log file.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (when (and (not jabber-use-global-history)
	     (not (file-directory-p jabber-history-dir)))
    (make-directory jabber-history-dir))
  (let ((is-muc (jabber-muc-message-p xml-data)))
    (when (and jabber-history-enabled
	       (or
		(not is-muc)                ;chat message or private MUC message
		(and jabber-history-muc-enabled is-muc))) ;muc message and muc logging active
      (unless (run-hook-with-args-until-success
	       'jabber-history-inhibit-received-message-functions
	       jc xml-data)
	(let ((from (jabber-xml-get-attribute xml-data 'from))
	      (text (car (jabber-xml-node-children
			  (car (jabber-xml-get-children xml-data 'body)))))
	      (timestamp (jabber-message-timestamp xml-data)))
	  (when (and from text)
	    (jabber-history-log-message "in" from nil text timestamp)))))))
(add-hook 'jabber-chat-send-hooks 'jabber-history-send-hook)
jabber-history-send-hook   function
(defun jabber-history-send-hook (body id)
  "Log outgoing message to log file."
  (when (and (not jabber-use-global-history)
	     (not (file-directory-p jabber-history-dir)))
    (make-directory jabber-history-dir))
  ;; This function is called from a chat buffer, so jabber-chatting-with
  ;; contains the desired value.
  (if jabber-history-enabled
      (jabber-history-log-message "out" nil jabber-chatting-with body (current-time))))
jabber-history-filename   function
(defun jabber-history-filename (contact)
  "Return a history filename for CONTACT.
Return a history filename for CONTACT if the per-user file
loggin strategy is used or the global history filename."
  (if jabber-use-global-history
      jabber-global-history-filename
    ;; jabber-jid-symbol is the best canonicalization we have.
    (concat jabber-history-dir
	    "/" (symbol-name (jabber-jid-symbol contact)))))
jabber-history-log-message   function
(defun jabber-history-log-message (direction from to body timestamp)
  "Log a message."
  (with-temp-buffer
    ;; Remove properties
    (set-text-properties 0 (length body) nil body)
    ;; Encode text as Lisp string - get decoding for free
    (setq body (prin1-to-string body))
    ;; Encode LF and CR
    (while (string-match "\n" body)
      (setq body (replace-match "\\n" nil t body nil)))
    (while (string-match "\r" body)
      (setq body (replace-match "\\r" nil t body nil)))
    (insert (format "[\"%s\" \"%s\" %s %s %s]\n"
		    (jabber-encode-time (or timestamp (current-time)))
		    (or direction
			"in")
		    (or (when from
			  (prin1-to-string from))
			"\"me\"")
		    (or (when to
			  (prin1-to-string to))
			"\"me\"")
		    body))
    (let ((coding-system-for-write 'utf-8)
	  (history-file (jabber-history-filename (or from to))))
      (when (and (not jabber-use-global-history)
		 (not (file-directory-p jabber-history-dir)))
	(make-directory jabber-history-dir))
      (when (jabber-rotate-history-p history-file)
	(jabber-history-rotate history-file))
      (condition-case e
	  (write-region (point-min) (point-max) history-file t 'quiet)
	(error
	 (message "Unable to write history: %s" (error-message-string e)))))))
jabber-history-query   function
(defun jabber-history-query (start-time
			     end-time
			     number
			     direction
			     jid-regexp
			     history-file)
  "Return a list of vectors, one for each message matching the criteria.
START-TIME and END-TIME are floats as obtained from `float-time'.
Either or both may be nil, meaning no restriction.
NUMBER is the maximum number of messages to return, or t for
unlimited.
DIRECTION is either \"in\" or \"out\", or t for no limit on direction.
JID-REGEXP is a regexp which must match the JID.
HISTORY-FILE is the file in which to search.

Currently jabber-history-query performs a linear search from the end
of the log file."
  (when (file-readable-p history-file)
    (with-temp-buffer
      (let ((coding-system-for-read 'utf-8))
	(if jabber-use-global-history
            (insert-file-contents history-file)
          (let* ((lines-collected nil)
                (matched-files
		 (directory-files jabber-history-dir t
				  (concat "^"
					  (regexp-quote (file-name-nondirectory
							 history-file)))))
                (matched-files
		 (cons (car matched-files)
		       (sort (cdr matched-files) 'string>-numerical))))
            (while (not lines-collected)
              (if (null matched-files)
                  (setq lines-collected t)
                (let ((file (pop matched-files)))
                  (progn
                    (insert-file-contents file)
                    (when (numberp number)
                      (if (>= (count-lines (point-min) (point-max)) number)
                        (setq lines-collected t))))))))))
      (let (collected current-line)
	(goto-char (point-max))
	(catch 'beginning-of-file
	    (while (progn
		     (backward-sexp)
		     (setq current-line (car (read-from-string
					      (buffer-substring
					       (point)
					       (save-excursion
						 (forward-sexp)
						 (point))))))
		     (and (or (null start-time)
			      (> (jabber-float-time (jabber-parse-time
						     (aref current-line 0)))
				 start-time))
			  (or (eq number t)
			      (< (length collected) number))))
	      (if (and (or (eq direction t)
			   (string= direction (aref current-line 1)))
		       (or (null end-time)
			   (> end-time (jabber-float-time (jabber-parse-time
							   (aref current-line 0)))))
		       (string-match
			jid-regexp
			(car
			 (remove "me"
				 (list (aref current-line 2)
				       (aref current-line 3))))))
		  (push current-line collected))
	      (when (bobp)
		(throw 'beginning-of-file nil))))
	collected))))
jabber-backlog-days   custom variable
(defcustom jabber-backlog-days 3.0
  "Age limit on messages in chat buffer backlog, in days."
  :group 'jabber
  :type '(choice (number :tag "Number of days")
		 (const :tag "No limit" nil)))
jabber-backlog-number   custom variable
(defcustom jabber-backlog-number 10
  "Maximum number of messages in chat buffer backlog."
  :group 'jabber
  :type 'integer)
jabber-history-backlog   function
(defun jabber-history-backlog (jid &optional before)
  "Fetch context from previous chats with JID.
Return a list of history entries (vectors), limited by
`jabber-backlog-days' and `jabber-backlog-number'.
If BEFORE is non-nil, it should be a float-time after which
no entries will be fetched.  `jabber-backlog-days' still
applies, though."
  (jabber-history-query
   (and jabber-backlog-days
	(- (jabber-float-time) (* jabber-backlog-days 86400.0)))
   before
   jabber-backlog-number
   t					; both incoming and outgoing
   (concat "^" (regexp-quote (jabber-jid-user jid)) "\\(/.*\\)?$")
   (jabber-history-filename jid)))
jabber-history-move-to-per-user   command
(defun jabber-history-move-to-per-user ()
  "Migrate global history to per-user files."
  (interactive)
  (when (file-directory-p jabber-history-dir)
    (error "Per-user history directory already exists"))
  (make-directory jabber-history-dir)
  (let ((jabber-use-global-history nil))
    (with-temp-buffer
      (let ((coding-system-for-read 'utf-8))
	(insert-file-contents jabber-global-history-filename))
      (let ((progress-reporter
	     (when (fboundp 'make-progress-reporter)
	       (make-progress-reporter "Migrating history..."
				       (point-min) (point-max))))
	    ;;(file-table (make-hash-table :test 'equal))
	    ;; Keep track of blocks of entries pertaining to the same JID.
	    current-jid jid-start)
	(while (not (eobp))
	  (let* ((start (point))
		 (end (progn (forward-line) (point)))
		 (line (buffer-substring start end))
		 (parsed (car (read-from-string line)))
		 (jid (if (string= (aref parsed 2) "me")
			  (aref parsed 3)
			(aref parsed 2))))
	    ;; Whenever there is a change in JID...
	    (when (not (equal jid current-jid))
	      (when current-jid
		;; ...save data for previous JID...
		(let ((history-file (jabber-history-filename current-jid)))
		  (write-region jid-start start history-file t 'quiet)))
	      ;; ...and switch to new JID.
	      (setq current-jid jid)
	      (setq jid-start start))
	    (when (fboundp 'progress-reporter-update)
	      (progress-reporter-update progress-reporter (point)))))
	;; Finally, save the last block, if any.
	(when current-jid
	  (let ((history-file (jabber-history-filename current-jid)))
	    (write-region jid-start (point-max) history-file t 'quiet))))))
  (message "Done.  Please change `jabber-use-global-history' now."))

Functions common to all chat buffers

jabber-point-insert   variable
(defvar jabber-point-insert nil
  "Position where the message being composed starts.")
jabber-send-function   variable
(defvar jabber-send-function nil
  "Function for sending a message from a chat buffer.")
jabber-chat-mode-hook   variable
(defvar jabber-chat-mode-hook nil
  "Hook called at the end of `jabber-chat-mode'.
Note that functions in this hook have no way of knowing
what kind of chat buffer is being created.")
jabber-chat-fill-long-lines   custom variable
(defcustom jabber-chat-fill-long-lines t
  "If non-nil, fill long lines in chat buffers.
Lines are broken at word boundaries at the width of the
window or at `fill-column', whichever is shorter."
  :group 'jabber-chat
  :type 'boolean)
jabber-chat-ewoc   variable
(defvar jabber-chat-ewoc nil
  "The ewoc showing the messages of this chat buffer.")
jabber-buffer-connection   variable
;;;###autoload
(defvar jabber-buffer-connection nil
  "The connection used by this buffer.")
;;;###autoload
(make-variable-buffer-local 'jabber-buffer-connection)
jabber-chat-mode   function
(defun jabber-chat-mode (jc ewoc-pp)
  "Jabber chat mode.
\\{jabber-chat-mode-map}

JC is the Jabber connection."
  (kill-all-local-variables)
  ;; Make sure to set this variable somewhere
  (make-local-variable 'jabber-send-function)
  (make-local-variable 'scroll-conservatively)
  (make-local-variable 'jabber-point-insert)
  (make-local-variable 'jabber-chat-ewoc)
  (make-local-variable 'buffer-undo-list)

  (setq jabber-buffer-connection jc
        scroll-conservatively 5
        buffer-undo-list t)             ;dont keep undo list for chatbuffer

  (unless jabber-chat-ewoc
    (setq jabber-chat-ewoc
	  (ewoc-create ewoc-pp nil "---"))
    (goto-char (point-max))
    (put-text-property (point-min) (point) 'read-only t)
    (let ((inhibit-read-only t))
      (put-text-property (point-min) (point) 'front-sticky t)
      (put-text-property (point-min) (point) 'rear-nonsticky t))
    (setq jabber-point-insert (point-marker)))

  ;;(setq header-line-format jabber-chat-header-line-format)

  (setq major-mode 'jabber-chat-mode
        mode-name "jabber-chat")
  (use-local-map jabber-chat-mode-map)

  (if (fboundp 'run-mode-hooks)
      (run-mode-hooks 'jabber-chat-mode-hook)
    (run-hooks 'jabber-chat-mode-hook)))
jabber-chat-mode-flyspell-verify   function
(put 'jabber-chat-mode 'mode-class 'special)

;; Spell check only what you're currently writing
(defun jabber-chat-mode-flyspell-verify ()
  (>= (point) jabber-point-insert))
(put 'jabber-chat-mode 'flyspell-mode-predicate
  'jabber-chat-mode-flyspell-verify)
jabber-chat-mode-map   variable
(defvar jabber-chat-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map jabber-common-keymap)
    (define-key map "\r" 'jabber-chat-buffer-send)
    map))
jabber-chat-buffer-send   command
(defun jabber-chat-buffer-send ()
  (interactive)
  ;; If user accidentally hits RET without writing anything, just
  ;; ignore it.
  (when (cl-plusp (- (point-max) jabber-point-insert))
    ;; If connection was lost...
    (unless (memq jabber-buffer-connection jabber-connections)
      ;; ...maybe there is a new connection to the same account.
      (let ((new-jc (jabber-find-active-connection jabber-buffer-connection)))
	(if new-jc
	    ;; If so, just use it.
	    (setq jabber-buffer-connection new-jc)
	  ;; Otherwise, ask for a new account.
	  (setq jabber-buffer-connection (jabber-read-account t)))))

    (let ((body (delete-and-extract-region jabber-point-insert (point-max))))
      (funcall jabber-send-function jabber-buffer-connection body))))
jabber-chat-buffer-fill-long-lines   command
(defun jabber-chat-buffer-fill-long-lines ()
  "Fill lines that are wider than the window width."
  ;; This was mostly stolen from article-fill-long-lines
  (interactive)
  (save-excursion
    (let ((inhibit-read-only t)
	  (width (window-width (get-buffer-window (current-buffer)))))
      (goto-char (point-min))
      (let ((adaptive-fill-mode nil))	;Why?  -sm
	(while (not (eobp))
	  (end-of-line)
	  (when (>= (current-column) (min fill-column width))
	    (save-restriction
	      (narrow-to-region (min (1+ (point)) (point-max))
				(point-at-bol))
	      (let ((goback (point-marker)))
		(fill-paragraph nil)
		(goto-char (marker-position goback)))))
	  (forward-line 1))))))

Compose a Jabber message in a buffer

jabber-compose   command
;;;###autoload
(defun jabber-compose (jc &optional recipient)
  "Create a buffer for composing a Jabber message.

JC is the Jabber connection."
  (interactive (list (jabber-read-account)
		     (jabber-read-jid-completing "To whom? ")))

  (with-current-buffer (get-buffer-create
			(generate-new-buffer-name
			 (concat
			  "Jabber-Compose"
			  (when recipient
			    (format "-%s" (jabber-jid-displayname recipient))))))
    (set (make-local-variable 'jabber-widget-alist) nil)
    (setq jabber-buffer-connection jc)
    (use-local-map widget-keymap)

    (insert (jabber-propertize "Compose Jabber message\n" 'face 'jabber-title-large))

    (insert (substitute-command-keys "\\<widget-field-keymap>Completion available with \\[widget-complete].\n"))
    (push (cons :recipients
		(widget-create '(repeat :tag "Recipients" jid)
			       :value (when recipient
					(list recipient))))
	  jabber-widget-alist)

    (insert "\nSubject: ")
    (push (cons :subject
		(widget-create 'editable-field :value ""))
	  jabber-widget-alist)

    (insert "\nText:\n")
    (push (cons :text
		(widget-create 'text :value ""))
	  jabber-widget-alist)

    (insert "\n")
    (widget-create 'push-button :notify #'jabber-compose-send "Send")

    (widget-setup)

    (switch-to-buffer (current-buffer))
    (goto-char (point-min))))
jabber-compose-send   function
(defun jabber-compose-send (&rest ignore)
  (let ((recipients (widget-value (cdr (assq :recipients jabber-widget-alist))))
	(subject (widget-value (cdr (assq :subject jabber-widget-alist))))
	(text (widget-value (cdr (assq :text jabber-widget-alist)))))
    (when (null recipients)
      (error "No recipients specified"))

    (dolist (to recipients)
      (jabber-send-message jabber-buffer-connection to subject text nil))

    (bury-buffer)
    (message "Message sent")))

One-to-one chats

(require 'ewoc)
jabber-chat   custom group
(defgroup jabber-chat nil "chat display options"
  :group 'jabber)
jabber-chat-buffer-format   custom variable
(defcustom jabber-chat-buffer-format "*-jabber-chat-%n-*"
  "The format specification for the name of chat buffers.

These fields are available (all are about the person you are chatting
with):

%n   Nickname, or JID if no nickname set
%j   Bare JID (without resource)
%r   Resource"
  :type 'string
  :group 'jabber-chat)
jabber-chat-header-line-format   custom variable
(defcustom jabber-chat-header-line-format
  '("" (jabber-chat-buffer-show-avatar
	(:eval
	 (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
	   (jabber-propertize " "
			      'display (get buddy 'avatar)))))
    (:eval (jabber-jid-displayname jabber-chatting-with))
    "\t" (:eval (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
		  (propertize
		   (or
		    (cdr (assoc (get buddy 'show) jabber-presence-strings))
		    (get buddy 'show))
		   'face
		   (or (cdr (assoc (get buddy 'show) jabber-presence-faces))
		       'jabber-roster-user-online))))
    "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status)))
    "\t" jabber-events-message		;see jabber-events.el
    "\t" jabber-chatstates-message)		;see jabber-chatstates.el
  "The specification for the header line of chat buffers.

The format is that of `mode-line-format' and `header-line-format'."
  :type 'sexp
  :group 'jabber-chat)
jabber-chat-buffer-show-avatar   custom variable
(defcustom jabber-chat-buffer-show-avatar t
  "Show avatars in header line of chat buffer?
This variable might not take effect if you have changed
`jabber-chat-header-line-format'."
  :type 'boolean
  :group 'jabber-chat)
jabber-chat-time-format   custom variable
(defcustom jabber-chat-time-format "%H:%M"
  "The format specification for instant messages in the chat buffer.
See also `jabber-chat-delayed-time-format'.

See `format-time-string' for valid values."
  :type 'string
  :group 'jabber-chat)
jabber-chat-delayed-time-format   custom variable
(defcustom jabber-chat-delayed-time-format "%Y-%m-%d %H:%M"
  "The format specification for delayed messages in the chat buffer.
See also `jabber-chat-time-format'.

See `format-time-string' for valid values."
  :type 'string
  :group 'jabber-chat)
jabber-print-rare-time   custom variable
(defcustom jabber-print-rare-time t
  "Non-nil means to print \"rare time\" indications in chat buffers.
The default settings tell every new hour."
  :type 'boolean
  :group 'jabber-chat)
jabber-rare-time-format   custom variable
(defcustom jabber-rare-time-format "%a %e %b %Y %H:00"
  "The format specification for the rare time information.
Rare time information will be printed whenever the current time,
formatted according to this string, is different to the last
rare time printed."
  :type 'string
  :group 'jabber-chat)
jabber-rare-time-face   face
(defface jabber-rare-time-face
  '((t (:foreground "darkgreen" :underline t)))
  "face for displaying the rare time info"
  :group 'jabber-chat)
jabber-chat-local-prompt-format   custom variable
(defcustom jabber-chat-local-prompt-format "[%t] %n> "
  "The format specification for lines you type in the chat buffer.

These fields are available:

%t   Time, formatted according to `jabber-chat-time-format'
     or `jabber-chat-delayed-time-format'
%u   Username
%n   Nickname (obsolete, same as username)
%r   Resource
%j   Bare JID (without resource)"
  :type 'string
  :group 'jabber-chat)
jabber-chat-foreign-prompt-format   custom variable
(defcustom jabber-chat-foreign-prompt-format "[%t] %n> "
  "The format specification for lines others type in the chat buffer.

These fields are available:

%t   Time, formatted according to `jabber-chat-time-format'
     or `jabber-chat-delayed-time-format'
%n   Nickname, or JID if no nickname set
%u   Username
%r   Resource
%j   Bare JID (without resource)"
  :type 'string
  :group 'jabber-chat)
jabber-chat-system-prompt-format   custom variable
(defcustom jabber-chat-system-prompt-format "[%t] *** "
  "The format specification for lines from the system or that are special in the chat buffer."
  :type 'string
  :group 'jabber-chat)
jabber-chat-prompt-local   face
(defface jabber-chat-prompt-local
  '((t (:foreground "blue" :weight bold)))
  "face for displaying the chat prompt for what you type in"
  :group 'jabber-chat)
jabber-chat-prompt-foreign   face
(defface jabber-chat-prompt-foreign
  '((t (:foreground "red" :weight bold)))
  "face for displaying the chat prompt for what they send"
  :group 'jabber-chat)
jabber-chat-prompt-system   face
(defface jabber-chat-prompt-system
  '((t (:foreground "green" :weight bold)))
  "face used for system and special messages"
  :group 'jabber-chat)
jabber-chat-text-local   face
(defface jabber-chat-text-local '((t ()))
  "Face used for text you write"
  :group 'jabber-chat)
jabber-chat-text-foreign   face
(defface jabber-chat-text-foreign '((t ()))
  "Face used for text others write"
  :group 'jabber-chat)
jabber-chat-error   face
(defface jabber-chat-error
  '((t (:foreground "red" :weight bold)))
  "Face used for error messages"
  :group 'jabber-chat)
jabber-chatting-with   variable
;;;###autoload
(defvar jabber-chatting-with nil
  "JID of the person you are chatting with.")
jabber-chat-printers   variable
(defvar jabber-chat-printers '(jabber-chat-print-subject
			       jabber-chat-print-body
			       jabber-chat-print-url
			       jabber-chat-goto-address)
  "List of functions that may be able to print part of a message.
Each function receives these arguments:

XML-DATA   The entire message stanza
WHO        :local or :foreign, for sent or received stanza, respectively
MODE       :insert or :printp.  For :insert, insert text at point.
           For :printp, return non-nil if function would insert text.")
jabber-body-printers   variable
(defvar jabber-body-printers '(jabber-chat-normal-body)
  "List of functions that may be able to print a body for a message.
Each function receives these arguments:

XML-DATA   The entire message stanza
WHO        :local, :foreign or :error
MODE       :insert or :printp.  For :insert, insert text at point.
           For :printp, return non-nil if function would insert text.

These functions are called in order, until one of them returns
non-nil.

Add a function to the beginning of this list if the tag it handles
replaces the contents of the <body/> tag.")
jabber-chat-send-hooks   variable
(defvar jabber-chat-send-hooks nil
  "List of functions called when a chat message is sent.
The arguments are the text to send, and the id attribute of the
message.

The functions should return a list of XML nodes they want to be
added to the outgoing message.")
jabber-chat-earliest-backlog   variable
(defvar jabber-chat-earliest-backlog nil
  "Float-time of earliest backlog entry inserted into buffer.
nil if no backlog has been inserted.")
jabber-chat-get-buffer   function
;;;###autoload
(defun jabber-chat-get-buffer (chat-with)
  "Return the chat buffer for chatting with CHAT-WITH (bare or full JID).
Either a string or a buffer is returned, so use `get-buffer' or
`get-buffer-create'."
  (format-spec jabber-chat-buffer-format
	       (list
		(cons ?n (jabber-jid-displayname chat-with))
		(cons ?j (jabber-jid-user chat-with))
		(cons ?r (or (jabber-jid-resource chat-with) "")))))
jabber-chat-create-buffer   function
(defun jabber-chat-create-buffer (jc chat-with)
  "Prepare a buffer for chatting with CHAT-WITH.
This function is idempotent.
JC is the Jabber connection."
  (with-current-buffer (get-buffer-create (jabber-chat-get-buffer chat-with))
    (unless (eq major-mode 'jabber-chat-mode)
      (jabber-chat-mode jc #'jabber-chat-pp)

      (make-local-variable 'jabber-chatting-with)
      (setq jabber-chatting-with chat-with)
      (setq jabber-send-function 'jabber-chat-send)
      (setq header-line-format jabber-chat-header-line-format)

      (make-local-variable 'jabber-chat-earliest-backlog)

      ;; insert backlog
      (when (null jabber-chat-earliest-backlog)
	(let ((backlog-entries (jabber-history-backlog chat-with)))
	  (if (null backlog-entries)
	      (setq jabber-chat-earliest-backlog (jabber-float-time))
	    (setq jabber-chat-earliest-backlog
		  (jabber-float-time (jabber-parse-time
				      (aref (car backlog-entries) 0))))
	    (mapc 'jabber-chat-insert-backlog-entry (nreverse backlog-entries))))))

    ;; Make sure the connection variable is up to date.
    (setq jabber-buffer-connection jc)

    (current-buffer)))
jabber-chat-insert-backlog-entry   function
(defun jabber-chat-insert-backlog-entry (msg)
  "Insert backlog entry MSG at beginning of buffer."
  ;; Rare timestamps are especially important in backlog.  We risk
  ;; having superfluous timestamps if we just add before each backlog
  ;; entry.
  (let* ((message-time (jabber-parse-time (aref msg 0)))
	 (fake-stanza `(message ((from . ,(aref msg 2)))
				(body nil ,(aref msg 4))
				(x ((xmlns . "jabber:x:delay")
				    (stamp . ,(jabber-encode-legacy-time message-time))))))
	 (node-data (list (if (string= (aref msg 1) "in") :foreign :local)
			  fake-stanza :delayed t)))

    ;; Insert after existing rare timestamp?
    (if (and jabber-print-rare-time
	     (ewoc-nth jabber-chat-ewoc 0)
	     (eq (car (ewoc-data (ewoc-nth jabber-chat-ewoc 0))) :rare-time)
	     (not (jabber-rare-time-needed message-time (cadr (ewoc-data (ewoc-nth jabber-chat-ewoc 0))))))
	(ewoc-enter-after jabber-chat-ewoc (ewoc-nth jabber-chat-ewoc 0) node-data)
      ;; Insert first.
      (ewoc-enter-first jabber-chat-ewoc node-data)
      (when jabber-print-rare-time
	(ewoc-enter-first jabber-chat-ewoc (list :rare-time message-time))))))
(add-to-list 'jabber-jid-chat-menu
	     (cons "Display more context" 'jabber-chat-display-more-backlog))
jabber-chat-display-more-backlog   command
(defun jabber-chat-display-more-backlog (how-many)
  "Display more context.  HOW-MANY is number of messages.  Specify 0 to display all messages."
  (interactive "nHow many more messages (Specify 0 to display all)? ")
  (let* ((inhibit-read-only t)
	 (jabber-backlog-days nil)
	 (jabber-backlog-number (if (= how-many 0) t how-many))
	 (backlog-entries (jabber-history-backlog
			   (or jabber-chatting-with jabber-group) jabber-chat-earliest-backlog)))
    (when backlog-entries
      (setq jabber-chat-earliest-backlog
	    (jabber-float-time (jabber-parse-time
				(aref (car backlog-entries) 0))))
      (save-excursion
	(goto-char (point-min))
	(mapc 'jabber-chat-insert-backlog-entry (nreverse backlog-entries))))))
(add-to-list 'jabber-message-chain 'jabber-process-chat)
jabber-get-forwarded-message   function
(defun jabber-get-forwarded-message (xml-data)
  (let* ((sent (car (jabber-xml-get-children xml-data 'sent)))
         (forwarded (car (jabber-xml-get-children sent 'forwarded)))
         (forwarded-message (car (jabber-xml-get-children forwarded 'message))))
    (when forwarded-message
      forwarded-message)))
jabber-process-chat   function
(defun jabber-process-chat (jc xml-data)
  "If XML-DATA is a one-to-one chat message, handle it as such.
JC is the Jabber connection."
  ;; For now, everything that is not a public MUC message is
  ;; potentially a 1to1 chat message.
  (when (not (jabber-muc-message-p xml-data))
    ;; Note that we handle private MUC messages here.
    (cl-destructuring-bind (xml-data chat-buffer)
        (if (car (jabber-xml-get-children xml-data 'sent))
            (let* ((fwd-msg (jabber-get-forwarded-message xml-data))
                   (to (jabber-xml-get-attribute fwd-msg 'to)))
              (list fwd-msg
                    (jabber-chat-create-buffer jc to)))
          (list xml-data nil))
      (let ((from (jabber-xml-get-attribute xml-data 'from))
	    (error-p (jabber-xml-get-children xml-data 'error))
	    (body-text (car (jabber-xml-node-children
			     (car (jabber-xml-get-children
				   xml-data 'body))))))
        ;; First check if we would output anything for this stanza.
        (when (or error-p
		  (run-hook-with-args-until-success 'jabber-chat-printers
                                                    xml-data
                                                    :foreign :printp))
          ;; If so, create chat buffer, if necessary...
	  (with-current-buffer (if (jabber-muc-sender-p from)
				   (jabber-muc-private-create-buffer
				    jc
				    (jabber-jid-user from)
				    (jabber-jid-resource from))
			         (or chat-buffer
                                     (jabber-chat-create-buffer jc from)))
            ;; ...add the message to the ewoc...
	    (let ((node (ewoc-enter-last jabber-chat-ewoc
                                         (list (if error-p :error :foreign)
                                               xml-data
                                               :time
                                               (current-time)))))
	      (jabber-maybe-print-rare-time node))

            ;; ...and call alert hooks.
	    (dolist (hook '(jabber-message-hooks jabber-alert-message-hooks))
	      (run-hook-with-args hook
				  from (current-buffer) body-text
				  (funcall jabber-alert-message-function
					   from (current-buffer) body-text)))))))))
jabber-chat-send   function
(defun jabber-chat-send (jc body)
  "Send BODY through connection JC, and display it in chat buffer.
JC is the Jabber connection."
  ;; Build the stanza...
  (let* ((id (apply 'format "emacs-msg-%d.%d.%d" (current-time)))
	 (stanza-to-send `(message
			   ((to . ,jabber-chatting-with)
			    (type . "chat")
			    (id . ,id))
			   (body () ,body))))
    ;; ...add additional elements...
    ;; TODO: Once we require Emacs 24.1, use `run-hook-wrapped' instead.
    ;; That way we don't need to eliminate the "local hook" functionality
    ;; here.
    (dolist (hook jabber-chat-send-hooks)
      (if (eq hook t)
	  ;; Local hook referring to global...
	  (when (local-variable-p 'jabber-chat-send-hooks)
	    (dolist (global-hook (default-value 'jabber-chat-send-hooks))
	      (nconc stanza-to-send (funcall global-hook body id))))
      (nconc stanza-to-send (funcall hook body id))))
    ;; ...display it, if it would be displayed.
    (when (run-hook-with-args-until-success 'jabber-chat-printers stanza-to-send :local :printp)
      (jabber-maybe-print-rare-time
       (ewoc-enter-last jabber-chat-ewoc (list :local stanza-to-send :time (current-time)))))
    ;; ...and send it...
    (jabber-send-sexp jc stanza-to-send)))
jabber-chat-pp   function
(defun jabber-chat-pp (data)
  "Pretty-print a <message/> stanza.
\(car data) is either :local, :foreign, :error or :notice.
\(cadr data) is the <message/> stanza.
This function is used as an ewoc prettyprinter."
  (let* ((beg (point))
         (original-timestamp (when (listp (cadr data))
                               (jabber-message-timestamp (cadr data))))
         (internal-time
          (plist-get (cddr data) :time))
         (body (ignore-errors (car
               (jabber-xml-node-children
                (car
                 (jabber-xml-get-children (cadr data) 'body))))))
         (/me-p
          (and (> (length body) 4)
               (string= (substring body 0 4) "/me "))))

    ;; Print prompt...
    (let ((delayed (or original-timestamp (plist-get (cddr data) :delayed)))
          (prompt-start (point)))
      (cl-case (car data)
        (:local
         (jabber-chat-self-prompt (or original-timestamp internal-time)
                                  delayed
                                  /me-p))
        (:foreign
         (if (and (listp (cadr data))
                  (jabber-muc-private-message-p (cadr data)))
             (jabber-muc-private-print-prompt (cadr data))
           ;; For :error and :notice, this might be a string... beware
           (jabber-chat-print-prompt (when (listp (cadr data)) (cadr data))
                                     (or original-timestamp internal-time)
                                     delayed
                                     /me-p)))
        ((:error :notice :subscription-request)
         (jabber-chat-system-prompt (or original-timestamp internal-time)))
        (:muc-local
         (jabber-muc-print-prompt (cadr data) t /me-p))
        (:muc-foreign
         (jabber-muc-print-prompt (cadr data) nil /me-p))
        ((:muc-notice :muc-error)
         (jabber-muc-system-prompt)))
      (put-text-property prompt-start (point) 'field 'jabber-prompt))

    ;; ...and body
    (cl-case (car data)
      ((:local :foreign)
       (run-hook-with-args 'jabber-chat-printers (cadr data) (car data) :insert))
      ((:muc-local :muc-foreign)
       (dolist (hook '(jabber-muc-printers jabber-chat-printers))
         (run-hook-with-args hook (cadr data) (car data) :insert)))
      ((:error :muc-error)
       (if (stringp (cadr data))
            (insert (jabber-propertize (cadr data) 'face 'jabber-chat-error))
         (jabber-chat-print-error (cadr data))))
      ((:notice :muc-notice)
       (insert (cadr data)))
      (:rare-time
       (insert (jabber-propertize (format-time-string jabber-rare-time-format (cadr data))
                                  'face 'jabber-rare-time-face)))
      (:subscription-request
       (insert "This user requests subscription to your presence.\n")
       (when (and (stringp (cadr data)) (not (zerop (length (cadr data)))))
         (insert "Message: " (cadr data) "\n"))
       (insert "Accept?\n\n")
       (cl-flet ((button
               (text action)
               (if (fboundp 'insert-button)
                   (insert-button text 'action action)
                 ;; simple button replacement
                 (let ((keymap (make-keymap)))
                   (define-key keymap "\r" action)
                   (insert (jabber-propertize text 'keymap keymap 'face 'highlight))))
               (insert "\t")))
         (button "Mutual" 'jabber-subscription-accept-mutual)
         (button "One-way" 'jabber-subscription-accept-one-way)
         (button "Decline" 'jabber-subscription-decline))))

    (when jabber-chat-fill-long-lines
      (save-restriction
        (narrow-to-region beg (point))
        (jabber-chat-buffer-fill-long-lines)))

    (put-text-property beg (point) 'read-only t)
    (put-text-property beg (point) 'front-sticky t)
    (put-text-property beg (point) 'rear-nonsticky t)))
jabber-rare-time-needed   function
(defun jabber-rare-time-needed (time1 time2)
  "Return non-nil if a timestamp should be printed between TIME1 and TIME2."
  (not (string= (format-time-string jabber-rare-time-format time1)
		(format-time-string jabber-rare-time-format time2))))
jabber-maybe-print-rare-time   function
(defun jabber-maybe-print-rare-time (node)
  "Print rare time before NODE, if appropriate."
  (let* ((prev (ewoc-prev jabber-chat-ewoc node))
	 (data (ewoc-data node))
	 (prev-data (when prev (ewoc-data prev))))
    (cl-flet ((entry-time (entry)
		       (or (when (listp (cadr entry))
			     (jabber-message-timestamp (cadr entry)))
			   (plist-get (cddr entry) :time))))
      (when (and jabber-print-rare-time
		 (or (null prev)
		     (jabber-rare-time-needed (entry-time prev-data)
					      (entry-time data))))
	(ewoc-enter-before jabber-chat-ewoc node
			   (list :rare-time (entry-time data)))))))
jabber-chat-print-prompt   function
(defun jabber-chat-print-prompt (xml-data timestamp delayed dont-print-nick-p)
  "Print prompt for received message in XML-DATA.
TIMESTAMP is the timestamp to print, or nil to get it
from a jabber:x:delay element.
If DELAYED is non-nil, print long timestamp
\(`jabber-chat-delayed-time-format' as opposed to
`jabber-chat-time-format').
If DONT-PRINT-NICK-P is non-nil, don't include nickname."
  (let ((from (jabber-xml-get-attribute xml-data 'from))
	(timestamp (or timestamp (jabber-message-timestamp xml-data))))
    (insert (jabber-propertize
	     (format-spec jabber-chat-foreign-prompt-format
			  (list
			   (cons ?t (format-time-string
				     (if delayed
					 jabber-chat-delayed-time-format
				       jabber-chat-time-format)
				     timestamp))
			   (cons ?n (if dont-print-nick-p "" (jabber-jid-displayname from)))
			   (cons ?u (or (jabber-jid-username from) from))
			   (cons ?r (jabber-jid-resource from))
			   (cons ?j (jabber-jid-user from))))
	     'face 'jabber-chat-prompt-foreign
	     'help-echo
	     (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from " from)))))
jabber-chat-system-prompt   function
(defun jabber-chat-system-prompt (timestamp)
  (insert (jabber-propertize
	   (format-spec jabber-chat-foreign-prompt-format
			(list
			 (cons ?t (format-time-string jabber-chat-time-format
						      timestamp))
			 (cons ?n "")
			 (cons ?u "")
			 (cons ?r "")
			 (cons ?j "")))
	   'face 'jabber-chat-prompt-system
	   'help-echo
	   (concat (format-time-string "System message on %Y-%m-%d %H:%M:%S" timestamp)))))
jabber-chat-self-prompt   function
(defun jabber-chat-self-prompt (timestamp delayed dont-print-nick-p)
  "Print prompt for sent message.
TIMESTAMP is the timestamp to print, or nil for now.
If DELAYED is non-nil, print long timestamp
\(`jabber-chat-delayed-time-format' as opposed to
`jabber-chat-time-format').
If DONT-PRINT-NICK-P is non-nil, don't include nickname."
  (let* ((state-data (fsm-get-state-data jabber-buffer-connection))
	 (username (plist-get state-data :username))
	 (server (plist-get state-data :server))
	 (resource (plist-get state-data :resource))
	 (nickname username))
    (insert (jabber-propertize
	     (format-spec jabber-chat-local-prompt-format
			  (list
			   (cons ?t (format-time-string
				     (if delayed
					 jabber-chat-delayed-time-format
				       jabber-chat-time-format)
				     timestamp))
			   (cons ?n (if dont-print-nick-p "" nickname))
			   (cons ?u username)
			   (cons ?r resource)
			   (cons ?j (concat username "@" server))))
	     'face 'jabber-chat-prompt-local
	     'help-echo
	     (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from you")))))
jabber-chat-print-error   function
(defun jabber-chat-print-error (xml-data)
  "Print error in given <message/> in a readable way.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((the-error (car (jabber-xml-get-children xml-data 'error))))
    (insert
     (jabber-propertize
      (concat "Error: " (jabber-parse-error the-error))
      'face 'jabber-chat-error))))
jabber-chat-print-subject   function
(defun jabber-chat-print-subject (xml-data who mode)
  "Print subject of given <message/>, if any.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((subject (car
		  (jabber-xml-node-children
		   (car
		    (jabber-xml-get-children xml-data 'subject))))))
    (when (not (zerop (length subject)))
      (cl-case mode
	(:printp
	 t)
	(:insert
	 (insert (jabber-propertize
		  "Subject: " 'face 'jabber-chat-prompt-system)
		 (jabber-propertize
		  subject
		  'face 'jabber-chat-text-foreign)
		 "\n"))))))
jabber-chat-print-body   function
(defun jabber-chat-print-body (xml-data who mode)
  (run-hook-with-args-until-success 'jabber-body-printers xml-data who mode))
jabber-chat-normal-body   function
(defun jabber-chat-normal-body (xml-data who mode)
  "Print body for received message in XML-DATA."
  (let ((body (car
	       (jabber-xml-node-children
		(car
		 (jabber-xml-get-children xml-data 'body))))))
    (when body

      (when (eql mode :insert)
	(if (and (> (length body) 4)
		 (string= (substring body 0 4) "/me "))
	    (let ((action (substring body 4))
		  (nick (cond
			 ((eq who :local)
			  (plist-get (fsm-get-state-data jabber-buffer-connection) :username))
			 ((or (jabber-muc-message-p xml-data)
			      (jabber-muc-private-message-p xml-data))
			  (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
			 (t
			  (jabber-jid-displayname (jabber-xml-get-attribute xml-data 'from))))))
	      (insert (jabber-propertize
		       (concat nick
			       " "
			       action)
		       'face 'jabber-chat-prompt-system)))
	  (insert (jabber-propertize
		   body
		   'face (cl-case who
			   ((:foreign :muc-foreign) 'jabber-chat-text-foreign)
			   ((:local :muc-local) 'jabber-chat-text-local))))))
      t)))
jabber-chat-print-url   function
(defun jabber-chat-print-url (xml-data who mode)
  "Print URLs provided in jabber:x:oob namespace.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((foundp nil))
    (dolist (x (jabber-xml-node-children xml-data))
      (when (and (listp x) (eq (jabber-xml-node-name x) 'x)
		 (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:oob"))
	(setq foundp t)

	(when (eql mode :insert)
	  (let ((url (car (jabber-xml-node-children
			   (car (jabber-xml-get-children x 'url)))))
		(desc (car (jabber-xml-node-children
			    (car (jabber-xml-get-children x 'desc))))))
	    (insert "\n"
                    (jabber-propertize
		     "URL: " 'face 'jabber-chat-prompt-system)
                    (format "%s <%s>" desc url))))))
    foundp))
jabber-chat-goto-address   function
(defun jabber-chat-goto-address (xml-data who mode)
  "Call `goto-address' on the newly written text.

XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (when (eq mode :insert)
    (ignore-errors
      (let ((end (point))
	    (limit (max (- (point) 1000) (1+ (point-min)))))
	;; We only need to fontify the text written since the last
	;; prompt.  The prompt has a field property, so we can find it
	;; using `field-beginning'.
	(goto-address-fontify (field-beginning nil nil limit) end)))))

(add-to-list 'jabber-jid-chat-menu
	     (cons "Compose message" 'jabber-compose))
jabber-send-message   command
(defun jabber-send-message (jc to subject body type)
  "Send a message tag to the server.
JC is the Jabber connection."
  (interactive (list (jabber-read-account)
		     (jabber-read-jid-completing "to: ")
		     (jabber-read-with-input-method "subject: ")
		     (jabber-read-with-input-method "body: ")
		     (read-string "type: ")))
  (jabber-send-sexp jc
		    `(message ((to . ,to)
                               ,(if (> (length type) 0)
                                    `(type . ,type)))
                              ,(if (> (length subject) 0)
                                   `(subject () ,subject))
                              ,(if (> (length body) 0)
                                   `(body () ,body))))
  (if (and jabber-history-enabled (not (string= type "groupchat")))
      (jabber-history-log-message "out" nil to body (current-time))))
(add-to-list 'jabber-jid-chat-menu
	     (cons "Start chat" 'jabber-chat-with))
jabber-chat-with   command
(defun jabber-chat-with (jc jid &optional other-window)
  "Open an empty chat window for chatting with JID.
With a prefix argument, open buffer in other window.
Returns the chat buffer.
JC is the Jabber connection."
  (interactive (let* ((jid
		      (jabber-read-jid-completing "chat with:"))
		      (account
		       (jabber-read-account nil jid)))
		 (list
		  account jid current-prefix-arg)))
  (let ((buffer (jabber-chat-create-buffer jc jid)))
    (if other-window
	(switch-to-buffer-other-window buffer)
      (switch-to-buffer buffer))))
jabber-chat-with-jid-at-point   command
(defun jabber-chat-with-jid-at-point (&optional other-window)
  "Start chat with JID at point.
Signal an error if there is no JID at point.
With a prefix argument, open buffer in other window."
  (interactive "P")
  (let ((jid-at-point (get-text-property (point)
					 'jabber-jid))
	(account (get-text-property (point)
				    'jabber-account)))
    (if (and jid-at-point account)
	(jabber-chat-with account jid-at-point other-window)
      (error "No contact at point"))))

Roster and presence bookkeeping

jabber-presence-element-functions   variable
(defvar jabber-presence-element-functions nil
  "List of functions returning extra elements for <presence/> stanzas.
Each function takes one argument, the connection, and returns a
possibly empty list of extra child element of the <presence/>
stanza.")
jabber-presence-history   variable
(defvar jabber-presence-history ()
  "Keeps track of previously used presence status types.")
jabber-process-roster   function
(add-to-list 'jabber-iq-set-xmlns-alist
	     (cons "jabber:iq:roster" (function (lambda (jc x) (jabber-process-roster jc x nil)))))
(defun jabber-process-roster (jc xml-data closure-data)
  "Process an incoming roster infoquery result.
CLOSURE-DATA should be 'initial if initial roster push, nil otherwise.
JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((roster (plist-get (fsm-get-state-data jc) :roster))
	(from (jabber-xml-get-attribute xml-data 'from))
	(type (jabber-xml-get-attribute xml-data 'type))
	(id (jabber-xml-get-attribute xml-data 'id))
	(username (plist-get (fsm-get-state-data jc) :username))
	(server (plist-get (fsm-get-state-data jc) :server))
	(resource (plist-get (fsm-get-state-data jc) :resource))
	new-items changed-items deleted-items)
    ;; Perform sanity check on "from" attribute: it should be either absent
    ;; match our own JID, or match the server's JID (the latter is what
    ;; Facebook does).
    (if (not (or (null from)
		 (string= from server)
		 (string= from (concat username "@" server))
		 (string= from (concat username "@" server "/" resource))))
	(message "Roster push with invalid \"from\": \"%s\" (expected \"%s\", \"%s@%s\" or \"%s@%s/%s\")"
		 from
		 server username server username server resource)

      (dolist (item (jabber-xml-get-children (car (jabber-xml-get-children xml-data 'query)) 'item))
	(let (roster-item
	      (jid (jabber-jid-symbol (jabber-xml-get-attribute item 'jid))))

	  ;; If subscripton="remove", contact is to be removed from roster
	  (if (string= (jabber-xml-get-attribute item 'subscription) "remove")
	      (progn
		(if (jabber-jid-rostername jid)
		    (message "%s (%s) removed from roster" (jabber-jid-rostername jid) jid)
		  (message "%s removed from roster" jid))
		(push jid deleted-items))

	    ;; Find contact if already in roster
	    (setq roster-item (car (memq jid roster)))

	    (if roster-item
		(push roster-item changed-items)
	      ;; If not found, create a new roster item.
	      (unless (eq closure-data 'initial)
		(if (jabber-xml-get-attribute item 'name)
		    (message "%s (%s) added to roster" (jabber-xml-get-attribute item 'name) jid)
		  (message "%s added to roster" jid)))
	      (setq roster-item jid)
	      (push roster-item new-items))