Mercurial > emacs
annotate lisp/gnus/gnus-sync.el @ 109774:7a46ef068de4
* lisp/gnus/gnus-sync.el (gnus-sync): Fix defgroup version.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Fri, 13 Aug 2010 19:02:31 -0700 |
parents | fe81389a263d |
children | 729aca322fce |
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 |
109766 | 34 ;; (setq gnus-sync-backend `("/remote:/path.gpg") ; will use Tramp+EPA if loaded |
35 ;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date) | |
36 ;; gnus-sync-newsrc-groups `("nntp" "nnrss") | |
37 ;; gnus-sync-newsrc-vars `(read marks)) | |
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 | |
98 (let ((gnus-sync-newsrc-loader | |
99 (loop for entry in (cdr gnus-newsrc-alist) | |
100 when (gnus-grep-in-list | |
101 (car entry) ;the group name | |
102 gnus-sync-newsrc-groups) | |
103 collect (cons (car entry) | |
104 (mapcar (lambda (offset) | |
105 (cons offset (nth offset entry))) | |
106 gnus-sync-newsrc-offsets))))) | |
107 | |
108 (with-temp-file gnus-sync-backend | |
109 (progn | |
110 (let ((coding-system-for-write gnus-ding-file-coding-system) | |
111 (standard-output (current-buffer))) | |
112 (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" | |
113 gnus-ding-file-coding-system)) | |
114 (princ ";; Gnus sync data v. 0.0.1\n") | |
115 (let* ((print-quoted t) | |
116 (print-readably t) | |
117 (print-escape-multibyte nil) | |
118 (print-escape-nonascii t) | |
119 (print-length nil) | |
120 (print-level nil) | |
121 (print-circle nil) | |
122 (print-escape-newlines t) | |
123 (variables (cons 'gnus-sync-newsrc-loader | |
109767
f7cd57edb2ca
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109766
diff
changeset
|
124 gnus-sync-global-vars)) |
f7cd57edb2ca
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109766
diff
changeset
|
125 variable) |
109766 | 126 (while variables |
127 (when (and (boundp (setq variable (pop variables))) | |
128 (symbol-value variable)) | |
129 (princ "\n(setq ") | |
130 (princ (symbol-name variable)) | |
131 (princ " '") | |
132 (prin1 (symbol-value variable)) | |
133 (princ ")\n")))) | |
134 (gnus-message | |
135 7 | |
136 "gnus-sync: stored variables %s and %d groups in %s" | |
137 gnus-sync-global-vars | |
138 (length gnus-sync-newsrc-loader) | |
139 gnus-sync-backend) | |
140 | |
141 ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> | |
142 ;; Save the .eld file with extra line breaks. | |
143 (gnus-message 8 "gnus-sync: adding whitespace to %s" | |
144 gnus-sync-backend) | |
145 (save-excursion | |
146 (goto-char (point-min)) | |
147 (while (re-search-forward "^(\\|(\\\"" nil t) | |
148 (replace-match "\n\\&" t)) | |
149 (goto-char (point-min)) | |
150 (while (re-search-forward " $" nil t) | |
151 (replace-match "" t t)))))))) | |
152 ;; the pass-through case: gnus-sync-backend is not a known choice | |
153 (nil))) | |
154 | |
155 (defun gnus-sync-read () | |
156 "Load the Gnus sync data from the backend." | |
157 (interactive) | |
158 (when gnus-sync-backend | |
159 (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend) | |
160 (cond ((stringp gnus-sync-backend) | |
161 ;; read data here... | |
162 (if (or debug-on-error debug-on-quit) | |
163 (load gnus-sync-backend nil t) | |
164 (condition-case var | |
165 (load gnus-sync-backend nil t) | |
166 (error | |
167 (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
|
168 (let ((valid-count 0) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
169 invalid-groups) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
170 (dolist (node gnus-sync-newsrc-loader) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
171 (if (gnus-gethash (car node) gnus-newsrc-hashtb) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
172 (progn |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
173 (incf valid-count) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
174 (loop for store in (cdr node) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
175 do (setf (nth (car store) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
176 (assoc (car node) gnus-newsrc-alist)) |
109766 | 177 (cdr store)))) |
109769
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
178 (push (car node) invalid-groups))) |
109766 | 179 (gnus-message |
180 7 | |
181 "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
|
182 valid-count (length gnus-sync-newsrc-loader) |
109766 | 183 gnus-sync-backend) |
109769
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
184 (when invalid-groups |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
185 (gnus-message |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
186 7 |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
187 "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
|
188 (length invalid-groups) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
189 (length gnus-sync-newsrc-loader) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
190 gnus-sync-backend) |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
191 (gnus-message 9 "gnus-sync: skipped groups: %s" |
fe81389a263d
Optimizations for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109768
diff
changeset
|
192 (mapconcat 'identity invalid-groups ", "))) |
109766 | 193 (setq gnus-sync-newsrc-loader nil))) |
194 (nil)) | |
195 ;; 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
|
196 (when gnus-sync-newsrc-offsets |
109766 | 197 (gnus-message 9 "gnus-sync: remaking the newsrc hashtable") |
198 (gnus-make-hashtable-from-newsrc-alist)))) | |
199 | |
200 ;;;###autoload | |
201 (defun gnus-sync-initialize () | |
202 "Initialize the Gnus sync facility." | |
203 (interactive) | |
204 (gnus-message 5 "Initializing the sync facility") | |
205 (gnus-sync-install-hooks)) | |
206 | |
207 ;;;###autoload | |
208 (defun gnus-sync-install-hooks () | |
209 "Install the sync hooks." | |
210 (interactive) | |
109768
9c65ce5bc0db
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109767
diff
changeset
|
211 ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) |
109766 | 212 (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
|
213 (add-hook 'gnus-read-newsrc-el-hoo4a 'gnus-sync-read)) |
109766 | 214 |
215 (defun gnus-sync-unload-hook () | |
216 "Uninstall the sync hooks." | |
217 (interactive) | |
109768
9c65ce5bc0db
Minor bug fixes for gnus-sync.el.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
109767
diff
changeset
|
218 ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) |
109766 | 219 (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) |
220 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) | |
221 | |
222 (add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) | |
223 | |
224 ;; this is harmless by default, until the gnus-sync-backend is set | |
225 (gnus-sync-initialize) | |
226 | |
227 (provide 'gnus-sync) | |
228 | |
229 ;;; gnus-sync.el ends here |