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