109766
|
1 ;;; gnus-sync.el --- synchronization facility for Gnus
|
|
2
|
|
3 ;;; Copyright (C) 2010
|
|
4 ;;; Free Software Foundation, Inc.
|
|
5
|
|
6 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
|
|
7 ;; Keywords: news synchronization nntp nnrss
|
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation, either version 3 of the License, or
|
|
14 ;; (at your option) any later version.
|
|
15
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
23
|
|
24 ;;; Commentary:
|
|
25
|
|
26 ;; This is the gnus-sync.el package.
|
|
27
|
|
28 ;; Put this in your startup file (~/.gnus.el for instance)
|
|
29
|
|
30 ;; (setq gnus-sync-backend `("/remote:/path.gpg") ; will use Tramp+EPA if loaded
|
|
31 ;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
|
|
32 ;; gnus-sync-newsrc-groups `("nntp" "nnrss")
|
|
33 ;; gnus-sync-newsrc-vars `(read marks))
|
|
34
|
|
35 ;; TODO:
|
|
36
|
|
37 ;; - after gnus-sync-read, the message counts are wrong
|
|
38
|
|
39 ;;; Code:
|
|
40
|
|
41 (eval-when-compile (require 'cl))
|
|
42 (require 'gnus-util)
|
|
43
|
|
44 (defgroup gnus-sync nil
|
|
45 "The Gnus synchronization facility."
|
|
46 :version "23.1"
|
|
47 :group 'gnus)
|
|
48
|
|
49 (defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
|
|
50 "List of groups to be synchronized in the gnus-newsrc-alist.
|
|
51 The group names are matched, they don't have to be fully
|
|
52 qualified. Typically you would choose all of these. That's the
|
|
53 default because there is no active sync backend by default, so
|
|
54 this setting is harmless until the user chooses a sync backend."
|
|
55 :group 'gnus-sync
|
|
56 :type '(repeat regexp))
|
|
57
|
|
58 (defcustom gnus-sync-newsrc-offsets '(2 3)
|
|
59 "List of per-group data to be synchronized."
|
|
60 :group 'gnus-sync
|
|
61 :type '(set (const :tag "Read ranges" 2)
|
|
62 (const :tag "Marks" 3)))
|
|
63
|
|
64 (defcustom gnus-sync-global-vars nil
|
|
65 "List of global variables to be synchronized.
|
|
66 You may want to sync `gnus-newsrc-last-checked-date' but pretty
|
|
67 much any symbol is fair game. You could additionally sync
|
|
68 `gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
|
|
69 and `gnus-topic-alist' to cover all the variables in
|
|
70 newsrc.eld (except for `gnus-format-specs' which should not be
|
|
71 synchronized, I believe). Also see `gnus-variable-list'."
|
|
72 :group 'gnus-sync
|
|
73 :type '(repeat (choice (variable :tag "A known variable")
|
|
74 (symbol :tag "Any symbol"))))
|
|
75
|
|
76 (defcustom gnus-sync-backend nil
|
|
77 "The synchronization backend."
|
|
78 :group 'gnus-sync
|
|
79 :type '(radio (const :format "None" nil)
|
|
80 (string :tag "Sync to a file")))
|
|
81
|
|
82 (defvar gnus-sync-newsrc-loader nil
|
|
83 "Carrier for newsrc data")
|
|
84
|
|
85 (defun gnus-sync-save ()
|
|
86 "Save the Gnus sync data to the backend."
|
|
87 (interactive)
|
|
88 (gnus-message 6 "Saving the Gnus sync data")
|
|
89 (cond
|
|
90 ((stringp gnus-sync-backend)
|
|
91 (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
|
|
92 ;; populate gnus-sync-newsrc-loader from all but the first dummy
|
|
93 ;; entry in gnus-newsrc-alist whose group matches any of the
|
|
94 ;; gnus-sync-newsrc-groups
|
|
95 (let ((gnus-sync-newsrc-loader
|
|
96 (loop for entry in (cdr gnus-newsrc-alist)
|
|
97 when (gnus-grep-in-list
|
|
98 (car entry) ;the group name
|
|
99 gnus-sync-newsrc-groups)
|
|
100 collect (cons (car entry)
|
|
101 (mapcar (lambda (offset)
|
|
102 (cons offset (nth offset entry)))
|
|
103 gnus-sync-newsrc-offsets)))))
|
|
104
|
|
105 (with-temp-file gnus-sync-backend
|
|
106 (progn
|
|
107 (let ((coding-system-for-write gnus-ding-file-coding-system)
|
|
108 (standard-output (current-buffer)))
|
|
109 (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
|
|
110 gnus-ding-file-coding-system))
|
|
111 (princ ";; Gnus sync data v. 0.0.1\n")
|
|
112 (let* ((print-quoted t)
|
|
113 (print-readably t)
|
|
114 (print-escape-multibyte nil)
|
|
115 (print-escape-nonascii t)
|
|
116 (print-length nil)
|
|
117 (print-level nil)
|
|
118 (print-circle nil)
|
|
119 (print-escape-newlines t)
|
|
120 (variables (cons 'gnus-sync-newsrc-loader
|
|
121 gnus-sync-global-vars)))
|
|
122 (while variables
|
|
123 (when (and (boundp (setq variable (pop variables)))
|
|
124 (symbol-value variable))
|
|
125 (princ "\n(setq ")
|
|
126 (princ (symbol-name variable))
|
|
127 (princ " '")
|
|
128 (prin1 (symbol-value variable))
|
|
129 (princ ")\n"))))
|
|
130 (gnus-message
|
|
131 7
|
|
132 "gnus-sync: stored variables %s and %d groups in %s"
|
|
133 gnus-sync-global-vars
|
|
134 (length gnus-sync-newsrc-loader)
|
|
135 gnus-sync-backend)
|
|
136
|
|
137 ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
|
|
138 ;; Save the .eld file with extra line breaks.
|
|
139 (gnus-message 8 "gnus-sync: adding whitespace to %s"
|
|
140 gnus-sync-backend)
|
|
141 (save-excursion
|
|
142 (goto-char (point-min))
|
|
143 (while (re-search-forward "^(\\|(\\\"" nil t)
|
|
144 (replace-match "\n\\&" t))
|
|
145 (goto-char (point-min))
|
|
146 (while (re-search-forward " $" nil t)
|
|
147 (replace-match "" t t))))))))
|
|
148 ;; the pass-through case: gnus-sync-backend is not a known choice
|
|
149 (nil)))
|
|
150
|
|
151 (defun gnus-sync-read ()
|
|
152 "Load the Gnus sync data from the backend."
|
|
153 (interactive)
|
|
154 (when gnus-sync-backend
|
|
155 (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
|
|
156 (cond ((stringp gnus-sync-backend)
|
|
157 ;; read data here...
|
|
158 (if (or debug-on-error debug-on-quit)
|
|
159 (load gnus-sync-backend nil t)
|
|
160 (condition-case var
|
|
161 (load gnus-sync-backend nil t)
|
|
162 (error
|
|
163 (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
|
|
164 (let ((valid-nodes
|
|
165 (loop for node in gnus-sync-newsrc-loader
|
|
166 if (gnus-gethash (car node) gnus-newsrc-hashtb)
|
|
167 collect node)))
|
|
168 (dolist (node valid-nodes)
|
|
169 (loop for store in (cdr node)
|
|
170 do (setf (nth (car store)
|
|
171 (assoc (car node) gnus-newsrc-alist))
|
|
172 (cdr store))))
|
|
173 (gnus-message
|
|
174 7
|
|
175 "gnus-sync: loaded %d groups (out of %d) from %s"
|
|
176 (length valid-nodes)
|
|
177 (length gnus-sync-newsrc-loader)
|
|
178 gnus-sync-backend)
|
|
179 (setq gnus-sync-newsrc-loader nil)))
|
|
180 (nil))
|
|
181 ;; make the hashtable again because the newsrc-alist may have been modified
|
|
182 (when gnus-sync-newsrc-vars
|
|
183 (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
|
|
184 (gnus-make-hashtable-from-newsrc-alist))))
|
|
185
|
|
186 ;;;###autoload
|
|
187 (defun gnus-sync-initialize ()
|
|
188 "Initialize the Gnus sync facility."
|
|
189 (interactive)
|
|
190 (gnus-message 5 "Initializing the sync facility")
|
|
191 (gnus-sync-install-hooks))
|
|
192
|
|
193 ;;;###autoload
|
|
194 (defun gnus-sync-install-hooks ()
|
|
195 "Install the sync hooks."
|
|
196 (interactive)
|
|
197 (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
|
|
198 (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
|
|
199 (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
|
|
200
|
|
201 (defun gnus-sync-unload-hook ()
|
|
202 "Uninstall the sync hooks."
|
|
203 (interactive)
|
|
204 (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
|
|
205 (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
|
|
206 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
|
|
207
|
|
208 (add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
|
|
209
|
|
210 ;; this is harmless by default, until the gnus-sync-backend is set
|
|
211 (gnus-sync-initialize)
|
|
212
|
|
213 (provide 'gnus-sync)
|
|
214
|
|
215 ;;; gnus-sync.el ends here
|