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

;; jabber-bookmarks.el - bookmarks according to XEP-0048  -*- lexical-binding: t; -*-

;; Copyright (C) 2007, 2008 - Magnus Henoch - mange@freemail.hu

;; 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-private)
(require 'jabber-widget)

(require 'cl-lib)

(defvar jabber-bookmarks (make-hash-table :test 'equal)
  "Mapping from full JIDs to bookmarks.
Bookmarks are what has been retrieved from the server, as list of
XML elements.  This is nil if bookmarks have not been retrieved,
and t if no bookmarks where found.")

;;;###autoload
(defun jabber-get-conference-data (jc conference-jid cont &optional key)
  "Get bookmark data for CONFERENCE-JID.
KEY may be nil or one of :name, :autojoin, :nick and :password.
If KEY is nil, a plist containing the above keys is returned.
CONT is called when the result is available, with JC and the
result as arguments.  If CONT is nil, return the requested data
immediately, and return nil if it is not in the cache."
  (if (null cont)
      (let ((cache (jabber-get-bookmarks-from-cache jc)))
       (if (and cache (listp cache))
        (jabber-get-conference-data-internal
         cache conference-jid key)))
    (jabber-get-bookmarks
     jc
     (let ((conference-jid conference-jid)
		   (key key)
		   (cont cont))
       (lambda (jc result)
	 (let ((entry (jabber-get-conference-data-internal result conference-jid key)))
	   (funcall cont jc entry)))))))

(defun jabber-get-conference-data-internal (result conference-jid key)
  (let ((entry (cl-dolist (node result)
		(when (and (eq (jabber-xml-node-name node) 'conference)
			   (string= (jabber-xml-get-attribute node 'jid) conference-jid))
		  (cl-return (jabber-parse-conference-bookmark node))))))
    (if key
	(plist-get entry key)
      entry)))

;;;###autoload
(defun jabber-parse-conference-bookmark (node)
  "Convert a <conference/> tag into a plist.
The plist may contain the keys :jid, :name, :autojoin,
:nick and :password."
  (when (eq (jabber-xml-node-name node) 'conference)
    (list :jid (jabber-xml-get-attribute node 'jid)
	  :name (jabber-xml-get-attribute node 'name)
	  :autojoin (member (jabber-xml-get-attribute node 'autojoin)
			    '("true" "1"))
	  :nick (car (jabber-xml-node-children
		      (car (jabber-xml-get-children node 'nick))))
	  :password (car (jabber-xml-node-children
			  (car (jabber-xml-get-children node 'password)))))))

;;;###autoload
(defun jabber-get-bookmarks (jc cont &optional refresh)
  "Retrieve bookmarks (if needed) and call CONT.
Arguments to CONT are JC and the bookmark list.  CONT will be
called as the result of a filter function or a timer.
If REFRESH is non-nil, always fetch bookmarks."
  (let ((bookmarks (gethash (jabber-connection-bare-jid jc) jabber-bookmarks)))
    (if (and (not refresh) bookmarks)
	(run-with-timer 0 nil cont jc (when (listp bookmarks) bookmarks))
      (let* ((cont cont)
		     (callback (lambda (jc result) (jabber-get-bookmarks-1 jc result cont))))
	(jabber-private-get jc 'storage "storage:bookmarks"
			    callback callback)))))

(defun jabber-get-bookmarks-1 (jc result cont)
  (let ((my-jid (jabber-connection-bare-jid jc))
	(value
	 (if (eq (jabber-xml-node-name result) 'storage)
	     (or (jabber-xml-node-children result) t)
	   t)))
    (puthash my-jid value jabber-bookmarks)
    (funcall cont jc (when (listp value) value))))

;;;###autoload
(defun jabber-get-bookmarks-from-cache (jc)
  "Return cached bookmarks for JC.
If bookmarks have not yet been fetched by `jabber-get-bookmarks',
return nil."
  (gethash (jabber-connection-bare-jid jc) jabber-bookmarks))

(defun jabber-set-bookmarks (jc bookmarks &optional callback)
  "Set bookmarks to BOOKMARKS, which is a list of XML elements.
If CALLBACK is non-nil, call it with JC and t or nil as arguments
on success or failure, respectively."
  (unless callback
    (setq callback #'ignore))
  (jabber-private-set
   jc
   `(storage ((xmlns . "storage:bookmarks"))
	     ,@bookmarks)
   callback t
   callback nil))

;;;###autoload
(defun jabber-edit-bookmarks (jc)
  "Create a buffer for editing bookmarks interactively.

JC is the Jabber connection."
  (interactive (list (jabber-read-account)))
  (jabber-get-bookmarks jc 'jabber-edit-bookmarks-1 t))

(defun jabber-edit-bookmarks-1 (jc bookmarks)
  (setq bookmarks
	(mapcar
	 (lambda (e)
	   (cl-case (jabber-xml-node-name e)
	     (url
	      (list 'url (or (jabber-xml-get-attribute e 'url) "")
		    (or (jabber-xml-get-attribute e 'name) "")))
	     (conference
	      (list 'conference
		    (or (jabber-xml-get-attribute e 'jid) "")
		    (or (jabber-xml-get-attribute e 'name) "")
		    (not (not (member (jabber-xml-get-attribute e 'autojoin)
				      '("true" "1"))))
		    (or (jabber-xml-path e '(nick "")) "")
		    (or (jabber-xml-path e '(password "")) "")))))
	 bookmarks))
  (setq bookmarks (delq nil bookmarks))
  (with-current-buffer (get-buffer-create "Edit bookmarks")
    (jabber-init-widget-buffer nil)
    (setq jabber-buffer-connection jc)

    (widget-insert (jabber-propertize (concat "Edit bookmarks for "
					      (jabber-connection-bare-jid jc))
				      'face 'jabber-title-large)
		   "\n\n")

    (when (or (bound-and-true-p jabber-muc-autojoin)
	      (bound-and-true-p jabber-muc-default-nicknames))
      (widget-insert "The variables `jabber-muc-autojoin' and/or `jabber-muc-default-nicknames'\n"
		     "contain values.  They are only available to jabber.el on this machine.\n"
		     "You may want to import them into your bookmarks, to make them available\n"
		     "to any client on any machine.\n")
      (widget-create 'push-button :notify 'jabber-bookmarks-import "Import values from variables")
      (widget-insert "\n\n"))

    (push (cons 'bookmarks
		(widget-create
		 '(repeat
		   :tag "Bookmarks"
		   (choice
		    (list :tag "Conference"
			  (const :format "" conference)
			  (string :tag "JID") ;XXX: jid widget type?
			  (string :tag "Name")
			  (checkbox :tag "Autojoin" :format "%[%v%] Autojoin?\n")
			  (string :tag "Nick")	      ;or nil?
			  (string :tag "Password")    ;or nil?
			  )
		    (list :tag "URL"
			  (const :format "" url)
			  (string :tag "URL")
			  (string :tag "Name"))))
		 :value bookmarks))
	  jabber-widget-alist)

    (widget-insert "\n")
    (widget-create 'push-button :notify 'jabber-bookmarks-submit "Submit")

    (widget-setup)
    (widget-minor-mode 1)
    (switch-to-buffer (current-buffer))
    (goto-char (point-min))))

(defun jabber-bookmarks-submit (&rest _ignore)
  (let ((bookmarks (widget-value (cdr (assq 'bookmarks jabber-widget-alist)))))
    (setq bookmarks
	  (mapcar
	   (lambda (entry)
	     (cl-case (car entry)
	       (url
		(cl-destructuring-bind (symbol url name) entry
		  `(url ((url . ,url)
			 (name . ,name)))))
	       (conference
		(cl-destructuring-bind (symbol jid name autojoin nick password)
		    entry
		  `(conference ((jid . ,jid)
				(name . ,name)
				(autojoin . ,(if autojoin
						 "1"
					       "0")))
			       ,@(unless (zerop (length nick))
				   `((nick () ,nick)))
			       ,@(unless (zerop (length password))
				   `((password () ,password))))))))
	   bookmarks))
    (remhash (jabber-connection-bare-jid jabber-buffer-connection) jabber-bookmarks)
    (jabber-private-set
     jabber-buffer-connection
     `(storage ((xmlns . "storage:bookmarks"))
	       ,@bookmarks)
     'jabber-report-success "Storing bookmarks"
     'jabber-report-success "Storing bookmarks")))

(defun jabber-bookmarks-import (&rest _ignore)
  (let* ((value (widget-value (cdr (assq 'bookmarks jabber-widget-alist))))
	 (conferences (mapcar
		       'cdr
		       (cl-remove-if-not
			(lambda (entry)
			  (eq (car entry) 'conference))
			value))))
    (dolist (default-nickname jabber-muc-default-nicknames)
      (cl-destructuring-bind (muc-jid . nick) default-nickname
	(let ((entry (assoc muc-jid conferences)))
	  (if entry
	      (setf (cl-fourth entry) nick)
	    (setq entry (list muc-jid "" nil nick ""))
	    (push entry conferences)
	    (push (cons 'conference entry) value)))))
    (dolist (autojoin jabber-muc-autojoin)
      (let ((entry (assoc autojoin conferences)))
	(if entry
	    (setf (cl-third entry) t)
	  (setq entry (list autojoin "" t "" ""))
	  (push (cons 'conference entry) value))))
    (widget-value-set (cdr (assq 'bookmarks jabber-widget-alist)) value)
    (widget-setup)))

(provide 'jabber-bookmarks)
;; arch-tag: a7d6f862-bac0-11db-831f-000a95c2fcd0
Commit	Line	Data
53e6db90 DC	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