Mercurial > emacs
annotate lisp/gnus/gnus-sync.el @ 109768:9c65ce5bc0db
Minor bug fixes for gnus-sync.el.
From Ted Zlatanov <tzz@lifelogs.com>.
* gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): Don't
read the sync on get-new-news.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Fri, 13 Aug 2010 10:58:21 +0000 |
parents | f7cd57edb2ca |
children | fe81389a263d |
rev | line source |
---|---|
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 | |
109767
f7cd57edb2ca
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109766
diff
changeset
|
121 gnus-sync-global-vars)) |
f7cd57edb2ca
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109766
diff
changeset
|
122 variable) |
109766 | 123 (while variables |
124 (when (and (boundp (setq variable (pop variables))) | |
125 (symbol-value variable)) | |
126 (princ "\n(setq ") | |
127 (princ (symbol-name variable)) | |
128 (princ " '") | |
129 (prin1 (symbol-value variable)) | |
130 (princ ")\n")))) | |
131 (gnus-message | |
132 7 | |
133 "gnus-sync: stored variables %s and %d groups in %s" | |
134 gnus-sync-global-vars | |
135 (length gnus-sync-newsrc-loader) | |
136 gnus-sync-backend) | |
137 | |
138 ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> | |
139 ;; Save the .eld file with extra line breaks. | |
140 (gnus-message 8 "gnus-sync: adding whitespace to %s" | |
141 gnus-sync-backend) | |
142 (save-excursion | |
143 (goto-char (point-min)) | |
144 (while (re-search-forward "^(\\|(\\\"" nil t) | |
145 (replace-match "\n\\&" t)) | |
146 (goto-char (point-min)) | |
147 (while (re-search-forward " $" nil t) | |
148 (replace-match "" t t)))))))) | |
149 ;; the pass-through case: gnus-sync-backend is not a known choice | |
150 (nil))) | |
151 | |
152 (defun gnus-sync-read () | |
153 "Load the Gnus sync data from the backend." | |
154 (interactive) | |
155 (when gnus-sync-backend | |
156 (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend) | |
157 (cond ((stringp gnus-sync-backend) | |
158 ;; read data here... | |
159 (if (or debug-on-error debug-on-quit) | |
160 (load gnus-sync-backend nil t) | |
161 (condition-case var | |
162 (load gnus-sync-backend nil t) | |
163 (error | |
164 (error "Error in %s: %s" gnus-sync-backend (cadr var))))) | |
165 (let ((valid-nodes | |
166 (loop for node in gnus-sync-newsrc-loader | |
167 if (gnus-gethash (car node) gnus-newsrc-hashtb) | |
168 collect node))) | |
169 (dolist (node valid-nodes) | |
170 (loop for store in (cdr node) | |
171 do (setf (nth (car store) | |
172 (assoc (car node) gnus-newsrc-alist)) | |
173 (cdr store)))) | |
174 (gnus-message | |
175 7 | |
176 "gnus-sync: loaded %d groups (out of %d) from %s" | |
177 (length valid-nodes) | |
178 (length gnus-sync-newsrc-loader) | |
179 gnus-sync-backend) | |
180 (setq gnus-sync-newsrc-loader nil))) | |
181 (nil)) | |
182 ;; make the hashtable again because the newsrc-alist may have been modified | |
109767
f7cd57edb2ca
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109766
diff
changeset
|
183 (when gnus-sync-newsrc-offsets |
109766 | 184 (gnus-message 9 "gnus-sync: remaking the newsrc hashtable") |
185 (gnus-make-hashtable-from-newsrc-alist)))) | |
186 | |
187 ;;;###autoload | |
188 (defun gnus-sync-initialize () | |
189 "Initialize the Gnus sync facility." | |
190 (interactive) | |
191 (gnus-message 5 "Initializing the sync facility") | |
192 (gnus-sync-install-hooks)) | |
193 | |
194 ;;;###autoload | |
195 (defun gnus-sync-install-hooks () | |
196 "Install the sync hooks." | |
197 (interactive) | |
109768
9c65ce5bc0db
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109767
diff
changeset
|
198 ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) |
109766 | 199 (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save) |
109768
9c65ce5bc0db
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109767
diff
changeset
|
200 (add-hook 'gnus-read-newsrc-el-hoo4a 'gnus-sync-read)) |
109766 | 201 |
202 (defun gnus-sync-unload-hook () | |
203 "Uninstall the sync hooks." | |
204 (interactive) | |
109768
9c65ce5bc0db
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109767
diff
changeset
|
205 ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) |
109766 | 206 (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) |
207 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) | |
208 | |
209 (add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) | |
210 | |
211 ;; this is harmless by default, until the gnus-sync-backend is set | |
212 (gnus-sync-initialize) | |
213 | |
214 (provide 'gnus-sync) | |
215 | |
216 ;;; gnus-sync.el ends here |