diff options
Diffstat (limited to 'jabber-export.el')
| -rw-r--r-- | jabber-export.el | 251 |
1 files changed, 251 insertions, 0 deletions
diff --git a/jabber-export.el b/jabber-export.el new file mode 100644 index 0000000..63b7df5 --- /dev/null +++ b/jabber-export.el @@ -0,0 +1,251 @@ +;;; jabber-export.el --- export Jabber roster to file + +;; Copyright (C) 2005, 2007 Magnus Henoch + +;; Author: Magnus Henoch <mange@freemail.hu> + +;; This file 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, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(require 'cl) + +(defvar jabber-export-roster-widget nil) + +(defvar jabber-import-subscription-p-widget nil) + +;;;###autoload +(defun jabber-export-roster (jc) + "Export roster for connection JC." + (interactive (list (jabber-read-account))) + (let ((state-data (fsm-get-state-data jc))) + (jabber-export-roster-do-it + (jabber-roster-to-sexp (plist-get state-data :roster))))) + +(defun jabber-export-roster-do-it (roster) + "Create buffer from which ROSTER can be exported to a file." + (interactive) + (with-current-buffer (get-buffer-create "Export roster") + (jabber-init-widget-buffer nil) + + (widget-insert (jabber-propertize "Export roster\n" + 'face 'jabber-title-large)) + (widget-insert "You are about to save your roster to a file. Here +you can edit it before saving. Changes done here will +not affect your actual roster. + +") + + (widget-create 'push-button :notify #'jabber-export-save "Save to file") + (widget-insert " ") + (widget-create 'push-button :notify #'jabber-export-remove-regexp "Remove by regexp") + (widget-insert "\n\n") + (make-local-variable 'jabber-export-roster-widget) + + (jabber-export-display roster) + + (widget-setup) + (widget-minor-mode 1) + (goto-char (point-min)) + (switch-to-buffer (current-buffer)))) + +;;;###autoload +(defun jabber-import-roster (jc file) + "Create buffer for roster import for connection JC from FILE." + (interactive (list (jabber-read-account) + (read-file-name "Import roster from file: "))) + (let ((roster + (with-temp-buffer + (let ((coding-system-for-read 'utf-8)) + (jabber-roster-xml-to-sexp + (car (xml-parse-file file))))))) + (with-current-buffer (get-buffer-create "Import roster") + (setq jabber-buffer-connection jc) + + (jabber-init-widget-buffer nil) + + (widget-insert (jabber-propertize "Import roster\n" + 'face 'jabber-title-large)) + (widget-insert "You are about to import the contacts below to your roster. + +") + + (make-local-variable 'jabber-import-subscription-p-widget) + (setq jabber-import-subscription-p-widget + (widget-create 'checkbox)) + (widget-insert " Adjust subscriptions\n") + + (widget-create 'push-button :notify #'jabber-import-doit "Import to roster") + (widget-insert " ") + (widget-create 'push-button :notify #'jabber-export-remove-regexp "Remove by regexp") + (widget-insert "\n\n") + (make-local-variable 'jabber-export-roster-widget) + + (jabber-export-display roster) + + (widget-setup) + (widget-minor-mode 1) + (goto-char (point-min)) + (switch-to-buffer (current-buffer))))) + +(defun jabber-export-remove-regexp (&rest ignore) + (let* ((value (widget-value jabber-export-roster-widget)) + (length-before (length value)) + (regexp (read-string "Remove JIDs matching regexp: "))) + (setq value (delete-if + #'(lambda (a) + (string-match regexp (nth 0 a))) + value)) + (widget-value-set jabber-export-roster-widget value) + (widget-setup) + (message "%d items removed" (- length-before (length value))))) + +(defun jabber-export-save (&rest ignore) + "Export roster to file." + (let ((items (mapcar #'jabber-roster-sexp-to-xml (widget-value jabber-export-roster-widget))) + (coding-system-for-write 'utf-8)) + (with-temp-file (read-file-name "Export roster to file: ") + (insert "<iq xmlns='jabber:client'><query xmlns='jabber:iq:roster'>\n") + (dolist (item items) + (insert (jabber-sexp2xml item) "\n")) + (insert "</query></iq>\n")) + (message "Roster saved"))) + +(defun jabber-import-doit (&rest ignore) + "Import roster being edited in widget." + (let* ((state-data (fsm-get-state-data jabber-buffer-connection)) + (jabber-roster (plist-get state-data :roster)) + roster-delta) + + (dolist (n (widget-value jabber-export-roster-widget)) + (let* ((jid (nth 0 n)) + (name (and (not (zerop (length (nth 1 n)))) + (nth 1 n))) + (subscription (nth 2 n)) + (groups (nth 3 n)) + (jid-symbol (jabber-jid-symbol jid)) + (in-roster-p (memq jid-symbol jabber-roster)) + (jid-name (and in-roster-p (get jid-symbol 'name))) + (jid-subscription (and in-roster-p (get jid-symbol 'subscription))) + (jid-groups (and in-roster-p (get jid-symbol 'groups)))) + ;; Do we need to change the roster? + (when (or + ;; If the contact is not in the roster already, + (not in-roster-p) + ;; or if the import introduces a name, + (and name (not jid-name)) + ;; or changes a name, + (and name jid-name (not (string= name jid-name))) + ;; or introduces new groups. + (set-difference groups jid-groups :test #'string=)) + (push (jabber-roster-sexp-to-xml + (list jid (or name jid-name) nil (union groups jid-groups :test #'string=)) + t) + roster-delta)) + ;; And adujst subscription. + (when (widget-value jabber-import-subscription-p-widget) + (let ((want-to (member subscription '("to" "both"))) + (want-from (member subscription '("from" "both"))) + (have-to (member jid-subscription '("to" "both"))) + (have-from (member jid-subscription '("from" "both")))) + (flet ((request-subscription + (type) + (jabber-send-sexp jabber-buffer-connection + `(presence ((to . ,jid) + (type . ,type)))))) + (cond + ((and want-to (not have-to)) + (request-subscription "subscribe")) + ((and have-to (not want-to)) + (request-subscription "unsubscribe"))) + (cond + ((and want-from (not have-from)) + ;; not much to do here + ) + ((and have-from (not want-from)) + (request-subscription "unsubscribed")))))))) + (when roster-delta + (jabber-send-iq jabber-buffer-connection + nil "set" + `(query ((xmlns . "jabber:iq:roster")) ,@roster-delta) + #'jabber-report-success "Roster import" + #'jabber-report-success "Roster import")))) + +(defun jabber-roster-to-sexp (roster) + "Convert ROSTER to simpler sexp format. +Return a list, where each item is a vector: +\[jid name subscription groups] +where groups is a list of strings." + (mapcar + #'(lambda (n) + (list + (symbol-name n) + (or (get n 'name) "") + (get n 'subscription) + (get n 'groups))) + roster)) + +(defun jabber-roster-sexp-to-xml (sexp &optional omit-subscription) + "Convert SEXP to XML format. +Return an XML node." + `(item ((jid . ,(nth 0 sexp)) + ,@(let ((name (nth 1 sexp))) + (unless (zerop (length name)) + `((name . ,name)))) + ,@(unless omit-subscription + `((subscription . ,(nth 2 sexp))))) + ,@(mapcar + #'(lambda (g) + (list 'group nil g)) + (nth 3 sexp)))) + +(defun jabber-roster-xml-to-sexp (xml-data) + "Convert XML-DATA to simpler sexp format. +XML-DATA is an <iq> node with a <query xmlns='jabber:iq:roster'> child. +See `jabber-roster-to-sexp' for description of output format." + (assert (eq (jabber-xml-node-name xml-data) 'iq)) + (let ((query (car (jabber-xml-get-children xml-data 'query)))) + (assert query) + (mapcar + #'(lambda (n) + (list + (jabber-xml-get-attribute n 'jid) + (or (jabber-xml-get-attribute n 'name) "") + (jabber-xml-get-attribute n 'subscription) + (mapcar + #'(lambda (g) + (car (jabber-xml-node-children g))) + (jabber-xml-get-children n 'group)))) + (jabber-xml-get-children query 'item)))) + +(defun jabber-export-display (roster) + (setq jabber-export-roster-widget + (widget-create + '(repeat + :tag "Roster" + (list :format "%v" + (string :tag "JID") + (string :tag "Name") + (choice :tag "Subscription" + (const "none") + (const "both") + (const "to") + (const "from")) + (repeat :tag "Groups" + (string :tag "Group")))) + :value roster))) + +(provide 'jabber-export) + +;;; arch-tag: 9c6b94a9-290a-4c0f-9286-72bd9c1fb8a3 |