1 ;;; jabber-rtt.el --- XEP-0301: In-Band Real Time Text -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013 Magnus Henoch
5 ;; Author: Magnus Henoch <magnus.henoch@gmail.com>
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 (eval-when-compile (require 'cl-lib))
28 ;;;; Handling incoming events
31 (eval-after-load "jabber-disco"
32 '(jabber-disco-advertise-feature "urn:xmpp:rtt:0"))
34 (defvar jabber-rtt-ewoc-node nil)
35 (make-variable-buffer-local 'jabber-rtt-ewoc-node)
37 (defvar jabber-rtt-last-seq nil)
38 (make-variable-buffer-local 'jabber-rtt-last-seq)
40 (defvar jabber-rtt-message nil)
41 (make-variable-buffer-local 'jabber-rtt-message)
43 (defvar jabber-rtt-pending-events nil)
44 (make-variable-buffer-local 'jabber-rtt-pending-events)
46 (defvar jabber-rtt-timer nil)
47 (make-variable-buffer-local 'jabber-rtt-timer)
49 ;; Add function last in chain, so a chat buffer is already created.
51 (eval-after-load "jabber-core"
52 '(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t))
55 (defun jabber-rtt-handle-message (jc xml-data)
56 ;; We could support this for MUC as well, if useful.
57 (when (and (not (jabber-muc-message-p xml-data))
58 (get-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from))))
59 (with-current-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from))
60 (let* ((rtt (jabber-xml-path xml-data '(("urn:xmpp:rtt:0" . "rtt"))))
61 (body (jabber-xml-path xml-data '(body)))
62 (seq (when rtt (jabber-xml-get-attribute rtt 'seq)))
63 (event (when rtt (or (jabber-xml-get-attribute rtt 'event) "edit")))
64 (actions (when rtt (jabber-xml-node-children rtt)))
65 (inhibit-read-only t))
67 ((or body (string= event "cancel"))
68 ;; A <body/> element supersedes real time text.
70 ((member event '("new" "reset"))
72 (setq jabber-rtt-ewoc-node
73 (ewoc-enter-last jabber-chat-ewoc (list :notice "[typing...]"))
74 jabber-rtt-last-seq (string-to-number seq)
76 jabber-rtt-pending-events nil)
77 (jabber-rtt--enqueue-actions actions))
78 ((string= event "edit")
79 ;; TODO: check whether this works properly in 32-bit Emacs
81 ((and jabber-rtt-last-seq
82 (equal (1+ jabber-rtt-last-seq)
83 (string-to-number seq)))
85 (setq jabber-rtt-last-seq (string-to-number seq))
86 (jabber-rtt--enqueue-actions actions))
88 ;; TODO: show warning when not in sync
89 (message "out of sync! %s vs %s"
90 seq jabber-rtt-last-seq))))
91 ;; TODO: handle event="init"
94 (defun jabber-rtt--reset ()
95 (when jabber-rtt-ewoc-node
96 (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
97 (when (timerp jabber-rtt-timer)
98 (cancel-timer jabber-rtt-timer))
99 (setq jabber-rtt-ewoc-node nil
100 jabber-rtt-last-seq nil
101 jabber-rtt-message nil
102 jabber-rtt-pending-events nil
103 jabber-rtt-timer nil))
105 (defun jabber-rtt--enqueue-actions (new-actions)
106 (setq jabber-rtt-pending-events
107 ;; Ensure that the queue never contains more than 700 ms worth
109 (jabber-rtt--fix-waits (append jabber-rtt-pending-events new-actions)))
110 (unless jabber-rtt-timer
111 (jabber-rtt--process-actions (current-buffer))))
113 (defun jabber-rtt--process-actions (buffer)
114 (with-current-buffer buffer
115 (setq jabber-rtt-timer nil)
117 (while jabber-rtt-pending-events
118 (let ((action (pop jabber-rtt-pending-events)))
119 (cl-case (jabber-xml-node-name action)
122 (let* ((p (jabber-xml-get-attribute action 'p))
123 (position (if p (string-to-number p) (length jabber-rtt-message))))
124 (setq position (max position 0))
125 (setq position (min position (length jabber-rtt-message)))
126 (setf (substring jabber-rtt-message position position)
127 (car (jabber-xml-node-children action)))
129 (ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
130 (let ((inhibit-read-only t))
131 (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
134 (let* ((p (jabber-xml-get-attribute action 'p))
135 (position (if p (string-to-number p) (length jabber-rtt-message)))
136 (n (jabber-xml-get-attribute action 'n))
137 (number (if n (string-to-number n) 1)))
138 (setq position (max position 0))
139 (setq position (min position (length jabber-rtt-message)))
140 (setq number (max number 0))
141 (setq number (min number position))
142 ;; Now erase the NUMBER characters before POSITION.
143 (setf (substring jabber-rtt-message (- position number) position)
146 (ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
147 (let ((inhibit-read-only t))
148 (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
150 (setq jabber-rtt-timer
152 (/ (string-to-number (jabber-xml-get-attribute action 'n)) 1000.0)
154 #'jabber-rtt--process-actions
156 (throw 'wait nil))))))))
158 (defun jabber-rtt--fix-waits (actions)
159 ;; Ensure that the sum of all wait events is no more than 700 ms.
161 (dolist (action actions)
162 (when (eq (jabber-xml-node-name action) 'w)
163 (let ((n (jabber-xml-get-attribute action 'n)))
164 (setq n (string-to-number n))
166 (setq sum (+ sum n))))))
170 (let ((scale (/ 700.0 sum)))
173 (if (eq (jabber-xml-node-name action) 'w)
174 (let ((n (jabber-xml-get-attribute action 'n)))
175 (setq n (string-to-number n))
177 `(w ((n . ,(number-to-string (* scale n)))) nil))
183 (defvar jabber-rtt-send-timer nil)
184 (make-variable-buffer-local 'jabber-rtt-send-timer)
186 (defvar jabber-rtt-send-seq nil)
187 (make-variable-buffer-local 'jabber-rtt-send-seq)
189 (defvar jabber-rtt-outgoing-events nil)
190 (make-variable-buffer-local 'jabber-rtt-outgoing-events)
192 (defvar jabber-rtt-send-last-timestamp nil)
193 (make-variable-buffer-local 'jabber-rtt-send-last-timestamp)
196 (define-minor-mode jabber-rtt-send-mode
197 "Show text to recipient as it is being typed.
198 This lets the recipient see every change made to the message up
199 until it's sent. The recipient's client needs to implement
200 XEP-0301, In-Band Real Time Text."
202 (if (null jabber-rtt-send-mode)
204 (remove-hook 'after-change-functions #'jabber-rtt--queue-update t)
205 (remove-hook 'jabber-chat-send-hooks #'jabber-rtt--message-sent t)
206 (jabber-rtt--cancel-send))
207 (unless (derived-mode-p 'jabber-chat-mode)
208 (error "Real Time Text only makes sense in chat buffers"))
209 (when (timerp jabber-rtt-send-timer)
210 (cancel-timer jabber-rtt-send-timer))
211 (setq jabber-rtt-send-timer nil
212 jabber-rtt-send-seq nil
213 jabber-rtt-outgoing-events nil
214 jabber-rtt-send-last-timestamp nil)
215 (jabber-rtt--send-current-text nil)
216 (add-hook 'after-change-functions #'jabber-rtt--queue-update nil t)
217 (add-hook 'jabber-chat-send-hooks #'jabber-rtt--message-sent nil t)))
219 (defun jabber-rtt--cancel-send ()
220 (when (timerp jabber-rtt-send-timer)
221 (cancel-timer jabber-rtt-send-timer))
222 (setq jabber-rtt-send-seq (1+ jabber-rtt-send-seq))
223 (jabber-send-sexp jabber-buffer-connection
224 `(message ((to . ,jabber-chatting-with)
226 (rtt ((xmlns . "urn:xmpp:rtt:0")
227 (seq . ,(number-to-string jabber-rtt-send-seq))
230 (setq jabber-rtt-send-timer nil
231 jabber-rtt-send-seq nil
232 jabber-rtt-outgoing-events nil
233 jabber-rtt-send-last-timestamp nil))
235 (defun jabber-rtt--send-current-text (resetp)
236 (let ((text (buffer-substring-no-properties jabber-point-insert (point-max))))
237 ;; This should give us enough room to avoid wrap-arounds, even
238 ;; with just 28 bits...
239 (setq jabber-rtt-send-seq (random 100000))
240 (jabber-send-sexp jabber-buffer-connection
241 `(message ((to . ,jabber-chatting-with)
243 (rtt ((xmlns . "urn:xmpp:rtt:0")
244 (seq . ,(number-to-string jabber-rtt-send-seq))
245 (event . ,(if resetp "reset" "new")))
248 (defun jabber-rtt--queue-update (beg end pre-change-length)
249 (unless (or (< beg jabber-point-insert)
250 (< end jabber-point-insert))
251 (let ((timestamp (current-time)))
252 (when jabber-rtt-send-last-timestamp
253 (let* ((time-difference (time-subtract timestamp jabber-rtt-send-last-timestamp))
254 (interval (truncate (* 1000 (float-time time-difference)))))
255 (when (and (> interval 0)
256 ;; Don't send too long intervals - this should have
257 ;; been sent by our timer already.
259 (push `(w ((n . ,(number-to-string interval))) nil)
260 jabber-rtt-outgoing-events))))
261 (setq jabber-rtt-send-last-timestamp timestamp))
263 (when (> pre-change-length 0)
264 ;; Some text was deleted. Let's check if we can use a shorter
266 (let ((at-end (= end (point-max)))
267 (erase-one (= pre-change-length 1)))
270 `((p . ,(number-to-string
272 (- jabber-point-insert)
273 pre-change-length)))))
275 `((n . ,(number-to-string pre-change-length))))))
276 jabber-rtt-outgoing-events)))
279 ;; Some text was inserted.
280 (let ((text (buffer-substring-no-properties beg end))
281 (at-end (= end (point-max))))
284 `((p . ,(number-to-string (- beg jabber-point-insert))))))
286 jabber-rtt-outgoing-events)))
288 (when (null jabber-rtt-send-timer)
289 (setq jabber-rtt-send-timer
290 (run-with-timer 0.7 nil #'jabber-rtt--send-queued-events (current-buffer))))))
292 (defun jabber-rtt--send-queued-events (buffer)
293 (with-current-buffer buffer
294 (setq jabber-rtt-send-timer nil)
295 (when jabber-rtt-outgoing-events
296 (let ((event (if jabber-rtt-send-seq "edit" "new")))
297 (setq jabber-rtt-send-seq
298 (if jabber-rtt-send-seq
299 (1+ jabber-rtt-send-seq)
301 (jabber-send-sexp jabber-buffer-connection
302 `(message ((to . ,jabber-chatting-with)
304 (rtt ((xmlns . "urn:xmpp:rtt:0")
305 (seq . ,(number-to-string jabber-rtt-send-seq))
307 ,@(nreverse jabber-rtt-outgoing-events))))
308 (setq jabber-rtt-outgoing-events nil)))))
310 (defun jabber-rtt--message-sent (_text _id)
311 ;; We're sending a <body/> element; reset our state
312 (when (timerp jabber-rtt-send-timer)
313 (cancel-timer jabber-rtt-send-timer))
314 (setq jabber-rtt-send-timer nil
315 jabber-rtt-send-seq nil
316 jabber-rtt-outgoing-events nil
317 jabber-rtt-send-last-timestamp nil))
319 (provide 'jabber-rtt)
320 ;;; jabber-rtt.el ends here