djavu-asus/elpa/jabber-20230715.456/jabber-version.el

   1 ;; jabber-version.el - version reporting by JEP-0092  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2003, 2004, 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-iq)
  23 (require 'jabber-util)
  24 (require 'jabber-ourversion)
  25
  26 (defcustom jabber-version-show t
  27   "Show our client version to others.  Acts on loading."
  28   :type 'boolean
  29   :group 'jabber)
  30
  31 (add-to-list 'jabber-jid-info-menu
  32              (cons "Request software version" 'jabber-get-version))
  33 (defun jabber-get-version (jc to)
  34   "Request software version.
  35
  36 JC is the Jabber connection."
  37   (interactive (list
  38                 (jabber-read-account)
  39                 (jabber-read-jid-completing "Request version of: " nil nil nil 'full t)))
  40   (jabber-send-iq jc to
  41                   "get"
  42                   '(query ((xmlns . "jabber:iq:version")))
  43                   #'jabber-process-data #'jabber-process-version
  44                   #'jabber-process-data "Version request failed"))
  45
  46 ;; called by jabber-process-data
  47 (defun jabber-process-version (jc xml-data)
  48   "Handle results from jabber:iq:version requests.
  49
  50 JC is the Jabber connection.
  51 XML-DATA is the parsed tree data from the stream (stanzas)
  52 obtained from `xml-parse-region'."
  53   (let ((query (jabber-iq-query xml-data)))
  54     (dolist (x '((name . "Name:\t\t") (version . "Version:\t") (os . "OS:\t\t")))
  55       (let ((data (car (jabber-xml-node-children (car (jabber-xml-get-children query (car x)))))))
  56         (when data
  57           (insert (cdr x) data "\n"))))))
  58
  59 (if jabber-version-show
  60     (and
  61      (add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:version" 'jabber-return-version))
  62      (jabber-disco-advertise-feature "jabber:iq:version")))
  63
  64 (defun jabber-return-version (jc xml-data)
  65   "Return client version as defined in XEP-0092.
  66 Sender and ID are determined from the incoming packet passed in XML-DATA.
  67
  68 JC is the Jabber connection."
  69   ;; Things we might check: does this iq message really have type='get' and
  70   ;; exactly one child, namely query with xmlns='jabber:iq:version'?
  71   ;; Then again, jabber-process-iq should take care of that.
  72   (let ((to (jabber-xml-get-attribute xml-data 'from))
  73         (id (jabber-xml-get-attribute xml-data 'id))
  74         (os (format "%s %d.%d (%s)"
  75              (cond ((featurep 'xemacs) "XEmacs")
  76                    (t "Emacs"))
  77              emacs-major-version emacs-minor-version
  78              system-type)))
  79     (jabber-send-iq jc to "result"
  80                     `(query ((xmlns . "jabber:iq:version"))
  81                             (name () "jabber.el")
  82                             (version () ,jabber-version)
  83                             ;; Booting... /vmemacs.el
  84                             ;; Shamelessly stolen from someone's sig.
  85                             (os () ,os))
  86                     nil nil nil nil
  87                     id)))
  88
  89 (provide 'jabber-version)
  90
  91 ;;; arch-tag: 2051dbe7-01b5-401e-bd8a-fe24afb88e1e