Mercurial > emacs
comparison lisp/gnus/nndiary.el @ 56927:55fd4f77387a after-merge-gnus-5_10
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Merge from emacs--gnus--5.10, gnus--rel--5.10
Patches applied:
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
Import from CVS branch gnus-5_10-branch
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
Remove autoconf-generated files from archive
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sat, 04 Sep 2004 13:13:48 +0000 |
parents | |
children | df80d19d7a2e |
comparison
equal
deleted
inserted
replaced
56926:f8e248e9a717 | 56927:55fd4f77387a |
---|---|
1 ;;; nndiary.el --- A diary backend for Gnus | |
2 | |
3 ;; Copyright (C) 1999, 2000, 2001, 2003 | |
4 ;; Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Didier Verna <didier@xemacs.org> | |
7 ;; Maintainer: Didier Verna <didier@xemacs.org> | |
8 ;; Created: Fri Jul 16 18:55:42 1999 | |
9 ;; Keywords: calendar mail news | |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 ;; it under the terms of the GNU General Public License as published by | |
15 ;; the Free Software Foundation; either version 2 of the License, or | |
16 ;; (at your option) any later version. | |
17 | |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;; GNU General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
24 ;; along with this program; if not, write to the Free Software | |
25 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | |
26 | |
27 | |
28 ;;; Commentary: | |
29 | |
30 ;; Contents management by FCM version 0.1. | |
31 | |
32 ;; Description: | |
33 ;; =========== | |
34 | |
35 ;; This package implements NNDiary, a diary backend for Gnus. NNDiary is a | |
36 ;; mail backend, pretty similar to nnml in its functionnning (it has all the | |
37 ;; features of nnml, actually), but in which messages are treated as event | |
38 ;; reminders. | |
39 | |
40 ;; Here is a typical scenario: | |
41 ;; - You've got a date with Andy Mc Dowell or Bruce Willis (select according | |
42 ;; to your sexual preference) in one month. You don't want to forget it. | |
43 ;; - Send a (special) diary message to yourself (see below). | |
44 ;; - Forget all about it and keep on getting and reading new mail, as usual. | |
45 ;; - From time to time, as you type `g' in the group buffer and as the date | |
46 ;; is getting closer, the message will pop up again, just like if it were | |
47 ;; new and unread. | |
48 ;; - Read your "new" messages, this one included, and start dreaming of the | |
49 ;; night you're gonna have. | |
50 ;; - Once the date is over (you actually fell asleep just after dinner), the | |
51 ;; message will be automatically deleted if it is marked as expirable. | |
52 | |
53 ;; Some more notes on the diary backend: | |
54 ;; - NNDiary is a *real* mail backend. You *really* send real diary | |
55 ;; messsages. This means for instance that you can give appointements to | |
56 ;; anybody (provided they use Gnus and NNDiary) by sending the diary message | |
57 ;; to them as well. | |
58 ;; - However, since NNDiary also has a 'request-post method, you can also | |
59 ;; `C-u a' instead of `C-u m' on a diary group and the message won't actually | |
60 ;; be sent; just stored in the group. | |
61 ;; - The events you want to remember need not be punctual. You can set up | |
62 ;; reminders for regular dates (like once each week, each monday at 13:30 | |
63 ;; and so on). Diary messages of this kind will never be deleted (unless | |
64 ;; you do it explicitely). But that, you guessed. | |
65 | |
66 | |
67 ;; Usage: | |
68 ;; ===== | |
69 | |
70 ;; 1/ NNDiary has two modes of operation: traditional (the default) and | |
71 ;; autonomous. | |
72 ;; a/ In traditional mode, NNDiary does not get new mail by itself. You | |
73 ;; have to move mails from your primary mail backend to nndiary | |
74 ;; groups. | |
75 ;; b/ In autonomous mode, NNDiary retrieves its own mail and handles it | |
76 ;; independantly of your primary mail backend. To use NNDiary in | |
77 ;; autonomous mode, you have several things to do: | |
78 ;; i/ Put (setq nndiary-get-new-mail t) in your gnusrc file. | |
79 ;; ii/ Diary messages contain several `X-Diary-*' special headers. | |
80 ;; You *must* arrange that these messages be split in a private | |
81 ;; folder *before* Gnus treat them. You need this because Gnus | |
82 ;; is not able yet to manage multiple backends for mail | |
83 ;; retrieval. Getting them from a separate source will | |
84 ;; compensate this misfeature to some extent, as we will see. | |
85 ;; As an example, here's my procmailrc entry to store diary files | |
86 ;; in ~/.nndiary (the default nndiary mail source file): | |
87 ;; | |
88 ;; :0 HD : | |
89 ;; * ^X-Diary | |
90 ;; .nndiary | |
91 ;; iii/ Customize the variables `nndiary-mail-sources' and | |
92 ;; `nndiary-split-methods'. These are replacements for the usual | |
93 ;; mail sources and split methods which, and will be used in | |
94 ;; autonomous mode. `nndiary-mail-sources' defaults to | |
95 ;; '(file :path "~/.nndiary"). | |
96 ;; 2/ Install nndiary somewhere Emacs / Gnus can find it. Normally, you | |
97 ;; *don't* have to '(require 'nndiary) anywhere. Gnus will do so when | |
98 ;; appropriate as long as nndiary is somewhere in the load path. | |
99 ;; 3/ Now, customize the rest of nndiary. In particular, you should | |
100 ;; customize `nndiary-reminders', the list of times when you want to be | |
101 ;; reminded of your appointements (e.g. 3 weeks before, then 2 days | |
102 ;; before, then 1 hour before and that's it). | |
103 ;; 4/ You *must* use the group timestamp feature of Gnus. This adds a | |
104 ;; timestamp to each groups' parameters (please refer to the Gnus | |
105 ;; documentation ("Group Timestamp" info node) to see how it's done. | |
106 ;; 5/ Once you have done this, you may add a permanent nndiary virtual server | |
107 ;; (something like '(nndiary "")) to your `gnus-secondary-select-methods'. | |
108 ;; Yes, this server will be able to retrieve mails and split them when you | |
109 ;; type `g' in the group buffer, just as if it were your only mail backend. | |
110 ;; This is the benefit of using a private folder. | |
111 ;; 6/ Hopefully, almost everything (see the TODO section below) will work as | |
112 ;; expected when you restart Gnus: in the group buffer, `g' and `M-g' will | |
113 ;; also get your new diary mails, `F' will find your new diary groups etc. | |
114 | |
115 | |
116 ;; How to send diary messages: | |
117 ;; ========================== | |
118 | |
119 ;; There are 7 special headers in diary messages. These headers are of the | |
120 ;; form `X-Diary-<something>', the <something> being one of `Minute', `Hour', | |
121 ;; `Dom', `Month', `Year', `Time-Zone' and `Dow'. `Dom' means "Day of Month", | |
122 ;; and `dow' means "Day of Week". These headers actually behave like crontab | |
123 ;; specifications and define the event date(s). | |
124 | |
125 ;; For all headers but the `Time-Zone' one, a header value is either a | |
126 ;; star (meaning all possible values), or a list of fields (separated by a | |
127 ;; comma). A field is either an integer, or a range. A range is two integers | |
128 ;; separated by a dash. Possible integer values are 0-59 for `Minute', 0-23 | |
129 ;; for `Hour', 1-31 for `Dom', `1-12' for Month, above 1971 for `Year' and 0-6 | |
130 ;; for `Dow' (0 = sunday). As a special case, a star in either `Dom' or `Dow' | |
131 ;; doesn't mean "all possible values", but "use only the other field". Note | |
132 ;; that if both are star'ed, the use of either one gives the same result :-), | |
133 | |
134 ;; The `Time-Zone' header is special in that it can have only one value (you | |
135 ;; bet ;-). | |
136 ;; A star doesn't mean "all possible values" (because it has no sense), but | |
137 ;; "the current local time zone". | |
138 | |
139 ;; As an example, here's how you would say "Each Monday and each 1st of month, | |
140 ;; at 12:00, 20:00, 21:00, 22:00, 23:00 and 24:00, from 1999 to 2010" (I let | |
141 ;; you find what to do then): | |
142 ;; | |
143 ;; X-Diary-Minute: 0 | |
144 ;; X-Diary-Hour: 12, 20-24 | |
145 ;; X-Diary-Dom: 1 | |
146 ;; X-Diary-Month: * | |
147 ;; X-Diary-Year: 1999-2010 | |
148 ;; X-Diary-Dow: 1 | |
149 ;; X-Diary-Time-Zone: * | |
150 ;; | |
151 ;; | |
152 ;; Sending a diary message is not different from sending any other kind of | |
153 ;; mail, except that such messages are identified by the presence of these | |
154 ;; special headers. | |
155 | |
156 | |
157 | |
158 ;; Bugs / Todo: | |
159 ;; =========== | |
160 | |
161 ;; * Respooling doesn't work because contrary to the request-scan function, | |
162 ;; Gnus won't allow me to override the split methods when calling the | |
163 ;; respooling backend functions. | |
164 ;; * There's a bug in the time zone mechanism with variable TZ locations. | |
165 ;; * We could allow a keyword like `ask' in X-Diary-* headers, that would mean | |
166 ;; "ask for value upon reception of the message". | |
167 ;; * We could add an optional header X-Diary-Reminders to specify a special | |
168 ;; reminders value for this message. Suggested by Jody Klymak. | |
169 ;; * We should check messages validity in other circumstances than just | |
170 ;; moving an article from sonwhere else (request-accept). For instance, when | |
171 ;; editing / saving and so on. | |
172 | |
173 | |
174 ;; Remarks: | |
175 ;; ======= | |
176 | |
177 ;; * nnoo. | |
178 ;; NNDiary is very similar to nnml. This makes the idea of using nnoo (to | |
179 ;; derive nndiary from nnml) natural. However, my experience with nnoo is | |
180 ;; that for reasonably complex backends like this one, noo is a burden | |
181 ;; rather than an help. It's tricky to use, not everything can be | |
182 ;; inherited, what can be inherited and when is not very clear, and you've | |
183 ;; got to be very careful because a little mistake can fuck up your your | |
184 ;; other backends, especially because their variables will be use instead of | |
185 ;; your real ones. Finally, I found it easier to just clone the needed | |
186 ;; parts of nnml, and tracking nnml updates is not a big deal. | |
187 | |
188 ;; IMHO, nnoo is actually badly designed. A much simpler, and yet more | |
189 ;; powerful one would be to make *real* functions and variables for a new | |
190 ;; backend based on another. Lisp is a reflexive language so that's a very | |
191 ;; easy thing to do: inspect the function's form, replace occurences of | |
192 ;; <nnfrom> (even in strings) with <nnto>, and you're done. | |
193 | |
194 ;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods: | |
195 ;; NNDiary has some experimental parts, in the sense Gnus normally uses only | |
196 ;; one mail backends for mail retreival and splitting. This backend is also | |
197 ;; an attempt to make it behave differently. For Gnus developpers: as you | |
198 ;; can see if you snarf into the code, that was not a very difficult thing | |
199 ;; to do. Something should be done about the respooling breakage though. | |
200 | |
201 | |
202 ;;; Code: | |
203 | |
204 (require 'nnoo) | |
205 (require 'nnheader) | |
206 (require 'nnmail) | |
207 (eval-when-compile (require 'cl)) | |
208 | |
209 (require 'gnus-start) | |
210 (require 'gnus-sum) | |
211 | |
212 ;; Compatibility Functions ================================================= | |
213 | |
214 (eval-and-compile | |
215 (if (fboundp 'signal-error) | |
216 (defun nndiary-error (&rest args) | |
217 (apply #'signal-error 'nndiary args)) | |
218 (defun nndiary-error (&rest args) | |
219 (apply #'error args)))) | |
220 | |
221 | |
222 ;; Backend behavior customization =========================================== | |
223 | |
224 (defgroup nndiary nil | |
225 "The Gnus Diary backend." | |
226 :group 'gnus-diary) | |
227 | |
228 (defcustom nndiary-mail-sources | |
229 `((file :path ,(expand-file-name "~/.nndiary"))) | |
230 "*NNDiary specific mail sources. | |
231 This variable is used by nndiary in place of the standard `mail-sources' | |
232 variable when `nndiary-get-new-mail' is set to non-nil. These sources | |
233 must contain diary messages ONLY." | |
234 :group 'nndiary | |
235 :group 'mail-source | |
236 :type 'sexp) | |
237 | |
238 (defcustom nndiary-split-methods '(("diary" "")) | |
239 "*NNDiary specific split methods. | |
240 This variable is used by nndiary in place of the standard | |
241 `nnmail-split-methods' variable when `nndiary-get-new-mail' is set to | |
242 non-nil." | |
243 :group 'nndiary | |
244 :group 'nnmail-split | |
245 :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) | |
246 (function-item nnmail-split-fancy) | |
247 (function :tag "Other"))) | |
248 | |
249 | |
250 (defcustom nndiary-reminders '((0 . day)) | |
251 "*Different times when you want to be reminded of your appointements. | |
252 Diary articles will appear again, as if they'd been just received. | |
253 | |
254 Entries look like (3 . day) which means something like \"Please | |
255 Hortense, would you be so kind as to remind me of my appointments 3 days | |
256 before the date, thank you very much. Anda, hmmm... by the way, are you | |
257 doing anything special tonight ?\". | |
258 | |
259 The units of measure are 'minute 'hour 'day 'week 'month and 'year (no, | |
260 not 'century, sorry). | |
261 | |
262 NOTE: the units of measure actually express dates, not durations: if you | |
263 use 'week, messages will pop up on Sundays at 00:00 (or Mondays if | |
264 `nndiary-week-starts-on-monday' is non nil) and *not* 7 days before the | |
265 appointement, if you use 'month, messages will pop up on the first day of | |
266 each months, at 00:00 and so on. | |
267 | |
268 If you really want to specify a duration (like 24 hours exactly), you can | |
269 use the equivalent in minutes (the smallest unit). A fuzz of 60 seconds | |
270 maximum in the reminder is not that painful, I think. Although this | |
271 scheme might appear somewhat weird at a first glance, it is very powerful. | |
272 In order to make this clear, here are some examples: | |
273 | |
274 - '(0 . day): this is the default value of `nndiary-reminders'. It means | |
275 pop up the appointements of the day each morning at 00:00. | |
276 | |
277 - '(1 . day): this means pop up the appointements the day before, at 00:00. | |
278 | |
279 - '(6 . hour): for an appointement at 18:30, this would pop up the | |
280 appointement message at 12:00. | |
281 | |
282 - '(360 . minute): for an appointement at 18:30 and 15 seconds, this would | |
283 pop up the appointement message at 12:30." | |
284 :group 'nndiary | |
285 :type '(repeat (cons :format "%v\n" | |
286 (integer :format "%v") | |
287 (choice :format "%[%v(s)%] before...\n" | |
288 :value day | |
289 (const :format "%v" minute) | |
290 (const :format "%v" hour) | |
291 (const :format "%v" day) | |
292 (const :format "%v" week) | |
293 (const :format "%v" month) | |
294 (const :format "%v" year))))) | |
295 | |
296 (defcustom nndiary-week-starts-on-monday nil | |
297 "*Whether a week starts on monday (otherwise, sunday)." | |
298 :type 'boolean | |
299 :group 'nndiary) | |
300 | |
301 | |
302 (defcustom nndiary-request-create-group-hooks nil | |
303 "*Hooks to run after `nndiary-request-create-group' is executed. | |
304 The hooks will be called with the full group name as argument." | |
305 :group 'nndiary | |
306 :type 'hook) | |
307 | |
308 (defcustom nndiary-request-update-info-hooks nil | |
309 "*Hooks to run after `nndiary-request-update-info-group' is executed. | |
310 The hooks will be called with the full group name as argument." | |
311 :group 'nndiary | |
312 :type 'hook) | |
313 | |
314 (defcustom nndiary-request-accept-article-hooks nil | |
315 "*Hooks to run before accepting an article. | |
316 Executed near the beginning of `nndiary-request-accept-article'. | |
317 The hooks will be called with the article in the current buffer." | |
318 :group 'nndiary | |
319 :type 'hook) | |
320 | |
321 (defcustom nndiary-check-directory-twice t | |
322 "*If t, check directories twice to avoid NFS failures." | |
323 :group 'nndiary | |
324 :type 'boolean) | |
325 | |
326 | |
327 ;; Backend declaration ====================================================== | |
328 | |
329 ;; Well, most of this is nnml clonage. | |
330 | |
331 (nnoo-declare nndiary) | |
332 | |
333 (defvoo nndiary-directory (nnheader-concat gnus-directory "diary/") | |
334 "Spool directory for the nndiary backend.") | |
335 | |
336 (defvoo nndiary-active-file | |
337 (expand-file-name "active" nndiary-directory) | |
338 "Active file for the nndiary backend.") | |
339 | |
340 (defvoo nndiary-newsgroups-file | |
341 (expand-file-name "newsgroups" nndiary-directory) | |
342 "Newsgroups description file for the nndiary backend.") | |
343 | |
344 (defvoo nndiary-get-new-mail nil | |
345 "Whether nndiary gets new mail and split it. | |
346 Contrary to traditional mail backends, this variable can be set to t | |
347 even if your primary mail backend also retreives mail. In such a case, | |
348 NDiary uses its own mail-sources and split-methods.") | |
349 | |
350 (defvoo nndiary-nov-is-evil nil | |
351 "If non-nil, Gnus will never use nov databases for nndiary groups. | |
352 Using nov databases will speed up header fetching considerably. | |
353 This variable shouldn't be flipped much. If you have, for some reason, | |
354 set this to t, and want to set it to nil again, you should always run | |
355 the `nndiary-generate-nov-databases' command. The function will go | |
356 through all nnml directories and generate nov databases for them | |
357 all. This may very well take some time.") | |
358 | |
359 (defvoo nndiary-prepare-save-mail-hook nil | |
360 "*Hook run narrowed to an article before saving.") | |
361 | |
362 (defvoo nndiary-inhibit-expiry nil | |
363 "If non-nil, inhibit expiry.") | |
364 | |
365 | |
366 | |
367 (defconst nndiary-version "0.2-b14" | |
368 "Current Diary backend version.") | |
369 | |
370 (defun nndiary-version () | |
371 "Current Diary backend version." | |
372 (interactive) | |
373 (message "NNDiary version %s" nndiary-version)) | |
374 | |
375 (defvoo nndiary-nov-file-name ".overview") | |
376 | |
377 (defvoo nndiary-current-directory nil) | |
378 (defvoo nndiary-current-group nil) | |
379 (defvoo nndiary-status-string "" ) | |
380 (defvoo nndiary-nov-buffer-alist nil) | |
381 (defvoo nndiary-group-alist nil) | |
382 (defvoo nndiary-active-timestamp nil) | |
383 (defvoo nndiary-article-file-alist nil) | |
384 | |
385 (defvoo nndiary-generate-active-function 'nndiary-generate-active-info) | |
386 (defvoo nndiary-nov-buffer-file-name nil) | |
387 (defvoo nndiary-file-coding-system nnmail-file-coding-system) | |
388 | |
389 (defconst nndiary-headers | |
390 '(("Minute" 0 59) | |
391 ("Hour" 0 23) | |
392 ("Dom" 1 31) | |
393 ("Month" 1 12) | |
394 ("Year" 1971) | |
395 ("Dow" 0 6) | |
396 ("Time-Zone" (("Y" -43200) | |
397 | |
398 ("X" -39600) | |
399 | |
400 ("W" -36000) | |
401 | |
402 ("V" -32400) | |
403 | |
404 ("U" -28800) | |
405 ("PST" -28800) | |
406 | |
407 ("T" -25200) | |
408 ("MST" -25200) | |
409 ("PDT" -25200) | |
410 | |
411 ("S" -21600) | |
412 ("CST" -21600) | |
413 ("MDT" -21600) | |
414 | |
415 ("R" -18000) | |
416 ("EST" -18000) | |
417 ("CDT" -18000) | |
418 | |
419 ("Q" -14400) | |
420 ("AST" -14400) | |
421 ("EDT" -14400) | |
422 | |
423 ("P" -10800) | |
424 ("ADT" -10800) | |
425 | |
426 ("O" -7200) | |
427 | |
428 ("N" -3600) | |
429 | |
430 ("Z" 0) | |
431 ("GMT" 0) | |
432 ("UT" 0) | |
433 ("UTC" 0) | |
434 ("WET" 0) | |
435 | |
436 ("A" 3600) | |
437 ("CET" 3600) | |
438 ("MET" 3600) | |
439 ("MEZ" 3600) | |
440 ("BST" 3600) | |
441 ("WEST" 3600) | |
442 | |
443 ("B" 7200) | |
444 ("EET" 7200) | |
445 ("CEST" 7200) | |
446 ("MEST" 7200) | |
447 ("MESZ" 7200) | |
448 | |
449 ("C" 10800) | |
450 | |
451 ("D" 14400) | |
452 | |
453 ("E" 18000) | |
454 | |
455 ("F" 21600) | |
456 | |
457 ("G" 25200) | |
458 | |
459 ("H" 28800) | |
460 | |
461 ("I" 32400) | |
462 ("JST" 32400) | |
463 | |
464 ("K" 36000) | |
465 ("GST" 36000) | |
466 | |
467 ("L" 39600) | |
468 | |
469 ("M" 43200) | |
470 ("NZST" 43200) | |
471 | |
472 ("NZDT" 46800)))) | |
473 ;; List of NNDiary headers that specify the time spec. Each header name is | |
474 ;; followed by either two integers (specifying a range of possible values | |
475 ;; for this header) or one list (specifying all the possible values for this | |
476 ;; header). In the latter case, the list does NOT include the unspecifyed | |
477 ;; spec (*). | |
478 ;; For time zone values, we have symbolic time zone names associated with | |
479 ;; the (relative) number of seconds ahead GMT. | |
480 ) | |
481 | |
482 (defsubst nndiary-schedule () | |
483 (let (head) | |
484 (condition-case arg | |
485 (mapcar | |
486 (lambda (elt) | |
487 (setq head (nth 0 elt)) | |
488 (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt))) | |
489 nndiary-headers) | |
490 (t | |
491 (nnheader-report 'nndiary "X-Diary-%s header parse error: %s." | |
492 head (cdr arg)) | |
493 nil)) | |
494 )) | |
495 | |
496 ;;; Interface functions ===================================================== | |
497 | |
498 (nnoo-define-basics nndiary) | |
499 | |
500 (deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old) | |
501 (when (nndiary-possibly-change-directory group server) | |
502 (save-excursion | |
503 (set-buffer nntp-server-buffer) | |
504 (erase-buffer) | |
505 (let* ((file nil) | |
506 (number (length sequence)) | |
507 (count 0) | |
508 (file-name-coding-system nnmail-pathname-coding-system) | |
509 beg article | |
510 (nndiary-check-directory-twice | |
511 (and nndiary-check-directory-twice | |
512 ;; To speed up, disable it in some case. | |
513 (or (not (numberp nnmail-large-newsgroup)) | |
514 (<= number nnmail-large-newsgroup))))) | |
515 (if (stringp (car sequence)) | |
516 'headers | |
517 (if (nndiary-retrieve-headers-with-nov sequence fetch-old) | |
518 'nov | |
519 (while sequence | |
520 (setq article (car sequence)) | |
521 (setq file (nndiary-article-to-file article)) | |
522 (when (and file | |
523 (file-exists-p file) | |
524 (not (file-directory-p file))) | |
525 (insert (format "221 %d Article retrieved.\n" article)) | |
526 (setq beg (point)) | |
527 (nnheader-insert-head file) | |
528 (goto-char beg) | |
529 (if (search-forward "\n\n" nil t) | |
530 (forward-char -1) | |
531 (goto-char (point-max)) | |
532 (insert "\n\n")) | |
533 (insert ".\n") | |
534 (delete-region (point) (point-max))) | |
535 (setq sequence (cdr sequence)) | |
536 (setq count (1+ count)) | |
537 (and (numberp nnmail-large-newsgroup) | |
538 (> number nnmail-large-newsgroup) | |
539 (zerop (% count 20)) | |
540 (nnheader-message 6 "nndiary: Receiving headers... %d%%" | |
541 (/ (* count 100) number)))) | |
542 | |
543 (and (numberp nnmail-large-newsgroup) | |
544 (> number nnmail-large-newsgroup) | |
545 (nnheader-message 6 "nndiary: Receiving headers...done")) | |
546 | |
547 (nnheader-fold-continuation-lines) | |
548 'headers)))))) | |
549 | |
550 (deffoo nndiary-open-server (server &optional defs) | |
551 (nnoo-change-server 'nndiary server defs) | |
552 (when (not (file-exists-p nndiary-directory)) | |
553 (ignore-errors (make-directory nndiary-directory t))) | |
554 (cond | |
555 ((not (file-exists-p nndiary-directory)) | |
556 (nndiary-close-server) | |
557 (nnheader-report 'nndiary "Couldn't create directory: %s" | |
558 nndiary-directory)) | |
559 ((not (file-directory-p (file-truename nndiary-directory))) | |
560 (nndiary-close-server) | |
561 (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory)) | |
562 (t | |
563 (nnheader-report 'nndiary "Opened server %s using directory %s" | |
564 server nndiary-directory) | |
565 t))) | |
566 | |
567 (deffoo nndiary-request-regenerate (server) | |
568 (nndiary-possibly-change-directory nil server) | |
569 (nndiary-generate-nov-databases server) | |
570 t) | |
571 | |
572 (deffoo nndiary-request-article (id &optional group server buffer) | |
573 (nndiary-possibly-change-directory group server) | |
574 (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) | |
575 (file-name-coding-system nnmail-pathname-coding-system) | |
576 path gpath group-num) | |
577 (if (stringp id) | |
578 (when (and (setq group-num (nndiary-find-group-number id)) | |
579 (cdr | |
580 (assq (cdr group-num) | |
581 (nnheader-article-to-file-alist | |
582 (setq gpath | |
583 (nnmail-group-pathname | |
584 (car group-num) | |
585 nndiary-directory)))))) | |
586 (setq path (concat gpath (int-to-string (cdr group-num))))) | |
587 (setq path (nndiary-article-to-file id))) | |
588 (cond | |
589 ((not path) | |
590 (nnheader-report 'nndiary "No such article: %s" id)) | |
591 ((not (file-exists-p path)) | |
592 (nnheader-report 'nndiary "No such file: %s" path)) | |
593 ((file-directory-p path) | |
594 (nnheader-report 'nndiary "File is a directory: %s" path)) | |
595 ((not (save-excursion (let ((nnmail-file-coding-system | |
596 nndiary-file-coding-system)) | |
597 (nnmail-find-file path)))) | |
598 (nnheader-report 'nndiary "Couldn't read file: %s" path)) | |
599 (t | |
600 (nnheader-report 'nndiary "Article %s retrieved" id) | |
601 ;; We return the article number. | |
602 (cons (if group-num (car group-num) group) | |
603 (string-to-int (file-name-nondirectory path))))))) | |
604 | |
605 (deffoo nndiary-request-group (group &optional server dont-check) | |
606 (let ((file-name-coding-system nnmail-pathname-coding-system)) | |
607 (cond | |
608 ((not (nndiary-possibly-change-directory group server)) | |
609 (nnheader-report 'nndiary "Invalid group (no such directory)")) | |
610 ((not (file-exists-p nndiary-current-directory)) | |
611 (nnheader-report 'nndiary "Directory %s does not exist" | |
612 nndiary-current-directory)) | |
613 ((not (file-directory-p nndiary-current-directory)) | |
614 (nnheader-report 'nndiary "%s is not a directory" | |
615 nndiary-current-directory)) | |
616 (dont-check | |
617 (nnheader-report 'nndiary "Group %s selected" group) | |
618 t) | |
619 (t | |
620 (nnheader-re-read-dir nndiary-current-directory) | |
621 (nnmail-activate 'nndiary) | |
622 (let ((active (nth 1 (assoc group nndiary-group-alist)))) | |
623 (if (not active) | |
624 (nnheader-report 'nndiary "No such group: %s" group) | |
625 (nnheader-report 'nndiary "Selected group %s" group) | |
626 (nnheader-insert "211 %d %d %d %s\n" | |
627 (max (1+ (- (cdr active) (car active))) 0) | |
628 (car active) (cdr active) group))))))) | |
629 | |
630 (deffoo nndiary-request-scan (&optional group server) | |
631 ;; Use our own mail sources and split methods while Gnus doesn't let us have | |
632 ;; multiple backends for retrieving mail. | |
633 (let ((mail-sources nndiary-mail-sources) | |
634 (nnmail-split-methods nndiary-split-methods)) | |
635 (setq nndiary-article-file-alist nil) | |
636 (nndiary-possibly-change-directory group server) | |
637 (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group))) | |
638 | |
639 (deffoo nndiary-close-group (group &optional server) | |
640 (setq nndiary-article-file-alist nil) | |
641 t) | |
642 | |
643 (deffoo nndiary-request-create-group (group &optional server args) | |
644 (nndiary-possibly-change-directory nil server) | |
645 (nnmail-activate 'nndiary) | |
646 (cond | |
647 ((assoc group nndiary-group-alist) | |
648 t) | |
649 ((and (file-exists-p (nnmail-group-pathname group nndiary-directory)) | |
650 (not (file-directory-p (nnmail-group-pathname | |
651 group nndiary-directory)))) | |
652 (nnheader-report 'nndiary "%s is a file" | |
653 (nnmail-group-pathname group nndiary-directory))) | |
654 (t | |
655 (let (active) | |
656 (push (list group (setq active (cons 1 0))) | |
657 nndiary-group-alist) | |
658 (nndiary-possibly-create-directory group) | |
659 (nndiary-possibly-change-directory group server) | |
660 (let ((articles (nnheader-directory-articles nndiary-current-directory))) | |
661 (when articles | |
662 (setcar active (apply 'min articles)) | |
663 (setcdr active (apply 'max articles)))) | |
664 (nnmail-save-active nndiary-group-alist nndiary-active-file) | |
665 (run-hook-with-args 'nndiary-request-create-group-hooks | |
666 (gnus-group-prefixed-name group | |
667 (list "nndiary" server))) | |
668 t)) | |
669 )) | |
670 | |
671 (deffoo nndiary-request-list (&optional server) | |
672 (save-excursion | |
673 (let ((nnmail-file-coding-system nnmail-active-file-coding-system) | |
674 (file-name-coding-system nnmail-pathname-coding-system)) | |
675 (nnmail-find-file nndiary-active-file)) | |
676 (setq nndiary-group-alist (nnmail-get-active)) | |
677 t)) | |
678 | |
679 (deffoo nndiary-request-newgroups (date &optional server) | |
680 (nndiary-request-list server)) | |
681 | |
682 (deffoo nndiary-request-list-newsgroups (&optional server) | |
683 (save-excursion | |
684 (nnmail-find-file nndiary-newsgroups-file))) | |
685 | |
686 (deffoo nndiary-request-expire-articles (articles group &optional server force) | |
687 (nndiary-possibly-change-directory group server) | |
688 (let ((active-articles | |
689 (nnheader-directory-articles nndiary-current-directory)) | |
690 article rest number) | |
691 (nnmail-activate 'nndiary) | |
692 ;; Articles not listed in active-articles are already gone, | |
693 ;; so don't try to expire them. | |
694 (setq articles (gnus-intersection articles active-articles)) | |
695 (while articles | |
696 (setq article (nndiary-article-to-file (setq number (pop articles)))) | |
697 (if (and (nndiary-deletable-article-p group number) | |
698 ;; Don't use nnmail-expired-article-p. Our notion of expiration | |
699 ;; is a bit peculiar ... | |
700 (or force (nndiary-expired-article-p article))) | |
701 (progn | |
702 ;; Allow a special target group. | |
703 (unless (eq nnmail-expiry-target 'delete) | |
704 (with-temp-buffer | |
705 (nndiary-request-article number group server (current-buffer)) | |
706 (let ((nndiary-current-directory nil)) | |
707 (nnmail-expiry-target-group nnmail-expiry-target group))) | |
708 (nndiary-possibly-change-directory group server)) | |
709 (nnheader-message 5 "Deleting article %s in %s" number group) | |
710 (condition-case () | |
711 (funcall nnmail-delete-file-function article) | |
712 (file-error (push number rest))) | |
713 (setq active-articles (delq number active-articles)) | |
714 (nndiary-nov-delete-article group number)) | |
715 (push number rest))) | |
716 (let ((active (nth 1 (assoc group nndiary-group-alist)))) | |
717 (when active | |
718 (setcar active (or (and active-articles | |
719 (apply 'min active-articles)) | |
720 (1+ (cdr active))))) | |
721 (nnmail-save-active nndiary-group-alist nndiary-active-file)) | |
722 (nndiary-save-nov) | |
723 (nconc rest articles))) | |
724 | |
725 (deffoo nndiary-request-move-article | |
726 (article group server accept-form &optional last) | |
727 (let ((buf (get-buffer-create " *nndiary move*")) | |
728 result) | |
729 (nndiary-possibly-change-directory group server) | |
730 (nndiary-update-file-alist) | |
731 (and | |
732 (nndiary-deletable-article-p group article) | |
733 (nndiary-request-article article group server) | |
734 (let (nndiary-current-directory | |
735 nndiary-current-group | |
736 nndiary-article-file-alist) | |
737 (save-excursion | |
738 (set-buffer buf) | |
739 (insert-buffer-substring nntp-server-buffer) | |
740 (setq result (eval accept-form)) | |
741 (kill-buffer (current-buffer)) | |
742 result)) | |
743 (progn | |
744 (nndiary-possibly-change-directory group server) | |
745 (condition-case () | |
746 (funcall nnmail-delete-file-function | |
747 (nndiary-article-to-file article)) | |
748 (file-error nil)) | |
749 (nndiary-nov-delete-article group article) | |
750 (when last | |
751 (nndiary-save-nov) | |
752 (nnmail-save-active nndiary-group-alist nndiary-active-file)))) | |
753 result)) | |
754 | |
755 (deffoo nndiary-request-accept-article (group &optional server last) | |
756 (nndiary-possibly-change-directory group server) | |
757 (nnmail-check-syntax) | |
758 (run-hooks 'nndiary-request-accept-article-hooks) | |
759 (when (nndiary-schedule) | |
760 (let (result) | |
761 (when nnmail-cache-accepted-message-ids | |
762 (nnmail-cache-insert (nnmail-fetch-field "message-id") | |
763 group | |
764 (nnmail-fetch-field "subject"))) | |
765 (if (stringp group) | |
766 (and | |
767 (nnmail-activate 'nndiary) | |
768 (setq result | |
769 (car (nndiary-save-mail | |
770 (list (cons group (nndiary-active-number group)))))) | |
771 (progn | |
772 (nnmail-save-active nndiary-group-alist nndiary-active-file) | |
773 (and last (nndiary-save-nov)))) | |
774 (and | |
775 (nnmail-activate 'nndiary) | |
776 (if (and (not (setq result | |
777 (nnmail-article-group 'nndiary-active-number))) | |
778 (yes-or-no-p "Moved to `junk' group; delete article? ")) | |
779 (setq result 'junk) | |
780 (setq result (car (nndiary-save-mail result)))) | |
781 (when last | |
782 (nnmail-save-active nndiary-group-alist nndiary-active-file) | |
783 (when nnmail-cache-accepted-message-ids | |
784 (nnmail-cache-close)) | |
785 (nndiary-save-nov)))) | |
786 result)) | |
787 ) | |
788 | |
789 (deffoo nndiary-request-post (&optional server) | |
790 (nnmail-do-request-post 'nndiary-request-accept-article server)) | |
791 | |
792 (deffoo nndiary-request-replace-article (article group buffer) | |
793 (nndiary-possibly-change-directory group) | |
794 (save-excursion | |
795 (set-buffer buffer) | |
796 (nndiary-possibly-create-directory group) | |
797 (let ((chars (nnmail-insert-lines)) | |
798 (art (concat (int-to-string article) "\t")) | |
799 headers) | |
800 (when (ignore-errors | |
801 (nnmail-write-region | |
802 (point-min) (point-max) | |
803 (or (nndiary-article-to-file article) | |
804 (expand-file-name (int-to-string article) | |
805 nndiary-current-directory)) | |
806 nil (if (nnheader-be-verbose 5) nil 'nomesg)) | |
807 t) | |
808 (setq headers (nndiary-parse-head chars article)) | |
809 ;; Replace the NOV line in the NOV file. | |
810 (save-excursion | |
811 (set-buffer (nndiary-open-nov group)) | |
812 (goto-char (point-min)) | |
813 (if (or (looking-at art) | |
814 (search-forward (concat "\n" art) nil t)) | |
815 ;; Delete the old NOV line. | |
816 (delete-region (progn (beginning-of-line) (point)) | |
817 (progn (forward-line 1) (point))) | |
818 ;; The line isn't here, so we have to find out where | |
819 ;; we should insert it. (This situation should never | |
820 ;; occur, but one likes to make sure...) | |
821 (while (and (looking-at "[0-9]+\t") | |
822 (< (string-to-int | |
823 (buffer-substring | |
824 (match-beginning 0) (match-end 0))) | |
825 article) | |
826 (zerop (forward-line 1))))) | |
827 (beginning-of-line) | |
828 (nnheader-insert-nov headers) | |
829 (nndiary-save-nov) | |
830 t))))) | |
831 | |
832 (deffoo nndiary-request-delete-group (group &optional force server) | |
833 (nndiary-possibly-change-directory group server) | |
834 (when force | |
835 ;; Delete all articles in GROUP. | |
836 (let ((articles | |
837 (directory-files | |
838 nndiary-current-directory t | |
839 (concat nnheader-numerical-short-files | |
840 "\\|" (regexp-quote nndiary-nov-file-name) "$"))) | |
841 article) | |
842 (while articles | |
843 (setq article (pop articles)) | |
844 (when (file-writable-p article) | |
845 (nnheader-message 5 "Deleting article %s in %s..." article group) | |
846 (funcall nnmail-delete-file-function article)))) | |
847 ;; Try to delete the directory itself. | |
848 (ignore-errors (delete-directory nndiary-current-directory))) | |
849 ;; Remove the group from all structures. | |
850 (setq nndiary-group-alist | |
851 (delq (assoc group nndiary-group-alist) nndiary-group-alist) | |
852 nndiary-current-group nil | |
853 nndiary-current-directory nil) | |
854 ;; Save the active file. | |
855 (nnmail-save-active nndiary-group-alist nndiary-active-file) | |
856 t) | |
857 | |
858 (deffoo nndiary-request-rename-group (group new-name &optional server) | |
859 (nndiary-possibly-change-directory group server) | |
860 (let ((new-dir (nnmail-group-pathname new-name nndiary-directory)) | |
861 (old-dir (nnmail-group-pathname group nndiary-directory))) | |
862 (when (ignore-errors | |
863 (make-directory new-dir t) | |
864 t) | |
865 ;; We move the articles file by file instead of renaming | |
866 ;; the directory -- there may be subgroups in this group. | |
867 ;; One might be more clever, I guess. | |
868 (let ((files (nnheader-article-to-file-alist old-dir))) | |
869 (while files | |
870 (rename-file | |
871 (concat old-dir (cdar files)) | |
872 (concat new-dir (cdar files))) | |
873 (pop files))) | |
874 ;; Move .overview file. | |
875 (let ((overview (concat old-dir nndiary-nov-file-name))) | |
876 (when (file-exists-p overview) | |
877 (rename-file overview (concat new-dir nndiary-nov-file-name)))) | |
878 (when (<= (length (directory-files old-dir)) 2) | |
879 (ignore-errors (delete-directory old-dir))) | |
880 ;; That went ok, so we change the internal structures. | |
881 (let ((entry (assoc group nndiary-group-alist))) | |
882 (when entry | |
883 (setcar entry new-name)) | |
884 (setq nndiary-current-directory nil | |
885 nndiary-current-group nil) | |
886 ;; Save the new group alist. | |
887 (nnmail-save-active nndiary-group-alist nndiary-active-file) | |
888 t)))) | |
889 | |
890 (deffoo nndiary-set-status (article name value &optional group server) | |
891 (nndiary-possibly-change-directory group server) | |
892 (let ((file (nndiary-article-to-file article))) | |
893 (cond | |
894 ((not (file-exists-p file)) | |
895 (nnheader-report 'nndiary "File %s does not exist" file)) | |
896 (t | |
897 (with-temp-file file | |
898 (nnheader-insert-file-contents file) | |
899 (nnmail-replace-status name value)) | |
900 t)))) | |
901 | |
902 | |
903 ;;; Interface optional functions ============================================ | |
904 | |
905 (deffoo nndiary-request-update-info (group info &optional server) | |
906 (nndiary-possibly-change-directory group) | |
907 (let ((timestamp (gnus-group-parameter-value (gnus-info-params info) | |
908 'timestamp t))) | |
909 (if (not timestamp) | |
910 (nnheader-report 'nndiary "Group %s doesn't have a timestamp" group) | |
911 ;; else | |
912 ;; Figure out which articles should be re-new'ed | |
913 (let ((articles (nndiary-flatten (gnus-info-read info) 0)) | |
914 article file unread buf) | |
915 (save-excursion | |
916 (setq buf (nnheader-set-temp-buffer " *nndiary update*")) | |
917 (while (setq article (pop articles)) | |
918 (setq file (concat nndiary-current-directory | |
919 (int-to-string article))) | |
920 (and (file-exists-p file) | |
921 (nndiary-renew-article-p file timestamp) | |
922 (push article unread))) | |
923 ;;(message "unread: %s" unread) | |
924 (sit-for 1) | |
925 (kill-buffer buf)) | |
926 (setq unread (sort unread '<)) | |
927 (and unread | |
928 (gnus-info-set-read info (gnus-update-read-articles | |
929 (gnus-info-group info) unread t))) | |
930 )) | |
931 (run-hook-with-args 'nndiary-request-update-info-hooks | |
932 (gnus-info-group info)) | |
933 t)) | |
934 | |
935 | |
936 | |
937 ;;; Internal functions ====================================================== | |
938 | |
939 (defun nndiary-article-to-file (article) | |
940 (nndiary-update-file-alist) | |
941 (let (file) | |
942 (if (setq file (cdr (assq article nndiary-article-file-alist))) | |
943 (expand-file-name file nndiary-current-directory) | |
944 ;; Just to make sure nothing went wrong when reading over NFS -- | |
945 ;; check once more. | |
946 (if nndiary-check-directory-twice | |
947 (when (file-exists-p | |
948 (setq file (expand-file-name (number-to-string article) | |
949 nndiary-current-directory))) | |
950 (nndiary-update-file-alist t) | |
951 file))))) | |
952 | |
953 (defun nndiary-deletable-article-p (group article) | |
954 "Say whether ARTICLE in GROUP can be deleted." | |
955 (let (path) | |
956 (when (setq path (nndiary-article-to-file article)) | |
957 (when (file-writable-p path) | |
958 (or (not nnmail-keep-last-article) | |
959 (not (eq (cdr (nth 1 (assoc group nndiary-group-alist))) | |
960 article))))))) | |
961 | |
962 ;; Find an article number in the current group given the Message-ID. | |
963 (defun nndiary-find-group-number (id) | |
964 (save-excursion | |
965 (set-buffer (get-buffer-create " *nndiary id*")) | |
966 (let ((alist nndiary-group-alist) | |
967 number) | |
968 ;; We want to look through all .overview files, but we want to | |
969 ;; start with the one in the current directory. It seems most | |
970 ;; likely that the article we are looking for is in that group. | |
971 (if (setq number (nndiary-find-id nndiary-current-group id)) | |
972 (cons nndiary-current-group number) | |
973 ;; It wasn't there, so we look through the other groups as well. | |
974 (while (and (not number) | |
975 alist) | |
976 (or (string= (caar alist) nndiary-current-group) | |
977 (setq number (nndiary-find-id (caar alist) id))) | |
978 (or number | |
979 (setq alist (cdr alist)))) | |
980 (and number | |
981 (cons (caar alist) number)))))) | |
982 | |
983 (defun nndiary-find-id (group id) | |
984 (erase-buffer) | |
985 (let ((nov (expand-file-name nndiary-nov-file-name | |
986 (nnmail-group-pathname group | |
987 nndiary-directory))) | |
988 number found) | |
989 (when (file-exists-p nov) | |
990 (nnheader-insert-file-contents nov) | |
991 (while (and (not found) | |
992 (search-forward id nil t)) ; We find the ID. | |
993 ;; And the id is in the fourth field. | |
994 (if (not (and (search-backward "\t" nil t 4) | |
995 (not (search-backward"\t" (gnus-point-at-bol) t)))) | |
996 (forward-line 1) | |
997 (beginning-of-line) | |
998 (setq found t) | |
999 ;; We return the article number. | |
1000 (setq number | |
1001 (ignore-errors (read (current-buffer)))))) | |
1002 number))) | |
1003 | |
1004 (defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old) | |
1005 (if (or gnus-nov-is-evil nndiary-nov-is-evil) | |
1006 nil | |
1007 (let ((nov (expand-file-name nndiary-nov-file-name | |
1008 nndiary-current-directory))) | |
1009 (when (file-exists-p nov) | |
1010 (save-excursion | |
1011 (set-buffer nntp-server-buffer) | |
1012 (erase-buffer) | |
1013 (nnheader-insert-file-contents nov) | |
1014 (if (and fetch-old | |
1015 (not (numberp fetch-old))) | |
1016 t ; Don't remove anything. | |
1017 (nnheader-nov-delete-outside-range | |
1018 (if fetch-old (max 1 (- (car articles) fetch-old)) | |
1019 (car articles)) | |
1020 (car (last articles))) | |
1021 t)))))) | |
1022 | |
1023 (defun nndiary-possibly-change-directory (group &optional server) | |
1024 (when (and server | |
1025 (not (nndiary-server-opened server))) | |
1026 (nndiary-open-server server)) | |
1027 (if (not group) | |
1028 t | |
1029 (let ((pathname (nnmail-group-pathname group nndiary-directory)) | |
1030 (file-name-coding-system nnmail-pathname-coding-system)) | |
1031 (when (not (equal pathname nndiary-current-directory)) | |
1032 (setq nndiary-current-directory pathname | |
1033 nndiary-current-group group | |
1034 nndiary-article-file-alist nil)) | |
1035 (file-exists-p nndiary-current-directory)))) | |
1036 | |
1037 (defun nndiary-possibly-create-directory (group) | |
1038 (let ((dir (nnmail-group-pathname group nndiary-directory))) | |
1039 (unless (file-exists-p dir) | |
1040 (make-directory (directory-file-name dir) t) | |
1041 (nnheader-message 5 "Creating mail directory %s" dir)))) | |
1042 | |
1043 (defun nndiary-save-mail (group-art) | |
1044 "Called narrowed to an article." | |
1045 (let (chars headers) | |
1046 (setq chars (nnmail-insert-lines)) | |
1047 (nnmail-insert-xref group-art) | |
1048 (run-hooks 'nnmail-prepare-save-mail-hook) | |
1049 (run-hooks 'nndiary-prepare-save-mail-hook) | |
1050 (goto-char (point-min)) | |
1051 (while (looking-at "From ") | |
1052 (replace-match "X-From-Line: ") | |
1053 (forward-line 1)) | |
1054 ;; We save the article in all the groups it belongs in. | |
1055 (let ((ga group-art) | |
1056 first) | |
1057 (while ga | |
1058 (nndiary-possibly-create-directory (caar ga)) | |
1059 (let ((file (concat (nnmail-group-pathname | |
1060 (caar ga) nndiary-directory) | |
1061 (int-to-string (cdar ga))))) | |
1062 (if first | |
1063 ;; It was already saved, so we just make a hard link. | |
1064 (funcall nnmail-crosspost-link-function first file t) | |
1065 ;; Save the article. | |
1066 (nnmail-write-region (point-min) (point-max) file nil | |
1067 (if (nnheader-be-verbose 5) nil 'nomesg)) | |
1068 (setq first file))) | |
1069 (setq ga (cdr ga)))) | |
1070 ;; Generate a nov line for this article. We generate the nov | |
1071 ;; line after saving, because nov generation destroys the | |
1072 ;; header. | |
1073 (setq headers (nndiary-parse-head chars)) | |
1074 ;; Output the nov line to all nov databases that should have it. | |
1075 (let ((ga group-art)) | |
1076 (while ga | |
1077 (nndiary-add-nov (caar ga) (cdar ga) headers) | |
1078 (setq ga (cdr ga)))) | |
1079 group-art)) | |
1080 | |
1081 (defun nndiary-active-number (group) | |
1082 "Compute the next article number in GROUP." | |
1083 (let ((active (cadr (assoc group nndiary-group-alist)))) | |
1084 ;; The group wasn't known to nndiary, so we just create an active | |
1085 ;; entry for it. | |
1086 (unless active | |
1087 ;; Perhaps the active file was corrupt? See whether | |
1088 ;; there are any articles in this group. | |
1089 (nndiary-possibly-create-directory group) | |
1090 (nndiary-possibly-change-directory group) | |
1091 (unless nndiary-article-file-alist | |
1092 (setq nndiary-article-file-alist | |
1093 (sort | |
1094 (nnheader-article-to-file-alist nndiary-current-directory) | |
1095 'car-less-than-car))) | |
1096 (setq active | |
1097 (if nndiary-article-file-alist | |
1098 (cons (caar nndiary-article-file-alist) | |
1099 (caar (last nndiary-article-file-alist))) | |
1100 (cons 1 0))) | |
1101 (push (list group active) nndiary-group-alist)) | |
1102 (setcdr active (1+ (cdr active))) | |
1103 (while (file-exists-p | |
1104 (expand-file-name (int-to-string (cdr active)) | |
1105 (nnmail-group-pathname group nndiary-directory))) | |
1106 (setcdr active (1+ (cdr active)))) | |
1107 (cdr active))) | |
1108 | |
1109 (defun nndiary-add-nov (group article headers) | |
1110 "Add a nov line for the GROUP base." | |
1111 (save-excursion | |
1112 (set-buffer (nndiary-open-nov group)) | |
1113 (goto-char (point-max)) | |
1114 (mail-header-set-number headers article) | |
1115 (nnheader-insert-nov headers))) | |
1116 | |
1117 (defsubst nndiary-header-value () | |
1118 (buffer-substring (match-end 0) (progn (end-of-line) (point)))) | |
1119 | |
1120 (defun nndiary-parse-head (chars &optional number) | |
1121 "Parse the head of the current buffer." | |
1122 (save-excursion | |
1123 (save-restriction | |
1124 (unless (zerop (buffer-size)) | |
1125 (narrow-to-region | |
1126 (goto-char (point-min)) | |
1127 (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) | |
1128 (let ((headers (nnheader-parse-naked-head))) | |
1129 (mail-header-set-chars headers chars) | |
1130 (mail-header-set-number headers number) | |
1131 headers)))) | |
1132 | |
1133 (defun nndiary-open-nov (group) | |
1134 (or (cdr (assoc group nndiary-nov-buffer-alist)) | |
1135 (let ((buffer (get-buffer-create (format " *nndiary overview %s*" | |
1136 group)))) | |
1137 (save-excursion | |
1138 (set-buffer buffer) | |
1139 (set (make-local-variable 'nndiary-nov-buffer-file-name) | |
1140 (expand-file-name | |
1141 nndiary-nov-file-name | |
1142 (nnmail-group-pathname group nndiary-directory))) | |
1143 (erase-buffer) | |
1144 (when (file-exists-p nndiary-nov-buffer-file-name) | |
1145 (nnheader-insert-file-contents nndiary-nov-buffer-file-name))) | |
1146 (push (cons group buffer) nndiary-nov-buffer-alist) | |
1147 buffer))) | |
1148 | |
1149 (defun nndiary-save-nov () | |
1150 (save-excursion | |
1151 (while nndiary-nov-buffer-alist | |
1152 (when (buffer-name (cdar nndiary-nov-buffer-alist)) | |
1153 (set-buffer (cdar nndiary-nov-buffer-alist)) | |
1154 (when (buffer-modified-p) | |
1155 (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name | |
1156 nil 'nomesg)) | |
1157 (set-buffer-modified-p nil) | |
1158 (kill-buffer (current-buffer))) | |
1159 (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist))))) | |
1160 | |
1161 ;;;###autoload | |
1162 (defun nndiary-generate-nov-databases (&optional server) | |
1163 "Generate NOV databases in all nndiary directories." | |
1164 (interactive (list (or (nnoo-current-server 'nndiary) ""))) | |
1165 ;; Read the active file to make sure we don't re-use articles | |
1166 ;; numbers in empty groups. | |
1167 (nnmail-activate 'nndiary) | |
1168 (unless (nndiary-server-opened server) | |
1169 (nndiary-open-server server)) | |
1170 (setq nndiary-directory (expand-file-name nndiary-directory)) | |
1171 ;; Recurse down the directories. | |
1172 (nndiary-generate-nov-databases-1 nndiary-directory nil t) | |
1173 ;; Save the active file. | |
1174 (nnmail-save-active nndiary-group-alist nndiary-active-file)) | |
1175 | |
1176 (defun nndiary-generate-nov-databases-1 (dir &optional seen no-active) | |
1177 "Regenerate the NOV database in DIR." | |
1178 (interactive "DRegenerate NOV in: ") | |
1179 (setq dir (file-name-as-directory dir)) | |
1180 ;; Only scan this sub-tree if we haven't been here yet. | |
1181 (unless (member (file-truename dir) seen) | |
1182 (push (file-truename dir) seen) | |
1183 ;; We descend recursively | |
1184 (let ((dirs (directory-files dir t nil t)) | |
1185 dir) | |
1186 (while (setq dir (pop dirs)) | |
1187 (when (and (not (string-match "^\\." (file-name-nondirectory dir))) | |
1188 (file-directory-p dir)) | |
1189 (nndiary-generate-nov-databases-1 dir seen)))) | |
1190 ;; Do this directory. | |
1191 (let ((files (sort (nnheader-article-to-file-alist dir) | |
1192 'car-less-than-car))) | |
1193 (if (not files) | |
1194 (let* ((group (nnheader-file-to-group | |
1195 (directory-file-name dir) nndiary-directory)) | |
1196 (info (cadr (assoc group nndiary-group-alist)))) | |
1197 (when info | |
1198 (setcar info (1+ (cdr info))))) | |
1199 (funcall nndiary-generate-active-function dir) | |
1200 ;; Generate the nov file. | |
1201 (nndiary-generate-nov-file dir files) | |
1202 (unless no-active | |
1203 (nnmail-save-active nndiary-group-alist nndiary-active-file)))))) | |
1204 | |
1205 (eval-when-compile (defvar files)) | |
1206 (defun nndiary-generate-active-info (dir) | |
1207 ;; Update the active info for this group. | |
1208 (let* ((group (nnheader-file-to-group | |
1209 (directory-file-name dir) nndiary-directory)) | |
1210 (entry (assoc group nndiary-group-alist)) | |
1211 (last (or (caadr entry) 0))) | |
1212 (setq nndiary-group-alist (delq entry nndiary-group-alist)) | |
1213 (push (list group | |
1214 (cons (or (caar files) (1+ last)) | |
1215 (max last | |
1216 (or (let ((f files)) | |
1217 (while (cdr f) (setq f (cdr f))) | |
1218 (caar f)) | |
1219 0)))) | |
1220 nndiary-group-alist))) | |
1221 | |
1222 (defun nndiary-generate-nov-file (dir files) | |
1223 (let* ((dir (file-name-as-directory dir)) | |
1224 (nov (concat dir nndiary-nov-file-name)) | |
1225 (nov-buffer (get-buffer-create " *nov*")) | |
1226 chars file headers) | |
1227 (save-excursion | |
1228 ;; Init the nov buffer. | |
1229 (set-buffer nov-buffer) | |
1230 (buffer-disable-undo) | |
1231 (erase-buffer) | |
1232 (set-buffer nntp-server-buffer) | |
1233 ;; Delete the old NOV file. | |
1234 (when (file-exists-p nov) | |
1235 (funcall nnmail-delete-file-function nov)) | |
1236 (while files | |
1237 (unless (file-directory-p (setq file (concat dir (cdar files)))) | |
1238 (erase-buffer) | |
1239 (nnheader-insert-file-contents file) | |
1240 (narrow-to-region | |
1241 (goto-char (point-min)) | |
1242 (progn | |
1243 (search-forward "\n\n" nil t) | |
1244 (setq chars (- (point-max) (point))) | |
1245 (max 1 (1- (point))))) | |
1246 (unless (zerop (buffer-size)) | |
1247 (goto-char (point-min)) | |
1248 (setq headers (nndiary-parse-head chars (caar files))) | |
1249 (save-excursion | |
1250 (set-buffer nov-buffer) | |
1251 (goto-char (point-max)) | |
1252 (nnheader-insert-nov headers))) | |
1253 (widen)) | |
1254 (setq files (cdr files))) | |
1255 (save-excursion | |
1256 (set-buffer nov-buffer) | |
1257 (nnmail-write-region 1 (point-max) nov nil 'nomesg) | |
1258 (kill-buffer (current-buffer)))))) | |
1259 | |
1260 (defun nndiary-nov-delete-article (group article) | |
1261 (save-excursion | |
1262 (set-buffer (nndiary-open-nov group)) | |
1263 (when (nnheader-find-nov-line article) | |
1264 (delete-region (point) (progn (forward-line 1) (point))) | |
1265 (when (bobp) | |
1266 (let ((active (cadr (assoc group nndiary-group-alist))) | |
1267 num) | |
1268 (when active | |
1269 (if (eobp) | |
1270 (setf (car active) (1+ (cdr active))) | |
1271 (when (and (setq num (ignore-errors (read (current-buffer)))) | |
1272 (numberp num)) | |
1273 (setf (car active) num))))))) | |
1274 t)) | |
1275 | |
1276 (defun nndiary-update-file-alist (&optional force) | |
1277 (when (or (not nndiary-article-file-alist) | |
1278 force) | |
1279 (setq nndiary-article-file-alist | |
1280 (nnheader-article-to-file-alist nndiary-current-directory)))) | |
1281 | |
1282 | |
1283 (defun nndiary-string-to-int (str min &optional max) | |
1284 ;; Like `string-to-int' but barf if STR is not exactly an integer, and not | |
1285 ;; within the specified bounds. | |
1286 ;; Signals are caught by `nndiary-schedule'. | |
1287 (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str)) | |
1288 (nndiary-error "not an integer value") | |
1289 ;; else | |
1290 (let ((val (string-to-int str))) | |
1291 (and (or (< val min) | |
1292 (and max (> val max))) | |
1293 (nndiary-error "value out of range")) | |
1294 val))) | |
1295 | |
1296 (defun nndiary-parse-schedule-value (str min-or-values max) | |
1297 ;; Parse the schedule string STR, or signal an error. | |
1298 ;; Signals are caught by `nndary-schedule'. | |
1299 (if (string-match "[ \t]*\\*[ \t]*" str) | |
1300 ;; unspecifyed | |
1301 nil | |
1302 ;; specifyed | |
1303 (if (listp min-or-values) | |
1304 ;; min-or-values is values | |
1305 ;; #### NOTE: this is actually only a hack for time zones. | |
1306 (let ((val (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" str) | |
1307 (match-string 1 str)))) | |
1308 (if (and val (setq val (assoc val min-or-values))) | |
1309 (list (cadr val)) | |
1310 (nndiary-error "invalid syntax"))) | |
1311 ;; min-or-values is min | |
1312 (mapcar | |
1313 (lambda (val) | |
1314 (let ((res (split-string val "-"))) | |
1315 (cond | |
1316 ((= (length res) 1) | |
1317 (nndiary-string-to-int (car res) min-or-values max)) | |
1318 ((= (length res) 2) | |
1319 ;; don't know if crontab accepts this, but ensure | |
1320 ;; that BEG is <= END | |
1321 (let ((beg (nndiary-string-to-int (car res) min-or-values max)) | |
1322 (end (nndiary-string-to-int (cadr res) min-or-values max))) | |
1323 (cond ((< beg end) | |
1324 (cons beg end)) | |
1325 ((= beg end) | |
1326 beg) | |
1327 (t | |
1328 (cons end beg))))) | |
1329 (t | |
1330 (nndiary-error "invalid syntax"))) | |
1331 )) | |
1332 (split-string str ","))) | |
1333 )) | |
1334 | |
1335 ;; ### FIXME: remove this function if it's used only once. | |
1336 (defun nndiary-parse-schedule (head min-or-values max) | |
1337 ;; Parse the cron-like value of header X-Diary-HEAD in current buffer. | |
1338 ;; - Returns nil if `*' | |
1339 ;; - Otherwise returns a list of integers and/or ranges (BEG . END) | |
1340 ;; The exception is the Timze-Zone value which is always of the form (STR). | |
1341 ;; Signals are caught by `nndary-schedule'. | |
1342 (let ((header (format "^X-Diary-%s: \\(.*\\)$" head))) | |
1343 (goto-char (point-min)) | |
1344 (if (not (re-search-forward header nil t)) | |
1345 (nndiary-error "header missing") | |
1346 ;; else | |
1347 (nndiary-parse-schedule-value (match-string 1) min-or-values max)) | |
1348 )) | |
1349 | |
1350 (defun nndiary-max (spec) | |
1351 ;; Returns the max of specification SPEC, or nil for permanent schedules. | |
1352 (unless (null spec) | |
1353 (let ((elts spec) | |
1354 (max 0) | |
1355 elt) | |
1356 (while (setq elt (pop elts)) | |
1357 (if (integerp elt) | |
1358 (and (> elt max) (setq max elt)) | |
1359 (and (> (cdr elt) max) (setq max (cdr elt))))) | |
1360 max))) | |
1361 | |
1362 (defun nndiary-flatten (spec min &optional max) | |
1363 ;; flatten the spec by expanding ranges to all possible values. | |
1364 (let (flat n) | |
1365 (cond ((null spec) | |
1366 ;; this happens when I flatten something else than one of my | |
1367 ;; schedules (a list of read articles for instance). | |
1368 (unless (null max) | |
1369 (setq n min) | |
1370 (while (<= n max) | |
1371 (push n flat) | |
1372 (setq n (1+ n))))) | |
1373 (t | |
1374 (let ((elts spec) | |
1375 elt) | |
1376 (while (setq elt (pop elts)) | |
1377 (if (integerp elt) | |
1378 (push elt flat) | |
1379 ;; else | |
1380 (setq n (car elt)) | |
1381 (while (<= n (cdr elt)) | |
1382 (push n flat) | |
1383 (setq n (1+ n)))))))) | |
1384 flat)) | |
1385 | |
1386 (defun nndiary-unflatten (spec) | |
1387 ;; opposite of flatten: build ranges if possible | |
1388 (setq spec (sort spec '<)) | |
1389 (let (min max res) | |
1390 (while (setq min (pop spec)) | |
1391 (setq max min) | |
1392 (while (and (car spec) (= (car spec) (1+ max))) | |
1393 (setq max (1+ max)) | |
1394 (pop spec)) | |
1395 (if (= max min) | |
1396 (setq res (append res (list min))) | |
1397 (setq res (append res (list (cons min max)))))) | |
1398 res)) | |
1399 | |
1400 (defun nndiary-compute-reminders (date) | |
1401 ;; Returns a list of times corresponding to the reminders of date DATE. | |
1402 ;; See the comment in `nndiary-reminders' about rounding. | |
1403 (let* ((reminders nndiary-reminders) | |
1404 (date-elts (decode-time date)) | |
1405 ;; ### NOTE: out-of-range values are accepted by encode-time. This | |
1406 ;; makes our life easier. | |
1407 (monday (- (nth 3 date-elts) | |
1408 (if nndiary-week-starts-on-monday | |
1409 (if (zerop (nth 6 date-elts)) | |
1410 6 | |
1411 (- (nth 6 date-elts) 1)) | |
1412 (nth 6 date-elts)))) | |
1413 reminder res) | |
1414 ;; remove the DOW and DST entries | |
1415 (setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts)) | |
1416 (while (setq reminder (pop reminders)) | |
1417 (push | |
1418 (cond ((eq (cdr reminder) 'minute) | |
1419 (subtract-time | |
1420 (apply 'encode-time 0 (nthcdr 1 date-elts)) | |
1421 (seconds-to-time (* (car reminder) 60.0)))) | |
1422 ((eq (cdr reminder) 'hour) | |
1423 (subtract-time | |
1424 (apply 'encode-time 0 0 (nthcdr 2 date-elts)) | |
1425 (seconds-to-time (* (car reminder) 3600.0)))) | |
1426 ((eq (cdr reminder) 'day) | |
1427 (subtract-time | |
1428 (apply 'encode-time 0 0 0 (nthcdr 3 date-elts)) | |
1429 (seconds-to-time (* (car reminder) 86400.0)))) | |
1430 ((eq (cdr reminder) 'week) | |
1431 (subtract-time | |
1432 (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts)) | |
1433 (seconds-to-time (* (car reminder) 604800.0)))) | |
1434 ((eq (cdr reminder) 'month) | |
1435 (subtract-time | |
1436 (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts)) | |
1437 (seconds-to-time (* (car reminder) 18748800.0)))) | |
1438 ((eq (cdr reminder) 'year) | |
1439 (subtract-time | |
1440 (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) | |
1441 (seconds-to-time (* (car reminder) 400861056.0))))) | |
1442 res)) | |
1443 (sort res 'time-less-p))) | |
1444 | |
1445 (defun nndiary-last-occurence (sched) | |
1446 ;; Returns the last occurence of schedule SCHED as an Emacs time struct, or | |
1447 ;; nil for permanent schedule or errors. | |
1448 (let ((minute (nndiary-max (nth 0 sched))) | |
1449 (hour (nndiary-max (nth 1 sched))) | |
1450 (year (nndiary-max (nth 4 sched))) | |
1451 (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) | |
1452 (current-time-zone)))) | |
1453 (when year | |
1454 (or minute (setq minute 59)) | |
1455 (or hour (setq hour 23)) | |
1456 ;; I'll just compute all possible values and test them by decreasing | |
1457 ;; order until one succeeds. This is probably quide rude, but I got | |
1458 ;; bored in finding a good algorithm for doing that ;-) | |
1459 ;; ### FIXME: remove identical entries. | |
1460 (let ((dom-list (nth 2 sched)) | |
1461 (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>)) | |
1462 (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>)) | |
1463 (dow-list (nth 5 sched))) | |
1464 ;; Special case: an asterisk in one of the days specifications means | |
1465 ;; that only the other should be taken into account. If both are | |
1466 ;; unspecified, you would get all possible days in both. | |
1467 (cond ((null dow-list) | |
1468 ;; this gets all days if dom-list is nil | |
1469 (setq dom-list (nndiary-flatten dom-list 1 31))) | |
1470 ((null dom-list) | |
1471 ;; this also gets all days if dow-list is nil | |
1472 (setq dow-list (nndiary-flatten dow-list 0 6))) | |
1473 (t | |
1474 (setq dom-list (nndiary-flatten dom-list 1 31)) | |
1475 (setq dow-list (nndiary-flatten dow-list 0 6)))) | |
1476 (or | |
1477 (catch 'found | |
1478 (while (setq year (pop year-list)) | |
1479 (let ((months month-list) | |
1480 month) | |
1481 (while (setq month (pop months)) | |
1482 ;; Now we must merge the Dows with the Doms. To do that, we | |
1483 ;; have to know which day is the 1st one for this month. | |
1484 ;; Maybe there's simpler, but decode-time(encode-time) will | |
1485 ;; give us the answer. | |
1486 (let ((first (nth 6 (decode-time | |
1487 (encode-time 0 0 0 1 month year | |
1488 time-zone)))) | |
1489 (max (cond ((= month 2) | |
1490 (if (date-leap-year-p year) 29 28)) | |
1491 ((<= month 7) | |
1492 (if (zerop (% month 2)) 30 31)) | |
1493 (t | |
1494 (if (zerop (% month 2)) 31 30)))) | |
1495 (doms dom-list) | |
1496 (dows dow-list) | |
1497 day days) | |
1498 ;; first, review the doms to see if they are valid. | |
1499 (while (setq day (pop doms)) | |
1500 (and (<= day max) | |
1501 (push day days))) | |
1502 ;; second add all possible dows | |
1503 (while (setq day (pop dows)) | |
1504 ;; days start at 1. | |
1505 (setq day (1+ (- day first))) | |
1506 (and (< day 0) (setq day (+ 7 day))) | |
1507 (while (<= day max) | |
1508 (push day days) | |
1509 (setq day (+ 7 day)))) | |
1510 ;; Finally, if we have some days, they are valid | |
1511 (when days | |
1512 (sort days '>) | |
1513 (throw 'found | |
1514 (encode-time 0 minute hour | |
1515 (car days) month year time-zone))) | |
1516 ))))) | |
1517 ;; There's an upper limit, but we didn't find any last occurence. | |
1518 ;; This means that the schedule is undecidable. This can happen if | |
1519 ;; you happen to say something like "each Feb 31 until 2038". | |
1520 (progn | |
1521 (nnheader-report 'nndiary "Undecidable schedule") | |
1522 nil)) | |
1523 )))) | |
1524 | |
1525 (defun nndiary-next-occurence (sched now) | |
1526 ;; Returns the next occurence of schedule SCHED, starting from time NOW. | |
1527 ;; If there's no next occurence, returns the last one (if any) which is then | |
1528 ;; in the past. | |
1529 (let* ((today (decode-time now)) | |
1530 (this-minute (nth 1 today)) | |
1531 (this-hour (nth 2 today)) | |
1532 (this-day (nth 3 today)) | |
1533 (this-month (nth 4 today)) | |
1534 (this-year (nth 5 today)) | |
1535 (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<)) | |
1536 (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<)) | |
1537 (dom-list (nth 2 sched)) | |
1538 (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<)) | |
1539 (years (if (nth 4 sched) | |
1540 (sort (nndiary-flatten (nth 4 sched) 1971) '<) | |
1541 t)) | |
1542 (dow-list (nth 5 sched)) | |
1543 (year (1- this-year)) | |
1544 (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) | |
1545 (current-time-zone)))) | |
1546 ;; Special case: an asterisk in one of the days specifications means that | |
1547 ;; only the other should be taken into account. If both are unspecified, | |
1548 ;; you would get all possible days in both. | |
1549 (cond ((null dow-list) | |
1550 ;; this gets all days if dom-list is nil | |
1551 (setq dom-list (nndiary-flatten dom-list 1 31))) | |
1552 ((null dom-list) | |
1553 ;; this also gets all days if dow-list is nil | |
1554 (setq dow-list (nndiary-flatten dow-list 0 6))) | |
1555 (t | |
1556 (setq dom-list (nndiary-flatten dom-list 1 31)) | |
1557 (setq dow-list (nndiary-flatten dow-list 0 6)))) | |
1558 ;; Remove past years. | |
1559 (unless (eq years t) | |
1560 (while (and (car years) (< (car years) this-year)) | |
1561 (pop years))) | |
1562 (if years | |
1563 ;; Because we might not be limited in years, we must guard against | |
1564 ;; infinite loops. Appart from cases like Feb 31, there are probably | |
1565 ;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to | |
1566 ;; decide this, so I assume that if we reach 10 years later, the | |
1567 ;; schedule is undecidable. | |
1568 (or | |
1569 (catch 'found | |
1570 (while (if (eq years t) | |
1571 (and (setq year (1+ year)) | |
1572 (<= year (+ 10 this-year))) | |
1573 (setq year (pop years))) | |
1574 (let ((months month-list) | |
1575 month) | |
1576 ;; Remove past months for this year. | |
1577 (and (= year this-year) | |
1578 (while (and (car months) (< (car months) this-month)) | |
1579 (pop months))) | |
1580 (while (setq month (pop months)) | |
1581 ;; Now we must merge the Dows with the Doms. To do that, we | |
1582 ;; have to know which day is the 1st one for this month. | |
1583 ;; Maybe there's simpler, but decode-time(encode-time) will | |
1584 ;; give us the answer. | |
1585 (let ((first (nth 6 (decode-time | |
1586 (encode-time 0 0 0 1 month year | |
1587 time-zone)))) | |
1588 (max (cond ((= month 2) | |
1589 (if (date-leap-year-p year) 29 28)) | |
1590 ((<= month 7) | |
1591 (if (zerop (% month 2)) 30 31)) | |
1592 (t | |
1593 (if (zerop (% month 2)) 31 30)))) | |
1594 (doms dom-list) | |
1595 (dows dow-list) | |
1596 day days) | |
1597 ;; first, review the doms to see if they are valid. | |
1598 (while (setq day (pop doms)) | |
1599 (and (<= day max) | |
1600 (push day days))) | |
1601 ;; second add all possible dows | |
1602 (while (setq day (pop dows)) | |
1603 ;; days start at 1. | |
1604 (setq day (1+ (- day first))) | |
1605 (and (< day 0) (setq day (+ 7 day))) | |
1606 (while (<= day max) | |
1607 (push day days) | |
1608 (setq day (+ 7 day)))) | |
1609 ;; Aaaaaaall right. Now we have a valid list of DAYS for | |
1610 ;; this month and this year. | |
1611 (when days | |
1612 (setq days (sort days '<)) | |
1613 ;; Remove past days for this year and this month. | |
1614 (and (= year this-year) | |
1615 (= month this-month) | |
1616 (while (and (car days) (< (car days) this-day)) | |
1617 (pop days))) | |
1618 (while (setq day (pop days)) | |
1619 (let ((hours hour-list) | |
1620 hour) | |
1621 ;; Remove past hours for this year, this month and | |
1622 ;; this day. | |
1623 (and (= year this-year) | |
1624 (= month this-month) | |
1625 (= day this-day) | |
1626 (while (and (car hours) | |
1627 (< (car hours) this-hour)) | |
1628 (pop hours))) | |
1629 (while (setq hour (pop hours)) | |
1630 (let ((minutes minute-list) | |
1631 minute) | |
1632 ;; Remove past hours for this year, this month, | |
1633 ;; this day and this hour. | |
1634 (and (= year this-year) | |
1635 (= month this-month) | |
1636 (= day this-day) | |
1637 (= hour this-hour) | |
1638 (while (and (car minutes) | |
1639 (< (car minutes) this-minute)) | |
1640 (pop minutes))) | |
1641 (while (setq minute (pop minutes)) | |
1642 ;; Ouch! Here, we've got a complete valid | |
1643 ;; schedule. It's a good one if it's in the | |
1644 ;; future. | |
1645 (let ((time (encode-time 0 minute hour day | |
1646 month year | |
1647 time-zone))) | |
1648 (and (time-less-p now time) | |
1649 (throw 'found time))) | |
1650 )))) | |
1651 )) | |
1652 ))) | |
1653 )) | |
1654 (nndiary-last-occurence sched)) | |
1655 ;; else | |
1656 (nndiary-last-occurence sched)) | |
1657 )) | |
1658 | |
1659 (defun nndiary-expired-article-p (file) | |
1660 (with-temp-buffer | |
1661 (if (nnheader-insert-head file) | |
1662 (let ((sched (nndiary-schedule))) | |
1663 ;; An article has expired if its last schedule (if any) is in the | |
1664 ;; past. A permanent schedule never expires. | |
1665 (and sched | |
1666 (setq sched (nndiary-last-occurence sched)) | |
1667 (time-less-p sched (current-time)))) | |
1668 ;; else | |
1669 (nnheader-report 'nndiary "Could not read file %s" file) | |
1670 nil) | |
1671 )) | |
1672 | |
1673 (defun nndiary-renew-article-p (file timestamp) | |
1674 (erase-buffer) | |
1675 (if (nnheader-insert-head file) | |
1676 (let ((now (current-time)) | |
1677 (sched (nndiary-schedule))) | |
1678 ;; The article should be re-considered as unread if there's a reminder | |
1679 ;; between the group timestamp and the current time. | |
1680 (when (and sched (setq sched (nndiary-next-occurence sched now))) | |
1681 (let ((reminders ;; add the next occurence itself at the end. | |
1682 (append (nndiary-compute-reminders sched) (list sched)))) | |
1683 (while (and reminders (time-less-p (car reminders) timestamp)) | |
1684 (pop reminders)) | |
1685 ;; The reminders might be empty if the last date is in the past, | |
1686 ;; or we've got at least the next occurence itself left. All past | |
1687 ;; dates are renewed. | |
1688 (or (not reminders) | |
1689 (time-less-p (car reminders) now))) | |
1690 )) | |
1691 ;; else | |
1692 (nnheader-report 'nndiary "Could not read file %s" file) | |
1693 nil)) | |
1694 | |
1695 ;; The end... =============================================================== | |
1696 | |
1697 (mapcar | |
1698 (lambda (elt) | |
1699 (let ((header (intern (format "X-Diary-%s" (car elt))))) | |
1700 ;; Required for building NOV databases and some other stuff | |
1701 (add-to-list 'gnus-extra-headers header) | |
1702 (add-to-list 'nnmail-extra-headers header))) | |
1703 nndiary-headers) | |
1704 | |
1705 (unless (assoc "nndiary" gnus-valid-select-methods) | |
1706 (gnus-declare-backend "nndiary" 'post-mail 'respool 'address)) | |
1707 | |
1708 (provide 'nndiary) | |
1709 | |
1710 | |
1711 ;;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203 | |
1712 ;;; nndiary.el ends here |