1 ;; jabber-iq.el - infoquery functions
3 ;; Copyright (C) 2003, 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
4 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
6 ;; This file is a part of jabber.el.
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.
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.
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
22 (require 'jabber-core
)
23 (require 'jabber-util
)
24 (require 'jabber-keymap
)
26 (defvar *jabber-open-info-queries
* nil
27 "an alist of open query id and their callback functions")
29 (defvar jabber-iq-get-xmlns-alist nil
30 "Mapping from XML namespace to handler for IQ GET requests.")
32 (defvar jabber-iq-set-xmlns-alist nil
33 "Mapping from XML namespace to handler for IQ SET requests.")
35 (defvar jabber-browse-mode-map
36 (let ((map (make-sparse-keymap)))
37 (set-keymap-parent map jabber-common-keymap
)
38 (define-key map
[mouse-2
] 'jabber-popup-combined-menu
)
41 (defcustom jabber-browse-mode-hook nil
42 "Hook run when entering Browse mode."
46 (defgroup jabber-browse nil
"browse display options"
49 (defcustom jabber-browse-buffer-format
"*-jabber-browse:-%n-*"
50 "The format specification for the name of browse buffers.
52 These fields are available at this moment:
56 :group
'jabber-browse
)
58 (defun jabber-browse-mode ()
59 "\\{jabber-browse-mode-map}"
60 (kill-all-local-variables)
61 (setq major-mode
'jabber-browse-mode
62 mode-name
"jabber-browse")
63 (use-local-map jabber-browse-mode-map
)
64 (setq buffer-read-only t
)
65 (if (fboundp 'run-mode-hooks
)
66 (run-mode-hooks 'jabber-browse-mode-hook
)
67 (run-hooks 'jabber-browse-mode-hook
)))
69 (put 'jabber-browse-mode
'mode-class
'special
)
71 (add-to-list 'jabber-iq-chain
'jabber-process-iq
)
72 (defun jabber-process-iq (jc xml-data
)
73 "process an incoming iq stanza"
74 (let* ((id (jabber-xml-get-attribute xml-data
'id
))
75 (type (jabber-xml-get-attribute xml-data
'type
))
76 (from (jabber-xml-get-attribute xml-data
'from
))
77 (query (jabber-iq-query xml-data
))
78 (callback (assoc id
*jabber-open-info-queries
*)))
80 ;; if type is "result" or "error", this is a response to a query we sent.
81 ((or (string= type
"result")
82 (string= type
"error"))
83 (let ((callback-cons (nth (cdr (assoc type
'(("result" .
0)
84 ("error" .
1)))) (cdr callback
))))
85 (if (consp callback-cons
)
86 (funcall (car callback-cons
) jc xml-data
(cdr callback-cons
))))
87 (setq *jabber-open-info-queries
* (delq callback
*jabber-open-info-queries
*)))
89 ;; if type is "get" or "set", correct action depends on namespace of request.
91 (or (string= type
"get")
92 (string= type
"set")))
93 (let* ((which-alist (eval (cdr (assoc type
95 (cons "get" 'jabber-iq-get-xmlns-alist
)
96 (cons "set" 'jabber-iq-set-xmlns-alist
))))))
97 (handler (cdr (assoc (jabber-xml-get-attribute query
'xmlns
) which-alist
))))
99 (condition-case error-var
100 (funcall handler jc xml-data
)
102 (apply 'jabber-send-iq-error jc from id query
(cdr error-var
)))
103 (error (jabber-send-iq-error jc from id query
"wait" 'internal-server-error
(error-message-string error-var
))))
104 (jabber-send-iq-error jc from id query
"cancel" 'feature-not-implemented
)))))))
106 (defun jabber-send-iq (jc to type query success-callback success-closure-data
107 error-callback error-closure-data
&optional result-id
)
108 "Send an iq stanza to the specified entity, and optionally set up a callback.
109 JC is the Jabber connection.
111 TYPE is one of \"get\", \"set\", \"result\" or \"error\".
112 QUERY is a list containing the child of the iq node in the format `jabber-sexp2xml'
114 SUCCESS-CALLBACK is the function to be called when a successful result arrives.
115 SUCCESS-CLOSURE-DATA is an extra argument to SUCCESS-CALLBACK.
116 ERROR-CALLBACK is the function to be called when an error arrives.
117 ERROR-CLOSURE-DATA is an extra argument to ERROR-CALLBACK.
118 RESULT-ID is the id to be used for a response to a received iq message.
119 `jabber-report-success' and `jabber-process-data' are common callbacks.
121 The callback functions are called like this:
122 \(funcall CALLBACK JC XML-DATA CLOSURE-DATA)
123 with XML-DATA being the IQ stanza received in response. "
124 (let ((id (or result-id
(apply 'format
"emacs-iq-%d.%d.%d" (current-time)))))
125 (if (or success-callback error-callback
)
126 (setq *jabber-open-info-queries
* (cons (list id
127 (cons success-callback success-closure-data
)
128 (cons error-callback error-closure-data
))
130 *jabber-open-info-queries
*)))
133 (if to
(list (cons 'to to
)))
134 (list (cons 'type type
))
135 (list (cons 'id id
)))
138 (defun jabber-send-iq-error (jc to id original-query error-type condition
139 &optional text app-specific
)
140 "Send an error iq stanza to the specified entity in response to a
141 previously sent iq stanza.
143 ID is the id of the iq stanza that caused the error.
144 ORIGINAL-QUERY is the original query, which should be included in the
146 ERROR-TYPE is one of \"cancel\", \"continue\", \"modify\", \"auth\"
148 CONDITION is a symbol denoting a defined XMPP condition.
149 TEXT is a string to be sent in the error message, or nil for no text.
150 APP-SPECIFIC is a list of extra XML tags.
152 See section 9.3 of XMPP Core."
159 (error ((type .
,error-type
))
160 (,condition
((xmlns .
"urn:ietf:params:xml:ns:xmpp-stanzas")))
162 `(text ((xmlns .
"urn:ietf:params:xml:ns:xmpp-stanzas"))
166 (defun jabber-process-data (jc xml-data closure-data
)
167 "Process random results from various requests."
168 (let ((from (or (jabber-xml-get-attribute xml-data
'from
) (plist-get (fsm-get-state-data jc
) :server
)))
169 (xmlns (jabber-iq-xmlns xml-data
))
170 (type (jabber-xml-get-attribute xml-data
'type
)))
171 (with-current-buffer (get-buffer-create (format-spec jabber-browse-buffer-format
172 (list (cons ?n from
))))
173 (if (not (eq major-mode
'jabber-browse-mode
))
174 (jabber-browse-mode))
176 (setq buffer-read-only nil
)
177 (goto-char (point-max))
179 (insert (jabber-propertize from
180 'face
'jabber-title-large
) "\n\n")
182 ;; Put point at beginning of data
184 ;; If closure-data is a function, call it. If it is a string,
185 ;; output it along with a description of the error. For other
186 ;; values (e.g. nil), just dump the XML.
188 ((functionp closure-data
)
189 (funcall closure-data jc xml-data
))
190 ((stringp closure-data
)
191 (insert closure-data
": " (jabber-parse-error (jabber-iq-error xml-data
)) "\n\n"))
193 (insert (format "%S\n\n" xml-data
))))
195 (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks
))
196 (run-hook-with-args hook
'browse
(current-buffer) (funcall jabber-alert-info-message-function
'browse
(current-buffer))))))))
200 ;;; arch-tag: 5585dfa3-b59a-42ee-9292-803652c85e26