forked from legoscia/emacs-jabber
-
Notifications
You must be signed in to change notification settings - Fork 0
/
jabber-rtt.el
321 lines (281 loc) · 11.2 KB
/
jabber-rtt.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
;;; jabber-rtt.el --- XEP-0301: In-Band Real Time Text
;; Copyright (C) 2013 Magnus Henoch
;; Author: Magnus Henoch <[email protected]>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(eval-when-compile (require 'cl))
;;;; Handling incoming events
;;;###autoload
(eval-after-load "jabber-disco"
'(jabber-disco-advertise-feature "urn:xmpp:rtt:0"))
(defvar jabber-rtt-ewoc-node nil)
(make-variable-buffer-local 'jabber-rtt-ewoc-node)
(defvar jabber-rtt-last-seq nil)
(make-variable-buffer-local 'jabber-rtt-last-seq)
(defvar jabber-rtt-message nil)
(make-variable-buffer-local 'jabber-rtt-message)
(defvar jabber-rtt-pending-events nil)
(make-variable-buffer-local 'jabber-rtt-pending-events)
(defvar jabber-rtt-timer nil)
(make-variable-buffer-local 'jabber-rtt-timer)
;; Add function last in chain, so a chat buffer is already created.
;;;###autoload
(eval-after-load "jabber-core"
'(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t))
;;;###autoload
(defun jabber-rtt-handle-message (jc xml-data)
;; We could support this for MUC as well, if useful.
(when (and (not (jabber-muc-message-p xml-data))
(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))
(let* ((rtt (jabber-xml-path xml-data '(("urn:xmpp:rtt:0" . "rtt"))))
(body (jabber-xml-path xml-data '(body)))
(seq (when rtt (jabber-xml-get-attribute rtt 'seq)))
(event (when rtt (or (jabber-xml-get-attribute rtt 'event) "edit")))
(actions (when rtt (jabber-xml-node-children rtt)))
(inhibit-read-only t))
(cond
((or body (string= event "cancel"))
;; A <body/> element supersedes real time text.
(jabber-rtt--reset))
((member event '("new" "reset"))
(jabber-rtt--reset)
(setq jabber-rtt-ewoc-node
(ewoc-enter-last jabber-chat-ewoc (list :notice "[typing...]"))
jabber-rtt-last-seq (string-to-number seq)
jabber-rtt-message ""
jabber-rtt-pending-events nil)
(jabber-rtt--enqueue-actions actions))
((string= event "edit")
;; TODO: check whether this works properly in 32-bit Emacs
(cond
((and jabber-rtt-last-seq
(equal (1+ jabber-rtt-last-seq)
(string-to-number seq)))
;; We are in sync.
(setq jabber-rtt-last-seq (string-to-number seq))
(jabber-rtt--enqueue-actions actions))
(t
;; TODO: show warning when not in sync
(message "out of sync! %s vs %s"
seq jabber-rtt-last-seq))
))
;; TODO: handle event="init"
)))))
(defun jabber-rtt--reset ()
(when jabber-rtt-ewoc-node
(ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
(when (timerp jabber-rtt-timer)
(cancel-timer jabber-rtt-timer))
(setq jabber-rtt-ewoc-node nil
jabber-rtt-last-seq nil
jabber-rtt-message nil
jabber-rtt-pending-events nil
jabber-rtt-timer nil))
(defun jabber-rtt--enqueue-actions (new-actions)
(setq jabber-rtt-pending-events
;; Ensure that the queue never contains more than 700 ms worth
;; of wait events.
(jabber-rtt--fix-waits (append jabber-rtt-pending-events new-actions)))
(unless jabber-rtt-timer
(jabber-rtt--process-actions (current-buffer))))
(defun jabber-rtt--process-actions (buffer)
(with-current-buffer buffer
(setq jabber-rtt-timer nil)
(catch 'wait
(while jabber-rtt-pending-events
(let ((action (pop jabber-rtt-pending-events)))
(case (jabber-xml-node-name action)
((t)
;; insert text
(let* ((p (jabber-xml-get-attribute action 'p))
(position (if p (string-to-number p) (length jabber-rtt-message))))
(setq position (max position 0))
(setq position (min position (length jabber-rtt-message)))
(setf (substring jabber-rtt-message position position)
(car (jabber-xml-node-children action)))
(ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
(let ((inhibit-read-only t))
(ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
((e)
;; erase text
(let* ((p (jabber-xml-get-attribute action 'p))
(position (if p (string-to-number p) (length jabber-rtt-message)))
(n (jabber-xml-get-attribute action 'n))
(number (if n (string-to-number n) 1)))
(setq position (max position 0))
(setq position (min position (length jabber-rtt-message)))
(setq number (max number 0))
(setq number (min number position))
;; Now erase the NUMBER characters before POSITION.
(setf (substring jabber-rtt-message (- position number) position)
"")
(ewoc-set-data jabber-rtt-ewoc-node (list :notice (concat "[typing...] " jabber-rtt-message)))
(let ((inhibit-read-only t))
(ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
((w)
(setq jabber-rtt-timer
(run-with-timer
(/ (string-to-number (jabber-xml-get-attribute action 'n)) 1000.0)
nil
#'jabber-rtt--process-actions
buffer))
(throw 'wait nil))))))))
(defun jabber-rtt--fix-waits (actions)
;; Ensure that the sum of all wait events is no more than 700 ms.
(let ((sum 0))
(dolist (action actions)
(when (eq (jabber-xml-node-name action) 'w)
(let ((n (jabber-xml-get-attribute action 'n)))
(setq n (string-to-number n))
(when (>= n 0)
(setq sum (+ sum n))))))
(if (<= sum 700)
actions
(let ((scale (/ 700.0 sum)))
(mapcar
(lambda (action)
(if (eq (jabber-xml-node-name action) 'w)
(let ((n (jabber-xml-get-attribute action 'n)))
(setq n (string-to-number n))
(setq n (max n 0))
`(w ((n . ,(number-to-string (* scale n)))) nil))
action))
actions)))))
;;;; Sending events
(defvar jabber-rtt-send-timer nil)
(make-variable-buffer-local 'jabber-rtt-send-timer)
(defvar jabber-rtt-send-seq nil)
(make-variable-buffer-local 'jabber-rtt-send-seq)
(defvar jabber-rtt-outgoing-events nil)
(make-variable-buffer-local 'jabber-rtt-outgoing-events)
(defvar jabber-rtt-send-last-timestamp nil)
(make-variable-buffer-local 'jabber-rtt-send-last-timestamp)
;;;###autoload
(define-minor-mode jabber-rtt-send-mode
"Show text to recipient as it is being typed.
This lets the recipient see every change made to the message up
until it's sent. The recipient's client needs to implement
XEP-0301, In-Band Real Time Text."
nil " Real-Time" nil
(if (null jabber-rtt-send-mode)
(progn
(remove-hook 'after-change-functions #'jabber-rtt--queue-update t)
(remove-hook 'jabber-chat-send-hooks #'jabber-rtt--message-sent t)
(jabber-rtt--cancel-send))
(unless (derived-mode-p 'jabber-chat-mode)
(error "Real Time Text only makes sense in chat buffers"))
(when (timerp jabber-rtt-send-timer)
(cancel-timer jabber-rtt-send-timer))
(setq jabber-rtt-send-timer nil
jabber-rtt-send-seq nil
jabber-rtt-outgoing-events nil
jabber-rtt-send-last-timestamp nil)
(jabber-rtt--send-current-text nil)
(add-hook 'after-change-functions #'jabber-rtt--queue-update nil t)
(add-hook 'jabber-chat-send-hooks #'jabber-rtt--message-sent nil t)))
(defun jabber-rtt--cancel-send ()
(when (timerp jabber-rtt-send-timer)
(cancel-timer jabber-rtt-send-timer))
(setq jabber-rtt-send-seq (1+ jabber-rtt-send-seq))
(jabber-send-sexp jabber-buffer-connection
`(message ((to . ,jabber-chatting-with)
(type . "chat"))
(rtt ((xmlns . "urn:xmpp:rtt:0")
(seq . ,(number-to-string jabber-rtt-send-seq))
(event . "cancel"))
nil)))
(setq jabber-rtt-send-timer nil
jabber-rtt-send-seq nil
jabber-rtt-outgoing-events nil
jabber-rtt-send-last-timestamp nil))
(defun jabber-rtt--send-current-text (resetp)
(let ((text (buffer-substring-no-properties jabber-point-insert (point-max))))
;; This should give us enough room to avoid wrap-arounds, even
;; with just 28 bits...
(setq jabber-rtt-send-seq (random 100000))
(jabber-send-sexp jabber-buffer-connection
`(message ((to . ,jabber-chatting-with)
(type . "chat"))
(rtt ((xmlns . "urn:xmpp:rtt:0")
(seq . ,(number-to-string jabber-rtt-send-seq))
(event . ,(if resetp "reset" "new")))
(t () ,text))))))
(defun jabber-rtt--queue-update (beg end pre-change-length)
(unless (or (< beg jabber-point-insert)
(< end jabber-point-insert))
(let ((timestamp (current-time)))
(when jabber-rtt-send-last-timestamp
(let* ((time-difference (time-subtract timestamp jabber-rtt-send-last-timestamp))
(interval (truncate (* 1000 (float-time time-difference)))))
(when (and (> interval 0)
;; Don't send too long intervals - this should have
;; been sent by our timer already.
(< interval 1000))
(push `(w ((n . ,(number-to-string interval))) nil)
jabber-rtt-outgoing-events))))
(setq jabber-rtt-send-last-timestamp timestamp))
(when (> pre-change-length 0)
;; Some text was deleted. Let's check if we can use a shorter
;; tag:
(let ((at-end (= end (point-max)))
(erase-one (= pre-change-length 1)))
(push `(e (
,@(unless at-end
`((p . ,(number-to-string
(+ beg
(- jabber-point-insert)
pre-change-length)))))
,@(unless erase-one
`((n . ,(number-to-string pre-change-length))))))
jabber-rtt-outgoing-events)))
(when (/= beg end)
;; Some text was inserted.
(let ((text (buffer-substring-no-properties beg end))
(at-end (= end (point-max))))
(push `(t (
,@(unless at-end
`((p . ,(number-to-string (- beg jabber-point-insert))))))
,text)
jabber-rtt-outgoing-events)))
(when (null jabber-rtt-send-timer)
(setq jabber-rtt-send-timer
(run-with-timer 0.7 nil #'jabber-rtt--send-queued-events (current-buffer))))))
(defun jabber-rtt--send-queued-events (buffer)
(with-current-buffer buffer
(setq jabber-rtt-send-timer nil)
(when jabber-rtt-outgoing-events
(let ((event (if jabber-rtt-send-seq "edit" "new")))
(setq jabber-rtt-send-seq
(if jabber-rtt-send-seq
(1+ jabber-rtt-send-seq)
(random 100000)))
(jabber-send-sexp jabber-buffer-connection
`(message ((to . ,jabber-chatting-with)
(type . "chat"))
(rtt ((xmlns . "urn:xmpp:rtt:0")
(seq . ,(number-to-string jabber-rtt-send-seq))
(event . ,event))
,@(nreverse jabber-rtt-outgoing-events))))
(setq jabber-rtt-outgoing-events nil)))))
(defun jabber-rtt--message-sent (_text _id)
;; We're sending a <body/> element; reset our state
(when (timerp jabber-rtt-send-timer)
(cancel-timer jabber-rtt-send-timer))
(setq jabber-rtt-send-timer nil
jabber-rtt-send-seq nil
jabber-rtt-outgoing-events nil
jabber-rtt-send-last-timestamp nil))
(provide 'jabber-rtt)
;;; jabber-rtt.el ends here