Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add Jabber client.

  • Loading branch information...
commit b6f578cee40a77ce701b0cc2c00198a9ffc359d9 1 parent cd23f0c
@technomancy authored
Showing with 11,353 additions and 2 deletions.
  1. +15 −0 elpa-to-submit/jabber/AUTHORS
  2. +92 −0 elpa-to-submit/jabber/NEWS
  3. +104 −0 elpa-to-submit/jabber/README
  4. +55 −0 elpa-to-submit/jabber/filetransfer.txt
  5. +75 −0 elpa-to-submit/jabber/hex-util.el
  6. +373 −0 elpa-to-submit/jabber/jabber-activity.el
  7. +105 −0 elpa-to-submit/jabber/jabber-ahc-presence.el
  8. +226 −0 elpa-to-submit/jabber/jabber-ahc.el
  9. +424 −0 elpa-to-submit/jabber/jabber-alert.el
  10. +98 −0 elpa-to-submit/jabber/jabber-browse.el
  11. +477 −0 elpa-to-submit/jabber/jabber-chat.el
  12. +162 −0 elpa-to-submit/jabber/jabber-chatbuffer.el
  13. +138 −0 elpa-to-submit/jabber/jabber-conn.el
  14. +511 −0 elpa-to-submit/jabber/jabber-core.el
  15. +202 −0 elpa-to-submit/jabber/jabber-disco.el
  16. +227 −0 elpa-to-submit/jabber/jabber-events.el
  17. +234 −0 elpa-to-submit/jabber/jabber-export.el
  18. +125 −0 elpa-to-submit/jabber/jabber-feature-neg.el
  19. +33 −0 elpa-to-submit/jabber/jabber-festival.el
  20. +54 −0 elpa-to-submit/jabber/jabber-ft-client.el
  21. +104 −0 elpa-to-submit/jabber/jabber-ft-server.el
  22. +244 −0 elpa-to-submit/jabber/jabber-history.el
  23. +177 −0 elpa-to-submit/jabber/jabber-iq.el
  24. +95 −0 elpa-to-submit/jabber/jabber-keepalive.el
  25. +58 −0 elpa-to-submit/jabber/jabber-keymap.el
  26. +88 −0 elpa-to-submit/jabber/jabber-logon.el
  27. +141 −0 elpa-to-submit/jabber/jabber-menu.el
  28. +95 −0 elpa-to-submit/jabber/jabber-modeline.el
  29. +745 −0 elpa-to-submit/jabber/jabber-muc.el
  30. +346 −0 elpa-to-submit/jabber/jabber-presence.el
  31. +34 −0 elpa-to-submit/jabber/jabber-ratpoison.el
  32. +143 −0 elpa-to-submit/jabber/jabber-register.el
  33. +456 −0 elpa-to-submit/jabber/jabber-roster.el
  34. +116 −0 elpa-to-submit/jabber/jabber-sasl.el
  35. +40 −0 elpa-to-submit/jabber/jabber-sawfish.el
  36. +29 −0 elpa-to-submit/jabber/jabber-screen.el
  37. +115 −0 elpa-to-submit/jabber/jabber-search.el
  38. +74 −0 elpa-to-submit/jabber/jabber-si-client.el
  39. +100 −0 elpa-to-submit/jabber/jabber-si-server.el
  40. +310 −0 elpa-to-submit/jabber/jabber-socks5.el
  41. +444 −0 elpa-to-submit/jabber/jabber-util.el
  42. +468 −0 elpa-to-submit/jabber/jabber-vcard.el
  43. +72 −0 elpa-to-submit/jabber/jabber-version.el
  44. +72 −0 elpa-to-submit/jabber/jabber-watch.el
  45. +322 −0 elpa-to-submit/jabber/jabber-widget.el
  46. +30 −0 elpa-to-submit/jabber/jabber-xmessage.el
  47. +206 −0 elpa-to-submit/jabber/jabber-xml.el
  48. +183 −0 elpa-to-submit/jabber/jabber.el
  49. +1,863 −0 elpa-to-submit/jabber/jabber.texi
  50. +443 −0 elpa-to-submit/jabber/sha1.el
  51. +6 −0 init.el
  52. +1 −1  starter-kit-bindings.el
  53. +3 −1 starter-kit-elpa.el
View
15 elpa-to-submit/jabber/AUTHORS
@@ -0,0 +1,15 @@
+Developers:
+Tom Berger
+Magnus Henoch
+
+Contributors:
+Mathias Dahl
+Mario Domenech Goulart
+Nolan Eakins
+François Fleuret
+Justin Kirby
+Carl Henrik Lunde
+Andrey Slusar
+
+
+arch-tag: 15700144-3BD9-11D9-871C-000A95C2FCD0
View
92 elpa-to-submit/jabber/NEWS
@@ -0,0 +1,92 @@
+-*- mode: outline -*-
+
+* New features in jabber.el 0.7
+
+** SSL connections possible
+See variable `jabber-connection-type'.
+
+** Chat buffers rewritten
+New modular design gives increased extensibility.
+*** Received URLs are displayed
+*** Long lines are filled
+See jabber-chat-fill-long-lines.
+*** Rare timestamps are printed by default
+See jabber-print-rare-time and jabber-rare-time-format.
+
+** MUC features
+*** Different default nicknames for different MUC rooms
+See jabber-muc-default-nicknames.
+*** Autojoin MUC rooms on connection
+See jabber-muc-autojoin.
+*** Change nickname
+Actually simply an alias from jabber-muc-nick to jabber-groupchat-join.
+*** Invitations
+Both sending and receiving invitiations is supported.
+*** Basic affiliation change support
+(Not finished)
+*** Private MUC messages
+*** Support for setting and displaying topic
+
+** Global key bindings
+Global keymap under C-x C-j.
+
+** Vcard viewer and editor
+
+** Roster export
+
+** Message events (JEP-0022)
+
+** Easy way to define external notifiers
+See define-jabber-alert. Alerts for Festival (speech synthesis),
+Sawfish, and xmessage added.
+
+** Activity mode improved
+Can now display count in frame title. Update hook added.
+
+** Roster display optimized
+
+** Optionally use per-contact history files
+
+** Jabber menu in menubar not enabled by default
+Call jabber-menu to have it there.
+
+** Flyspell in chat buffers
+Flyspell will only spell check what you're currently writing.
+
+** Different time formats for instant and delayed messages
+See `jabber-chat-time-format' and `jabber-chat-delayed-time-format'.
+You can see the complete timestamp in a tooltip by holding the mouse
+over the prompt.
+
+** Chat buffers in inactive windows are scrolled
+
+** Roster is sorted by name also
+
+* New features in jabber.el 0.6.1
+
+** Message history
+Set jabber-history-enabled to t to activate it.
+
+** Backlogs
+If you have history enabled, the last few messages are inserted when
+you open a new chat buffer.
+
+** Activity tracking on the mode line
+Activate it with M-x jabber-activity-mode.
+
+** Receive an alert when a specific person goes online
+Use it with M-x jabber-watch-add.
+
+** Support for /me in chats
+As in "/me laughs" etc.
+
+** Message alerts for current buffer can be disabled
+Set jabber-message-alert-same-buffer to nil to do that.
+
+** Basic moderation support in MUC
+
+** MUC alerts are separated from ordinary message alerts
+Customize jabber-alert-muc-hooks to get your desired behaviour.
+
+
+arch-tag: 1CE20E4E-3BD9-11D9-8D64-000A95C2FCD0
View
104 elpa-to-submit/jabber/README
@@ -0,0 +1,104 @@
+This is jabber.el 0.7, a Jabber client for Emacs. If you don't know
+what Jabber is, see http://www.jabber.org .
+
+Home page: http://emacs-jabber.sourceforge.net
+Project page: http://sourceforge.net/projects/emacs-jabber
+Wiki page: http://www.emacswiki.org/cgi-bin/wiki/JabberEl
+Mailing list: http://lists.sourceforge.net/lists/listinfo/emacs-jabber-general
+and: http://dir.gmane.org/gmane.emacs.jabber.general
+
+GNU Emacs
+=========
+
+jabber.el depends on GNU Emacs 21, in particular xml.el, and some
+files from Gnus 5.10. If you don't have Gnus 5.10 (M-x gnus-version
+will tell), you can download sha1.el and hex-util.el from Gnus CVS
+at http://quimby.gnus.org/cgi-bin/cvsweb.cgi/gnus/lisp/ . For your
+convenience, these files are included in the tarball.
+
+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.
+
+SASL
+====
+jabber.el will use the SASL library of FLIM (Faithful Library about
+Internet Message; it is also included in newer versions of Gnus) if
+it's present. If not, it will fall back to JEP-0077 authentication.
+
+TLS/SSL
+=======
+To get an encrypted connection, you need either tls.el (from Gnus) or
+ssl.el. These are interfaces to GnuTLS and OpenSSL, respectively; use
+the appropriate one. Recent versions of tls.el support both programs,
+though. The version of ssl.el distributed with Gnus is outdated; use
+the one from W3 CVS instead:
+http://cvs.savannah.gnu.org/viewcvs/w3/lisp/ssl.el?root=w3
+
+To actually use encryption, customize the variables
+jabber-connection-type and jabber-connection-ssl-program.
+
+Note that only the connection from you to the server is encrypted;
+there is no guarantee of other connections being encrypted.
+
+StartTLS is not supported in this version of jabber.el.
+
+Installation
+============
+To install, put all .el files somewhere in your load-path (or have
+your load-path include the directory they're in) and put
+(require 'jabber) in your .emacs file. To install the Info
+documentation, copy jabber.info to /usr/local/info and run
+"install-info /usr/local/info/jabber.info".
+
+If you've been using a post-0.6 CVS version of jabber.el, you might
+need to remove some redundant hook functions. Make sure that
+jabber-alert-message-hooks doesn't contain jabber-message-history, and
+that jabber-alert-presence-hooks doesn't contain
+jabber-presence-watch.
+
+Usage
+=====
+To start using it, type M-x jabber-customize and set your username and
+server. Then, type C-x C-j C-c (or equivalently M-x jabber-connect)
+to connect (with prefix argument, register new account).
+
+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 experimental support for file
+transfer. It is not enabled by default. See the file
+filetransfer.txt for details.
View
55 elpa-to-submit/jabber/filetransfer.txt
@@ -0,0 +1,55 @@
+-*- outline -*-
+* File transfer
+
+This release of jabber.el contains some support for file transfer.
+Both sending and receiving files are supported. Since this feature
+needs more testing, it is not enabled by default. To enable it, add
+
+(require 'jabber-ft-server)
+(require 'jabber-ft-client)
+(require 'jabber-socks5)
+
+to your .emacs file. Please share your experiences - does it work for
+you? Can you suggest any improvements?
+
+** Sending files
+
+Sending files over Jabber normally requires the ability to listen on a
+network port. As of Emacs 21.3 and XEmacs 21.4, elisp programs can't
+do this, so you have to specify a JEP-0065 proxy. The variable
+jabber-socks5-proxies is a list of proxies to use. "proxy.jabber.org"
+and "proxy65.jabber.ccc.de" are the only proxies I know of.
+
+After you have specified one or more proxies, jabber.el needs to know
+their network addresses. Type M-x jabber-socks5-query-all-proxies,
+and watch the progress in the echo area. Note that you have to be
+connected when you do this, and that you have to do this every
+session.
+
+To send a file, type M-x jabber-ft-send. You will be asked for which
+file to send, and whom to send it to. You have to specify a complete
+JID with resource, such as user@domain/resource - only user@domain
+will not work. To see the resources of your contacts, set
+jabber-show-resources to t and type M-x jabber-display-roster.
+
+While the file is being sent, your Emacs will be locked up and you
+can't do anything else. Hopefully, this will be fixed some time.
+
+** Receiving files
+
+When someone tries to send a file to you, you will get a message
+either in the echo area or in a dialog box, asking you to confirm.
+You will also be asked for where to save the file.
+
+Receiving a file should not cause any interruption to your work. If
+it does, please tell.
+
+** Protocol details
+
+See JEPs 95, 96 and 65.
+
+SOCKS5 (JEP-0065) is the only stream method currently supported by
+jabber.el, in conflict with JEP-0096, which requires that In-Band
+Bytestreams be supported as well.
+
+Range requests are not supported, neither in sending nor in receiving.
View
75 elpa-to-submit/jabber/hex-util.el
@@ -0,0 +1,75 @@
+;;; hex-util.el --- Functions to encode/decode hexadecimal string.
+
+;; Copyright (C) 1999, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: data
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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, 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; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+ (defmacro hex-char-to-num (chr)
+ (` (let ((chr (, chr)))
+ (cond
+ ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
+ ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
+ ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
+ (t (error "Invalid hexadecimal digit `%c'" chr))))))
+ (defmacro num-to-hex-char (num)
+ (` (aref "0123456789abcdef" (, num)))))
+
+(defun decode-hex-string (string)
+ "Decode hexadecimal STRING to octet string."
+ (let* ((len (length string))
+ (dst (make-string (/ len 2) 0))
+ (idx 0)(pos 0))
+ (while (< pos len)
+;;; logior and lsh are not byte-coded.
+;;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
+;;; (hex-char-to-num (aref string (1+ pos)))))
+ (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
+ (hex-char-to-num (aref string (1+ pos)))))
+ (setq idx (1+ idx)
+ pos (+ 2 pos)))
+ dst))
+
+(defun encode-hex-string (string)
+ "Encode octet STRING to hexadecimal string."
+ (let* ((len (length string))
+ (dst (make-string (* len 2) 0))
+ (idx 0)(pos 0))
+ (while (< pos len)
+;;; logand and lsh are not byte-coded.
+;;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
+ (aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
+ (setq idx (1+ idx))
+;;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
+ (aset dst idx (num-to-hex-char (% (aref string pos) 16)))
+ (setq idx (1+ idx)
+ pos (1+ pos)))
+ dst))
+
+(provide 'hex-util)
+
+;;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859
+;;; hex-util.el ends here
View
373 elpa-to-submit/jabber/jabber-activity.el
@@ -0,0 +1,373 @@
+;;; jabber-activity.el --- show jabber activity in the mode line
+
+;; Copyright (C) 2004 Carl Henrik Lunde - <chlunde+jabber+@ping.uio.no>
+
+;; This file is a part of jabber.el
+
+;; 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, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Allows tracking messages from buddies using the global mode line
+;; See (info "(jabber)Tracking activity")
+
+;;; TODO:
+
+;; - Make it possible to enable this mode using M-x customize
+;; - When Emacs is on another desktop, (get-buffer-window buf 'visible)
+;; returns nil. We need to know when the user selects the frame again
+;; so we can remove the string from the mode line. (Or just run
+;; jabber-activity-clean often).
+;; - jabber-activity-switch-to needs a keybinding. In which map?
+;; - Is there any need for having defcustom jabber-activity-make-string?
+;; - When there's activity in a buffer it would be nice with a hook which
+;; does the opposite of bury-buffer, so switch-to-buffer will show that
+;; buffer first.
+
+;;; Code:
+
+(require 'jabber-core)
+(require 'jabber-alert)
+(require 'jabber-util)
+(require 'cl)
+
+(defgroup jabber-activity nil
+ "activity tracking options"
+ :group 'jabber)
+
+(defcustom jabber-activity-make-string 'jabber-activity-make-string-default
+ "Function to call, for making the string to put in the mode
+line. The default function returns the nick of the user."
+ :set #'(lambda (var val)
+ (custom-set-default var val)
+ (when (fboundp 'jabber-activity-make-name-alist)
+ (jabber-activity-make-name-alist)
+ (jabber-activity-mode-line-update)))
+ :type 'function
+ :group 'jabber-activity)
+
+(defcustom jabber-activity-shorten-minimum 1
+ "All strings returned by `jabber-activity-make-strings-shorten' will be
+at least this long, when possible."
+ :group 'jabber-activity
+ :type 'number)
+
+(defcustom jabber-activity-make-strings 'jabber-activity-make-strings-default
+ "Function which should return an alist of JID -> string when given a list of
+JIDs."
+ :set #'(lambda (var val)
+ (custom-set-default var val)
+ (when (fboundp 'jabber-activity-make-name-alist)
+ (jabber-activity-make-name-alist)
+ (jabber-activity-mode-line-update)))
+ :type '(choice (function-item :tag "Keep strings"
+ :value jabber-activity-make-strings-default)
+ (function-item :tag "Shorten strings"
+ :value jabber-activity-make-strings-shorten)
+ (function :tag "Other function"))
+ :group 'jabber-activity)
+
+(defcustom jabber-activity-count-in-title nil
+ "If non-nil, display number of active JIDs in frame title."
+ :type 'boolean
+ :group 'jabber-activity
+ :set #'(lambda (var val)
+ (custom-set-default var val)
+ (when (bound-and-true-p jabber-activity-mode)
+ (jabber-activity-mode -1)
+ (jabber-activity-mode 1))))
+
+(defcustom jabber-activity-count-in-title-format
+ '(jabber-activity-jids ("[" jabber-activity-count-string "] "))
+ "Format string used for displaying activity in frame titles.
+Same syntax as `mode-line-format'."
+ :type 'sexp
+ :group 'jabber-activity
+ :set #'(lambda (var val)
+ (if (not (bound-and-true-p jabber-activity-mode))
+ (custom-set-default var val)
+ (jabber-activity-mode -1)
+ (custom-set-default var val)
+ (jabber-activity-mode 1))))
+
+(defcustom jabber-activity-show-p 'jabber-activity-show-p-default
+ "Predicate function to call to check if the given JID should be
+shown in the mode line or not."
+ :type 'function
+ :group 'jabber-activity)
+
+(defcustom jabber-activity-query-unread t
+ "Query the user as to whether killing Emacs should be cancelled when
+there are unread messages which otherwise would be lost."
+ :type 'boolean
+ :group 'jabber-activity)
+
+(defface jabber-activity-face
+ '((t (:foreground "red" :weight bold)))
+ "The face for displaying jabber-activity-string in the mode line"
+ :group 'jabber-activity)
+
+(defvar jabber-activity-jids nil
+ "A list of JIDs which have caused activity")
+
+(defvar jabber-activity-name-alist nil
+ "Alist of mode line names for bare JIDs")
+
+(defvar jabber-activity-mode-string ""
+ "The mode string for jabber activity")
+
+(defvar jabber-activity-count-string "0"
+ "Number of active JIDs as a string.")
+
+(defvar jabber-activity-update-hook nil
+ "Hook called when `jabber-activity-jids' changes.
+It is called after `jabber-activity-mode-string' and
+`jabber-activity-count-string' are updated.")
+
+;; Protect this variable from being set in Local variables etc.
+(put 'jabber-activity-mode-string 'risky-local-variable t)
+(put 'jabber-activity-count-string 'risky-local-variable t)
+
+(defun jabber-activity-make-string-default (jid)
+ "Return the nick of the JID. If no nick is available, return
+the user name part of the JID. In private MUC conversations,
+return the user's nickname."
+ (if (jabber-muc-sender-p jid)
+ (jabber-jid-resource jid)
+ (let ((nick (jabber-jid-displayname jid))
+ (user (jabber-jid-user jid))
+ (username (jabber-jid-username jid)))
+ (if (and username (string= nick user))
+ username
+ nick))))
+
+(defun jabber-activity-make-strings-default (jids)
+ "Apply `jabber-activity-make-string' on JIDS"
+ (mapcar #'(lambda (jid) (cons jid (funcall jabber-activity-make-string jid)))
+ jids))
+
+(defun jabber-activity-common-prefix (s1 s2)
+ "Return length of common prefix string shared by S1 and S2"
+ (let ((len (min (length s1) (length s2))))
+ (or (dotimes (i len)
+ (when (not (eq (aref s1 i) (aref s2 i)))
+ (return i)))
+ ;; Substrings, equal, nil, or empty ("")
+ len)))
+
+(defun jabber-activity-make-strings-shorten (jids)
+ "Return an alist of JID -> names acquired by running
+`jabber-activity-make-string' on JIDS, and then shortening the names
+as much as possible such that all strings still are unique and at
+least `jabber-activity-shorten-minimum' long."
+ (let ((alist
+ (sort (mapcar
+ #'(lambda (x) (cons x (funcall jabber-activity-make-string x)))
+ jids)
+ #'(lambda (x y) (string-lessp (cdr x) (cdr y))))))
+ (loop for ((prev-jid . prev) (cur-jid . cur) (next-jid . next))
+ on (cons nil alist)
+ until (null cur)
+ collect
+ (cons
+ cur-jid
+ (substring
+ cur
+ 0 (min (length cur)
+ (max jabber-activity-shorten-minimum
+ (1+ (jabber-activity-common-prefix cur prev))
+ (1+ (jabber-activity-common-prefix cur next)))))))))
+
+(defun jabber-activity-find-buffer-name (jid)
+ "Find the name of the buffer that messages from JID would use."
+ (or (and (jabber-jid-resource jid)
+ (get-buffer (jabber-muc-private-get-buffer
+ (jabber-jid-user jid)
+ (jabber-jid-resource jid))))
+ (get-buffer (jabber-chat-get-buffer jid))
+ (get-buffer (jabber-muc-get-buffer jid))))
+
+(defun jabber-activity-show-p-default (jid)
+ "Returns t only if there is an invisible buffer for JID"
+ (let ((buffer (jabber-activity-find-buffer-name jid)))
+ (and (buffer-live-p buffer)
+ (not (get-buffer-window buffer 'visible)))))
+
+(defun jabber-activity-make-name-alist ()
+ "Rebuild `jabber-activity-name-alist' based on currently known JIDs"
+ (let ((jids (or (mapcar #'car jabber-activity-name-alist)
+ (mapcar #'symbol-name *jabber-roster*))))
+ (setq jabber-activity-name-alist
+ (funcall jabber-activity-make-strings jids))))
+
+(defun jabber-activity-lookup-name (jid)
+ "Lookup name in `jabber-activity-name-alist', creates an entry
+if needed, and returns a (jid . string) pair suitable for the mode line"
+ (let ((elm (assoc jid jabber-activity-name-alist)))
+ (if elm
+ elm
+ (progn
+ ;; Remake alist with the new JID
+ (setq jabber-activity-name-alist
+ (funcall jabber-activity-make-strings
+ (cons jid (mapcar #'car jabber-activity-name-alist))))
+ (jabber-activity-lookup-name jid)))))
+
+(defun jabber-activity-mode-line-update ()
+ "Update the string shown in the mode line using `jabber-activity-make-string'
+on JIDs where `jabber-activity-show-p'"
+ (setq jabber-activity-mode-string
+ (if jabber-activity-jids
+ (mapconcat
+ (lambda (x)
+ (let ((jump-to-jid (car x)))
+ (jabber-propertize
+ (cdr x)
+ 'face 'jabber-activity-face
+ 'local-map (make-mode-line-mouse-map
+ 'mouse-1 `(lambda ()
+ (interactive)
+ (jabber-activity-switch-to
+ ,(car x))))
+ 'help-echo (concat "Jump to "
+ (jabber-jid-displayname (car x))
+ "'s buffer"))))
+ (mapcar #'jabber-activity-lookup-name
+ jabber-activity-jids)
+ ",")
+ ""))
+ (setq jabber-activity-count-string
+ (number-to-string (length jabber-activity-jids)))
+ (force-mode-line-update 'all)
+ (run-hooks 'jabber-activity-update-hook))
+
+;;; Hooks
+
+(defun jabber-activity-clean ()
+ "Remove JIDs where `jabber-activity-show-p' no longer is true"
+ (setq jabber-activity-jids (delete-if-not jabber-activity-show-p
+ jabber-activity-jids))
+ (jabber-activity-mode-line-update))
+
+(defun jabber-activity-add (from buffer text proposed-alert)
+ "Add a JID to mode line when `jabber-activity-show-p'"
+ ;; In case of private MUC message, we want to keep the full JID.
+ (let ((jid (if (jabber-muc-sender-p from)
+ from
+ (jabber-jid-user from))))
+ (when (funcall jabber-activity-show-p jid)
+ (add-to-list 'jabber-activity-jids jid)
+ (jabber-activity-mode-line-update))))
+
+(defun jabber-activity-add-muc (nick group buffer text proposed-alert)
+ "Add a JID to mode line when `jabber-activity-show-p'"
+ (when (funcall jabber-activity-show-p group)
+ (add-to-list 'jabber-activity-jids group)
+ (jabber-activity-mode-line-update)))
+
+(defun jabber-activity-kill-hook ()
+ "Query the user as to whether killing Emacs should be cancelled
+when there are unread messages which otherwise would be lost, if
+`jabber-activity-query-unread' is t"
+ (if (and jabber-activity-jids
+ jabber-activity-query-unread)
+ (yes-or-no-p
+ "You have unread Jabber messages, are you sure you want to quit?")
+ t))
+
+;;; Interactive functions
+
+(defun jabber-activity-switch-to (&optional jid-param)
+ "If JID-PARAM is provided, switch to that buffer. If JID-PARAM is nil and
+there has been activity in another buffer, switch to that buffer. If no such
+buffer exists, switch back to most recently used buffer."
+ (interactive)
+ (if (or jid-param jabber-activity-jids)
+ (let ((jid (or jid-param (car jabber-activity-jids))))
+ (switch-to-buffer (jabber-activity-find-buffer-name jid))
+ (jabber-activity-clean))
+ ;; Switch back to the buffer used last
+ (switch-to-buffer nil)))
+
+;;;###autoload
+(define-minor-mode jabber-activity-mode
+ "Toggle display of activity in hidden jabber buffers in the mode line.
+
+With a numeric arg, enable this display if arg is positive."
+ :global t
+ :group 'jabber-activity
+ :init-value t
+ (if jabber-activity-mode
+ (progn
+ ;; XEmacs compatibilty hack from erc-track
+ (if (featurep 'xemacs)
+ (defadvice switch-to-buffer (after jabber-activity-update (&rest args) activate)
+ (jabber-activity-clean))
+ (add-hook 'window-configuration-change-hook
+ 'jabber-activity-clean))
+ (add-hook 'jabber-message-hooks
+ 'jabber-activity-add)
+ (add-hook 'jabber-muc-hooks
+ 'jabber-activity-add-muc)
+ (add-hook 'jabber-post-connect-hook
+ 'jabber-activity-make-name-alist)
+ (add-to-list 'kill-emacs-query-functions
+ 'jabber-activity-kill-hook)
+ (add-to-list 'global-mode-string
+ '(t jabber-activity-mode-string))
+ (when jabber-activity-count-in-title
+ ;; Be careful not to override specific meanings of the
+ ;; existing title format. In particular, if the car is
+ ;; a symbol, we can't just add our stuff at the beginning.
+ ;; If the car is "", we should be safe.
+ (if (equal (car frame-title-format) "")
+ (add-to-list 'frame-title-format
+ jabber-activity-count-in-title-format)
+ (setq frame-title-format (list ""
+ jabber-activity-count-in-title-format
+ frame-title-format)))
+ (if (equal (car icon-title-format) "")
+ (add-to-list 'icon-title-format
+ jabber-activity-count-in-title-format)
+ (setq icon-title-format (list ""
+ jabber-activity-count-in-title-format
+ icon-title-format)))))
+ (progn
+ (if (featurep 'xemacs)
+ (ad-disable-advice 'switch-to-buffer 'after 'jabber-activity-update)
+ (remove-hook 'window-configuration-change-hook
+ 'jabber-activity-remove-visible))
+ (remove-hook 'jabber-message-hooks
+ 'jabber-activity-add)
+ (remove-hook 'jabber-muc-hooks
+ 'jabber-activity-add-muc)
+ (remove-hook 'jabber-post-connect-hook
+ 'jabber-activity-make-name-alist)
+ (setq global-mode-string (delete '(t jabber-activity-mode-string)
+ global-mode-string))
+ (setq frame-title-format
+ (delete jabber-activity-count-in-title-format
+ frame-title-format))
+ (setq icon-title-format
+ (delete jabber-activity-count-in-title-format
+ icon-title-format)))))
+
+;; XXX: define-minor-mode should probably do this for us, but it doesn't.
+(if jabber-activity-mode (jabber-activity-mode 1))
+
+(provide 'jabber-activity)
+
+;; arch-tag: 127D7E42-356B-11D9-BE1E-000A95C2FCD0
View
105 elpa-to-submit/jabber/jabber-ahc-presence.el
@@ -0,0 +1,105 @@
+;; jabber-ahc-presence.el - provide remote control of presence
+
+;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
+;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(require 'jabber-ahc)
+
+(defconst jabber-ahc-presence-node "presence"
+ "Node used by jabber-ahc-presence")
+
+(jabber-ahc-add jabber-ahc-presence-node "Set presence" 'jabber-ahc-presence
+ 'jabber-my-jid-p)
+
+(defun jabber-ahc-presence (xml-data)
+ "Process presence change command."
+
+ (let* ((query (jabber-iq-query xml-data))
+ (sessionid (jabber-xml-get-attribute query 'sessionid))
+ (action (jabber-xml-get-attribute query 'action)))
+ ;; No session state is kept; instead, lack of session-id is used
+ ;; as indication of first command.
+ (cond
+ ;; command cancelled
+ ((string= action "cancel")
+ `(command ((xmlns . "http://jabber.org/protocol/commands")
+ (sessionid . ,sessionid)
+ (node . ,jabber-ahc-presence-node)
+ (status . "canceled"))))
+ ;; return form
+ ((null sessionid)
+ `(command ((xmlns . "http://jabber.org/protocol/commands")
+ (sessionid . "jabber-ahc-presence")
+ (node . ,jabber-ahc-presence-node)
+ (status . "executing"))
+ (x ((xmlns . "jabber:x:data")
+ (type . "form"))
+ (title nil ,(format "Set presence of %s@%s/%s" jabber-username jabber-server jabber-resource))
+ (instructions nil "Select new presence status.")
+ (field ((var . "show")
+ (label . "Show")
+ (type . "list-single"))
+ (value nil ,(if (string= *jabber-current-show* "")
+ "online"
+ *jabber-current-show*))
+ (option ((label . "Online")) (value nil "online"))
+ (option ((label . "Chatty")) (value nil "chat"))
+ (option ((label . "Away")) (value nil "away"))
+ (option ((label . "Extended away")) (value nil "xa"))
+ (option ((label . "Do not disturb")) (value nil "dnd")))
+ (field ((var . "status")
+ (label . "Status text")
+ (type . "text-single"))
+ (value nil ,*jabber-current-status*))
+ (field ((var . "priority")
+ (label . "Priority")
+ (type . "text-single"))
+ (value nil ,(int-to-string *jabber-current-priority*))))))
+ ;; process form
+ (t
+ (let* ((x (car (jabber-xml-get-children query 'x)))
+ ;; we assume that the first <x/> is the jabber:x:data one
+ (fields (jabber-xml-get-children x 'field))
+ (new-show *jabber-current-show*)
+ (new-status *jabber-current-status*)
+ (new-priority *jabber-current-priority*))
+ (dolist (field fields)
+ (let ((var (jabber-xml-get-attribute field 'var))
+ ;; notice that multi-value fields won't be handled properly
+ ;; by this
+ (value (car (jabber-xml-node-children (car (jabber-xml-get-children field 'value))))))
+ (cond
+ ((string= var "show")
+ (setq new-show (if (string= value "online")
+ ""
+ value)))
+ ((string= var "status")
+ (setq new-status value))
+ ((string= var "priority")
+ (setq new-priority (string-to-int value))))))
+ (jabber-send-presence new-show new-status new-priority))
+ `(command ((xmlns . "http://jabber.org/protocol/commands")
+ (sessionid . ,sessionid)
+ (node . ,jabber-ahc-presence-node)
+ (status . "completed"))
+ (note ((type . "info")) "Presence has been changed."))))))
+
+(provide 'jabber-ahc-presence)
+
+;;; arch-tag: 4b8cbbe7-00a9-4d42-a4ac-b824ab914fba
View
226 elpa-to-submit/jabber/jabber-ahc.el
@@ -0,0 +1,226 @@
+;; jabber-ahc.el - Ad-Hoc Commands by JEP-0050
+
+;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
+;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(require 'jabber-disco)
+(require 'jabber-widget)
+
+(defvar jabber-ahc-sessionid nil
+ "session id of Ad-Hoc Command session")
+
+(defvar jabber-ahc-node nil
+ "node to send commands to")
+
+(defvar jabber-ahc-commands nil
+ "Commands provided
+
+This is an alist, where the keys are node names as strings (which
+means that they must not conflict). The values are plists having
+following properties:
+
+acl - function taking JID as single argument, return non-nil for
+ access allowed. No function means open for everyone.
+name - name of command
+func - function receiving entire IQ stanza as single argument
+ and returning a <command/> node
+
+Use the function `jabber-ahc-add' to add a command to this list.")
+
+
+;;; SERVER
+(add-to-list 'jabber-disco-info-nodes
+ (list "http://jabber.org/protocol/commands"
+ '((identity ((category . "automation")
+ (type . "command-list")
+ (name . "Ad-Hoc Command list")))
+ (feature ((var . "http://jabber.org/protocol/commands")))
+ (feature ((var . "http://jabber.org/protocol/disco#items")))
+ (feature
+ ((var . "http://jabber.org/protocol/disco#info"))))))
+
+(defun jabber-ahc-add (node name func acl)
+ "Add a command to internal lists.
+NODE is the node name to be used. It must be unique.
+NAME is the natural-language name of the command.
+FUNC is a function taking the entire IQ stanza as single argument when
+this command is invoked, and returns a <command/> node.
+ACL is a function taking JID as single argument, returning non-nil for
+access allowed. nil means open for everyone."
+ (add-to-list 'jabber-ahc-commands (cons node (list 'name name
+ 'func func
+ 'acl acl)))
+ (add-to-list 'jabber-disco-info-nodes
+ (list node `((identity ((category . "automation")
+ (type . "command-node")
+ (name . ,name)))
+ (feature ((var . "http://jabber.org/protocol/commands")))
+ (feature ((var . "http://jabber.org/protocol/disco#info")))
+ (feature ((var . "jabber:x:data")))))))
+
+(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/commands")
+(add-to-list 'jabber-disco-items-nodes
+ (list "http://jabber.org/protocol/commands" #'jabber-ahc-disco-items nil))
+(defun jabber-ahc-disco-items (xml-data)
+ "Return commands in response to disco#items request"
+ (let ((jid (jabber-xml-get-attribute xml-data 'from)))
+ (mapcar (function
+ (lambda (command)
+ (let ((node (car command))
+ (plist (cdr command)))
+ (let ((acl (plist-get plist 'acl))
+ (name (plist-get plist 'name))
+ (func (plist-get plist 'func)))
+ (when (or (not (functionp acl))
+ (funcall acl jid))
+ `(item ((name . ,name)
+ (jid . ,(format "%s@%s/%s" jabber-username jabber-server jabber-resource))
+ (node . ,node))))))))
+ jabber-ahc-commands)))
+
+(add-to-list 'jabber-iq-set-xmlns-alist
+ (cons "http://jabber.org/protocol/commands" 'jabber-ahc-process))
+(defun jabber-ahc-process (xml-data)
+
+ (let ((to (jabber-xml-get-attribute xml-data 'from))
+ (id (jabber-xml-get-attribute xml-data 'id))
+ (node (jabber-xml-get-attribute (jabber-iq-query xml-data) 'node)))
+ ;; find command
+ (let* ((plist (cdr (assoc node jabber-ahc-commands)))
+ (acl (plist-get plist 'acl))
+ (func (plist-get plist 'func)))
+ (if plist
+ ;; found
+ (if (or (not (functionp acl))
+ (funcall acl to))
+ ;; access control passed
+ (jabber-send-iq to "result"
+ (funcall func xml-data)
+ nil nil nil nil id)
+ ;; ...or failed
+ (jabber-signal-error "cancel" 'not-allowed))
+ ;; No such node
+ (jabber-signal-error "cancel" 'item-not-found)))))
+
+;;; CLIENT
+(add-to-list 'jabber-jid-service-menu
+ (cons "Request command list" 'jabber-ahc-get-list))
+(defun jabber-ahc-get-list (to)
+ "Request list of ad-hoc commands. (JEP-0050)"
+ (interactive (list (jabber-read-jid-completing "Request command list from: ")))
+ (jabber-get-disco-items to "http://jabber.org/protocol/commands"))
+
+(add-to-list 'jabber-jid-service-menu
+ (cons "Execute command" 'jabber-ahc-execute-command))
+(defun jabber-ahc-execute-command (to node)
+ "Execute ad-hoc command. (JEP-0050)"
+ (interactive (list (jabber-read-jid-completing "Execute command of: ")
+ (jabber-read-node "Node of command: ")))
+ (jabber-send-iq to
+ "set"
+ `(command ((xmlns . "http://jabber.org/protocol/commands")
+ (node . ,node)
+ (action . "execute")))
+ #'jabber-process-data #'jabber-ahc-display
+ #'jabber-process-data "Command execution failed"))
+
+(defun jabber-ahc-display (xml-data)
+ (let* ((from (jabber-xml-get-attribute xml-data 'from))
+ (query (jabber-iq-query xml-data))
+ (node (jabber-xml-get-attribute query 'node))
+ (notes (jabber-xml-get-children query 'note))
+ (sessionid (jabber-xml-get-attribute query 'sessionid))
+ (status (jabber-xml-get-attribute query 'status))
+ (actions (car (jabber-xml-get-children query 'actions)))
+ xdata
+ (inhibit-read-only t))
+
+ (make-local-variable 'jabber-ahc-sessionid)
+ (setq jabber-ahc-sessionid sessionid)
+ (make-local-variable 'jabber-ahc-node)
+ (setq jabber-ahc-node node)
+
+ (dolist (x (jabber-xml-get-children query 'x))
+ (when (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:data")
+ (setq xdata x)))
+
+ (cond
+ ((string= status "executing")
+ (insert "Executing command\n\n"))
+ ((string= status "completed")
+ (insert "Command completed\n\n"))
+ ((string= status "canceled")
+ (insert "Command canceled\n\n")))
+
+ (dolist (note notes)
+ (let ((note-type (jabber-xml-get-attribute note 'type)))
+ (cond
+ ((string= note-type "warn")
+ (insert "Warning: "))
+ ((string= note-type "error")
+ (insert "Error: ")))
+ (insert (car (jabber-xml-node-children note)) "\n")))
+ (insert "\n")
+
+ (when xdata
+ (jabber-init-widget-buffer from)
+
+ (let ((formtype (jabber-xml-get-attribute xdata 'type)))
+ (if (string= formtype "result")
+ (jabber-render-xdata-search-results xdata)
+ (jabber-render-xdata-form xdata)
+
+ (when (string= status "executing")
+ (let ((button-titles
+ (cond
+ ((null actions)
+ '(complete cancel))
+ (t
+ (let ((children (mapcar #'jabber-xml-node-name (jabber-xml-node-children actions)))
+ (default-action (jabber-xml-get-attribute actions 'execute)))
+ (if (or (null default-action) (memq (intern default-action) children))
+ children
+ (cons (intern default-action) children)))))))
+ (dolist (button-title button-titles)
+ (widget-create 'push-button :notify `(lambda (&rest ignore) (jabber-ahc-submit (quote ,button-title))) (symbol-name button-title))
+ (widget-insert "\t")))
+ (widget-insert "\n"))))
+
+ (widget-setup)
+ (widget-minor-mode 1))))
+
+(defun jabber-ahc-submit (action)
+ "Submit Ad-Hoc Command."
+
+ (jabber-send-iq jabber-submit-to
+ "set"
+ `(command ((xmlns . "http://jabber.org/protocol/commands")
+ (sessionid . ,jabber-ahc-sessionid)
+ (node . ,jabber-ahc-node)
+ (action . ,(symbol-name action)))
+ ,(if (and (not (eq action 'cancel))
+ (eq jabber-form-type 'xdata))
+ (jabber-parse-xdata-form)))
+
+ #'jabber-process-data #'jabber-ahc-display
+ #'jabber-process-data "Command execution failed"))
+
+(provide 'jabber-ahc)
+
+;;; arch-tag: c0d5ed8c-50cb-44e1-8e0f-4058b79ee353
View
424 elpa-to-submit/jabber/jabber-alert.el
@@ -0,0 +1,424 @@
+;; jabber-alert.el - alert hooks
+
+;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
+;; Copyright (C) 2003, 2004, 2005 - Magnus Henoch - mange@freemail.hu
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(require 'jabber-util)
+
+(require 'cl)
+
+(defgroup jabber-alerts nil "auditory and visual alerts for jabber events"
+ :group 'jabber)
+
+(defcustom jabber-alert-message-hooks '(jabber-message-echo
+ jabber-message-scroll)
+ "Hooks run when a new message arrives.
+
+Arguments are FROM, BUFFER, TEXT and PROPOSED-ALERT. 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. PROPOSED-ALERT 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)
+
+(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.")
+
+(defcustom jabber-alert-message-function
+ 'jabber-message-default-message
+ "Function for constructing 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)
+
+(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 PROPOSED-ALERT. 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. PROPOSED-ALERT 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)
+
+(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.")
+
+(defcustom jabber-alert-muc-function
+ 'jabber-muc-default-message
+ "Function for constructing 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)
+
+(defcustom jabber-alert-presence-hooks
+ '(jabber-presence-update-roster
+ 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\". PROPOSED-ALERT is the string returned by
+`jabber-alert-presence-message-function' for these arguments."
+ :type 'hook
+ :options '(jabber-presence-beep
+ jabber-presence-wave
+ jabber-presence-update-roster
+ jabber-presence-switch
+ jabber-presence-display
+ jabber-presence-echo)
+ :group 'jabber-alerts)
+
+(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.")
+
+(defcustom jabber-alert-presence-message-function
+ 'jabber-presence-default-message
+ "Function for constructing 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)
+
+(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)
+
+(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.")
+
+(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)
+
+(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)
+
+(defcustom jabber-alert-message-wave ""
+ "a sound file to play when a message arrived"
+ :type 'file
+ :group 'jabber-alerts)
+
+(defcustom jabber-alert-muc-wave ""
+ "a sound file to play when a MUC message arrived"
+ :type 'file
+ :group 'jabber-alerts)
+
+(defcustom jabber-alert-presence-wave ""
+ "a sound file to play when a presence arrived"
+ :type 'file
+ :group 'jabber-alerts)
+
+(defcustom jabber-alert-info-wave ""
+ "a sound file to play when an info query result arrived"
+ :type 'file
+ :group 'jabber-alerts)
+
+(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 proposed-alert)
+ ,docstring
+ (when proposed-alert
+ (funcall ,function proposed-alert)))
+ (pushnew (quote ,msg) (get 'jabber-alert-message-hooks 'custom-options))
+ (defun ,muc (nick group buffer text proposed-alert)
+ ,docstring
+ (when proposed-alert
+ (funcall ,function proposed-alert)))
+ (pushnew (quote ,muc) (get 'jabber-alert-muc-hooks 'custom-options))
+ (defun ,pres (who oldstatus newstatus statustext proposed-alert)
+ ,docstring
+ (when proposed-alert
+ (funcall ,function proposed-alert)))
+ (pushnew (quote ,pres) (get 'jabber-alert-presence-hooks 'custom-options))
+ (defun ,info (infotype buffer proposed-alert)
+ ,docstring
+ (when proposed-alert
+ (funcall ,function proposed-alert)))
+ (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 (msg) (message "%s" msg)))
+(define-jabber-alert beep "Beep on event"
+ (lambda (&rest ignore) (beep)))
+
+;; External notifiers
+(require 'jabber-screen)
+(require 'jabber-ratpoison)
+(require 'jabber-sawfish)
+(require 'jabber-festival)
+(require 'jabber-xmessage)
+
+;; 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)))))
+
+(defcustom jabber-message-alert-same-buffer t
+ "If nil, don't display message alerts for the current buffer."
+ :type 'boolean
+ :group 'jabber-alerts)
+
+(defun jabber-message-wave (from buffer text proposed-alert)
+ "Play the wave file specified in `jabber-alert-message-wave'"
+ (when proposed-alert
+ (jabber-play-sound-file jabber-alert-message-wave)))
+
+(defun jabber-message-display (from buffer text proposed-alert)
+ "Display the buffer where a new message has arrived."
+ (when proposed-alert
+ (display-buffer buffer)))
+
+(defun jabber-message-switch (from buffer text proposed-alert)
+ "Switch to the buffer where a new message has arrived."
+ (when proposed-alert
+ (switch-to-buffer buffer)))
+
+(defun jabber-message-scroll (from buffer text proposed-alert)
+ "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)))))
+
+;; 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
+ (format "Message from %s in %s" nick (jabber-jid-displayname
+ group))
+ (format "Message in %s" (jabber-jid-displayname group)))))
+
+(defun jabber-muc-wave (nick group buffer text proposed-alert)
+ "Play the wave file specified in `jabber-alert-muc-wave'"
+ (when proposed-alert
+ (jabber-play-sound-file jabber-alert-muc-wave)))
+
+(defun jabber-muc-display (nick group buffer text proposed-alert)
+ "Display the buffer where a new message has arrived."
+ (when proposed-alert
+ (display-buffer buffer)))
+
+(defun jabber-muc-switch (nick group buffer text proposed-alert)
+ "Switch to the buffer where a new message has arrived."
+ (when proposed-alert
+ (switch-to-buffer buffer)))
+
+(defun jabber-muc-scroll (nick group buffer text proposed-alert)
+ "Scroll buffer even if it is in an unselected window."
+ (jabber-message-scroll nil buffer nil nil))
+
+;; Presence alert hooks
+(defun jabber-presence-default-message (who oldstatus newstatus statustext)
+ "This function returns 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))))
+ (formattedtext
+ (if (> (length statustext) 0)
+ (concat " (" (jabber-unescape-xml statustext) ")")
+ "")))
+ (concat formattedname formattedstatus formattedtext)))))
+
+(defun jabber-presence-wave (who oldstatus newstatus statustext proposed-alert)
+ "Play the wave file specified in `jabber-alert-presence-wave'"
+ (if proposed-alert
+ (jabber-play-sound-file jabber-alert-presence-wave)))
+
+;; 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))
+
+(defun jabber-presence-display (who oldstatus newstatus statustext proposed-alert)
+ "Display the roster buffer"
+ (when proposed-alert
+ (display-buffer jabber-roster-buffer)))
+
+(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
+
+(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) ")"))
+
+(defun jabber-info-wave (infotype buffer proposed-alert)
+ "Play the wave file specified in `jabber-alert-info-wave'"
+ (if proposed-alert
+ (jabber-play-sound-file jabber-alert-info-wave)))
+
+(defun jabber-info-display (infotype buffer proposed-alert)
+ "Display buffer of completed request"
+ (when proposed-alert
+ (display-buffer buffer)))
+
+(defun jabber-info-switch (infotype buffer proposed-alert)
+ "Switch to buffer of completed request"
+ (when proposed-alert
+ (switch-to-buffer buffer)))
+
+(provide 'jabber-alert)
+
+;;; arch-tag: 725bd73e-c613-4fdc-a11d-3392a7598d4f
View
98 elpa-to-submit/jabber/jabber-browse.el
@@ -0,0 +1,98 @@
+;; jabber-browse.el - jabber browsing by JEP-0011
+
+;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
+;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(require 'jabber-iq)
+(require 'jabber-xml)
+(require 'jabber-util)
+
+;; jabber.el can perform browse requests, but will not answer them.
+
+(add-to-list 'jabber-jid-info-menu
+ (cons "Send browse query" 'jabber-get-browse))
+(defun jabber-get-browse (to)
+ "send a browse infoquery request to someone"
+ (interactive (list (jabber-read-jid-completing "browse: ")))
+ (jabber-send-iq to
+ "get"
+ '(query ((xmlns . "jabber:iq:browse")))
+ #'jabber-process-data #'jabber-process-browse
+ #'jabber-process-data "Browse failed"))
+
+;; called from jabber-process-data
+(defun jabber-process-browse (xml-data)
+ "Handle results from jabber:iq:browse requests."
+ (dolist (item (jabber-xml-node-children xml-data))
+ (when (and (listp item)
+ (not (eq (jabber-xml-node-name item) 'ns)))
+ (let ((jid (jabber-xml-get-attribute item 'jid))
+ (beginning (point)))
+ (cond
+ ((or
+ (eq (jabber-xml-node-name item) 'user)
+ (string= (jabber-xml-get-attribute item 'category) "user"))
+ (insert (jabber-propertize "$ USER"
+ 'face 'jabber-title-medium)
+ "\n\n"))
+ ((or
+ (eq (jabber-xml-node-name item) 'service)
+ (string= (jabber-xml-get-attribute item 'category) "service"))
+ (insert (jabber-propertize "* SERVICE"
+ 'face 'jabber-title-medium)
+ "\n\n"))
+ ((or
+ (eq (jabber-xml-node-name item) 'conference)
+ (string= (jabber-xml-get-attribute item 'category) "conference"))
+ (insert (jabber-propertize "@ CONFERENCE"
+ 'face 'jabber-title-medium)
+ "\n\n"))
+ (t
+ ;; So far I've seen "server" and "directory", both in the node-name.
+ ;; Those are actually service disco categories, but jabberd 2 seems
+ ;; to use them for browse results as well. It's not right (as in
+ ;; JEP-0011), but it's reasonable.
+ (let ((category (jabber-xml-get-attribute item 'category)))
+ (if (= (length category) 0)
+ (setq category (jabber-xml-node-name item)))
+ (insert (jabber-propertize (format "! OTHER: %s" category)
+ 'face 'jabber-title-medium)
+ "\n\n"))))
+ (dolist (attr '((type . "Type:\t\t")
+ (jid . "JID:\t\t")
+ (name . "Name:\t\t")
+ (version . "Version:\t")))
+ (let ((data (jabber-xml-get-attribute item (car attr))))
+ (if (> (length data) 0)
+ (insert (cdr attr) (jabber-unescape-xml data) "\n"))))
+
+ (dolist (ns (jabber-xml-get-children item 'ns))
+ (if (stringp (car (jabber-xml-node-children ns)))
+ (insert "Namespace:\t" (car (jabber-xml-node-children ns)) "\n")))
+
+ (insert "\n")
+ (put-text-property beginning (point) 'jabber-jid jid)
+
+ ;; XXX: Is this kind of recursion really needed?
+ (if (listp (car (jabber-xml-node-children item)))
+ (jabber-process-browse item))))))
+
+(provide 'jabber-browse)
+
+;;; arch-tag: be01ab34-96eb-4fcb-aa35-a0d3e6c446c3
View
477 elpa-to-submit/jabber/jabber-chat.el
@@ -0,0 +1,477 @@
+;; jabber-chat.el - one-to-one chats
+
+;; Copyright (C) 2005 - Magnus Henoch - mange@freemail.hu
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(require 'jabber-core)
+(require 'jabber-chatbuffer)
+(require 'jabber-history)
+
+(defgroup jabber-chat nil "chat display options"
+ :group 'jabber)
+
+(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)
+
+(defcustom jabber-chat-header-line-format
+ '(" " (: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 (get (jabber-jid-symbol jabber-chatting-with) 'status))
+ "\t" jabber-events-message) ;see jabber-events.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)
+
+(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)
+
+(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)
+
+(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)
+
+(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)
+
+(defface jabber-rare-time-face
+ '((t (:foreground "darkgreen" :underline t)))
+ "face for displaying the rare time info"
+ :group 'jabber-chat)
+
+(defvar jabber-rare-time ""
+ "Latest rare time printed")
+(make-variable-buffer-local 'jabber-rare-time)
+
+(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'
+%n Nickname (`jabber-nickname')
+%u Username
+%r Resource
+%j Bare JID (without resource)"
+ :type 'string
+ :group 'jabber-chat)
+
+(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)
+
+(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)
+
+(defface jabber-chat-prompt-local
+ '((t (:foreground "blue" :weight bold)))
+ "face for displaying the chat prompt for what you type in"
+ :group 'jabber-chat)
+
+(defface jabber-chat-prompt-foreign
+ '((t (:foreground "red" :weight bold)))
+ "face for displaying the chat prompt for what they send"
+ :group 'jabber-chat)
+
+(defface jabber-chat-prompt-system
+ '((t (:foreground "green" :weight bold)))
+ "face used for system and special messages"
+ :group 'jabber-chat)
+
+(defface jabber-chat-text-local nil
+ "Face used for text you write"
+ :group 'jabber-chat)
+
+(defface jabber-chat-text-foreign nil
+ "Face used for text others write"
+ :group 'jabber-chat)
+
+(defface jabber-chat-error
+ '((t (:foreground "red" :weight bold)))
+ "Face used for error messages"
+ :group 'jabber-chat)
+
+(defvar jabber-chatting-with nil
+ "JID of the person you are chatting with")
+
+(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 the entire <message/> stanza as argument.")
+
+(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 the entire <message/> stanza as argument, and
+should either output a representation of the body part of the message
+and return non-nil, or output nothing and return nil. 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.")
+
+(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.")
+
+(defvar jabber-chat-earliest-backlog nil
+ "Float-time of earliest backlog entry inserted into buffer.
+nil if no backlog has been inserted.")
+
+(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 (jabber-jid-resource chat-with)))))
+
+(defun jabber-chat-create-buffer (chat-with)
+ "Prepare a buffer for chatting with CHAT-WITH.
+This function is idempotent."
+ (with-current-buffer (get-buffer-create (jabber-chat-get-buffer chat-with))
+ (if (not (eq major-mode 'jabber-chat-mode)) (jabber-chat-mode))
+ (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 (zerop (buffer-size))
+ (let ((backlog-entries (jabber-history-backlog chat-with)))
+ (when backlog-entries
+ (setq jabber-chat-earliest-backlog
+ (jabber-float-time (jabber-parse-time
+ (aref (car backlog-entries) 0))))
+ (mapc 'jabber-chat-insert-backlog-entry backlog-entries))))
+
+ (current-buffer)))
+
+(defun jabber-chat-insert-backlog-entry (msg)
+ "Insert backlog entry MSG at point."
+ (if (string= (aref msg 1) "in")
+ (let ((fake-stanza `(message ((from . ,(aref msg 2)))
+ (body nil ,(aref msg 4))
+ (x ((xmlns . "jabber:x:delay")
+ (stamp . ,(jabber-encode-legacy-time (jabber-parse-time (aref msg 0)))))))))
+ (jabber-chat-buffer-display-at-point 'jabber-chat-print-prompt
+ fake-stanza
+ jabber-chat-printers
+ fake-stanza))
+ (jabber-chat-buffer-display-at-point 'jabber-chat-self-prompt
+ (jabber-parse-time (aref msg 0))
+ '(insert)
+ (jabber-propertize
+ (aref msg 4)
+ 'face 'jabber-chat-text-local))))
+
+(add-to-list 'jabber-jid-chat-menu
+ (cons "Display more context" 'jabber-chat-display-more-backlog))
+
+(defun jabber-chat-display-more-backlog (how-many)
+ (interactive "nHow many more messages? ")
+ (let* ((inhibit-read-only t)
+ (jabber-backlog-days nil)
+ (jabber-backlog-number how-many)
+ (backlog-entries (jabber-history-backlog
+ jabber-chatting-with 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 backlog-entries)))))
+
+(add-to-list 'jabber-message-chain 'jabber-process-chat)
+
+(defun jabber-process-chat (xml-data)
+ "If XML-DATA is a one-to-one chat message, handle it as such."
+ ;; XXX: there's more to being a chat message than not being MUC.
+ ;; Maybe make independent predicate.
+ (when (not (jabber-muc-message-p xml-data))
+ ;; Note that we handle private MUC messages here.
+ (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))))))
+ (with-current-buffer (if (jabber-muc-sender-p from)
+ (jabber-muc-private-create-buffer
+ (jabber-jid-user from)
+ (jabber-jid-resource from))
+ (jabber-chat-create-buffer from))
+ ;; Call alert hooks only when something is output
+ (when
+ (jabber-chat-buffer-display (if (jabber-muc-sender-p from)
+ 'jabber-muc-private-print-prompt
+ 'jabber-chat-print-prompt)
+ xml-data
+ (if error-p
+ '(jabber-chat-print-error)
+ jabber-chat-printers)
+ xml-data)
+
+ (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))))))))
+
+(defun jabber-chat-send (body)
+ "Send BODY, and display it in chat buffer."
+ (let* ((id (apply 'format "emacs-msg-%d.%d.%d" (current-time)))
+ (stanza-to-send `(message
+ ((to . ,jabber-chatting-with)
+ (type . "chat")
+ (id . ,id))
+ (body () ,(jabber-escape-xml body)))))
+ (dolist (hook jabber-chat-send-hooks)
+ (nconc stanza-to-send (funcall hook body id)))
+ (jabber-send-sexp stanza-to-send))
+
+ ;; Note that we pass a string, not an XML stanza,
+ ;; to the print functions.
+ (jabber-chat-buffer-display 'jabber-chat-self-prompt
+ nil
+ '(insert)
+ (jabber-propertize
+ body
+ 'face 'jabber-chat-text-local)))
+
+(defun jabber-maybe-print-rare-time (timestamp)
+ "Print rare time, if changed since last time printed."
+ (let ((new-time (format-time-string jabber-rare-time-format timestamp)))
+ (unless (string= new-time jabber-rare-time)
+ (setq jabber-rare-time new-time)
+ (when jabber-print-rare-time
+ (let ((inhibit-read-only t))
+ (goto-char jabber-point-insert)
+ (insert (jabber-propertize jabber-rare-time 'face 'jabber-rare-time-face) "\n")
+ (setq jabber-point-insert (point)))))))
+
+(defun jabber-chat-print-prompt (xml-data)
+ "Print prompt for received message in XML-DATA."
+ (let ((from (jabber-xml-get-attribute xml-data 'from))
+ (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
+ (jabber-maybe-print-rare-time timestamp)
+ (insert (jabber-propertize
+ (format-spec jabber-chat-foreign-prompt-format
+ (list
+ (cons ?t (format-time-string
+ (if timestamp
+ jabber-chat-delayed-time-format
+ jabber-chat-time-format)
+ timestamp))
+ (cons ?n (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)))))
+
+(defun jabber-chat-self-prompt (timestamp)
+ "Print prompt for sent message.
+TIMESTAMP is the timestamp to print, or nil for now."
+ (jabber-maybe-print-rare-time timestamp)
+ (insert (jabber-propertize
+ (format-spec jabber-chat-local-prompt-format
+ (list
+ (cons ?t (format-time-string
+ (if timestamp
+ jabber-chat-delayed-time-format
+ jabber-chat-time-format)
+ timestamp))
+ (cons ?n jabber-nickname)
+ (cons ?u jabber-username)
+ (cons ?r jabber-resource)
+ (cons ?j (concat jabber-username "@" jabber-server))))
+ 'face 'jabber-chat-prompt-local
+ 'help-echo
+ (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from you"))))
+
+(defun jabber-chat-print-error (xml-data)
+ "Print error in given <message/> in a readable way."
+ (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))))
+
+(defun jabber-chat-print-subject (xml-data)
+ "Print subject of given <message/>, if any."
+ (let ((subject (car
+ (jabber-xml-node-children
+ (car
+ (jabber-xml-get-children xml-data 'subject))))))
+ (when (not (zerop (length subject)))
+ (insert (jabber-propertize
+ "Subject: " 'face 'jabber-chat-prompt-system)
+ (jabber-propertize
+ subject
+ 'face 'jabber-chat-text-foreign)
+ "\n"))))
+
+(defun jabber-chat-print-body (xml-data)
+ (run-hook-with-args-until-success 'jabber-body-printers xml-data))
+
+(defun jabber-chat-normal-body (xml-data)
+ "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
+ (if (string-match "^/me \\(.*\\)$" body)
+ (let ((action (match-string 1 body))
+ (nick (if (jabber-muc-message-p xml-data)
+ (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from))
+ (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 'jabber-chat-text-foreign)))
+ t)))
+
+(defun jabber-chat-print-url (xml-data)
+ "Print URLs provided in jabber:x:oob namespace."
+ (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"))
+
+ (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 (jabber-propertize
+ "URL: " 'face 'jabber-chat-prompt-system))
+ (insert (format "%s <%s>" desc url))
+ (insert "\n")))))
+
+(defun jabber-chat-goto-address (&rest ignore)
+ "Call `goto-address' on the newly written text."
+ (goto-address))
+
+(add-to-list 'jabber-jid-chat-menu
+ (cons "Send message" 'jabber-send-message))
+
+(defun jabber-send-message (to subject body type)
+ "send a message tag to the server"
+ (interactive (list (jabber-read-jid-completing "to: ")
+ (jabber-read-with-input-method "subject: ")
+ (jabber-read-with-input-method "body: ")
+ (read-string "type: ")))
+ (jabber-send-sexp `(message ((to . ,to)
+ ,(if (> (length type) 0)
+ `(type . ,type)))
+ ,(if (> (length subject) 0)
+ `(subject () ,(jabber-escape-xml subject)))
+ ,(if (> (length body) 0)
+ `(body () ,(jabber-escape-xml 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))
+
+(defun jabber-chat-with (jid &optional other-window)
+ "Open an empty chat window for chatting with JID.
+With a prefix argument, open buffer in other window."
+ (interactive (list (jabber-read-jid-completing "chat with:")
+ current-prefix-arg))
+ (let ((buffer (jabber-chat-create-buffer jid)))
+ (if other-window
+ (switch-to-buffer-other-window buffer)
+ (switch-to-buffer buffer))))
+
+(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)))
+ (if jid-at-point
+ (jabber-chat-with jid-at-point other-window)
+ (error "No contact at point"))))
+
+(provide 'jabber-chat)
+
+;; arch-tag: f423eb92-aa87-475b-b590-48c93ccba9be
View
162 elpa-to-submit/jabber/jabber-chatbuffer.el
@@ -0,0 +1,162 @@
+;; jabber-chatbuffer.el - functions common to all chat buffers
+
+;; Copyright (C) 2005 - Magnus Henoch - mange@freemail.hu
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(require 'jabber-keymap)
+
+(defvar jabber-point-insert nil
+ "Position where the message being composed starts")
+
+(defvar jabber-send-function nil
+ "Function for sending a message from a chat buffer.")
+
+(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.")
+
+(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)
+
+(defun jabber-chat-mode ()
+ "\\{jabber-chat-mode-map}"
+ (kill-all-local-variables)
+ ;; Make sure to set this variable somewhere
+ (make-local-variable 'jabber-send-function)
+
+ (make-local-variable 'scroll-conservatively)
+ (setq scroll-conservatively 5)
+
+ (make-local-variable 'jabber-point-insert)
+ (setq jabber-point-insert (point-min))
+
+ ;;(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)))
+
+(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)
+
+(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))
+
+(defun jabber-chat-buffer-send ()
+ (interactive)
+ (let ((body (delete-and-extract-region jabber-point-insert (point-max))))
+ ;; If user accidentally hits RET without writing anything,
+ ;; delete-and-extract-region returns "". In that case,
+ ;; no message should be sent.
+ (unless (zerop (length body))
+ (funcall jabber-send-function body))))
+
+(defun jabber-chat-buffer-display (prompt-function prompt-data output-functions output-data)
+ "Display a message in current buffer.
+PROMPT-FUNCTION is a function that prints the correct prompt at
+point. It is called with PROMPT-DATA as argument.
+OUTPUT-FUNCTIONS is a list of functions that may or may not print something
+at point. They are called in order with OUTPUT-DATA as argument.
+If the OUTPUT-FUNCTIONS produce any output, PROMPT-FUNCTION is called
+with point before that output. If there is no output, there is
+no prompt. Return non-nil if there is output.
+
+If point is at or after jabber-point-insert, it is advanced.
+If point is before jabber-point-insert, it is not moved."
+ (let ((at-insert-point (eq (point) jabber-point-insert))
+ outputp)
+ (save-excursion
+ (goto-char jabber-point-insert)
+ (setq outputp
+ (jabber-chat-buffer-display-at-point prompt-function prompt-data output-functions output-data))
+ (setq jabber-point-insert (point))
+ (set-text-properties jabber-point-insert (point-max) nil))
+
+ (when at-insert-point
+ (goto-char jabber-point-insert))
+ outputp))
+
+(defun jabber-chat-buffer-display-at-point (prompt-function prompt-data output-functions output-data)
+ "Display a message at point.
+Arguments are as to `jabber-chat-buffer-display'.
+Return non-nil if any data was inserted."
+ (let ((inhibit-read-only t)
+ (beg (point))
+ (point-insert (set-marker (make-marker) jabber-point-insert)))
+ (set-marker-insertion-type point-insert t)
+
+ (dolist (printer output-functions)
+ (funcall printer output-data)
+ (unless (bolp)
+ (insert "\n")))
+
+ (unless (eq (point) beg)
+ (let ((end (point-marker)))
+ (goto-char beg)
+ (funcall prompt-function prompt-data)
+ (goto-char end)
+ (put-text-property beg end 'read-only t)
+ (put-text-property beg end 'front-sticky t)
+ (put-text-property beg end 'rear-nonsticky t)
+ (when jabber-chat-fill-long-lines
+ (save-restriction
+ (narrow-to-region beg end)
+ (jabber-chat-buffer-fill-long-lines)))
+ ;; this is always non-nil, so we return that
+ (setq jabber-point-insert (marker-position point-insert))))))
+
+(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)))))
+ (save-restriction
+ (goto-char (point-min))
+ (let ((adaptive-fill-mode nil)) ;Why? -sm
+ (while (not (eobp))
+ (end-of-line)
+ (when (>= (current-column) (min fill-column width))
+ (narrow-to-region (min (1+ (point)) (point-max))
+ (point-at-bol))
+ (let ((goback (point-marker)))
+ (fill-paragraph nil)
+ (goto-char (marker-position goback)))
+ (widen))
+ (forward-line 1)))))))
+
+(provide 'jabber-chatbuffer)
+;; arch-tag: 917e5b60-5894-4c49-b3bc-12e1f97ffdc6
View
138 elpa-to-submit/jabber/jabber-conn.el
@@ -0,0 +1,138 @@
+;; jabber-conn.el - Network transport functions
+
+;; Copyright (C) 2005 - Georg Lehner - jorge@magma.com.ni
+;; mostly inspired by Gnus.
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+;; A collection of functions, that hide the details of transmitting to
+;; and fro a Jabber Server
+
+(eval-when-compile (require 'cl))
+
+;; Try two different TLS/SSL libraries, but don't fail if none available.
+(or (ignore-errors (require 'tls))
+ (ignore-errors (require 'ssl)))
+
+;; TODO: Add custom flag, to not complain about plain-text passwords
+;; in encrypted connections
+;;
+
+;; This variable holds the connection, which is used for further
+;; input/output to the server
+(defvar *jabber-connection* nil
+ "the process that does the actual connection")
+
+(defgroup jabber-conn nil "Jabber Connection Settings"
+ :group 'jabber)
+
+(defcustom jabber-network-server nil
+ "hostname or IP address of server to connect to, if different from `jabber-server'."
+ :type '(radio (const :tag "Same as `jabber-server'" nil)
+ (string :tag "Hostname or IP address"))
+ :group 'jabber-conn)
+
+(defcustom jabber-port nil
+ "jabber port
+The default depends on the connection type: 5222 for ordinary connections
+and 5223 for SSL connections."
+ :type '(choice (const :tag "Default" nil)
+ (integer :tag "Port number"))
+ :group 'jabber-conn)
+
+(defcustom jabber-connection-type 'network
+ "Type of connection to the jabber server, ssl or network most likely."
+ :type '(radio (const :tag "Encrypted connection, SSL" ssl)
+ (const :tag "Standard TCP/IP connection" network))
+ :group 'jabber-conn)
+
+(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)
+
+(defvar jabber-connect-methods
+ '((network jabber-network-connect jabber-network-send)
+ (ssl jabber-ssl-connect jabber-ssl-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.")
+
+(defvar jabber-connect-function nil
+ "function that connects to the jabber server")
+
+(defvar jabber-conn-send-function nil
+ "function that sends a line to the server")
+
+(defun jabber-setup-connect-method ()
+ (let ((entry (assq jabber-connection-type jabber-connect-methods)))
+ (setq jabber-connect-function (nth 1 entry))
+ (setq jabber-conn-send-function (nth 2 entry))))
+
+;; Plain TCP/IP connection
+(defun jabber-network-connect ()
+ (let ((coding-system-for-read 'utf-8)
+ (coding-system-for-write 'utf-8))
+ (setq *jabber-connection*
+ (open-network-stream
+ "jabber"
+ jabber-process-buffer
+ (or jabber-network-server jabber-server)
+ (or jabber-port 5222)))))
+
+(defun jabber-network-send (string)
+ "Send a string via a plain TCP/IP connection to the Jabber Server."
+ (process-send-string *jabber-connection* string))
+
+;; SSL connection, we use openssl's s_client function for encryption
+;; of the link
+;; TODO: make this configurable
+(defun jabber-ssl-connect ()
+ "connect via OpenSSL or GnuTLS to a Jabber Server"
+ (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")))))
+ (setq *jabber-connection*
+ (funcall connect-function
+ "jabber"
+ jabber-process-buffer
+ (or jabber-network-server jabber-server)
+ (or jabber-port 5223)))))
+
+(defun jabber-ssl-send (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 *jabber-connection* string)
+ (process-send-string *jabber-connection* "\n"))
+
+(provide 'jabber-conn)
+;; arch-tag: f95ec240-8cd3-11d9-9dbf-000a95c2fcd0
View
511 elpa-to-submit/jabber/jabber-core.el
@@ -0,0 +1,511 @@
+;; jabber-core.el - core functions
+
+;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
+;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
+
+;; SSL-Connection Parts:
+;; Copyright (C) 2005 - Georg Lehner - jorge@magma.com.ni
+
+;; This file is a part of jabber.el.
+
+;; 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
+
+(eval-when-compile (require 'cl))
+
+(require 'jabber-util)
+(require 'jabber-logon)
+(require 'jabber-conn)
+
+;; SASL depends on FLIM.
+(eval-and-compile
+ (condition-case nil
+ (require 'jabber-sasl)
+ (error nil)))
+
+(defvar *jabber-roster* nil
+ "the roster list")
+
+(defvar jabber-jid-obarray (make-vector 127 0)
+ "obarray for keeping JIDs")
+
+(defvar *jabber-connected* nil
+ "boolean - are we connected")
+
+(defvar *jabber-authenticated* nil
+ "boolean - are we authenticated")
+
+(defvar *jabber-disconnecting* nil
+ "boolean - are we in the process of disconnecting by free will")
+
+(defvar *xmlq* ""
+ "a string with all the incoming xml that is waiting to be parsed")
+
+(defvar jabber-register-p nil
+ "Register a new account in this session?")
+
+(defvar jabber-session-id nil
+ "id of the current session")
+
+(defvar jabber-stream-version nil
+ "Stream version indicated by server")
+
+(defvar jabber-register-p nil
+ "Is account registration occurring in this session?")
+
+(defvar jabber-call-on-connection nil
+ "Function to be called on connection.
+This is set by `jabber-connect' on each call, and later picked up in
+`jabber-filter'.")
+
+(defvar jabber-short-circuit-input nil
+ "Function that receives all stanzas, instead of the usual ones.
+Used for SASL authentication.")
+
+(defvar jabber-message-chain nil
+ "Incoming messages are sent to these functions, in order.")
+
+(defvar jabber-iq-chain nil
+ "Incoming infoqueries are sent to these functions, in order.")
+
+(defvar jabber-presence-chain nil
+ "Incoming presence notifications are sent to these functions, in order.")
+
+(defvar jabber-stream-error-chain '(jabber-process-stream-error)
+ "Stream errors are sent to these functions, in order")
+
+(defvar jabber-choked-count 0
+ "Number of successive times that the process buffer has been nonempty.")
+
+(defvar jabber-choked-timer nil)
+
+(defgroup jabber-core nil "customize core functionality"
+ :group 'jabber)
+
+(defcustom jabber-post-connect-hook '(jabber-send-default-presence
+ jabber-muc-autojoin)
+ "*Hooks run after successful connection and authentication."
+ :type 'hook
+ :group 'jabber-core)
+
+(defcustom jabber-pre-disconnect-hook nil
+ "*Hooks run just before voluntary disconnection
+This might be due to failed authentication. Check `*jabber-authenticated*'."
+ :type 'hook
+ :group 'jabber-core)
+
+(defcustom jabber-lost-connection-hook nil
+ "*Hooks run after involuntary disconnection"
+ :type 'hook
+ :group 'jabber-core)
+
+(defcustom jabber-post-disconnect-hook nil
+ "*Hooks run after disconnection"
+ :type 'hook
+ :group 'jabber-core)
+
+(defcustom jabber-roster-buffer "*-jabber-*"
+ "The name of the roster buffer"
+ :type 'string
+ :group 'jabber-core)
+
+(defvar jabber-process-buffer " *-jabber-process-*"
+ "The name of the process buffer")
+
+(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)
+
+(defsubst jabber-have-sasl-p ()
+ "Return non-nil if SASL functions are available."
+ (fboundp 'jabber-sasl-start-auth))
+
+(defun jabber-connect (&optional registerp)
+ "connect to the jabber server and start a jabber xml stream
+With prefix argument, register a new account."
+ (interactive "P")
+ (if *jabber-connected*
+ (message "Already connected")
+ (setq *xmlq* "")
+ (setq *jabber-authenticated* nil)
+ (jabber-clear-roster)
+ (jabber-reset-choked)
+
+ ;; Call the function responsible for establishing a bidirectional
+ ;; data stream to the Jabber Server, *jabber-connection* is set
+ ;; afterwards.
+ (jabber-setup-connect-method)
+ (funcall jabber-connect-function)
+ (unless *jabber-connection*
+ (error "Connection failed"))
+
+ ;; TLS connections leave data in the process buffer, which
+ ;; the XML parser will choke on.
+ (with-current-buffer (process-buffer *jabber-connection*)
+ (erase-buffer))
+ (set-process-filter *jabber-connection* #'jabber-pre-filter)
+ (set-process-sentinel *jabber-connection* #'jabber-sentinel)
+
+ (setq jabber-short-circuit-input nil)
+ (setq jabber-register-p registerp)
+
+ (setq jabber-call-on-connection (if registerp
+ #'(lambda (stream-features) (jabber-get-register jabber-server))
+ #'jabber-auth-somehow))
+ (let ((stream-header (concat "<?xml version='1.0'?><stream:stream to='"
+ jabber-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'"
+ "")
+ ">
+")))
+
+ (funcall jabber-conn-send-function stream-header)
+ (if jabber-debug-log-xml
+ (with-current-buffer (get-buffer-create "*-jabber-xml-log-*")
+ (save-excursion
+ (goto-char (point-max))
+ (insert (format "sending %S\n\n" stream-header)))))
+
+ (setq jabber-choked-timer
+ (run-with-timer 5 5 #'jabber-check-choked))
+
+ (accept-process-output *jabber-connection*))
+ ;; Next thing happening is the server sending its own <stream:stream> start tag.
+ ;; That is handled in jabber-filter.
+
+ (setq *jabber-connected* t)))
+
+(defun jabber-auth-somehow (stream-features)
+ "Start authentication with SASL if the server supports it,
+otherwise JEP-0077. The STREAM-FEATURES argument is the stream features
+tag, or nil if we're connecting to a pre-XMPP server."
+ (if (and stream-features
+ jabber-use-sasl
+ (jabber-have-sasl-p)
+ jabber-stream-version
+ (>= (string-to-number jabber-stream-version) 1.0))
+ (jabber-sasl-start-auth stream-features)
+ (jabber-get-auth jabber-server)))
+
+(defun jabber-disconnect ()
+ "disconnect from the jabber server and re-initialise the jabber package variables"
+ (interactive)
+ (unless *jabber-disconnecting* ; avoid reentry
+ (let ((*jabber-disconnecting* t))
+ (when (and *jabber-connection*
+ (memq (process-status *jabber-connection*) '(open run)))
+ (run-hooks 'jabber-pre-disconnect-hook)
+ (funcall jabber-conn-send-function "</stream:stream>")
+ ;; let the server close the stream
+ (accept-process-output *jabber-connection* 3)
+ ;; and do it ourselves as well, just to be sure
+ (delete-process *jabber-connection*))
+ (jabber-disconnected)
+ (if (interactive-p)
+ (message "Disconnected from Jabber server")))))
+
+(defun jabber-disconnected ()
+ "Re-initialise jabber package variables.
+Call this function after disconnection."
+ (when jabber-choked-timer
+ (jabber-cancel-timer jabber-choked-timer)
+ (setq jabber-choked-timer nil))
+
+ (when (get-buffer jabber-roster-buffer)
+ (with-current-buffer (get-buffer jabber-roster-buffer)
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
+
+ (setq *jabber-connection* nil)
+ (jabber-clear-roster)
+ (setq *xmlq* "")
+ (setq *jabber-authenticated* nil)
+ (setq *jabber-connected* nil)
+ (setq *jabber-active-groupchats* nil)
+ (setq jabber-session-id nil)
+ (run-hooks 'jabber-post-disconnect-hook))
+
+(defun jabber-sentinel (process event)
+ "alert user about lost connection"
+ (unless (or *jabber-disconnecting* (not *jabber-connected*))
+ (beep)
+ (run-hooks 'jabber-lost-connection-hook)
+ (message "Jabber connection lost: `%s'" event)
+ ;; If there is data left (maybe a stream error) process it first
+ (with-current-buffer (process-buffer process)
+ (unless (zerop (buffer-size))
+ (jabber-filter process)))
+ (jabber-disconnected)))
+
+(defun jabber-pre-filter (process string)
+ (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)))))
+
+(defun jabber-filter (process)
+ "the filter function for the jabber process"
+ (with-current-buffer (process-buffer process)
+ ;; Start from the beginning
+ (goto-char (point-min))
+ (let (xml-data)
+ (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>")
+ (return (jabber-disconnect)))