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