X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/79993b193e9766c7c8731549a68b6a27eac89f1d..07976ae3b816dea4fd541bbba862603d3132eb2c:/lisp/gnus/gnus-sync.el

diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
index bd889576dc..8a492e8d2c 100644
--- a/lisp/gnus/gnus-sync.el
+++ b/lisp/gnus/gnus-sync.el
@@ -1,7 +1,6 @@
 ;;; gnus-sync.el --- synchronization facility for Gnus
 
-;;; Copyright (C) 2010
-;;; Free Software Foundation, Inc.
+;; Copyright (C) 2010  Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: news synchronization nntp nnrss
@@ -25,25 +24,39 @@
 
 ;; 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")
@@ -85,13 +98,13 @@ synchronized, I believe).  Also see `gnus-variable-list'."
 (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
@@ -101,7 +114,6 @@ synchronized, I believe).  Also see `gnus-variable-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)
@@ -121,13 +133,16 @@ synchronized, I believe).  Also see `gnus-variable-list'."
                                     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"
@@ -162,22 +177,31 @@ synchronized, I believe).  Also see `gnus-variable-list'."
                  (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
@@ -197,7 +221,7 @@ synchronized, I believe).  Also see `gnus-variable-list'."
   (interactive)
   ;; (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-hoo4a 'gnus-sync-read))
+  (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
 
 (defun gnus-sync-unload-hook ()
   "Uninstall the sync hooks."