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