jabber-chatstates.el

   1 ;;; jabber-chatstate.el --- Chat state notification (XEP-0085) implementation
   2
   3 ;; Author: Ami Fischman <ami@fischman.org>
   4 ;; (based entirely on jabber-events.el by Magnus Henoch <mange@freemail.hu>)
   5
   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)
   9 ;; any later version.
  10
  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.
  15
  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.
  20
  21 ;; TODO
  22 ;; - Currently only active/composing notifications are /sent/ though all 5
  23 ;;   notifications are handled on receipt.
  24
  25 (require 'jabber-autoloads)
  26 (require 'cl)
  27
  28 (defgroup jabber-chatstates nil
  29   "Chat state notifications."
  30   :group 'jabber)
  31
  32 (defconst jabber-chatstates-xmlns "http://jabber.org/protocol/chatstates"
  33   "XML namespace for the chatstates feature.")
  34
  35 (defcustom jabber-chatstates-confirm t
  36   "Send notifications about chat states?"
  37   :group 'jabber-chatstates
  38   :type 'boolean)
  39
  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
  44 t - send states
  45 nil - don't send states")
  46 (make-variable-buffer-local 'jabber-chatstates-requested)
  47
  48 (defvar jabber-chatstates-last-state nil
  49   "The last seen chat state.")
  50 (make-variable-buffer-local 'jabber-chatstates-last-state)
  51
  52 (defvar jabber-chatstates-message ""
  53   "Human-readable presentation of chat state information")
  54 (make-variable-buffer-local 'jabber-chatstates-message)
  55
  56 ;;; INCOMING
  57 ;;; Code for requesting chat state notifications from others and handling
  58 ;;; them.
  59
  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))
  65           "")))
  66
  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
  74       ;; side wants them.
  75       (setq jabber-chatstates-requested nil))
  76     `((active ((xmlns . ,jabber-chatstates-xmlns))))))
  77
  78 ;;; OUTGOING
  79 ;;; Code for handling requests for chat state notifications and providing
  80 ;;; them, modulo user preferences.
  81
  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)
  86
  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)
  90
  91 (defun jabber-chatstates-stop-timer ()
  92   "Stop the 'paused timer."
  93   (when jabber-chatstates-paused-timer
  94     (cancel-timer jabber-chatstates-paused-timer)))
  95
  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)))
 101
 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)
 106     (jabber-send-sexp
 107      jabber-buffer-connection
 108      `(message
 109        ((to . ,jabber-chatting-with))
 110        (paused ((xmlns . ,jabber-chatstates-xmlns)))))))
 111
 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
 116                jabber-chatting-with
 117                jabber-chatstates-requested
 118                (not (eq composing-now jabber-chatstates-composing-sent)))
 119       (jabber-send-sexp
 120        jabber-buffer-connection
 121        `(message
 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)))))
 126
 127 ;;; COMMON
 128
 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))
 132       (cond
 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))
 138
 139        (t
 140         (let ((state
 141                (or
 142                 (let ((node
 143                        (find jabber-chatstates-xmlns
 144                              (jabber-xml-node-children xml-data)
 145                              :key #'(lambda (x) (jabber-xml-get-attribute x 'xmlns))
 146                              :test #'string=)))
 147                   (jabber-xml-node-name node))
 148                 (let ((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))
 155                              :test #'string=)))
 156                   (when node
 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))
 165
 166           (setq jabber-chatstates-last-state state)
 167           (jabber-chatstates-update-message)))))))
 168
 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)
 171
 172 (add-to-list 'jabber-advertised-features "http://jabber.org/protocol/chatstates")
 173
 174 (provide 'jabber-chatstates)
 175 ;; arch-tag: d879de90-51e1-11dc-909d-000a95c2fcd0