]>
Commit | Line | Data |
---|---|---|
1 | ;; jabber-bookmarks.el - bookmarks according to XEP-0048 -*- lexical-binding: t; -*- | |
2 | ||
3 | ;; Copyright (C) 2007, 2008 - Magnus Henoch - mange@freemail.hu | |
4 | ||
5 | ;; This file is a part of jabber.el. | |
6 | ||
7 | ;; This program is free software; you can redistribute it and/or modify | |
8 | ;; it under the terms of the GNU General Public License as published by | |
9 | ;; the Free Software Foundation; either version 2 of the License, or | |
10 | ;; (at your option) any later version. | |
11 | ||
12 | ;; This program is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with this program; if not, write to the Free Software | |
19 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
20 | ||
21 | (require 'jabber-private) | |
22 | (require 'jabber-widget) | |
23 | ||
24 | (require 'cl-lib) | |
25 | ||
26 | (defvar jabber-bookmarks (make-hash-table :test 'equal) | |
27 | "Mapping from full JIDs to bookmarks. | |
28 | Bookmarks are what has been retrieved from the server, as list of | |
29 | XML elements. This is nil if bookmarks have not been retrieved, | |
30 | and t if no bookmarks where found.") | |
31 | ||
32 | ;;;###autoload | |
33 | (defun jabber-get-conference-data (jc conference-jid cont &optional key) | |
34 | "Get bookmark data for CONFERENCE-JID. | |
35 | KEY may be nil or one of :name, :autojoin, :nick and :password. | |
36 | If KEY is nil, a plist containing the above keys is returned. | |
37 | CONT is called when the result is available, with JC and the | |
38 | result as arguments. If CONT is nil, return the requested data | |
39 | immediately, and return nil if it is not in the cache." | |
40 | (if (null cont) | |
41 | (let ((cache (jabber-get-bookmarks-from-cache jc))) | |
42 | (if (and cache (listp cache)) | |
43 | (jabber-get-conference-data-internal | |
44 | cache conference-jid key))) | |
45 | (jabber-get-bookmarks | |
46 | jc | |
47 | (let ((conference-jid conference-jid) | |
48 | (key key) | |
49 | (cont cont)) | |
50 | (lambda (jc result) | |
51 | (let ((entry (jabber-get-conference-data-internal result conference-jid key))) | |
52 | (funcall cont jc entry))))))) | |
53 | ||
54 | (defun jabber-get-conference-data-internal (result conference-jid key) | |
55 | (let ((entry (cl-dolist (node result) | |
56 | (when (and (eq (jabber-xml-node-name node) 'conference) | |
57 | (string= (jabber-xml-get-attribute node 'jid) conference-jid)) | |
58 | (cl-return (jabber-parse-conference-bookmark node)))))) | |
59 | (if key | |
60 | (plist-get entry key) | |
61 | entry))) | |
62 | ||
63 | ;;;###autoload | |
64 | (defun jabber-parse-conference-bookmark (node) | |
65 | "Convert a <conference/> tag into a plist. | |
66 | The plist may contain the keys :jid, :name, :autojoin, | |
67 | :nick and :password." | |
68 | (when (eq (jabber-xml-node-name node) 'conference) | |
69 | (list :jid (jabber-xml-get-attribute node 'jid) | |
70 | :name (jabber-xml-get-attribute node 'name) | |
71 | :autojoin (member (jabber-xml-get-attribute node 'autojoin) | |
72 | '("true" "1")) | |
73 | :nick (car (jabber-xml-node-children | |
74 | (car (jabber-xml-get-children node 'nick)))) | |
75 | :password (car (jabber-xml-node-children | |
76 | (car (jabber-xml-get-children node 'password))))))) | |
77 | ||
78 | ;;;###autoload | |
79 | (defun jabber-get-bookmarks (jc cont &optional refresh) | |
80 | "Retrieve bookmarks (if needed) and call CONT. | |
81 | Arguments to CONT are JC and the bookmark list. CONT will be | |
82 | called as the result of a filter function or a timer. | |
83 | If REFRESH is non-nil, always fetch bookmarks." | |
84 | (let ((bookmarks (gethash (jabber-connection-bare-jid jc) jabber-bookmarks))) | |
85 | (if (and (not refresh) bookmarks) | |
86 | (run-with-timer 0 nil cont jc (when (listp bookmarks) bookmarks)) | |
87 | (let* ((cont cont) | |
88 | (callback (lambda (jc result) (jabber-get-bookmarks-1 jc result cont)))) | |
89 | (jabber-private-get jc 'storage "storage:bookmarks" | |
90 | callback callback))))) | |
91 | ||
92 | (defun jabber-get-bookmarks-1 (jc result cont) | |
93 | (let ((my-jid (jabber-connection-bare-jid jc)) | |
94 | (value | |
95 | (if (eq (jabber-xml-node-name result) 'storage) | |
96 | (or (jabber-xml-node-children result) t) | |
97 | t))) | |
98 | (puthash my-jid value jabber-bookmarks) | |
99 | (funcall cont jc (when (listp value) value)))) | |
100 | ||
101 | ;;;###autoload | |
102 | (defun jabber-get-bookmarks-from-cache (jc) | |
103 | "Return cached bookmarks for JC. | |
104 | If bookmarks have not yet been fetched by `jabber-get-bookmarks', | |
105 | return nil." | |
106 | (gethash (jabber-connection-bare-jid jc) jabber-bookmarks)) | |
107 | ||
108 | (defun jabber-set-bookmarks (jc bookmarks &optional callback) | |
109 | "Set bookmarks to BOOKMARKS, which is a list of XML elements. | |
110 | If CALLBACK is non-nil, call it with JC and t or nil as arguments | |
111 | on success or failure, respectively." | |
112 | (unless callback | |
113 | (setq callback #'ignore)) | |
114 | (jabber-private-set | |
115 | jc | |
116 | `(storage ((xmlns . "storage:bookmarks")) | |
117 | ,@bookmarks) | |
118 | callback t | |
119 | callback nil)) | |
120 | ||
121 | ;;;###autoload | |
122 | (defun jabber-edit-bookmarks (jc) | |
123 | "Create a buffer for editing bookmarks interactively. | |
124 | ||
125 | JC is the Jabber connection." | |
126 | (interactive (list (jabber-read-account))) | |
127 | (jabber-get-bookmarks jc 'jabber-edit-bookmarks-1 t)) | |
128 | ||
129 | (defun jabber-edit-bookmarks-1 (jc bookmarks) | |
130 | (setq bookmarks | |
131 | (mapcar | |
132 | (lambda (e) | |
133 | (cl-case (jabber-xml-node-name e) | |
134 | (url | |
135 | (list 'url (or (jabber-xml-get-attribute e 'url) "") | |
136 | (or (jabber-xml-get-attribute e 'name) ""))) | |
137 | (conference | |
138 | (list 'conference | |
139 | (or (jabber-xml-get-attribute e 'jid) "") | |
140 | (or (jabber-xml-get-attribute e 'name) "") | |
141 | (not (not (member (jabber-xml-get-attribute e 'autojoin) | |
142 | '("true" "1")))) | |
143 | (or (jabber-xml-path e '(nick "")) "") | |
144 | (or (jabber-xml-path e '(password "")) ""))))) | |
145 | bookmarks)) | |
146 | (setq bookmarks (delq nil bookmarks)) | |
147 | (with-current-buffer (get-buffer-create "Edit bookmarks") | |
148 | (jabber-init-widget-buffer nil) | |
149 | (setq jabber-buffer-connection jc) | |
150 | ||
151 | (widget-insert (jabber-propertize (concat "Edit bookmarks for " | |
152 | (jabber-connection-bare-jid jc)) | |
153 | 'face 'jabber-title-large) | |
154 | "\n\n") | |
155 | ||
156 | (when (or (bound-and-true-p jabber-muc-autojoin) | |
157 | (bound-and-true-p jabber-muc-default-nicknames)) | |
158 | (widget-insert "The variables `jabber-muc-autojoin' and/or `jabber-muc-default-nicknames'\n" | |
159 | "contain values. They are only available to jabber.el on this machine.\n" | |
160 | "You may want to import them into your bookmarks, to make them available\n" | |
161 | "to any client on any machine.\n") | |
162 | (widget-create 'push-button :notify 'jabber-bookmarks-import "Import values from variables") | |
163 | (widget-insert "\n\n")) | |
164 | ||
165 | (push (cons 'bookmarks | |
166 | (widget-create | |
167 | '(repeat | |
168 | :tag "Bookmarks" | |
169 | (choice | |
170 | (list :tag "Conference" | |
171 | (const :format "" conference) | |
172 | (string :tag "JID") ;XXX: jid widget type? | |
173 | (string :tag "Name") | |
174 | (checkbox :tag "Autojoin" :format "%[%v%] Autojoin?\n") | |
175 | (string :tag "Nick") ;or nil? | |
176 | (string :tag "Password") ;or nil? | |
177 | ) | |
178 | (list :tag "URL" | |
179 | (const :format "" url) | |
180 | (string :tag "URL") | |
181 | (string :tag "Name")))) | |
182 | :value bookmarks)) | |
183 | jabber-widget-alist) | |
184 | ||
185 | (widget-insert "\n") | |
186 | (widget-create 'push-button :notify 'jabber-bookmarks-submit "Submit") | |
187 | ||
188 | (widget-setup) | |
189 | (widget-minor-mode 1) | |
190 | (switch-to-buffer (current-buffer)) | |
191 | (goto-char (point-min)))) | |
192 | ||
193 | (defun jabber-bookmarks-submit (&rest _ignore) | |
194 | (let ((bookmarks (widget-value (cdr (assq 'bookmarks jabber-widget-alist))))) | |
195 | (setq bookmarks | |
196 | (mapcar | |
197 | (lambda (entry) | |
198 | (cl-case (car entry) | |
199 | (url | |
200 | (cl-destructuring-bind (symbol url name) entry | |
201 | `(url ((url . ,url) | |
202 | (name . ,name))))) | |
203 | (conference | |
204 | (cl-destructuring-bind (symbol jid name autojoin nick password) | |
205 | entry | |
206 | `(conference ((jid . ,jid) | |
207 | (name . ,name) | |
208 | (autojoin . ,(if autojoin | |
209 | "1" | |
210 | "0"))) | |
211 | ,@(unless (zerop (length nick)) | |
212 | `((nick () ,nick))) | |
213 | ,@(unless (zerop (length password)) | |
214 | `((password () ,password)))))))) | |
215 | bookmarks)) | |
216 | (remhash (jabber-connection-bare-jid jabber-buffer-connection) jabber-bookmarks) | |
217 | (jabber-private-set | |
218 | jabber-buffer-connection | |
219 | `(storage ((xmlns . "storage:bookmarks")) | |
220 | ,@bookmarks) | |
221 | 'jabber-report-success "Storing bookmarks" | |
222 | 'jabber-report-success "Storing bookmarks"))) | |
223 | ||
224 | (defun jabber-bookmarks-import (&rest _ignore) | |
225 | (let* ((value (widget-value (cdr (assq 'bookmarks jabber-widget-alist)))) | |
226 | (conferences (mapcar | |
227 | 'cdr | |
228 | (cl-remove-if-not | |
229 | (lambda (entry) | |
230 | (eq (car entry) 'conference)) | |
231 | value)))) | |
232 | (dolist (default-nickname jabber-muc-default-nicknames) | |
233 | (cl-destructuring-bind (muc-jid . nick) default-nickname | |
234 | (let ((entry (assoc muc-jid conferences))) | |
235 | (if entry | |
236 | (setf (cl-fourth entry) nick) | |
237 | (setq entry (list muc-jid "" nil nick "")) | |
238 | (push entry conferences) | |
239 | (push (cons 'conference entry) value))))) | |
240 | (dolist (autojoin jabber-muc-autojoin) | |
241 | (let ((entry (assoc autojoin conferences))) | |
242 | (if entry | |
243 | (setf (cl-third entry) t) | |
244 | (setq entry (list autojoin "" t "" "")) | |
245 | (push (cons 'conference entry) value)))) | |
246 | (widget-value-set (cdr (assq 'bookmarks jabber-widget-alist)) value) | |
247 | (widget-setup))) | |
248 | ||
249 | (provide 'jabber-bookmarks) | |
250 | ;; arch-tag: a7d6f862-bac0-11db-831f-000a95c2fcd0 |