]> crepu.dev Git - config.git/blame_incremental - djavu-asus/emacs/elpa/jabber-20230715.456/jabber-time.el
Reorganización de directorios
[config.git] / djavu-asus / emacs / elpa / jabber-20230715.456 / jabber-time.el
... / ...
CommitLineData
1;; jabber-time.el - time reporting by XEP-0012, XEP-0090, XEP-0202 -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2006, 2010 - Kirill A. Kroinskiy - catap@catap.ru
4;; Copyright (C) 2006 - Magnus Henoch - mange@freemail.hu
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 GNU Emacs; see the file COPYING. If not, write to
20;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21;; Boston, MA 02110-1301, USA.
22
23(require 'jabber-iq)
24(require 'jabber-util)
25(require 'jabber-autoaway)
26
27(require 'time-date)
28
29(add-to-list 'jabber-jid-info-menu (cons "Request time" 'jabber-get-time))
30
31(defun jabber-get-time (jc to)
32 "Request time.
33
34JC is the Jabber connection."
35 (interactive (list (jabber-read-account)
36 (jabber-read-jid-completing "Request time of: "
37 nil nil nil 'full t)))
38
39 (jabber-send-iq jc to "get"
40 '(time ((xmlns . "urn:xmpp:time")))
41 'jabber-silent-process-data 'jabber-process-time
42 'jabber-silent-process-data
43 (lambda (jc xml-data)
44 (let ((from (jabber-xml-get-attribute xml-data 'from)))
45 (jabber-get-legacy-time jc from)))))
46
47(defun jabber-get-legacy-time (jc to)
48 "Request legacy time.
49
50JC is the Jabber connection.
51XML-DATA is the parsed tree data from the stream (stanzas)
52obtained from `xml-parse-region'."
53 (interactive (list (jabber-read-account)
54 (jabber-read-jid-completing "Request time of: "
55 nil nil nil 'full t)))
56
57 (jabber-send-iq jc to
58 "get"
59 '(query ((xmlns . "jabber:iq:time")))
60 'jabber-silent-process-data 'jabber-process-legacy-time
61 'jabber-silent-process-data "Time request failed"))
62
63;; called by jabber-process-data
64(defun jabber-process-time (jc xml-data)
65 "Handle results from urn:xmpp:time requests.
66
67JC is the Jabber Connection.
68XML-DATA is the parsed tree data from the stream (stanzas)
69obtained from `xml-parse-region'."
70 (let* ((from (jabber-xml-get-attribute xml-data 'from))
71 (time (or (car (jabber-xml-get-children xml-data 'time))
72 ;; adium response of qeury
73 (car (jabber-xml-get-children xml-data 'query))))
74 (tzo (car (jabber-xml-node-children
75 (car (jabber-xml-get-children time 'tzo)))))
76 (utc (car (jabber-xml-node-children
77 (car (jabber-xml-get-children time 'utc))))))
78 (when (and utc tzo)
79 (format "%s has time: %s %s"
80 from (format-time-string "%Y-%m-%d %T" (jabber-parse-time utc)) tzo))))
81
82(defun jabber-process-legacy-time (jc xml-data)
83 "Handle results from jabber:iq:time requests.
84
85JC is the Jabber connection.
86XML-DATA is the parsed tree data from the stream (stanzas)
87obtained from `xml-parse-region'."
88 (let* ((from (jabber-xml-get-attribute xml-data 'from))
89 (query (jabber-iq-query xml-data))
90 (display
91 (car (jabber-xml-node-children
92 (car (jabber-xml-get-children
93 query 'display)))))
94 (utc
95 (car (jabber-xml-node-children
96 (car (jabber-xml-get-children
97 query 'utc)))))
98 (tz
99 (car (jabber-xml-node-children
100 (car (jabber-xml-get-children
101 query 'tz))))))
102 (format "%s has time: %s" from
103 (cond
104 (display display)
105 (utc
106 (concat
107 (format-time-string "%Y-%m-%d %T" (jabber-parse-legacy-time utc))
108 (when tz
109 (concat " " tz))))))))
110
111;; the only difference between these two functions is the
112;; `jabber-read-jid-completing' call.
113(defun jabber-get-last-online (jc to)
114 "Request time since a user was last online, or uptime of a component.
115
116JC is the Jabber connection."
117 (interactive (list (jabber-read-account)
118 (jabber-read-jid-completing "Get last online for: "
119 nil nil nil 'bare-or-muc)))
120 (jabber-send-iq jc to
121 "get"
122 '(query ((xmlns . "jabber:iq:last")))
123 #'jabber-silent-process-data #'jabber-process-last
124 #'jabber-silent-process-data "Last online request failed"))
125
126(defun jabber-get-idle-time (jc to)
127 "Request idle time of user.
128
129JC is the Jabber connection."
130 (interactive (list (jabber-read-account)
131 (jabber-read-jid-completing "Get idle time for: "
132 nil nil nil 'full t)))
133 (jabber-send-iq jc to
134 "get"
135 '(query ((xmlns . "jabber:iq:last")))
136 #'jabber-silent-process-data #'jabber-process-last
137 #'jabber-silent-process-data "Idle time request failed"))
138
139(defun jabber-process-last (jc xml-data)
140 "Handle results from jabber:iq:last requests.
141
142JC is the Jabber connection.
143XML-DATA is the parsed tree data from the stream (stanzas)
144obtained from `xml-parse-region'."
145 (let* ((from (jabber-xml-get-attribute xml-data 'from))
146 (query (jabber-iq-query xml-data))
147 (seconds (jabber-xml-get-attribute query 'seconds))
148 (message (car (jabber-xml-node-children query))))
149 (cond
150 ((jabber-jid-resource from)
151 ;; Full JID: idle time
152 (format "%s idle for %s seconds" from seconds))
153 ((jabber-jid-username from)
154 ;; Bare JID with username: time since online
155 (concat
156 (format "%s last online %s seconds ago" from seconds)
157 (let ((seconds (condition-case nil
158 (string-to-number seconds)
159 (error nil))))
160 (when (numberp seconds)
161 (concat
162 " - that is, at "
163 (format-time-string "%Y-%m-%d %T"
164 (time-subtract (current-time)
165 (seconds-to-time seconds)))
166 "\n")))))
167 (t
168 ;; Only hostname: uptime
169 (format "%s uptime: %s seconds" from seconds)))))
170
171(add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:time" 'jabber-return-legacy-time))
172(jabber-disco-advertise-feature "jabber:iq:time")
173
174(defun jabber-return-legacy-time (jc xml-data)
175 "Return client time as defined in XEP-0090.
176Sender and ID are determined from the incoming packet passed in XML-DATA.
177
178JC is the Jabber connection.
179XML-DATA is the parsed tree data from the stream (stanzas)
180obtained from `xml-parse-region'."
181 (let ((to (jabber-xml-get-attribute xml-data 'from))
182 (id (jabber-xml-get-attribute xml-data 'id)))
183 (jabber-send-iq jc to "result"
184 `(query ((xmlns . "jabber:iq:time"))
185 ;; what is ``human-readable'' format?
186 ;; the same way as formating using by tkabber
187 (display () ,(format-time-string "%a %b %d %H:%M:%S %Z %Y"))
188 (tz () ,(format-time-string "%Z"))
189 (utc () ,(jabber-encode-legacy-time nil)))
190 nil nil nil nil
191 id)))
192
193(add-to-list 'jabber-iq-get-xmlns-alist (cons "urn:xmpp:time" 'jabber-return-time))
194(jabber-disco-advertise-feature "urn:xmpp:time")
195
196(defun jabber-return-time (jc xml-data)
197 "Return client time as defined in XEP-0202.
198Sender and ID are determined from the incoming packet passed in XML-DATA.
199
200JC is the Jabber connection.
201XML-DATA is the parsed tree data from the stream (stanzas)
202obtained from `xml-parse-region'."
203 (let ((to (jabber-xml-get-attribute xml-data 'from))
204 (id (jabber-xml-get-attribute xml-data 'id)))
205 (jabber-send-iq jc to "result"
206 `(time ((xmlns . "urn:xmpp:time"))
207 (utc () ,(jabber-encode-time nil))
208 (tzo () ,(jabber-encode-timezone)))
209 nil nil nil nil
210 id)))
211
212(add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:last" 'jabber-return-last))
213(jabber-disco-advertise-feature "jabber:iq:last")
214
215(defun jabber-return-last (jc xml-data)
216 (let ((to (jabber-xml-get-attribute xml-data 'from))
217 (id (jabber-xml-get-attribute xml-data 'id)))
218 (jabber-send-iq jc to "result"
219 `(time ((xmlns . "jabber:iq:last")
220 ;; XEP-0012 specifies that this is an integer.
221 (seconds . ,(number-to-string
222 (floor (jabber-autoaway-get-idle-time))))))
223 nil nil nil nil
224 id)))
225
226
227(provide 'jabber-time)
228
229;; arch-tag: 5396bfda-323a-11db-ac8d-000a95c2fcd0