]>
Commit | Line | Data |
---|---|---|
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 |