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