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