From: Magnus H. <leg...@us...> - 2013-11-14 10:29:44
|
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 updated via 74a98f3da67f3f438889eb801ea49237a9ea1003 (commit) via d1732df73a4c192761ba137a3a6dca1cc8128b9e (commit) from ccd6e4a596aba77bf7ba2759068e937c01453d42 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 74a98f3da67f3f438889eb801ea49237a9ea1003 Author: Magnus Henoch <mag...@gm...> Date: Thu Nov 14 10:22:26 2013 +0000 Add jabber-rtt-send-mode, for sending Real Time Text events diff --git a/jabber-rtt.el b/jabber-rtt.el index 44e98bb..65d5272 100644 --- a/jabber-rtt.el +++ b/jabber-rtt.el @@ -23,6 +23,8 @@ ;;; Code: +;;;; Handling incoming events + (defvar jabber-rtt-ewoc-node nil) (make-variable-buffer-local 'jabber-rtt-ewoc-node) @@ -170,5 +172,142 @@ 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) + +(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 commit d1732df73a4c192761ba137a3a6dca1cc8128b9e Author: Magnus Henoch <mag...@gm...> Date: Thu Nov 14 10:21:50 2013 +0000 Allow local hooks in jabber-chat-send-hooks diff --git a/jabber-chat.el b/jabber-chat.el index 2c15f84..80d214f 100644 --- a/jabber-chat.el +++ b/jabber-chat.el @@ -337,8 +337,16 @@ This function is idempotent." (id . ,id)) (body () ,body)))) ;; ...add additional elements... + ;; TODO: Once we require Emacs 24.1, use `run-hook-wrapped' instead. + ;; That way we don't need to eliminate the "local hook" functionality + ;; here. (dolist (hook jabber-chat-send-hooks) - (nconc stanza-to-send (funcall hook body id))) + (if (eq hook t) + ;; Local hook referring to global... + (when (local-variable-p 'jabber-chat-send-hooks) + (dolist (global-hook (default-value 'jabber-chat-send-hooks)) + (nconc stanza-to-send (funcall global-hook body id)))) + (nconc stanza-to-send (funcall hook body id)))) ;; ...display it, if it would be displayed. (when (run-hook-with-args-until-success 'jabber-chat-printers stanza-to-send :local :printp) (jabber-maybe-print-rare-time ----------------------------------------------------------------------- Summary of changes: jabber-chat.el | 10 ++++- jabber-rtt.el | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 148 insertions(+), 1 deletions(-) hooks/post-receive -- emacs-jabber |