From: yamaoka Date: Mon, 10 Sep 2001 22:21:32 +0000 (+0000) Subject: Synch with Oort Gnus (includes TSUCHIYA-san's changes). X-Git-Tag: semi-gnus~24 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=61de10a008215b293ddae9e7f237517ea8e13f96;p=elisp%2Fgnus.git- Synch with Oort Gnus (includes TSUCHIYA-san's changes). --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4074cfe..4174904 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2001-09-10 TSUCHIYA Masatoshi + + * gnus-sum.el (gnus-select-newsgroup): Make + `gnus-current-select-method' buffer-local. + + * gnus-art.el (gnus-request-article-this-buffer): Refer + `gnus-current-select-method' in the current summary buffer. + +2001-09-10 Simon Josefsson + From Daniel Pittman + + * gnus-spec.el (gnus-correct-pad-form): Fix. + 2001-09-09 Simon Josefsson * mm-decode.el (mm-inline-media-tests): Add diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 2abe7a6..f1dd476 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -4894,7 +4894,9 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (setq gnus-override-method (pop methods))) (while (not result) (when (eq gnus-override-method 'current) - (setq gnus-override-method gnus-current-select-method)) + (setq gnus-override-method + (with-current-buffer gnus-summary-buffer + gnus-current-select-method))) (erase-buffer) (gnus-kill-all-overlays) (let ((gnus-newsgroup-name group)) diff --git a/lisp/gnus-diary.el b/lisp/gnus-diary.el new file mode 100644 index 0000000..27c2a50 --- /dev/null +++ b/lisp/gnus-diary.el @@ -0,0 +1,335 @@ +;;; gnus-diary.el --- Wrapper around the NNDiary Gnus backend + +;; Copyright (C) 1999 Didier Verna. + +;; PRCS: $Id: gnus-diary.el,v 1.1.2.1 2001-09-10 22:21:30 yamaoka Exp $ + +;; Author: Didier Verna +;; Maintainer: Didier Verna +;; Created: Tue Jul 20 10:42:55 1999 under XEmacs 21.2 (beta 18) +;; Last Revision: Wed Aug 8 14:38:14 2001 +;; Keywords: calendar mail news + +;; This file is part of NNDiary. + +;; NNDiary 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 2 of the License, or +;; (at your option) any later version. + +;; NNDiary 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 this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; Commentary: + +;; Contents management by FCM version 0.1. + +;; Description: +;; =========== + +;; Gnus-Diary is a wrapper around the NNDiary Gnus backend. It is here to +;; make your nndiary-user life easier in differnet ways. So, you don't have +;; to use it if you don't want to. But, really, you should. + +;; Gnus-Diary offers the following improvements on top of the NNDiary backend: + +;; - A nice summary line format: +;; Displaying diary messages in standard summary line format (usually +;; something like ": ") is pretty useless. Most of the +;; time, you're the one who wrote the message, and you mostly want to see +;; the event's date. Gnus-Diary offers you a nice summary line format which +;; will do this. By default, a summary line will appear like this: +;; +;; : +;; +;; for example, here's how Joe's birthday is displayed in my +;; "nndiary:birhdays" summary buffer (the message is expirable, but will +;; never be deleted, as it specifies a regular event): +;; +;; E Sat, Sep 22 01, 12:00: Joe's birthday (in 6 months, 1 week) + +;; - More article sorting functions: +;; Gnus-Diary adds a new sorting function called +;; `gnus-summary-sort-by-schedule'. This function lets you organize your +;; diary summary buffers from the closest event to the farthest one. + +;; - Automatic generation of diary group parameters: +;; When you create a new diary group, or visit one, Gnus-Diary checks your +;; group parameters, and if needed, sets the summary line format to the +;; diary-specific value, adds the diary-specific sorting functions, and +;; also adds the different `X-Diary-*' headers to the group's +;; posting-style. It is then easier to send a diary message, because if +;; you use `C-u a' or `C-u m' on a diary group to prepare a message, these +;; headers will be inserted automatically (but not filled with proper +;; values yet). + + +;; Usage: +;; ===== + +;; 0/ Don't use any `gnus-user-format-function-[d|D]'. Gnus-Diary provides +;; both of these (sorry if you used them before). +;; 1/ Add '(require 'gnus-diary) to your gnusrc file. +;; 2/ Customize your gnus-diary options to suit your needs. + + + +;; Bugs / Todo: +;; =========== + +;; * Provide `gnus-group-diary-mail' and `gnus-group-post-diary-news' (or +;; something like that), that would do just like `gnus-group-mail' and +;; `gnus-group-post-news', but also prompt for diary header values with +;; completion etc. +;; * Maybe not actually: we could just have a function that converts *any* +;; message to a diary one, by prompting the schedule. You could then forward +;; a message and make it a diary one etc. + +;;; Code: + +(require 'nndiary) + +(defgroup gnus-diary nil + "Utilities on top of the nndiary backend for Gnus.") + +(defcustom gnus-diary-summary-line-format "%U%R%z%I %uD: %(%s%) (%ud)\n" + "*Summary line format for nndiary groups." + :type 'string + :group 'gnus-diary + :group 'gnus-summary-format) + +(defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M" + "*Time format to display appointements in nndiary summary buffers. +Please refer to `format-time-string' for information on possible values." + :type 'string + :group 'gnus-diary) + +(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english + "*Function called to format a diary delay string. +It is passed two arguments. The first one is non nil if the delay is in +the past. The second one is of the form ((NUM . UNIT) ...) where NUM is +an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute. +It should return strings like \"In 2 months, 3 weeks\", \"3 hours, +1 minute ago\" and so on. + +There are currently two built-in format functions: +`gnus-diary-delay-format-english' (the default) +`gnus-diary-delay-format-french'" + :type '(choice (const :tag "english" gnus-diary-delay-format-english) + (const :tag "french" gnus-diary-delay-format-french) + (symbol :tag "other")) + :group 'gnus-diary) + +(defconst gnus-diary-version nndiary-version + "Current Diary backend version.") + + +;; Summary line format ====================================================== + +(defun gnus-diary-delay-format-french (past delay) + (if (null delay) + "maintenant!" + ;; Keep only a precision of two degrees + (and (> (length delay) 1) (setf (nthcdr 2 delay) nil)) + (concat (if past "il y a " "dans ") + (let ((str "") + del) + (while (setq del (pop delay)) + (setq str (concat str + (int-to-string (car del)) " " + (cond ((eq (cdr del) 'year) + "an") + ((eq (cdr del) 'month) + "mois") + ((eq (cdr del) 'week) + "semaine") + ((eq (cdr del) 'day) + "jour") + ((eq (cdr del) 'hour) + "heure") + ((eq (cdr del) 'minute) + "minute")) + (unless (or (eq (cdr del) 'month) + (= (car del) 1)) + "s") + (if delay ", ")))) + str)))) + + +(defun gnus-diary-delay-format-english (past delay) + (if (null delay) + "now!" + ;; Keep only a precision of two degrees + (and (> (length delay) 1) (setf (nthcdr 2 delay) nil)) + (concat (unless past "in ") + (let ((str "") + del) + (while (setq del (pop delay)) + (setq str (concat str + (int-to-string (car del)) " " + (symbol-name (cdr del)) + (and (> (car del) 1) "s") + (if delay ", ")))) + str) + (and past " ago")))) + + +(defun gnus-diary-header-schedule (headers) + ;; Same as `nndiary-schedule', but given a set of headers HEADERS + (mapcar + (lambda (elt) + (let ((head (cdr (assoc (intern (format "X-Diary-%s" (car elt))) + headers)))) + (when head + (nndiary-parse-schedule-value head (cadr elt) (caddr elt))))) + nndiary-headers)) + +;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any +;; message, with all fields set to nil here. I don't know what it is for, and +;; I just ignore it. +(defun gnus-user-format-function-d (header) + ;; Returns an aproximative delay string for the next occurence of this + ;; message. The delay is given only in the first non zero unit. + ;; Code partly stolen from article-make-date-line + (let* ((extras (mail-header-extra header)) + (sched (gnus-diary-header-schedule extras)) + (occur (nndiary-next-occurence sched (current-time))) + (now (current-time)) + (real-time (subtract-time occur now))) + (if (null real-time) + "?????" + (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time))) + (past (< sec 0)) + delay) + (and past (setq sec (- sec))) + (unless (zerop sec) + ;; This is a bit convoluted, but basically we go through the time + ;; units for years, weeks, etc, and divide things to see whether + ;; that results in positive answers. + (let ((units `((year . ,(* 365.25 24 3600)) + (month . ,(* 31 24 3600)) + (week . ,(* 7 24 3600)) + (day . ,(* 24 3600)) + (hour . 3600) + (minute . 60))) + unit num) + (while (setq unit (pop units)) + (unless (zerop (setq num (ffloor (/ sec (cdr unit))))) + (setq delay (append delay `((,(floor num) . ,(car unit)))))) + (setq sec (- sec (* num (cdr unit))))))) + (funcall gnus-diary-delay-format-function past delay))) + )) + +;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any +;; message, with all fields set to nil here. I don't know what it is for, and +;; I just ignore it. +(defun gnus-user-format-function-D (header) + ;; Returns a formatted time string for the next occurence of this message. + (let* ((extras (mail-header-extra header)) + (sched (gnus-diary-header-schedule extras)) + (occur (nndiary-next-occurence sched (current-time)))) + (format-time-string gnus-diary-time-format occur))) + + +;; Article sorting functions ================================================ + +(defun gnus-article-sort-by-schedule (h1 h2) + (let* ((now (current-time)) + (e1 (mail-header-extra h1)) + (e2 (mail-header-extra h2)) + (s1 (gnus-diary-header-schedule e1)) + (s2 (gnus-diary-header-schedule e2)) + (o1 (nndiary-next-occurence s1 now)) + (o2 (nndiary-next-occurence s2 now))) + (if (and (= (car o1) (car o2)) (= (cadr o1) (cadr o2))) + (< (mail-header-number h1) (mail-header-number h2)) + (time-less-p o1 o2)))) + + +(defun gnus-thread-sort-by-schedule (h1 h2) + (gnus-article-sort-by-schedule (gnus-thread-header h1) + (gnus-thread-header h2))) + +(defun gnus-summary-sort-by-schedule (&optional reverse) + "Sort nndiary summary buffers by schedule of appointements. +Optional prefix (or REVERSE argument) means sort in reverse order." + (interactive "P") + (gnus-summary-sort 'schedule reverse)) + +(add-hook 'gnus-summary-menu-hook + (lambda () + (easy-menu-add-item gnus-summary-misc-menu + '("Sort") + ["Sort by schedule" + gnus-summary-sort-by-schedule + (eq (car (gnus-find-method-for-group + gnus-newsgroup-name)) + 'nndiary)] + "Sort by number"))) + +;; Group parameters autosetting ============================================= + +(defun gnus-diary-update-group-parameters (group) + ;; Ensure that nndiary groups have convenient group parameters: + ;; - a posting style containing X-Diary headers + ;; - a nice summary line format + ;; - NNDiary specific sorting by schedule functions + ;; In general, try not to mess with what the user might have modified. + (let ((posting-style (gnus-group-get-parameter group 'posting-style t))) + ;; Posting style: + (mapcar (lambda (elt) + (let ((header (format "X-Diary-%s" (car elt)))) + (unless (assoc header posting-style) + (setq posting-style (append posting-style + `((,header "*"))))) + )) + nndiary-headers) + (gnus-group-set-parameter group 'posting-style posting-style) + ;; Summary line format: + (unless (gnus-group-get-parameter group 'gnus-summary-line-format t) + (gnus-group-set-parameter group 'gnus-summary-line-format + `(,gnus-diary-summary-line-format))) + ;; Sorting by schedule: + (unless (gnus-group-get-parameter group 'gnus-article-sort-functions) + (gnus-group-set-parameter group 'gnus-article-sort-functions + '((append gnus-article-sort-functions + (list + 'gnus-article-sort-by-schedule))))) + (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions) + (gnus-group-set-parameter group 'gnus-thread-sort-functions + '((append gnus-thread-sort-functions + (list + 'gnus-thread-sort-by-schedule))))) + )) + +;; Called when a group is subscribed. This is needed because groups created +;; because of mail splitting are *not* created with the backend function. +;; Thus, `nndiary-request-create-group-hooks' is inoperative. +(defun gnus-diary-maybe-update-group-parameters (group) + (when (eq (car (gnus-find-method-for-group group)) 'nndiary) + (gnus-diary-update-group-parameters group))) + +(add-hook 'nndiary-request-create-group-hooks + 'gnus-diary-update-group-parameters) +;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed +;; anymore. Maybe I should remove this completely. +(add-hook 'nndiary-request-update-info-hooks + 'gnus-diary-update-group-parameters) +(add-hook 'gnus-subscribe-newsgroup-hooks + 'gnus-diary-maybe-update-group-parameters) + +(defun gnus-diary-version () + "Current Diary backend version." + (interactive) + (message "NNDiary version %s" nndiary-version)) + +(provide 'gnus-diary) + +;;; gnus-diary.el ends here diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index a4cb769..7e21fb9 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -408,16 +408,21 @@ "Return a form that pads EL to PAD-WIDTH accounting for multi-column characters correctly. This is because `format' may pad to columns or to characters when given a pad value." - (let ((pad (abs pad-width))) + (let ((pad (abs pad-width)) + (side (< 0 pad-width))) (if (symbolp el) `(let ((need (- ,pad (gnus-correct-length ,el)))) (if (> need 0) - (concat ,el (make-string need ?\ )) + (concat ,(when side '(make-string need ?\ )) + ,el + ,(when (not side) '(make-string need ?\ ))) ,el)) `(let* ((val (eval ,el)) (need (- ,pad (gnus-correct-length ,el)))) (if (> need 0) - (concat ,el (make-string need ?\ )) + (concat ,(when side '(make-string need ?\ )) + ,el + ,(when (not side) '(make-string need ?\ ))) ,el))))) (defun gnus-parse-format (format spec-alist &optional insert) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index b00c1d6..aba444f 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -4542,8 +4542,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." articles fetched-articles cached) (unless (gnus-check-server - (setq gnus-current-select-method - (gnus-find-method-for-group group))) + (set (make-local-variable 'gnus-current-select-method) + (gnus-find-method-for-group group))) (error "Couldn't open server")) (or (and entry (not (eq (car entry) t))) ; Either it's active... diff --git a/lisp/nndiary.el b/lisp/nndiary.el new file mode 100644 index 0000000..d451324 --- /dev/null +++ b/lisp/nndiary.el @@ -0,0 +1,1713 @@ +;;; nndiary.el --- A diary backend for Gnus + +;; Copyright (C) 1999-2001 Didier Verna. + +;; PRCS: $Id: nndiary.el,v 1.1.2.1 2001-09-10 22:21:32 yamaoka Exp $ + +;; Author: Didier Verna +;; Maintainer: Didier Verna +;; Created: Fri Jul 16 18:55:42 1999 +;; Last Revision: Wed Aug 8 17:36:21 2001 +;; Keywords: calendar mail news + +;; This file is part of NNDiary. + +;; NNDiary 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 2 of the License, or +;; (at your option) any later version. + +;; NNDiary 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 this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; Commentary: + +;; Contents management by FCM version 0.1. + +;; Description: +;; =========== + +;; This package implements NNDiary, a diary backend for Gnus. NNDiary is a +;; mail backend, pretty similar to nnml in its functionnning (it has all the +;; features of nnml, actually), but in which messages are treated as event +;; reminders. + +;; Here is a typical scenario: +;; - You've got a date with Andy Mc Dowell or Bruce Willis (select according +;; to your sexual preference) in one month. You don't want to forget it. +;; - Send a (special) diary message to yourself (see below). +;; - Forget all about it and keep on getting and reading new mail, as usual. +;; - From time to time, as you type `g' in the group buffer and as the date +;; is getting closer, the message will pop up again, just like if it were +;; new and unread. +;; - Read your "new" messages, this one included, and start dreaming of the +;; night you're gonna have. +;; - Once the date is over (you actually fell asleep just after dinner), the +;; message will be automatically deleted if it is marked as expirable. + +;; Some more notes on the diary backend: +;; - NNDiary is a *real* mail backend. You *really* send real diary +;; messsages. This means for instance that you can give appointements to +;; anybody (provided they use Gnus and NNDiary) by sending the diary message +;; to them as well. +;; - However, since NNDiary also has a 'request-post method, you can also +;; `C-u a' instead of `C-u m' on a diary group and the message won't actually +;; be sent; just stored in the group. +;; - The events you want to remember need not be punctual. You can set up +;; reminders for regular dates (like once each week, each monday at 13:30 +;; and so on). Diary messages of this kind will never be deleted (unless +;; you do it explicitely). But that, you guessed. + + +;; Usage: +;; ===== + +;; 1/ Diary messages contain several `X-Diary-*' special headers. You *must* +;; arrange that these messages be split in a private folder *before* Gnus +;; treat them. You need this because Gnus is not able yet to manage +;; multiple backends for mail retrieval. Getting them from a separate +;; source will compensate this misfeature to some extent, as we will see. +;; As an example, here's my procmailrc entry to store diary files in +;; ~/.nndiary (the default nndiary mail source file): +;; +;; :0 HD : +;; * ^X-Diary +;; .nndiary +;; +;; 2/ Install nndiary somewhere Emacs / Gnus can find it. Normally, you +;; *don't* have to '(require 'nndiary) anywhere. Gnus will do so when +;; appropriate as long as nndiary is somewhere in the load path. +;; 3/ Now, customize nndiary: type `M-x customize-group', and then `nndiary' +;; at the prompt (note that if you have not restarted Emacs yet, you'll +;; have to the load the library by hand before being able to customize it). +;; In particular, you should customize the following options: +;; - `nndiary-mail-sources', which overrides the normal `mail-sources' +;; value for diary messages retrieving. It defaults to +;; '(file :path "~/.nndiary"). +;; - `nndiary-split-methods', which overrides the normal +;; `nnmail-split-methods' value for diary messages splitting. You can +;; have all the diary groups you want (for example, I have a birthdays +;; group, and stuff like that). +;; - `nndiary-reminders', the list of times when you want to be reminded +;; of your appointements (e.g. 3 weeks before, then 2 days before, then +;; 1 hour before and that's it). +;; 4/ You *must* use the group timestamp feature of Gnus. This adds a +;; timestamp to each groups' parameters (please refer to the Gnus +;; documentation ("Group Timestamp" info node) to see how it's done. +;; 5/ Once you have done this, you may add a permanent nndiary virtual server +;; (something like '(nndiary "")) to your `gnus-secondary-select-methods'. +;; Yes, this server will be able to retrieve mails and split them when you +;; type `g' in the group buffer, just as if it were your only mail backend. +;; This is the benefit of using a private folder. +;; 6/ Hopefully, almost everything (see the TODO section below) will work as +;; expected when you restart Gnus: in the group buffer, `g' and `M-g' will +;; also get your new diary mails, `F' will find your new diary groups etc. + + +;; How to send diary messages: +;; ========================== + +;; There are 7 special headers in diary messages. These headers are of the +;; form `X-Diary-', the being one of `Minute', `Hour', +;; `Dom', `Month', `Year', `Time-Zone' and `Dow'. `Dom' means "Day of Month", +;; and `dow' means "Day of Week". These headers actually behave like crontab +;; specifications and define the event date(s). + +;; For all headers but the `Time-Zone' one, a header value is either a +;; star (meaning all possible values), or a list of fields (separated by a +;; comma). A field is either an integer, or a range. A range is two integers +;; separated by a dash. Possible integer values are 0-59 for `Minute', 0-23 +;; for `Hour', 1-31 for `Dom', `1-12' for Month, above 1971 for `Year' and 0-6 +;; for `Dow' (0 = sunday). As a special case, a star in either `Dom' or `Dow' +;; doesn't mean "all possible values", but "use only the other field". Note +;; that if both are star'ed, the use of either one gives the same result :-), + +;; The `Time-Zone' header is special in that it can have only one value (you +;; bet ;-). +;; A star doesn't mean "all possible values" (because it has no sense), but +;; "the current local time zone". + +;; As an example, here's how you would say "Each Monday and each 1st of month, +;; at 12:00, 20:00, 21:00, 22:00, 23:00 and 24:00, from 1999 to 2010" (I let +;; you find what to do then): +;; +;; X-Diary-Minute: 0 +;; X-Diary-Hour: 12, 20-24 +;; X-Diary-Dom: 1 +;; X-Diary-Month: * +;; X-Diary-Year: 1999-2010 +;; X-Diary-Dow: 1 +;; X-Diary-Time-Zone: * +;; +;; +;; Sending a diary message is not different from sending any other kind of +;; mail, except that such messages are identified by the presence of these +;; special headers. + + + +;; Bugs / Todo: +;; =========== + +;; * Respooling doesn't work because contrary to the request-scan function, +;; Gnus won't allow me to override the split methods when calling the +;; respooling backend functions. +;; * The time zone mechanism is subject to change. +;; * We could allow a keyword like `ask' in X-Diary-* headers, that would mean +;; "ask for value upon reception of the message". Suggested by Jody Klymak. +;; * We could add an optional header X-Diary-Reminders to specify a special +;; reminders value for this message. Suggested by Jody Klymak. +;; * Modify the request-accept-article function to make it prompt for diary +;; headers if they're missing. + +;; Remarks: +;; ======= + +;; * nnoo. +;; NNDiary is very similar to nnml. This makes the idea of using nnoo (to +;; derive nndiary from nnml) natural. However, my experience with nnoo is +;; that for reasonably complex backends like this one, noo is a burden +;; rather than an help. It's tricky to use, not everything can be +;; inherited, what can be inherited and when is not very clear, and you've +;; got to be very careful because a little mistake can fuck up your your +;; other backends, especially because their variables will be use instead of +;; your real ones. Finally, I found it easier to just clone the needed +;; parts of nnml, and tracking nnml updates is not a big deal. + +;; IMHO, nnoo is actually badly designed. A much simpler, and yet more +;; powerful one would be to make *real* functions and variables for a new +;; backend based on another. Lisp is a reflexive language so that's a very +;; easy thing to do: inspect the function's form, replace occurences of +;; (even in strings) with , and you're done. + +;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods: +;; NNDiary has some experimental parts, in the sense Gnus normally uses only +;; one mail backends for mail retreival and splitting. This backend is also +;; an attempt to make it behave differently. For Gnus developpers: as you +;; can see if you snarf into the code, that was not a very difficult thing +;; to do. Something should be done about the respooling breakage though. + + +;;; Code: + +(require 'nnoo) +(require 'nnheader) +(require 'nnmail) +(eval-when-compile (require 'cl)) + +(require 'gnus-start) +(require 'gnus-sum) + +;; Compatibility Functions ================================================= + +(if (fboundp 'signal-error) + (defun nndiary-error (&rest args) + (apply #'signal-error 'nndiary args)) + (defun nndiary-error (&rest args) + (apply #'error args))) + + +;; Backend behavior customization =========================================== + +(defgroup nndiary nil + "The Gnus Diary backend." + :group 'gnus-diary) + +(defcustom nndiary-mail-sources + `((file :path ,(expand-file-name "~/.nndiary"))) + "*NNDiary specific mail sources. +This variable is used by nndiary in place of the standard `mail-sources' +variable. These sources must contain diary messages ONLY." + :group 'nndiary + :group 'mail-source + :type 'sexp) + +(defcustom nndiary-split-methods '(("diary" "")) + "*NNDiary specific split methods. +This variable is used by nndiary in place of the standard +`nnmail-split-methods' variable." + :group 'nndiary + :group 'nnmail-split + :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) + (function-item nnmail-split-fancy) + (function :tag "Other"))) + + +(defcustom nndiary-reminders '((0 . day)) + "*Different times when you want to be reminded of your appointements. +Diary articles will appear again, as if they'd been just received. + +Entries look like (3 . day) which means something like \"Please +Hortense, would you be so kind as to remind me of my appointments 3 days +before the date, thank you very much. Anda, hmmm... by the way, are you +doing anything special tonight ?\". + +The units of measure are 'minute 'hour 'day 'week 'month and 'year (no, +not 'century, sorry). + +NOTE: the units of measure actually express dates, not durations: if you +use 'week, messages will pop up on Sundays at 00:00 (or Mondays if +`nndiary-week-starts-on-monday' is non nil) and *not* 7 days before the +appointement, if you use 'month, messages will pop up on the first day of +each months, at 00:00 and so on. + +If you really want to specify a duration (like 24 hours exactly), you can +use the equivalent in minutes (the smallest unit). A fuzz of 60 seconds +maximum in the reminder is not that painful, I think. Although this +scheme might appear somewhat weird at a first glance, it is very powerful. +In order to make this clear, here are some examples: + +- '(0 . day): this is the default value of `nndiary-reminders'. It means + pop up the appointements of the day each morning at 00:00. + +- '(1 . day): this means pop up the appointements the day before, at 00:00. + +- '(6 . hour): for an appointement at 18:30, this would pop up the + appointement message at 12:00. + +- '(360 . minute): for an appointement at 18:30 and 15 seconds, this would + pop up the appointement message at 12:30." + :group 'nndiary + :type '(repeat (cons :format "%v\n" + (integer :format "%v") + (choice :format "%[%v(s)%] before...\n" + :value day + (const :format "%v" minute) + (const :format "%v" hour) + (const :format "%v" day) + (const :format "%v" week) + (const :format "%v" month) + (const :format "%v" year))))) + +(defcustom nndiary-week-starts-on-monday nil + "*Whether a week starts on monday (otherwise, sunday)." + :type 'boolean + :group 'nndiary) + + +(defcustom nndiary-request-create-group-hooks nil + "*Hooks to run after `nndiary-request-create-group' is executed. +The hooks will be called with the full group name as argument." + :group 'nndiary + :type 'hook) + +(defcustom nndiary-request-update-info-hooks nil + "*Hooks to run after `nndiary-request-update-info-group' is executed. +The hooks will be called with the full group name as argument." + :group 'nndiary + :type 'hook) + +(defcustom nndiary-check-directory-twice t + "*If t, check directories twice to avoid NFS failures." + :group 'nndiary + :type 'boolean) + + +;; Backend declaration ====================================================== + +;; Well, most of this is nnml clonage. + +(nnoo-declare nndiary) + +(defvoo nndiary-directory (nnheader-concat gnus-directory "diary/") + "Spool directory for the nndiary backend.") + +(defvoo nndiary-active-file + (expand-file-name "active" nndiary-directory) + "Active file for the nndiary backend.") + +(defvoo nndiary-newsgroups-file + (expand-file-name "newsgroups" nndiary-directory) + "Newsgroups description file for the nndiary backend.") + +(defvoo nndiary-get-new-mail t + "Whether nndiary gets new mail and split it. +Contrary to traditional mail backends, this variable should always be +non-nil because nndiary uses its own mail-sources and split-methods.") + +(defvoo nndiary-nov-is-evil nil + "If non-nil, Gnus will never use nov databases for nndiary groups. +Using nov databases will speed up header fetching considerably. +This variable shouldn't be flipped much. If you have, for some reason, +set this to t, and want to set it to nil again, you should always run +the `nndiary-generate-nov-databases' command. The function will go +through all nnml directories and generate nov databases for them +all. This may very well take some time.") + +(defvoo nndiary-prepare-save-mail-hook nil + "*Hook run narrowed to an article before saving.") + +(defvoo nndiary-inhibit-expiry nil + "If non-nil, inhibit expiry.") + + + +;; $Format: "(defconst nndiary-prcs-major-version \"$ProjectMajorVersion$\")"$ +(defconst nndiary-prcs-major-version "branch-0-2") +;; $Format: "(defconst nndiary-prcs-minor-version \"$ProjectMinorVersion$\")"$ +(defconst nndiary-prcs-minor-version "1") +(defconst nndiary-version + (let ((level nndiary-prcs-minor-version) + major minor status) + (string-match "\\(branch\\|version\\)-\\([0-9]+\\)-\\([0-9]+\\)" + nndiary-prcs-major-version) + (setq major (match-string 2 nndiary-prcs-major-version) + minor (match-string 3 nndiary-prcs-major-version) + status (match-string 1 nndiary-prcs-major-version)) + (cond ((string= status "version") + (setq level (int-to-string (1- (string-to-int level)))) + (if (eq level 0) + (concat major "." minor) + (concat major "." minor "." level))) + ((string= status "branch") + (concat major "." minor "-b" level)))) + "Current Diary backend version.") + +(defun nndiary-version () + "Current Diary backend version." + (interactive) + (message "NNDiary version %s" nndiary-version)) + + +(defvoo nndiary-nov-file-name ".overview") + +(defvoo nndiary-current-directory nil) +(defvoo nndiary-current-group nil) +(defvoo nndiary-status-string "" ) +(defvoo nndiary-nov-buffer-alist nil) +(defvoo nndiary-group-alist nil) +(defvoo nndiary-active-timestamp nil) +(defvoo nndiary-article-file-alist nil) + +(defvoo nndiary-generate-active-function 'nndiary-generate-active-info) +(defvoo nndiary-nov-buffer-file-name nil) +(defvoo nndiary-file-coding-system nnmail-file-coding-system) + +(defconst nndiary-headers + '(("Minute" 0 59) + ("Hour" 0 23) + ("Dom" 1 31) + ("Month" 1 12) + ("Year" 1971) + ("Dow" 0 6) + ("Time-Zone" (("Y" -43200) + + ("X" -39600) + + ("W" -36000) + + ("V" -32400) + + ("U" -28800) + ("PST" -28800) + + ("T" -25200) + ("MST" -25200) + ("PDT" -25200) + + ("S" -21600) + ("CST" -21600) + ("MDT" -21600) + + ("R" -18000) + ("EST" -18000) + ("CDT" -18000) + + ("Q" -14400) + ("AST" -14400) + ("EDT" -14400) + + ("P" -10800) + ("ADT" -10800) + + ("O" -7200) + + ("N" -3600) + + ("Z" 0) + ("GMT" 0) + ("UT" 0) + ("UTC" 0) + ("WET" 0) + + ("A" 3600) + ("CET" 3600) + ("MET" 3600) + ("MEZ" 3600) + ("BST" 3600) + ("WEST" 3600) + + ("B" 7200) + ("EET" 7200) + ("CEST" 7200) + ("MEST" 7200) + ("MESZ" 7200) + + ("C" 10800) + + ("D" 14400) + + ("E" 18000) + + ("F" 21600) + + ("G" 25200) + + ("H" 28800) + + ("I" 32400) + ("JST" 32400) + + ("K" 36000) + ("GST" 36000) + + ("L" 39600) + + ("M" 43200) + ("NZST" 43200) + + ("NZDT" 46800)))) + ;; List of NNDiary headers that specify the time spec. Each header name is + ;; followed by either two integers (specifying a range of possible values + ;; for this header) or one list (specifying all the possible values for this + ;; header). In the latter case, the list does NOT include the unspecifyed + ;; spec (*). + ;; For time zone values, we have symbolic time zone names associated with + ;; the (relative) number of seconds ahead GMT. + ) + + +;;; Interface functions ===================================================== + +(nnoo-define-basics nndiary) + +(deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old) + (when (nndiary-possibly-change-directory group server) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let* ((file nil) + (number (length sequence)) + (count 0) + (file-name-coding-system nnmail-pathname-coding-system) + beg article + (nndiary-check-directory-twice + (and nndiary-check-directory-twice + ;; To speed up, disable it in some case. + (or (not (numberp nnmail-large-newsgroup)) + (<= number nnmail-large-newsgroup))))) + (if (stringp (car sequence)) + 'headers + (if (nndiary-retrieve-headers-with-nov sequence fetch-old) + 'nov + (while sequence + (setq article (car sequence)) + (setq file (nndiary-article-to-file article)) + (when (and file + (file-exists-p file) + (not (file-directory-p file))) + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (nnheader-insert-head file) + (goto-char beg) + (if (search-forward "\n\n" nil t) + (forward-char -1) + (goto-char (point-max)) + (insert "\n\n")) + (insert ".\n") + (delete-region (point) (point-max))) + (setq sequence (cdr sequence)) + (setq count (1+ count)) + (and (numberp nnmail-large-newsgroup) + (> number nnmail-large-newsgroup) + (zerop (% count 20)) + (nnheader-message 6 "nndiary: Receiving headers... %d%%" + (/ (* count 100) number)))) + + (and (numberp nnmail-large-newsgroup) + (> number nnmail-large-newsgroup) + (nnheader-message 6 "nndiary: Receiving headers...done")) + + (nnheader-fold-continuation-lines) + 'headers)))))) + +(deffoo nndiary-open-server (server &optional defs) + (nnoo-change-server 'nndiary server defs) + (when (not (file-exists-p nndiary-directory)) + (ignore-errors (make-directory nndiary-directory t))) + (cond + ((not (file-exists-p nndiary-directory)) + (nndiary-close-server) + (nnheader-report 'nndiary "Couldn't create directory: %s" + nndiary-directory)) + ((not (file-directory-p (file-truename nndiary-directory))) + (nndiary-close-server) + (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory)) + (t + (nnheader-report 'nndiary "Opened server %s using directory %s" + server nndiary-directory) + t))) + +(deffoo nndiary-request-regenerate (server) + (nndiary-possibly-change-directory nil server) + (nndiary-generate-nov-databases server) + t) + +(deffoo nndiary-request-article (id &optional group server buffer) + (nndiary-possibly-change-directory group server) + (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) + (file-name-coding-system nnmail-pathname-coding-system) + path gpath group-num) + (if (stringp id) + (when (and (setq group-num (nndiary-find-group-number id)) + (cdr + (assq (cdr group-num) + (nnheader-article-to-file-alist + (setq gpath + (nnmail-group-pathname + (car group-num) + nndiary-directory)))))) + (setq path (concat gpath (int-to-string (cdr group-num))))) + (setq path (nndiary-article-to-file id))) + (cond + ((not path) + (nnheader-report 'nndiary "No such article: %s" id)) + ((not (file-exists-p path)) + (nnheader-report 'nndiary "No such file: %s" path)) + ((file-directory-p path) + (nnheader-report 'nndiary "File is a directory: %s" path)) + ((not (save-excursion (let ((nnmail-file-coding-system + nndiary-file-coding-system)) + (nnmail-find-file path)))) + (nnheader-report 'nndiary "Couldn't read file: %s" path)) + (t + (nnheader-report 'nndiary "Article %s retrieved" id) + ;; We return the article number. + (cons (if group-num (car group-num) group) + (string-to-int (file-name-nondirectory path))))))) + +(deffoo nndiary-request-group (group &optional server dont-check) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (cond + ((not (nndiary-possibly-change-directory group server)) + (nnheader-report 'nndiary "Invalid group (no such directory)")) + ((not (file-exists-p nndiary-current-directory)) + (nnheader-report 'nndiary "Directory %s does not exist" + nndiary-current-directory)) + ((not (file-directory-p nndiary-current-directory)) + (nnheader-report 'nndiary "%s is not a directory" + nndiary-current-directory)) + (dont-check + (nnheader-report 'nndiary "Group %s selected" group) + t) + (t + (nnheader-re-read-dir nndiary-current-directory) + (nnmail-activate 'nndiary) + (let ((active (nth 1 (assoc group nndiary-group-alist)))) + (if (not active) + (nnheader-report 'nndiary "No such group: %s" group) + (nnheader-report 'nndiary "Selected group %s" group) + (nnheader-insert "211 %d %d %d %s\n" + (max (1+ (- (cdr active) (car active))) 0) + (car active) (cdr active) group))))))) + +(deffoo nndiary-request-scan (&optional group server) + ;; Use our own mail sources and split methods while Gnus doesn't let us have + ;; multiple backends for retrieving mail. + (let ((mail-sources nndiary-mail-sources) + (nnmail-split-methods nndiary-split-methods)) + (setq nndiary-article-file-alist nil) + (nndiary-possibly-change-directory group server) + (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group))) + +(deffoo nndiary-close-group (group &optional server) + (setq nndiary-article-file-alist nil) + t) + +(deffoo nndiary-request-create-group (group &optional server args) + (nndiary-possibly-change-directory nil server) + (nnmail-activate 'nndiary) + (cond + ((assoc group nndiary-group-alist) + t) + ((and (file-exists-p (nnmail-group-pathname group nndiary-directory)) + (not (file-directory-p (nnmail-group-pathname + group nndiary-directory)))) + (nnheader-report 'nndiary "%s is a file" + (nnmail-group-pathname group nndiary-directory))) + (t + (let (active) + (push (list group (setq active (cons 1 0))) + nndiary-group-alist) + (nndiary-possibly-create-directory group) + (nndiary-possibly-change-directory group server) + (let ((articles (nnheader-directory-articles nndiary-current-directory))) + (when articles + (setcar active (apply 'min articles)) + (setcdr active (apply 'max articles)))) + (nnmail-save-active nndiary-group-alist nndiary-active-file) + (run-hook-with-args 'nndiary-request-create-group-hooks + (gnus-group-prefixed-name group + (list "nndiary" server))) + t)) + )) + +(deffoo nndiary-request-list (&optional server) + (save-excursion + (let ((nnmail-file-coding-system nnmail-active-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (nnmail-find-file nndiary-active-file)) + (setq nndiary-group-alist (nnmail-get-active)) + t)) + +(deffoo nndiary-request-newgroups (date &optional server) + (nndiary-request-list server)) + +(deffoo nndiary-request-list-newsgroups (&optional server) + (save-excursion + (nnmail-find-file nndiary-newsgroups-file))) + +(deffoo nndiary-request-expire-articles (articles group &optional server force) + (nndiary-possibly-change-directory group server) + (let ((active-articles + (nnheader-directory-articles nndiary-current-directory)) + article rest number) + (nnmail-activate 'nndiary) + ;; Articles not listed in active-articles are already gone, + ;; so don't try to expire them. + (setq articles (gnus-intersection articles active-articles)) + (while articles + (setq article (nndiary-article-to-file (setq number (pop articles)))) + (if (and (nndiary-deletable-article-p group number) + ;; Don't use nnmail-expired-article-p. Our notion of expiration + ;; is a bit peculiar ... + (or force (nndiary-expired-article-p article))) + (progn + ;; Allow a special target group. + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nndiary-request-article number group server (current-buffer)) + (let ((nndiary-current-directory nil)) + (nnmail-expiry-target-group nnmail-expiry-target group)))) + (nnheader-message 5 "Deleting article %s in %s" number group) + (condition-case () + (funcall nnmail-delete-file-function article) + (file-error (push number rest))) + (setq active-articles (delq number active-articles)) + (nndiary-nov-delete-article group number)) + (push number rest))) + (let ((active (nth 1 (assoc group nndiary-group-alist)))) + (when active + (setcar active (or (and active-articles + (apply 'min active-articles)) + (1+ (cdr active))))) + (nnmail-save-active nndiary-group-alist nndiary-active-file)) + (nndiary-save-nov) + (nconc rest articles))) + +(deffoo nndiary-request-move-article + (article group server accept-form &optional last) + (let ((buf (get-buffer-create " *nndiary move*")) + result) + (nndiary-possibly-change-directory group server) + (nndiary-update-file-alist) + (and + (nndiary-deletable-article-p group article) + (nndiary-request-article article group server) + (let (nndiary-current-directory + nndiary-current-group + nndiary-article-file-alist) + (save-excursion + (set-buffer buf) + (insert-buffer-substring nntp-server-buffer) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result)) + (progn + (nndiary-possibly-change-directory group server) + (condition-case () + (funcall nnmail-delete-file-function + (nndiary-article-to-file article)) + (file-error nil)) + (nndiary-nov-delete-article group article) + (when last + (nndiary-save-nov) + (nnmail-save-active nndiary-group-alist nndiary-active-file)))) + result)) + +(deffoo nndiary-request-accept-article (group &optional server last) + (nndiary-possibly-change-directory group server) + (nnmail-check-syntax) + (let (result) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (if (stringp group) + (and + (nnmail-activate 'nndiary) + (setq result + (car (nndiary-save-mail + (list (cons group (nndiary-active-number group)))))) + (progn + (nnmail-save-active nndiary-group-alist nndiary-active-file) + (and last (nndiary-save-nov)))) + (and + (nnmail-activate 'nndiary) + (if (and (not (setq result + (nnmail-article-group 'nndiary-active-number))) + (yes-or-no-p "Moved to `junk' group; delete article? ")) + (setq result 'junk) + (setq result (car (nndiary-save-mail result)))) + (when last + (nnmail-save-active nndiary-group-alist nndiary-active-file) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) + (nndiary-save-nov)))) + result)) + +(deffoo nndiary-request-post (&optional server) + (nnmail-do-request-post 'nndiary-request-accept-article server)) + +(deffoo nndiary-request-replace-article (article group buffer) + (nndiary-possibly-change-directory group) + (save-excursion + (set-buffer buffer) + (nndiary-possibly-create-directory group) + (let ((chars (nnmail-insert-lines)) + (art (concat (int-to-string article) "\t")) + headers) + (when (ignore-errors + (nnmail-write-region + (point-min) (point-max) + (or (nndiary-article-to-file article) + (expand-file-name (int-to-string article) + nndiary-current-directory)) + nil (if (nnheader-be-verbose 5) nil 'nomesg)) + t) + (setq headers (nndiary-parse-head chars article)) + ;; Replace the NOV line in the NOV file. + (save-excursion + (set-buffer (nndiary-open-nov group)) + (goto-char (point-min)) + (if (or (looking-at art) + (search-forward (concat "\n" art) nil t)) + ;; Delete the old NOV line. + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point))) + ;; The line isn't here, so we have to find out where + ;; we should insert it. (This situation should never + ;; occur, but one likes to make sure...) + (while (and (looking-at "[0-9]+\t") + (< (string-to-int + (buffer-substring + (match-beginning 0) (match-end 0))) + article) + (zerop (forward-line 1))))) + (beginning-of-line) + (nnheader-insert-nov headers) + (nndiary-save-nov) + t))))) + +(deffoo nndiary-request-delete-group (group &optional force server) + (nndiary-possibly-change-directory group server) + (when force + ;; Delete all articles in GROUP. + (let ((articles + (directory-files + nndiary-current-directory t + (concat nnheader-numerical-short-files + "\\|" (regexp-quote nndiary-nov-file-name) "$"))) + article) + (while articles + (setq article (pop articles)) + (when (file-writable-p article) + (nnheader-message 5 "Deleting article %s in %s..." article group) + (funcall nnmail-delete-file-function article)))) + ;; Try to delete the directory itself. + (ignore-errors (delete-directory nndiary-current-directory))) + ;; Remove the group from all structures. + (setq nndiary-group-alist + (delq (assoc group nndiary-group-alist) nndiary-group-alist) + nndiary-current-group nil + nndiary-current-directory nil) + ;; Save the active file. + (nnmail-save-active nndiary-group-alist nndiary-active-file) + t) + +(deffoo nndiary-request-rename-group (group new-name &optional server) + (nndiary-possibly-change-directory group server) + (let ((new-dir (nnmail-group-pathname new-name nndiary-directory)) + (old-dir (nnmail-group-pathname group nndiary-directory))) + (when (ignore-errors + (make-directory new-dir t) + t) + ;; We move the articles file by file instead of renaming + ;; the directory -- there may be subgroups in this group. + ;; One might be more clever, I guess. + (let ((files (nnheader-article-to-file-alist old-dir))) + (while files + (rename-file + (concat old-dir (cdar files)) + (concat new-dir (cdar files))) + (pop files))) + ;; Move .overview file. + (let ((overview (concat old-dir nndiary-nov-file-name))) + (when (file-exists-p overview) + (rename-file overview (concat new-dir nndiary-nov-file-name)))) + (when (<= (length (directory-files old-dir)) 2) + (ignore-errors (delete-directory old-dir))) + ;; That went ok, so we change the internal structures. + (let ((entry (assoc group nndiary-group-alist))) + (when entry + (setcar entry new-name)) + (setq nndiary-current-directory nil + nndiary-current-group nil) + ;; Save the new group alist. + (nnmail-save-active nndiary-group-alist nndiary-active-file) + t)))) + +(deffoo nndiary-set-status (article name value &optional group server) + (nndiary-possibly-change-directory group server) + (let ((file (nndiary-article-to-file article))) + (cond + ((not (file-exists-p file)) + (nnheader-report 'nndiary "File %s does not exist" file)) + (t + (with-temp-file file + (nnheader-insert-file-contents file) + (nnmail-replace-status name value)) + t)))) + + +;;; Interface optional functions ============================================ + +(deffoo nndiary-request-update-info (group info &optional server) + (nndiary-possibly-change-directory group) + (let ((timestamp (gnus-group-parameter-value (gnus-info-params info) + 'timestamp t))) + (if (not timestamp) + (nnheader-report 'nndiary "Group %s doesn't have a timestamp" group) + ;; else + ;; Figure out which articles should be re-new'ed + (let ((articles (nndiary-flatten (gnus-info-read info) 0)) + article file unread buf) + (save-excursion + (setq buf (nnheader-set-temp-buffer " *nndiary update*")) + (while (setq article (pop articles)) + (setq file (concat nndiary-current-directory + (int-to-string article))) + (and (file-exists-p file) + (nndiary-renew-article-p file timestamp) + (push article unread))) + ;;(message "unread: %s" unread) + (sit-for 1) + (kill-buffer buf)) + (setq unread (sort unread '<)) + (and unread + (gnus-info-set-read info (gnus-update-read-articles + (gnus-info-group info) unread t))) + )) + (run-hook-with-args 'nndiary-request-update-info-hooks + (gnus-info-group info)) + t)) + + + +;;; Internal functions ====================================================== + +(defun nndiary-article-to-file (article) + (nndiary-update-file-alist) + (let (file) + (if (setq file (cdr (assq article nndiary-article-file-alist))) + (expand-file-name file nndiary-current-directory) + ;; Just to make sure nothing went wrong when reading over NFS -- + ;; check once more. + (if nndiary-check-directory-twice + (when (file-exists-p + (setq file (expand-file-name (number-to-string article) + nndiary-current-directory))) + (nndiary-update-file-alist t) + file))))) + +(defun nndiary-deletable-article-p (group article) + "Say whether ARTICLE in GROUP can be deleted." + (let (path) + (when (setq path (nndiary-article-to-file article)) + (when (file-writable-p path) + (or (not nnmail-keep-last-article) + (not (eq (cdr (nth 1 (assoc group nndiary-group-alist))) + article))))))) + +;; Find an article number in the current group given the Message-ID. +(defun nndiary-find-group-number (id) + (save-excursion + (set-buffer (get-buffer-create " *nndiary id*")) + (let ((alist nndiary-group-alist) + number) + ;; We want to look through all .overview files, but we want to + ;; start with the one in the current directory. It seems most + ;; likely that the article we are looking for is in that group. + (if (setq number (nndiary-find-id nndiary-current-group id)) + (cons nndiary-current-group number) + ;; It wasn't there, so we look through the other groups as well. + (while (and (not number) + alist) + (or (string= (caar alist) nndiary-current-group) + (setq number (nndiary-find-id (caar alist) id))) + (or number + (setq alist (cdr alist)))) + (and number + (cons (caar alist) number)))))) + +(defun nndiary-find-id (group id) + (erase-buffer) + (let ((nov (expand-file-name nndiary-nov-file-name + (nnmail-group-pathname group + nndiary-directory))) + number found) + (when (file-exists-p nov) + (nnheader-insert-file-contents nov) + (while (and (not found) + (search-forward id nil t)) ; We find the ID. + ;; And the id is in the fourth field. + (if (not (and (search-backward "\t" nil t 4) + (not (search-backward"\t" (gnus-point-at-bol) t)))) + (forward-line 1) + (beginning-of-line) + (setq found t) + ;; We return the article number. + (setq number + (ignore-errors (read (current-buffer)))))) + number))) + +(defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old) + (if (or gnus-nov-is-evil nndiary-nov-is-evil) + nil + (let ((nov (expand-file-name nndiary-nov-file-name + nndiary-current-directory))) + (when (file-exists-p nov) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents nov) + (if (and fetch-old + (not (numberp fetch-old))) + t ; Don't remove anything. + (nnheader-nov-delete-outside-range + (if fetch-old (max 1 (- (car articles) fetch-old)) + (car articles)) + (car (last articles))) + t)))))) + +(defun nndiary-possibly-change-directory (group &optional server) + (when (and server + (not (nndiary-server-opened server))) + (nndiary-open-server server)) + (if (not group) + t + (let ((pathname (nnmail-group-pathname group nndiary-directory)) + (file-name-coding-system nnmail-pathname-coding-system)) + (when (not (equal pathname nndiary-current-directory)) + (setq nndiary-current-directory pathname + nndiary-current-group group + nndiary-article-file-alist nil)) + (file-exists-p nndiary-current-directory)))) + +(defun nndiary-possibly-create-directory (group) + (let ((dir (nnmail-group-pathname group nndiary-directory))) + (unless (file-exists-p dir) + (make-directory (directory-file-name dir) t) + (nnheader-message 5 "Creating mail directory %s" dir)))) + +(defun nndiary-save-mail (group-art) + "Called narrowed to an article." + (let (chars headers) + (setq chars (nnmail-insert-lines)) + (nnmail-insert-xref group-art) + (run-hooks 'nnmail-prepare-save-mail-hook) + (run-hooks 'nndiary-prepare-save-mail-hook) + (goto-char (point-min)) + (while (looking-at "From ") + (replace-match "X-From-Line: ") + (forward-line 1)) + ;; We save the article in all the groups it belongs in. + (let ((ga group-art) + first) + (while ga + (nndiary-possibly-create-directory (caar ga)) + (let ((file (concat (nnmail-group-pathname + (caar ga) nndiary-directory) + (int-to-string (cdar ga))))) + (if first + ;; It was already saved, so we just make a hard link. + (funcall nnmail-crosspost-link-function first file t) + ;; Save the article. + (nnmail-write-region (point-min) (point-max) file nil + (if (nnheader-be-verbose 5) nil 'nomesg)) + (setq first file))) + (setq ga (cdr ga)))) + ;; Generate a nov line for this article. We generate the nov + ;; line after saving, because nov generation destroys the + ;; header. + (setq headers (nndiary-parse-head chars)) + ;; Output the nov line to all nov databases that should have it. + (let ((ga group-art)) + (while ga + (nndiary-add-nov (caar ga) (cdar ga) headers) + (setq ga (cdr ga)))) + group-art)) + +(defun nndiary-active-number (group) + "Compute the next article number in GROUP." + (let ((active (cadr (assoc group nndiary-group-alist)))) + ;; The group wasn't known to nndiary, so we just create an active + ;; entry for it. + (unless active + ;; Perhaps the active file was corrupt? See whether + ;; there are any articles in this group. + (nndiary-possibly-create-directory group) + (nndiary-possibly-change-directory group) + (unless nndiary-article-file-alist + (setq nndiary-article-file-alist + (sort + (nnheader-article-to-file-alist nndiary-current-directory) + 'car-less-than-car))) + (setq active + (if nndiary-article-file-alist + (cons (caar nndiary-article-file-alist) + (caar (last nndiary-article-file-alist))) + (cons 1 0))) + (push (list group active) nndiary-group-alist)) + (setcdr active (1+ (cdr active))) + (while (file-exists-p + (expand-file-name (int-to-string (cdr active)) + (nnmail-group-pathname group nndiary-directory))) + (setcdr active (1+ (cdr active)))) + (cdr active))) + +(defun nndiary-add-nov (group article headers) + "Add a nov line for the GROUP base." + (save-excursion + (set-buffer (nndiary-open-nov group)) + (goto-char (point-max)) + (mail-header-set-number headers article) + (nnheader-insert-nov headers))) + +(defsubst nndiary-header-value () + (buffer-substring (match-end 0) (progn (end-of-line) (point)))) + +(defun nndiary-parse-head (chars &optional number) + "Parse the head of the current buffer." + (save-excursion + (save-restriction + (unless (zerop (buffer-size)) + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) + ;; Fold continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + ;; Remove any tabs; they are too confusing. + (subst-char-in-region (point-min) (point-max) ?\t ? ) + (let ((headers (nnheader-parse-head t))) + (mail-header-set-chars headers chars) + (mail-header-set-number headers number) + headers)))) + +(defun nndiary-open-nov (group) + (or (cdr (assoc group nndiary-nov-buffer-alist)) + (let ((buffer (get-buffer-create (format " *nndiary overview %s*" + group)))) + (save-excursion + (set-buffer buffer) + (set (make-local-variable 'nndiary-nov-buffer-file-name) + (expand-file-name + nndiary-nov-file-name + (nnmail-group-pathname group nndiary-directory))) + (erase-buffer) + (when (file-exists-p nndiary-nov-buffer-file-name) + (nnheader-insert-file-contents nndiary-nov-buffer-file-name))) + (push (cons group buffer) nndiary-nov-buffer-alist) + buffer))) + +(defun nndiary-save-nov () + (save-excursion + (while nndiary-nov-buffer-alist + (when (buffer-name (cdar nndiary-nov-buffer-alist)) + (set-buffer (cdar nndiary-nov-buffer-alist)) + (when (buffer-modified-p) + (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name + nil 'nomesg)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist))))) + +;;;###autoload +(defun nndiary-generate-nov-databases (&optional server) + "Generate NOV databases in all nndiary directories." + (interactive (list (or (nnoo-current-server 'nndiary) ""))) + ;; Read the active file to make sure we don't re-use articles + ;; numbers in empty groups. + (nnmail-activate 'nndiary) + (unless (nndiary-server-opened server) + (nndiary-open-server server)) + (setq nndiary-directory (expand-file-name nndiary-directory)) + ;; Recurse down the directories. + (nndiary-generate-nov-databases-1 nndiary-directory nil t) + ;; Save the active file. + (nnmail-save-active nndiary-group-alist nndiary-active-file)) + +(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active) + "Regenerate the NOV database in DIR." + (interactive "DRegenerate NOV in: ") + (setq dir (file-name-as-directory dir)) + ;; Only scan this sub-tree if we haven't been here yet. + (unless (member (file-truename dir) seen) + (push (file-truename dir) seen) + ;; We descend recursively + (let ((dirs (directory-files dir t nil t)) + dir) + (while (setq dir (pop dirs)) + (when (and (not (string-match "^\\." (file-name-nondirectory dir))) + (file-directory-p dir)) + (nndiary-generate-nov-databases-1 dir seen)))) + ;; Do this directory. + (let ((files (sort (nnheader-article-to-file-alist dir) + 'car-less-than-car))) + (if (not files) + (let* ((group (nnheader-file-to-group + (directory-file-name dir) nndiary-directory)) + (info (cadr (assoc group nndiary-group-alist)))) + (when info + (setcar info (1+ (cdr info))))) + (funcall nndiary-generate-active-function dir) + ;; Generate the nov file. + (nndiary-generate-nov-file dir files) + (unless no-active + (nnmail-save-active nndiary-group-alist nndiary-active-file)))))) + +(eval-when-compile (defvar files)) +(defun nndiary-generate-active-info (dir) + ;; Update the active info for this group. + (let* ((group (nnheader-file-to-group + (directory-file-name dir) nndiary-directory)) + (entry (assoc group nndiary-group-alist)) + (last (or (caadr entry) 0))) + (setq nndiary-group-alist (delq entry nndiary-group-alist)) + (push (list group + (cons (or (caar files) (1+ last)) + (max last + (or (let ((f files)) + (while (cdr f) (setq f (cdr f))) + (caar f)) + 0)))) + nndiary-group-alist))) + +(defun nndiary-generate-nov-file (dir files) + (let* ((dir (file-name-as-directory dir)) + (nov (concat dir nndiary-nov-file-name)) + (nov-buffer (get-buffer-create " *nov*")) + chars file headers) + (save-excursion + ;; Init the nov buffer. + (set-buffer nov-buffer) + (buffer-disable-undo) + (erase-buffer) + (set-buffer nntp-server-buffer) + ;; Delete the old NOV file. + (when (file-exists-p nov) + (funcall nnmail-delete-file-function nov)) + (while files + (unless (file-directory-p (setq file (concat dir (cdar files)))) + (erase-buffer) + (nnheader-insert-file-contents file) + (narrow-to-region + (goto-char (point-min)) + (progn + (search-forward "\n\n" nil t) + (setq chars (- (point-max) (point))) + (max 1 (1- (point))))) + (unless (zerop (buffer-size)) + (goto-char (point-min)) + (setq headers (nndiary-parse-head chars (caar files))) + (save-excursion + (set-buffer nov-buffer) + (goto-char (point-max)) + (nnheader-insert-nov headers))) + (widen)) + (setq files (cdr files))) + (save-excursion + (set-buffer nov-buffer) + (nnmail-write-region 1 (point-max) nov nil 'nomesg) + (kill-buffer (current-buffer)))))) + +(defun nndiary-nov-delete-article (group article) + (save-excursion + (set-buffer (nndiary-open-nov group)) + (when (nnheader-find-nov-line article) + (delete-region (point) (progn (forward-line 1) (point))) + (when (bobp) + (let ((active (cadr (assoc group nndiary-group-alist))) + num) + (when active + (if (eobp) + (setf (car active) (1+ (cdr active))) + (when (and (setq num (ignore-errors (read (current-buffer)))) + (numberp num)) + (setf (car active) num))))))) + t)) + +(defun nndiary-update-file-alist (&optional force) + (when (or (not nndiary-article-file-alist) + force) + (setq nndiary-article-file-alist + (nnheader-article-to-file-alist nndiary-current-directory)))) + + +(defun nndiary-string-to-int (str min &optional max) + ;; Like `string-to-int' but barf if STR is not exactly an integer, and not + ;; within the specified bounds. + ;; Signals are caught by `nndiary-schedule'. + (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str)) + (nndiary-error "not an integer value") + ;; else + (let ((val (string-to-int str))) + (and (or (< val min) + (and max (> val max))) + (nndiary-error "value out of range")) + val))) + +(defun nndiary-parse-schedule-value (str min-or-values max) + ;; Parse the schedule string STR. + ;; Signals are caught by `nndary-schedule'. + (if (string-match "[ \t]*\\*[ \t]*" str) + ;; unspecifyed + nil + ;; specifyed + (if (listp min-or-values) + ;; min-or-values is values + ;; #### NOTE: this is actually only a hack for time zones. + (let ((val (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" str) + (match-string 1 str)))) + (if (and val (setq val (assoc val min-or-values))) + (list (cadr val)) + (nndiary-error "invalid syntax"))) + ;; min-or-values is min + (mapcar + (lambda (val) + (let ((res (split-string val "-"))) + (cond + ((= (length res) 1) + (nndiary-string-to-int (car res) min-or-values max)) + ((= (length res) 2) + ;; don't know if crontab accepts this, but ensure + ;; that BEG is <= END + (let ((beg (nndiary-string-to-int (car res) min-or-values max)) + (end (nndiary-string-to-int (cadr res) min-or-values max))) + (cond ((< beg end) + (cons beg end)) + ((= beg end) + beg) + (t + (cons end beg))))) + (t + (nndiary-error "invalid syntax"))) + )) + (split-string str ","))) + )) + +;; ### FIXME: remove this function if it's used only once. +(defun nndiary-parse-schedule (head min-or-values max) + ;; Parse the cron-like value of header X-Diary-HEAD in current buffer. + ;; - Returns nil if `*' + ;; - Otherwise returns a list of integers and/or ranges (BEG . END) + ;; The exception is the Timze-Zone value which is always of the form (STR). + ;; Signals are caught by `nndary-schedule'. + (let ((header (format "^X-Diary-%s: \\(.*\\)$" head))) + (goto-char (point-min)) + (if (not (re-search-forward header nil t)) + (nndiary-error "header missing") + ;; else + (nndiary-parse-schedule-value (match-string 1) min-or-values max)) + )) + +(defsubst nndiary-schedule () + (mapcar + (lambda (elt) + (condition-case arg + (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt)) + (t + (nnheader-report 'nndiary "X-Diary-%s header parse error: %s." + (car elt) (cdr arg)) + nil))) + nndiary-headers)) + +(defun nndiary-max (spec) + ;; Returns the max of specification SPEC, or nil for permanent schedules. + (unless (null spec) + (let ((elts spec) + (max 0) + elt) + (while (setq elt (pop elts)) + (if (integerp elt) + (and (> elt max) (setq max elt)) + (and (> (cdr elt) max) (setq max (cdr elt))))) + max))) + +(defun nndiary-flatten (spec min &optional max) + ;; flatten the spec by expanding ranges to all possible values. + (let (flat n) + (cond ((null spec) + ;; this happens when I flatten something else than one of my + ;; schedules (a list of read articles for instance). + (unless (null max) + (setq n min) + (while (<= n max) + (push n flat) + (setq n (1+ n))))) + (t + (let ((elts spec) + elt) + (while (setq elt (pop elts)) + (if (integerp elt) + (push elt flat) + ;; else + (setq n (car elt)) + (while (<= n (cdr elt)) + (push n flat) + (setq n (1+ n)))))))) + flat)) + +(defun nndiary-unflatten (spec) + ;; opposite of flatten: build ranges if possible + (setq spec (sort spec '<)) + (let (min max res) + (while (setq min (pop spec)) + (setq max min) + (while (and (car spec) (= (car spec) (1+ max))) + (setq max (1+ max)) + (pop spec)) + (if (= max min) + (setq res (append res (list min))) + (setq res (append res (list (cons min max)))))) + res)) + +(defun nndiary-compute-reminders (date) + ;; Returns a list of times corresponding to the reminders of date DATE. + ;; See the comment in `nndiary-reminders' about rounding. + (let* ((reminders nndiary-reminders) + (date-elts (decode-time date)) + ;; ### NOTE: out-of-range values are accepted by encode-time. This + ;; makes our life easier. + (monday (- (nth 3 date-elts) + (if nndiary-week-starts-on-monday + (if (zerop (nth 6 date-elts)) + 6 + (- (nth 6 date-elts) 1)) + (nth 6 date-elts)))) + reminder res) + ;; remove the DOW and DST entries + (setf (nthcdr 6 date-elts) (nthcdr 8 date-elts)) + (while (setq reminder (pop reminders)) + (push + (cond ((eq (cdr reminder) 'minute) + (subtract-time + (apply 'encode-time 0 (nthcdr 1 date-elts)) + (seconds-to-time (* (car reminder) 60.0)))) + ((eq (cdr reminder) 'hour) + (subtract-time + (apply 'encode-time 0 0 (nthcdr 2 date-elts)) + (seconds-to-time (* (car reminder) 3600.0)))) + ((eq (cdr reminder) 'day) + (subtract-time + (apply 'encode-time 0 0 0 (nthcdr 3 date-elts)) + (seconds-to-time (* (car reminder) 86400.0)))) + ((eq (cdr reminder) 'week) + (subtract-time + (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts)) + (seconds-to-time (* (car reminder) 604800.0)))) + ((eq (cdr reminder) 'month) + (subtract-time + (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts)) + (seconds-to-time (* (car reminder) 18748800.0)))) + ((eq (cdr reminder) 'year) + (subtract-time + (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) + (seconds-to-time (* (car reminder) 400861056.0))))) + res)) + (sort res 'time-less-p))) + +(defun nndiary-last-occurence (sched) + ;; Returns the last occurence of schedule SCHED as an Emacs time struct, or + ;; nil for permanent schedule or errors. + (let ((minute (nndiary-max (nth 0 sched))) + (hour (nndiary-max (nth 1 sched))) + (year (nndiary-max (nth 4 sched))) + (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) + (current-time-zone)))) + (when year + (or minute (setq minute 59)) + (or hour (setq hour 23)) + ;; I'll just compute all possible values and test them by decreasing + ;; order until one succeeds. This is probably quide rude, but I got + ;; bored in finding a good algorithm for doing that ;-) + ;; ### FIXME: remove identical entries. + (let ((dom-list (nth 2 sched)) + (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>)) + (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>)) + (dow-list (nth 5 sched))) + ;; Special case: an asterisk in one of the days specifications means + ;; that only the other should be taken into account. If both are + ;; unspecified, you would get all possible days in both. + (cond ((null dow-list) + ;; this gets all days if dom-list is nil + (setq dom-list (nndiary-flatten dom-list 1 31))) + ((null dom-list) + ;; this also gets all days if dow-list is nil + (setq dow-list (nndiary-flatten dow-list 0 6))) + (t + (setq dom-list (nndiary-flatten dom-list 1 31)) + (setq dow-list (nndiary-flatten dow-list 0 6)))) + (or + (catch 'found + (while (setq year (pop year-list)) + (let ((months month-list) + month) + (while (setq month (pop months)) + ;; Now we must merge the Dows with the Doms. To do that, we + ;; have to know which day is the 1st one for this month. + ;; Maybe there's simpler, but decode-time(encode-time) will + ;; give us the answer. + (let ((first (nth 6 (decode-time + (encode-time 0 0 0 1 month year + time-zone)))) + (max (cond ((= month 2) + (if (date-leap-year-p year) 29 28)) + ((<= month 7) + (if (zerop (% month 2)) 30 31)) + (t + (if (zerop (% month 2)) 31 30)))) + (doms dom-list) + (dows dow-list) + day days) + ;; first, review the doms to see if they are valid. + (while (setq day (pop doms)) + (and (<= day max) + (push day days))) + ;; second add all possible dows + (while (setq day (pop dows)) + ;; days start at 1. + (setq day (1+ (- day first))) + (and (< day 0) (setq day (+ 7 day))) + (while (<= day max) + (push day days) + (setq day (+ 7 day)))) + ;; Finally, if we have some days, they are valid + (when days + (sort days '>) + (throw 'found + (encode-time 0 minute hour + (car days) month year time-zone))) + ))))) + ;; There's an upper limit, but we didn't find any last occurence. + ;; This means that the schedule is undecidable. This can happen if + ;; you happen to say something like "each Feb 31 until 2038". + (progn + (nnheader-report 'nndiary "Undecidable schedule") + nil)) + )))) + +(defun nndiary-next-occurence (sched now) + ;; Returns the next occurence of schedule SCHED, starting from time NOW. + ;; If there's no next occurence, returns the last one (if any) which is then + ;; in the past. + (let* ((today (decode-time now)) + (this-minute (nth 1 today)) + (this-hour (nth 2 today)) + (this-day (nth 3 today)) + (this-month (nth 4 today)) + (this-year (nth 5 today)) + (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<)) + (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<)) + (dom-list (nth 2 sched)) + (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<)) + (years (if (nth 4 sched) + (sort (nndiary-flatten (nth 4 sched) 1971) '<) + t)) + (dow-list (nth 5 sched)) + (year (1- this-year)) + (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) + (current-time-zone)))) + ;; Special case: an asterisk in one of the days specifications means that + ;; only the other should be taken into account. If both are unspecified, + ;; you would get all possible days in both. + (cond ((null dow-list) + ;; this gets all days if dom-list is nil + (setq dom-list (nndiary-flatten dom-list 1 31))) + ((null dom-list) + ;; this also gets all days if dow-list is nil + (setq dow-list (nndiary-flatten dow-list 0 6))) + (t + (setq dom-list (nndiary-flatten dom-list 1 31)) + (setq dow-list (nndiary-flatten dow-list 0 6)))) + ;; Remove past years. + (unless (eq years t) + (while (and (car years) (< (car years) this-year)) + (pop years))) + (if years + ;; Because we might not be limited in years, we must guard against + ;; infinite loops. Appart from cases like Feb 31, there are probably + ;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to + ;; decide this, so I assume that if we reach 10 years later, the + ;; schedule is undecidable. + (or + (catch 'found + (while (if (eq years t) + (and (setq year (1+ year)) + (<= year (+ 10 this-year))) + (setq year (pop years))) + (let ((months month-list) + month) + ;; Remove past months for this year. + (and (= year this-year) + (while (and (car months) (< (car months) this-month)) + (pop months))) + (while (setq month (pop months)) + ;; Now we must merge the Dows with the Doms. To do that, we + ;; have to know which day is the 1st one for this month. + ;; Maybe there's simpler, but decode-time(encode-time) will + ;; give us the answer. + (let ((first (nth 6 (decode-time + (encode-time 0 0 0 1 month year + time-zone)))) + (max (cond ((= month 2) + (if (date-leap-year-p year) 29 28)) + ((<= month 7) + (if (zerop (% month 2)) 30 31)) + (t + (if (zerop (% month 2)) 31 30)))) + (doms dom-list) + (dows dow-list) + day days) + ;; first, review the doms to see if they are valid. + (while (setq day (pop doms)) + (and (<= day max) + (push day days))) + ;; second add all possible dows + (while (setq day (pop dows)) + ;; days start at 1. + (setq day (1+ (- day first))) + (and (< day 0) (setq day (+ 7 day))) + (while (<= day max) + (push day days) + (setq day (+ 7 day)))) + ;; Aaaaaaall right. Now we have a valid list of DAYS for + ;; this month and this year. + (when days + (setq days (sort days '<)) + ;; Remove past days for this year and this month. + (and (= year this-year) + (= month this-month) + (while (and (car days) (< (car days) this-day)) + (pop days))) + (while (setq day (pop days)) + (let ((hours hour-list) + hour) + ;; Remove past hours for this year, this month and + ;; this day. + (and (= year this-year) + (= month this-month) + (= day this-day) + (while (and (car hours) + (< (car hours) this-hour)) + (pop hours))) + (while (setq hour (pop hours)) + (let ((minutes minute-list) + minute) + ;; Remove past hours for this year, this month, + ;; this day and this hour. + (and (= year this-year) + (= month this-month) + (= day this-day) + (= hour this-hour) + (while (and (car minutes) + (< (car minutes) this-minute)) + (pop minutes))) + (while (setq minute (pop minutes)) + ;; Ouch! Here, we've got a complete valid + ;; schedule. It's a good one if it's in the + ;; future. + (let ((time (encode-time 0 minute hour day + month year + time-zone))) + (and (time-less-p now time) + (throw 'found time))) + )))) + )) + ))) + )) + (nndiary-last-occurence sched)) + ;; else + (nndiary-last-occurence sched)) + )) + +(defun nndiary-expired-article-p (file) + (with-temp-buffer + (if (nnheader-insert-head file) + (let ((sched (nndiary-schedule))) + ;; An article has expired if its last schedule (if any) is in the + ;; past. A permanent schedule never expires. + (and sched + (setq sched (nndiary-last-occurence sched)) + (time-less-p sched (current-time)))) + ;; else + (nnheader-report 'nndiary "Could not read file %s" file) + nil) + )) + +(defun nndiary-renew-article-p (file timestamp) + (erase-buffer) + (if (nnheader-insert-head file) + (let ((now (current-time)) + (sched (nndiary-schedule))) + ;; The article should be re-considered as unread if there's a reminder + ;; between the group timestamp and the current time. + (when (and sched (setq sched (nndiary-next-occurence sched now))) + (let ((reminders ;; add the next occurence itself at the end. + (append (nndiary-compute-reminders sched) (list sched)))) + (while (and reminders (time-less-p (car reminders) timestamp)) + (pop reminders)) + ;; The reminders might be empty if the last date is in the past, + ;; or we've got at least the next occurence itself left. All past + ;; dates are renewed. + (or (not reminders) + (time-less-p (car reminders) now))) + )) + ;; else + (nnheader-report 'nndiary "Could not read file %s" file) + nil)) + +;; The end... =============================================================== + +(mapcar + (lambda (elt) + (let ((header (intern (format "X-Diary-%s" (car elt))))) + ;; Required for building NOV databases and some other stuff + (add-to-list 'gnus-extra-headers header) + (add-to-list 'nnmail-extra-headers header))) + nndiary-headers) + +(unless (assoc "nndiary" gnus-valid-select-methods) + (gnus-declare-backend "nndiary" 'post-mail 'respool 'address)) + +(provide 'nndiary) + + +;;; nndiary.el ends here