djavu-asus/elpa/jabber-20230715.456/jabber-ahc-presence.el

   1 ;; jabber-ahc-presence.el - provide remote control of presence  -*- lexical-binding: t; -*-
   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-presence)
  23 (require 'jabber-ahc)
  24 (defvar *jabber-current-show*)
  25 (defvar *jabber-current-status*)
  26 (defvar *jabber-current-priority*)
  27
  28 (defconst jabber-ahc-presence-node "http://jabber.org/protocol/rc#set-status"
  29   "Node used by function `jabber-ahc-presence'.")
  30
  31 (jabber-ahc-add jabber-ahc-presence-node "Set presence" 'jabber-ahc-presence
  32                 'jabber-my-jid-p)
  33
  34 (defun jabber-ahc-presence (jc xml-data)
  35   "Process presence change command.
  36
  37 JC is the Jabber connection.
  38 XML-DATA is the parsed tree data from the stream (stanzas)
  39 obtained from `xml-parse-region'."
  40
  41   (let* ((query (jabber-iq-query xml-data))
  42          (sessionid (jabber-xml-get-attribute query 'sessionid))
  43          (action (jabber-xml-get-attribute query 'action)))
  44     ;; No session state is kept; instead, lack of session-id is used
  45     ;; as indication of first command.
  46     (cond
  47      ;; command cancelled
  48      ((string= action "cancel")
  49       `(command ((xmlns . "http://jabber.org/protocol/commands")
  50                  (sessionid . ,sessionid)
  51                  (node . ,jabber-ahc-presence-node)
  52                  (status . "canceled"))))
  53      ;; return form
  54      ((null sessionid)
  55       `(command ((xmlns . "http://jabber.org/protocol/commands")
  56                  (sessionid . "jabber-ahc-presence")
  57                  (node . ,jabber-ahc-presence-node)
  58                  (status . "executing"))
  59                 (x ((xmlns . "jabber:x:data")
  60                     (type . "form"))
  61                    (title nil ,(format "Set presence of %s" (jabber-connection-jid jc)))
  62                    (instructions nil "Select new presence status.")
  63                    (field ((var . "FORM_TYPE") (type . "hidden"))
  64                           (value nil "http://jabber.org/protocol/rc"))
  65                    (field ((var . "status")
  66                            (label . "Status")
  67                            (type . "list-single"))
  68                           (value nil ,(if (string= *jabber-current-show* "")
  69                                           "online"
  70                                         *jabber-current-show*))
  71                           (option ((label . "Online")) (value nil "online"))
  72                           (option ((label . "Chatty")) (value nil "chat"))
  73                           (option ((label . "Away")) (value nil "away"))
  74                           (option ((label . "Extended away")) (value nil "xa"))
  75                           (option ((label . "Do not disturb")) (value nil "dnd")))
  76                    (field ((var . "status-message")
  77                            (label . "Message")
  78                            (type . "text-single"))
  79                           (value nil ,*jabber-current-status*))
  80                    (field ((var . "status-priority")
  81                            (label . "Priority")
  82                            (type . "text-single"))
  83                           (value nil ,(int-to-string *jabber-current-priority*))))))
  84      ;; process form
  85      (t
  86       (let* ((x (car (jabber-xml-get-children query 'x)))
  87         ;; we assume that the first <x/> is the jabber:x:data one
  88              (fields (jabber-xml-get-children x 'field))
  89              (new-show *jabber-current-show*)
  90              (new-status *jabber-current-status*)
  91              (new-priority *jabber-current-priority*))
  92         (dolist (field fields)
  93           (let ((var (jabber-xml-get-attribute field 'var))
  94                 ;; notice that multi-value fields won't be handled properly
  95                 ;; by this
  96                 (value (car (jabber-xml-node-children (car (jabber-xml-get-children field 'value))))))
  97             (cond
  98              ((string= var "status")
  99               (setq new-show (if (string= value "online")
 100                                  ""
 101                                value)))
 102              ((string= var "status-message")
 103               (setq new-status value))
 104              ((string= var "status-priority")
 105               (setq new-priority (string-to-number value))))))
 106         (jabber-send-presence new-show new-status new-priority))
 107       `(command ((xmlns . "http://jabber.org/protocol/commands")
 108                  (sessionid . ,sessionid)
 109                  (node . ,jabber-ahc-presence-node)
 110                  (status . "completed"))
 111                 (note ((type . "info")) "Presence has been changed."))))))
 112
 113 (provide 'jabber-ahc-presence)
 114
 115 ;;; arch-tag: 4b8cbbe7-00a9-4d42-a4ac-b824ab914fba