Menu
▾
▴
[SCM] emacs-jabber branch, rtt, created. ccd6e4a596aba77bf7ba2759068e937c01453d42
|
From: Magnus H. <leg...@us...> - 2013-11-05 23:43:14
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, rtt has been created
at ccd6e4a596aba77bf7ba2759068e937c01453d42 (commit)
- Log -----------------------------------------------------------------
commit ccd6e4a596aba77bf7ba2759068e937c01453d42
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 5 23:42:57 2013 +0000
XEP-0301: handle wait events
diff --git a/jabber-rtt.el b/jabber-rtt.el
index c7cca9c..44e98bb 100644
--- a/jabber-rtt.el
+++ b/jabber-rtt.el
@@ -35,6 +35,9 @@
(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
(add-to-list 'jabber-message-chain #'jabber-rtt-handle-message t)
@@ -54,21 +57,15 @@
(cond
((or body (string= event "cancel"))
;; A <body/> element supersedes real time text.
- (when jabber-rtt-ewoc-node
- (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
- (setq jabber-rtt-ewoc-node nil
- jabber-rtt-last-seq nil
- jabber-rtt-message nil
- jabber-rtt-pending-events nil))
+ (jabber-rtt--reset))
((member event '("new" "reset"))
- (when jabber-rtt-ewoc-node
- (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (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--process-actions actions))
+ (jabber-rtt--enqueue-actions actions))
((string= event "edit")
;; TODO: check whether this works properly in 32-bit Emacs
(cond
@@ -77,7 +74,7 @@
(string-to-number seq)))
;; We are in sync.
(setq jabber-rtt-last-seq (string-to-number seq))
- (jabber-rtt--process-actions actions))
+ (jabber-rtt--enqueue-actions actions))
(t
;; TODO: show warning when not in sync
(message "out of sync! %s vs %s"
@@ -86,41 +83,92 @@
;; TODO: handle event="init"
)))))
-(defun jabber-rtt--process-actions (actions)
- (dolist (action actions)
- (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 jabber-rtt-message))
- (let ((inhibit-read-only t))
- (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
- ((w)
- ;; TODO: handle <w/>
- ))))
+(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)))))
(provide 'jabber-rtt)
;;; jabber-rtt.el ends here
commit 2b55c4ebd07ed40f741e7c10c02d9dc253f45fd3
Author: Magnus Henoch <mag...@gm...>
Date: Tue Nov 5 09:48:20 2013 +0000
Initial implementation of XEP-0301: In-Band Real Time Text
We can receive RTT events. Wait events are not yet supported.
diff --git a/jabber-rtt.el b/jabber-rtt.el
new file mode 100644
index 0000000..c7cca9c
--- /dev/null
+++ b/jabber-rtt.el
@@ -0,0 +1,126 @@
+;;; jabber-rtt.el --- XEP-0301: In-Band Real Time Text
+
+;; Copyright (C) 2013 Magnus Henoch
+
+;; Author: Magnus Henoch <mag...@gm...>
+
+;; 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:
+
+(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)
+
+;; Add function last in chain, so a chat buffer is already created.
+;;;###autoload
+(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.
+ (when jabber-rtt-ewoc-node
+ (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (setq jabber-rtt-ewoc-node nil
+ jabber-rtt-last-seq nil
+ jabber-rtt-message nil
+ jabber-rtt-pending-events nil))
+ ((member event '("new" "reset"))
+ (when jabber-rtt-ewoc-node
+ (ewoc-delete jabber-chat-ewoc jabber-rtt-ewoc-node))
+ (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--process-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--process-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--process-actions (actions)
+ (dolist (action actions)
+ (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 jabber-rtt-message))
+ (let ((inhibit-read-only t))
+ (ewoc-invalidate jabber-chat-ewoc jabber-rtt-ewoc-node))))
+ ((w)
+ ;; TODO: handle <w/>
+ ))))
+
+(provide 'jabber-rtt)
+;;; jabber-rtt.el ends here
-----------------------------------------------------------------------
hooks/post-receive
--
emacs-jabber
|
