jabber-ahc-presence.el

   1 ;; jabber-ahc-presence.el - provide remote control of presence
   2
   3 ;; Copyright (C) 2003, 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
   4 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
   5
   6 ;; This file is a part of jabber.el.
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program; if not, write to the Free Software
  20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 (require 'jabber-ahc)
  23 (require 'jabber-autoloads)
  24
  25 (defconst jabber-ahc-presence-node "http://jabber.org/protocol/rc#set-status"
  26   "Node used by jabber-ahc-presence")
  27
  28 (jabber-ahc-add jabber-ahc-presence-node "Set presence" 'jabber-ahc-presence
  29                 'jabber-my-jid-p)
  30
  31 (defun jabber-ahc-presence (jc xml-data)
  32   "Process presence change command."
  33
  34   (let* ((query (jabber-iq-query xml-data))
  35          (sessionid (jabber-xml-get-attribute query 'sessionid))
  36          (action (jabber-xml-get-attribute query 'action)))
  37     ;; No session state is kept; instead, lack of session-id is used
  38     ;; as indication of first command.
  39     (cond
  40      ;; command cancelled
  41      ((string= action "cancel")
  42       `(command ((xmlns . "http://jabber.org/protocol/commands")
  43                  (sessionid . ,sessionid)
  44                  (node . ,jabber-ahc-presence-node)
  45                  (status . "canceled"))))
  46      ;; return form
  47      ((null sessionid)
  48       `(command ((xmlns . "http://jabber.org/protocol/commands")
  49                  (sessionid . "jabber-ahc-presence")
  50                  (node . ,jabber-ahc-presence-node)
  51                  (status . "executing"))
  52                 (x ((xmlns . "jabber:x:data")
  53                     (type . "form"))
  54                    (title nil ,(format "Set presence of %s" (jabber-connection-jid jc)))
  55                    (instructions nil "Select new presence status.")
  56                    (field ((var . "FORM_TYPE") (type . "hidden"))
  57                           (value nil "http://jabber.org/protocol/rc"))
  58                    (field ((var . "status")
  59                            (label . "Status")
  60                            (type . "list-single"))
  61                           (value nil ,(if (string= *jabber-current-show* "")
  62                                           "online"
  63                                         *jabber-current-show*))
  64                           (option ((label . "Online")) (value nil "online"))
  65                           (option ((label . "Chatty")) (value nil "chat"))
  66                           (option ((label . "Away")) (value nil "away"))
  67                           (option ((label . "Extended away")) (value nil "xa"))
  68                           (option ((label . "Do not disturb")) (value nil "dnd")))
  69                    (field ((var . "status-message")
  70                            (label . "Message")
  71                            (type . "text-single"))
  72                           (value nil ,*jabber-current-status*))
  73                    (field ((var . "status-priority")
  74                            (label . "Priority")
  75                            (type . "text-single"))
  76                           (value nil ,(int-to-string *jabber-current-priority*))))))
  77      ;; process form
  78      (t
  79       (let* ((x (car (jabber-xml-get-children query 'x)))
  80         ;; we assume that the first <x/> is the jabber:x:data one
  81              (fields (jabber-xml-get-children x 'field))
  82              (new-show *jabber-current-show*)
  83              (new-status *jabber-current-status*)
  84              (new-priority *jabber-current-priority*))
  85         (dolist (field fields)
  86           (let ((var (jabber-xml-get-attribute field 'var))
  87                 ;; notice that multi-value fields won't be handled properly
  88                 ;; by this
  89                 (value (car (jabber-xml-node-children (car (jabber-xml-get-children field 'value))))))
  90             (cond
  91              ((string= var "status")
  92               (setq new-show (if (string= value "online")
  93                                  ""
  94                                value)))
  95              ((string= var "status-message")
  96               (setq new-status value))
  97              ((string= var "status-priority")
  98               (setq new-priority (string-to-number value))))))
  99         (jabber-send-presence new-show new-status new-priority))
 100       `(command ((xmlns . "http://jabber.org/protocol/commands")
 101                  (sessionid . ,sessionid)
 102                  (node . ,jabber-ahc-presence-node)
 103                  (status . "completed"))
 104                 (note ((type . "info")) "Presence has been changed."))))))
 105
 106 (provide 'jabber-ahc-presence)
 107
 108 ;;; arch-tag: 4b8cbbe7-00a9-4d42-a4ac-b824ab914fba