projects / config.git / blame
| Commit | Line | Data |
|---|---|---|
| 53e6db90 DC |
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 |