[config.git] / djavu-asus / emacs / elpa / jabber-20230715.456 / jabber-iq.el

;; jabber-iq.el - infoquery functions  -*- lexical-binding: t; -*-

;; Copyright (C) 2003, 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net

;; This file is a part of jabber.el.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

(require 'jabber-core)
(require 'jabber-util)
(require 'jabber-keymap)

(defvar *jabber-open-info-queries* nil
  "Alist of open query id and their callback functions.")

(defvar jabber-iq-get-xmlns-alist nil
  "Mapping from XML namespace to handler for IQ GET requests.")

(defvar jabber-iq-set-xmlns-alist nil
  "Mapping from XML namespace to handler for IQ SET requests.")

(defvar jabber-browse-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map jabber-common-keymap)
    (define-key map [mouse-2] 'jabber-popup-combined-menu)
    map))

(defcustom jabber-browse-mode-hook nil
  "Hook run when entering Browse mode."
  :group 'jabber
  :type 'hook)

(defgroup jabber-browse nil "browse display options"
  :group 'jabber)

(defcustom jabber-browse-buffer-format "*-jabber-browse:-%n-*"
  "The format specification for the name of browse buffers.

These fields are available at this moment:

%n   JID to browse"
  :type 'string
  :group 'jabber-browse)

(defun jabber-browse-mode ()
"Jabber browse mode.
\\{jabber-browse-mode-map}"
  (kill-all-local-variables)
  (setq major-mode 'jabber-browse-mode
        mode-name "jabber-browse")
  (use-local-map jabber-browse-mode-map)
  (setq buffer-read-only t)
  (if (fboundp 'run-mode-hooks)
      (run-mode-hooks 'jabber-browse-mode-hook)
    (run-hooks 'jabber-browse-mode-hook)))

(put 'jabber-browse-mode 'mode-class 'special)

(add-to-list 'jabber-iq-chain 'jabber-process-iq)
(defun jabber-process-iq (jc xml-data)
  "Process an incoming iq stanza.

JC is the Jabber Connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let* ((id (jabber-xml-get-attribute xml-data 'id))
         (type (jabber-xml-get-attribute xml-data 'type))
         (from (jabber-xml-get-attribute xml-data 'from))
         (query (jabber-iq-query xml-data))
         (callback (assoc id *jabber-open-info-queries*)))
    (cond
     ;; if type is "result" or "error", this is a response to a query we sent.
     ((or (string= type "result")
          (string= type "error"))
      (let ((callback-cons (nth (cdr (assoc type '(("result" . 0)
                                                   ("error" . 1)))) (cdr callback))))
        (if (consp callback-cons)
            (funcall (car callback-cons) jc xml-data (cdr callback-cons))))
      (setq *jabber-open-info-queries* (delq callback *jabber-open-info-queries*)))

     ;; if type is "get" or "set", correct action depends on namespace of request.
     ((and (listp query)
           (or (string= type "get")
               (string= type "set")))
      (let* ((which-alist (eval (cdr (assoc type
                                            (list
                                             (cons "get" 'jabber-iq-get-xmlns-alist)
                                             (cons "set" 'jabber-iq-set-xmlns-alist))))))
             (handler (cdr (assoc (jabber-xml-get-attribute query 'xmlns) which-alist))))
        (if handler
            (condition-case error-var
                (funcall handler jc xml-data)
              (jabber-error
               (apply 'jabber-send-iq-error jc from id query (cdr error-var)))
              (error (jabber-send-iq-error jc from id query "wait" 'internal-server-error (error-message-string error-var))))
          (jabber-send-iq-error jc from id query "cancel" 'feature-not-implemented)))))))

(defun jabber-send-iq (jc to type query success-callback success-closure-data
                          error-callback error-closure-data &optional result-id)
  "Send an iq stanza to the specified entity, and optionally set up a callback.
JC is the Jabber connection.
TO is the addressee.
TYPE is one of \"get\", \"set\", \"result\" or \"error\".
QUERY is a list containing the child of the iq node in the format
`jabber-sexp2xml' accepts.
SUCCESS-CALLBACK is the function to be called when a successful result arrives.
SUCCESS-CLOSURE-DATA is an extra argument to SUCCESS-CALLBACK.
ERROR-CALLBACK is the function to be called when an error arrives.
ERROR-CLOSURE-DATA is an extra argument to ERROR-CALLBACK.
RESULT-ID is the id to be used for a response to a received iq message.
`jabber-report-success' and `jabber-process-data' are common callbacks.

The callback functions are called like this:
\(funcall CALLBACK JC XML-DATA CLOSURE-DATA)
with XML-DATA being the IQ stanza received in response."
  (let ((id (or result-id (apply 'format "emacs-iq-%d.%d.%d" (current-time)))))
    (if (or success-callback error-callback)
        (setq *jabber-open-info-queries* (cons (list id
                                                     (cons success-callback success-closure-data)
                                                     (cons error-callback error-closure-data))

                                               *jabber-open-info-queries*)))
    (jabber-send-sexp jc
                      (list 'iq (append
                                 (if to (list (cons 'to to)))
                                 (list (cons 'type type))
                                 (list (cons 'id id)))
                            query))))

(defun jabber-send-iq-error (jc to id original-query error-type condition
                                &optional text app-specific)
  "Send an error iq stanza in response to a previously sent iq stanza.
Send an error iq stanza to the specified entity in response to a
previously sent iq stanza.
TO is the addressee.
ID is the id of the iq stanza that caused the error.
ORIGINAL-QUERY is the original query, which should be included in the
error, or nil.
ERROR-TYPE is one of \"cancel\", \"continue\", \"modify\", \"auth\"
and \"wait\".
CONDITION is a symbol denoting a defined XMPP condition.
TEXT is a string to be sent in the error message, or nil for no text.
APP-SPECIFIC is a list of extra XML tags.
JC is the Jabber connection.

See section 9.3 of XMPP Core."
  (jabber-send-sexp
   jc
   `(iq (,@(when to `((to . ,to)))
         (type . "error")
         (id . ,(or id "")))
        ,original-query
        (error ((type . ,error-type))
               (,condition ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas")))
               ,(if text
                    `(text ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas"))
                           ,text))
               ,@app-specific))))

(defun jabber-process-data (jc xml-data closure-data)
  "Process random results from various requests.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((from (or (jabber-xml-get-attribute xml-data 'from) (plist-get (fsm-get-state-data jc) :server)))
        (xmlns (jabber-iq-xmlns xml-data))
        (type (jabber-xml-get-attribute xml-data 'type)))
    (with-current-buffer (get-buffer-create (format-spec jabber-browse-buffer-format
                                                         (list (cons ?n from))))
      (if (not (eq major-mode 'jabber-browse-mode))
          (jabber-browse-mode))

      (setq buffer-read-only nil)
      (goto-char (point-max))

      (insert (jabber-propertize from
                          'face 'jabber-title-large) "\n\n")

      ;; Put point at beginning of data
      (save-excursion
        ;; If closure-data is a function, call it.  If it is a string,
        ;; output it along with a description of the error.  For other
        ;; values (e.g. nil), just dump the XML.
        (cond
         ((functionp closure-data)
          (funcall closure-data jc xml-data))
         ((stringp closure-data)
          (insert closure-data ": " (jabber-parse-error (jabber-iq-error xml-data)) "\n\n"))
         (t
          (insert (format "%S\n\n" xml-data))))

        (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks))
          (run-hook-with-args hook 'browse (current-buffer) (funcall jabber-alert-info-message-function 'browse (current-buffer))))))))

(defun jabber-silent-process-data (jc xml-data closure-data)
  "Process random results from various requests to only alert hooks.

JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
  (let ((text (cond
               ((functionp closure-data)
                (funcall closure-data jc xml-data))
               ((stringp closure-data)
                (concat closure-data ": " (jabber-parse-error (jabber-iq-error xml-data))))
               (t
                (format "%S" xml-data)))))
    (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks))
      (run-hook-with-args hook 'browse (current-buffer)
                          text))))

(provide 'jabber-iq)

;;; arch-tag: 5585dfa3-b59a-42ee-9292-803652c85e26