From: Magnus H. <leg...@us...> - 2007-08-24 01:36:12
|
Update of /cvsroot/emacs-jabber/emacs-jabber In directory sc8-pr-cvs17:/tmp/cvs-serv1097 Modified Files: jabber.el jabber-chat.el AUTHORS jabber-muc.el NEWS Added Files: jabber-chatstates.el Log Message: Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-392 Creator: Magnus Henoch <ma...@fr...> Support XEP-0085 Patch by Ami Fischman --- NEW FILE: jabber-chatstates.el --- ;;; jabber-chatstate.el --- Chat state notification (XEP-0085) implementation ;; Author: Ami Fischman <am...@fi...> ;; (based entirely on jabber-events.el by Magnus Henoch <ma...@fr...>) ;; This file 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 file 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. ;; TODO ;; - Currently only active/composing notifications are /sent/ though all 5 ;; notifications are handled on receipt. (require 'cl) (defgroup jabber-chatstates nil "Chat state notifications." :group 'jabber) (defconst jabber-chatstates-xmlns "http://jabber.org/protocol/chatstates" "XML namespace for the chatstates feature.") ;;; INCOMING ;;; Code for requesting chat state notifications from others and handling ;;; them. (defvar jabber-chatstates-last-state nil "The last seen chat state.") (make-variable-buffer-local 'jabber-chatstates-last-state) (defvar jabber-chatstates-message "" "Human-readable presentation of chat state information") (make-variable-buffer-local 'jabber-chatstates-message) (defun jabber-chatstates-update-message () (setq jabber-chatstates-message (if (and jabber-chatstates-last-state (not (eq 'active jabber-chatstates-last-state))) (format " (%s)" (symbol-name jabber-chatstates-last-state)) ""))) (add-hook 'jabber-chat-send-hooks 'jabber-chatstates-when-sending) (defun jabber-chatstates-when-sending (text id) (jabber-chatstates-update-message) (jabber-chatstates-stop-timer) `((active ((xmlns . ,jabber-chatstates-xmlns))))) ;;; OUTGOING ;;; Code for handling requests for chat state notifications and providing ;;; them, modulo user preferences. (defcustom jabber-chatstates-confirm t "Send notifications about chat states?" :group 'jabber-chatstates :type 'boolean) (defvar jabber-chatstates-requested t "Whether or not chat states notification was requested") (make-variable-buffer-local 'jabber-chatstates-requested) (defvar jabber-chatstates-composing-sent nil "Has composing notification been sent? It can be sent and cancelled several times.") (make-variable-buffer-local 'jabber-chatstates-composing-sent) (defvar jabber-chatstates-paused-timer nil "Timer that counts down from 'composing state to 'paused.") (make-variable-buffer-local 'jabber-chatstates-paused-timer) (defun jabber-chatstates-stop-timer () "Stop the 'paused timer." (when jabber-chatstates-paused-timer (cancel-timer jabber-chatstates-paused-timer))) (defun jabber-chatstates-kick-timer () "Start (or restart) the 'paused timer as approriate." (jabber-chatstates-stop-timer) (setq jabber-chatstates-paused-timer (run-with-timer 5 nil 'jabber-chatstates-send-paused))) (defun jabber-chatstates-send-paused () "Send an 'paused state notification." (when jabber-chatting-with (setq jabber-chatstates-composing-sent nil) (jabber-send-sexp jabber-buffer-connection `(message ((to . ,jabber-chatting-with)) (paused ((xmlns . ,jabber-chatstates-xmlns))))))) (defun jabber-chatstates-after-change () (let* ((composing-now (not (= (point-max) jabber-point-insert))) (state (if composing-now 'composing 'active))) (when (and jabber-chatstates-confirm jabber-chatting-with (not (eq composing-now jabber-chatstates-composing-sent))) (jabber-send-sexp jabber-buffer-connection `(message ((to . ,jabber-chatting-with)) (,state ((xmlns . ,jabber-chatstates-xmlns))))) (when (setq jabber-chatstates-composing-sent composing-now) (jabber-chatstates-kick-timer))))) ;;; COMMON (defun jabber-handle-incoming-message-chatstates (jc xml-data) (when (get-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from))) (with-current-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from)) (cond ;; If we get an error message, we shouldn't report any ;; events, as the requests are mirrored from us. ((string= (jabber-xml-get-attribute xml-data 'type) "error") (remove-hook 'post-command-hook 'jabber-chatstates-after-change t) (setq jabber-chatstates-requested nil)) (t ;; Set up hooks for composition notification (when (and jabber-chatstates-confirm jabber-chatstates-requested) (add-hook 'post-command-hook 'jabber-chatstates-after-change nil t)) (setq jabber-chatstates-last-state (dolist (possible-node '(active composing paused inactive gone)) (let ((state (or (find jabber-chatstates-xmlns (jabber-xml-get-children xml-data possible-node) :key #'(lambda (x) (jabber-xml-get-attribute x 'xmlns)) :test #'string=) ;; XXX: this is how we interoperate with ;; Google Talk. We should really use a ;; namespace-aware XML parser. (find jabber-chatstates-xmlns (jabber-xml-get-children xml-data (intern (concat "cha:" (symbol-name possible-node)))) :key #'(lambda (x) (jabber-xml-get-attribute x 'xmlns:cha)) :test #'string=)))) (when state (setq jabber-chatstates-requested t) (return possible-node))))) (jabber-chatstates-update-message)))))) ;; Add function last in chain, so a chat buffer is already created. (add-to-list 'jabber-message-chain 'jabber-handle-incoming-message-chatstates t) (add-to-list 'jabber-advertised-features "http://jabber.org/protocol/chatstates") (provide 'jabber-chatstates) ;; arch-tag: d879de90-51e1-11dc-909d-000a95c2fcd0 Index: jabber-chat.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-chat.el,v retrieving revision 1.79 retrieving revision 1.80 diff -u -d -r1.79 -r1.80 --- jabber-chat.el 7 Aug 2007 16:56:48 -0000 1.79 +++ jabber-chat.el 24 Aug 2007 01:36:06 -0000 1.80 @@ -54,7 +54,8 @@ (or (cdr (assoc (get buddy 'show) jabber-presence-faces)) 'jabber-roster-user-online)))) "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status))) - "\t" jabber-events-message) ;see jabber-events.el + "\t" jabber-events-message ;see jabber-events.el + "\t" jabber-chatstates-message) ;see jabber-chatstates.el "The specification for the header line of chat buffers. The format is that of `mode-line-format' and `header-line-format'." Index: jabber.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber.el,v retrieving revision 1.74 retrieving revision 1.75 diff -u -d -r1.74 -r1.75 --- jabber.el 7 May 2007 01:40:29 -0000 1.74 +++ jabber.el 24 Aug 2007 01:36:05 -0000 1.75 @@ -101,6 +101,7 @@ (require 'jabber-activity) (require 'jabber-vcard) (require 'jabber-events) +(require 'jabber-chatstates) (require 'jabber-vcard-avatars) (require 'jabber-autoaway) (require 'jabber-time) Index: jabber-muc.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-muc.el,v retrieving revision 1.70 retrieving revision 1.71 diff -u -d -r1.70 -r1.71 --- jabber-muc.el 23 Aug 2007 21:08:09 -0000 1.70 +++ jabber-muc.el 24 Aug 2007 01:36:06 -0000 1.71 @@ -127,7 +127,8 @@ (defcustom jabber-muc-private-header-line-format '(" " (:eval (jabber-jid-resource jabber-chatting-with)) " in " (:eval (jabber-jid-displayname (jabber-jid-user jabber-chatting-with))) - "\t" jabber-events-message) + "\t" jabber-events-message + "\t" jabber-chatstates-message) "The specification for the header line of private MUC chat buffers. The format is that of `mode-line-format' and `header-line-format'." Index: AUTHORS =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/AUTHORS,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- AUTHORS 19 Aug 2007 09:46:34 -0000 1.12 +++ AUTHORS 24 Aug 2007 01:36:06 -0000 1.13 @@ -7,6 +7,7 @@ Mathias Dahl Mario Domenech Goulart Nolan Eakins +Ami Fischman François Fleuret David Hansen Justin Kirby Index: NEWS =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/NEWS,v retrieving revision 1.59 retrieving revision 1.60 diff -u -d -r1.59 -r1.60 --- NEWS 31 Jul 2007 07:05:10 -0000 1.59 +++ NEWS 24 Aug 2007 01:36:06 -0000 1.60 @@ -2,6 +2,11 @@ * New features in jabber.el 0.8 +** Support for XEP-0085 +This means "contact is typing" notifications when chatting with Gajim +or Google Talk users, among others. +(not documented yet) + ** Support for multiple accounts (not documented yet) |