;;; gnus-sync.el --- synchronization facility for Gnus
-;;; Copyright (C) 2010
-;;; Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news synchronization nntp nnrss
;; This is the gnus-sync.el package.
+;; It's due for a rewrite using gnus-after-set-mark-hook and
+;; gnus-before-update-mark-hook. Until then please consider it
+;; experimental.
+
;; Put this in your startup file (~/.gnus.el for instance)
-;; (setq gnus-sync-backend `("/remote:/path.gpg") ; will use Tramp+EPA if loaded
+;; possibilities for gnus-sync-backend:
+;; Tramp over SSH: /ssh:user@host:/path/to/filename
+;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename
+;; ...or any other file Tramp and Emacs can handle...
+
+;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
;; gnus-sync-newsrc-groups `("nntp" "nnrss")
-;; gnus-sync-newsrc-vars `(read marks))
+;; gnus-sync-newsrc-offsets `(2 3))
;; TODO:
;; - after gnus-sync-read, the message counts are wrong
+;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
+;; catch the mark updates
+
;;; Code:
(eval-when-compile (require 'cl))
+(require 'gnus)
+(require 'gnus-start)
(require 'gnus-util)
(defgroup gnus-sync nil
"The Gnus synchronization facility."
- :version "23.1"
+ :version "24.1"
:group 'gnus)
(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
(defun gnus-sync-save ()
"Save the Gnus sync data to the backend."
(interactive)
- (gnus-message 6 "Saving the Gnus sync data")
(cond
((stringp gnus-sync-backend)
(gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
;; populate gnus-sync-newsrc-loader from all but the first dummy
;; entry in gnus-newsrc-alist whose group matches any of the
;; gnus-sync-newsrc-groups
+ ;; TODO: keep the old contents for groups we don't have!
(let ((gnus-sync-newsrc-loader
(loop for entry in (cdr gnus-newsrc-alist)
when (gnus-grep-in-list
(mapcar (lambda (offset)
(cons offset (nth offset entry)))
gnus-sync-newsrc-offsets)))))
-
(with-temp-file gnus-sync-backend
(progn
(let ((coding-system-for-write gnus-ding-file-coding-system)
gnus-sync-global-vars))
variable)
(while variables
- (when (and (boundp (setq variable (pop variables)))
+ (if (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (princ "\n(setq ")
- (princ (symbol-name variable))
- (princ " '")
- (prin1 (symbol-value variable))
- (princ ")\n"))))
+ (progn
+ (princ "\n(setq ")
+ (princ (symbol-name variable))
+ (princ " '")
+ (prin1 (symbol-value variable))
+ (princ ")\n"))
+ (princ "\n;;; skipping empty variable ")
+ (princ (symbol-name variable)))))
(gnus-message
7
"gnus-sync: stored variables %s and %d groups in %s"
(load gnus-sync-backend nil t)
(error
(error "Error in %s: %s" gnus-sync-backend (cadr var)))))
- (let ((valid-nodes
- (loop for node in gnus-sync-newsrc-loader
- if (gnus-gethash (car node) gnus-newsrc-hashtb)
- collect node)))
- (dolist (node valid-nodes)
- (loop for store in (cdr node)
- do (setf (nth (car store)
- (assoc (car node) gnus-newsrc-alist))
+ (let ((valid-count 0)
+ invalid-groups)
+ (dolist (node gnus-sync-newsrc-loader)
+ (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+ (progn
+ (incf valid-count)
+ (loop for store in (cdr node)
+ do (setf (nth (car store)
+ (assoc (car node) gnus-newsrc-alist))
(cdr store))))
+ (push (car node) invalid-groups)))
(gnus-message
7
"gnus-sync: loaded %d groups (out of %d) from %s"
- (length valid-nodes)
- (length gnus-sync-newsrc-loader)
+ valid-count (length gnus-sync-newsrc-loader)
gnus-sync-backend)
- (setq gnus-sync-newsrc-loader nil)))
+ (when invalid-groups
+ (gnus-message
+ 7
+ "gnus-sync: skipped %d groups (out of %d) from %s"
+ (length invalid-groups)
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (gnus-message 9 "gnus-sync: skipped groups: %s"
+ (mapconcat 'identity invalid-groups ", ")))))
(nil))
;; make the hashtable again because the newsrc-alist may have been modified
(when gnus-sync-newsrc-offsets
(defun gnus-sync-install-hooks ()
"Install the sync hooks."
(interactive)
- (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
+ ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
(add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
(add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
(defun gnus-sync-unload-hook ()
"Uninstall the sync hooks."
(interactive)
- (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
+ ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
(remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
(remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
projects / gnus / blobdiff