diff options
Diffstat (limited to 'jabber-bookmarks.el')
| -rw-r--r-- | jabber-bookmarks.el | 248 |
1 files changed, 248 insertions, 0 deletions
diff --git a/jabber-bookmarks.el b/jabber-bookmarks.el new file mode 100644 index 0000000..5a9f39f --- /dev/null +++ b/jabber-bookmarks.el @@ -0,0 +1,248 @@ +;; jabber-bookmarks.el - bookmarks according to XEP-0048 + +;; 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) + +(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 + (lexical-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 (dolist (node result) + (when (and (eq (jabber-xml-node-name node) 'conference) + (string= (jabber-xml-get-attribute node 'jid) conference-jid)) + (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)) + (lexical-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." + (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) + (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) + (case (car entry) + (url + (destructuring-bind (symbol url name) entry + `(url ((url . ,url) + (name . ,name))))) + (conference + (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 + (remove-if-not + (lambda (entry) + (eq (car entry) 'conference)) + value)))) + (dolist (default-nickname jabber-muc-default-nicknames) + (destructuring-bind (muc-jid . nick) default-nickname + (let ((entry (assoc muc-jid conferences))) + (if entry + (setf (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 (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 |