1 ;;; jabber-chatstate.el --- Chat state notification (XEP-0085) implementation
3 ;; Author: Ami Fischman <ami@fischman.org>
4 ;; (based entirely on jabber-events.el by Magnus Henoch <mange@freemail.hu>)
6 ;; This file is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; This file is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;; GNU General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
18 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 ;; Boston, MA 02111-1307, USA.
22 ;; - Currently only active/composing notifications are /sent/ though all 5
23 ;; notifications are handled on receipt.
25 (require 'jabber-autoloads
)
28 (defgroup jabber-chatstates nil
29 "Chat state notifications."
32 (defconst jabber-chatstates-xmlns
"http://jabber.org/protocol/chatstates"
33 "XML namespace for the chatstates feature.")
35 (defcustom jabber-chatstates-confirm t
36 "Send notifications about chat states?"
37 :group
'jabber-chatstates
40 (defvar jabber-chatstates-requested
'first-time
41 "Whether or not chat states notification was requested.
42 This is one of the following:
43 first-time - send state in first stanza, then switch to nil
45 nil - don't send states")
46 (make-variable-buffer-local 'jabber-chatstates-requested
)
48 (defvar jabber-chatstates-last-state nil
49 "The last seen chat state.")
50 (make-variable-buffer-local 'jabber-chatstates-last-state
)
52 (defvar jabber-chatstates-message
""
53 "Human-readable presentation of chat state information")
54 (make-variable-buffer-local 'jabber-chatstates-message
)
57 ;;; Code for requesting chat state notifications from others and handling
60 (defun jabber-chatstates-update-message ()
61 (setq jabber-chatstates-message
62 (if (and jabber-chatstates-last-state
63 (not (eq 'active jabber-chatstates-last-state
)))
64 (format " (%s)" (symbol-name jabber-chatstates-last-state
))
67 (add-hook 'jabber-chat-send-hooks
'jabber-chatstates-when-sending
)
68 (defun jabber-chatstates-when-sending (text id
)
69 (jabber-chatstates-update-message)
70 (jabber-chatstates-stop-timer)
71 (when (and jabber-chatstates-confirm jabber-chatstates-requested
)
72 (when (eq jabber-chatstates-requested
'first-time
)
73 ;; don't send more notifications until we know that the other
75 (setq jabber-chatstates-requested nil
))
76 `((active ((xmlns .
,jabber-chatstates-xmlns
))))))
79 ;;; Code for handling requests for chat state notifications and providing
80 ;;; them, modulo user preferences.
82 (defvar jabber-chatstates-composing-sent nil
83 "Has composing notification been sent?
84 It can be sent and cancelled several times.")
85 (make-variable-buffer-local 'jabber-chatstates-composing-sent
)
87 (defvar jabber-chatstates-paused-timer nil
88 "Timer that counts down from 'composing state to 'paused.")
89 (make-variable-buffer-local 'jabber-chatstates-paused-timer
)
91 (defun jabber-chatstates-stop-timer ()
92 "Stop the 'paused timer."
93 (when jabber-chatstates-paused-timer
94 (cancel-timer jabber-chatstates-paused-timer
)))
96 (defun jabber-chatstates-kick-timer ()
97 "Start (or restart) the 'paused timer as approriate."
98 (jabber-chatstates-stop-timer)
99 (setq jabber-chatstates-paused-timer
100 (run-with-timer 5 nil
'jabber-chatstates-send-paused
)))
102 (defun jabber-chatstates-send-paused ()
103 "Send an 'paused state notification."
104 (when (and jabber-chatstates-requested jabber-chatting-with
)
105 (setq jabber-chatstates-composing-sent nil
)
107 jabber-buffer-connection
109 ((to .
,jabber-chatting-with
))
110 (paused ((xmlns .
,jabber-chatstates-xmlns
)))))))
112 (defun jabber-chatstates-after-change ()
113 (let* ((composing-now (not (= (point-max) jabber-point-insert
)))
114 (state (if composing-now
'composing
'active
)))
115 (when (and jabber-chatstates-confirm
117 jabber-chatstates-requested
118 (not (eq composing-now jabber-chatstates-composing-sent
)))
120 jabber-buffer-connection
122 ((to .
,jabber-chatting-with
))
123 (,state
((xmlns .
,jabber-chatstates-xmlns
)))))
124 (when (setq jabber-chatstates-composing-sent composing-now
)
125 (jabber-chatstates-kick-timer)))))
129 (defun jabber-handle-incoming-message-chatstates (jc xml-data
)
130 (when (get-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data
'from
)))
131 (with-current-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data
'from
))
133 ;; If we get an error message, we shouldn't report any
134 ;; events, as the requests are mirrored from us.
135 ((string= (jabber-xml-get-attribute xml-data
'type
) "error")
136 (remove-hook 'post-command-hook
'jabber-chatstates-after-change t
)
137 (setq jabber-chatstates-requested nil
))
143 (find jabber-chatstates-xmlns
144 (jabber-xml-node-children xml-data
)
145 :key
#'(lambda (x) (jabber-xml-get-attribute x
'xmlns
))
147 (jabber-xml-node-name node
))
149 ;; XXX: this is how we interoperate with
150 ;; Google Talk. We should really use a
151 ;; namespace-aware XML parser.
152 (find jabber-chatstates-xmlns
153 (jabber-xml-node-children xml-data
)
154 :key
#'(lambda (x) (jabber-xml-get-attribute x
'xmlns
:cha
))
157 ;; Strip the "cha:" prefix
158 (let ((name (symbol-name (jabber-xml-node-name node
))))
159 (when (> (length name
) 4)
160 (intern (substring name
4)))))))))
161 ;; Set up hooks for composition notification
162 (when (and jabber-chatstates-confirm state
)
163 (setq jabber-chatstates-requested t
)
164 (add-hook 'post-command-hook
'jabber-chatstates-after-change nil t
))
166 (setq jabber-chatstates-last-state state
)
167 (jabber-chatstates-update-message)))))))
169 ;; Add function last in chain, so a chat buffer is already created.
170 (add-to-list 'jabber-message-chain
'jabber-handle-incoming-message-chatstates t
)
172 (add-to-list 'jabber-advertised-features
"http://jabber.org/protocol/chatstates")
174 (provide 'jabber-chatstates
)
175 ;; arch-tag: d879de90-51e1-11dc-909d-000a95c2fcd0