Lines Matching +defs:nndiary +defs:request +defs:create +defs:group +defs:hooks
0 ;;; nndiary.el --- A diary back end for Gnus
36 ;; nndiary is a mail back end designed to handle mails as diary event
43 ;; * Respooling doesn't work because contrary to the request-scan function,
52 ;; moving an article from somewhere else (request-accept). For instance,
60 ;; (to derive nndiary from nnml) natural. However, my experience with nnoo
75 ;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods:
98 (defun nndiary-error (&rest args)
99 (apply #'signal-error 'nndiary args))
100 (defun nndiary-error (&rest args)
106 (defgroup nndiary nil
109 :group 'gnus-diary)
111 (defcustom nndiary-mail-sources
112 `((file :path ,(expand-file-name "~/.nndiary")))
114 This variable is used by nndiary in place of the standard `mail-sources'
115 variable when `nndiary-get-new-mail' is set to non-nil. These sources
117 :group 'nndiary
118 :group 'mail-source
121 (defcustom nndiary-split-methods '(("diary" ""))
123 This variable is used by nndiary in place of the standard
124 `nnmail-split-methods' variable when `nndiary-get-new-mail' is set to
126 :group 'nndiary
127 :group 'nnmail-split
128 :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
133 (defcustom nndiary-reminders '((0 . day))
147 `nndiary-week-starts-on-monday' is non-nil) and *not* 7 days before the
157 - '(0 . day): this is the default value of `nndiary-reminders'. It means
167 :group 'nndiary
179 (defcustom nndiary-week-starts-on-monday nil
182 :group 'nndiary)
185 (defcustom nndiary-request-create-group-hooks nil
186 "*Hooks to run after `nndiary-request-create-group' is executed.
187 The hooks will be called with the full group name as argument."
188 :group 'nndiary
191 (defcustom nndiary-request-update-info-hooks nil
192 "*Hooks to run after `nndiary-request-update-info-group' is executed.
193 The hooks will be called with the full group name as argument."
194 :group 'nndiary
197 (defcustom nndiary-request-accept-article-hooks nil
199 Executed near the beginning of `nndiary-request-accept-article'.
200 The hooks will be called with the article in the current buffer."
201 :group 'nndiary
204 (defcustom nndiary-check-directory-twice t
206 :group 'nndiary
214 (nnoo-declare nndiary)
216 (defvoo nndiary-directory (nnheader-concat gnus-directory "diary/")
217 "Spool directory for the nndiary back end.")
219 (defvoo nndiary-active-file
220 (expand-file-name "active" nndiary-directory)
221 "Active file for the nndiary back end.")
223 (defvoo nndiary-newsgroups-file
224 (expand-file-name "newsgroups" nndiary-directory)
225 "Newsgroups description file for the nndiary back end.")
227 (defvoo nndiary-get-new-mail nil
228 "Whether nndiary gets new mail and split it.
233 (defvoo nndiary-nov-is-evil nil
234 "If non-nil, Gnus will never use nov databases for nndiary groups.
238 the `nndiary-generate-nov-databases' command. The function will go
242 (defvoo nndiary-prepare-save-mail-hook nil
245 (defvoo nndiary-inhibit-expiry nil
251 (defconst nndiary-version "0.2-b14"
254 (defun nndiary-version ()
257 (message "NNDiary version %s" nndiary-version))
259 (defvoo nndiary-nov-file-name ".overview")
261 (defvoo nndiary-current-directory nil)
262 (defvoo nndiary-current-group nil)
263 (defvoo nndiary-status-string "" )
264 (defvoo nndiary-nov-buffer-alist nil)
265 (defvoo nndiary-group-alist nil)
266 (defvoo nndiary-active-timestamp nil)
267 (defvoo nndiary-article-file-alist nil)
269 (defvoo nndiary-generate-active-function 'nndiary-generate-active-info)
270 (defvoo nndiary-nov-buffer-file-name nil)
271 (defvoo nndiary-file-coding-system nnmail-file-coding-system)
273 (defconst nndiary-headers
366 (defsubst nndiary-schedule ()
372 (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt)))
373 nndiary-headers)
375 (nnheader-report 'nndiary "X-Diary-%s header parse error: %s."
382 (nnoo-define-basics nndiary)
384 (deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old)
385 (when (nndiary-possibly-change-directory group server)
394 (nndiary-check-directory-twice
395 (and nndiary-check-directory-twice
401 (if (nndiary-retrieve-headers-with-nov sequence fetch-old)
405 (setq file (nndiary-article-to-file article))
424 (nnheader-message 6 "nndiary: Receiving headers... %d%%"
429 (nnheader-message 6 "nndiary: Receiving headers...done"))
434 (deffoo nndiary-open-server (server &optional defs)
435 (nnoo-change-server 'nndiary server defs)
436 (when (not (file-exists-p nndiary-directory))
437 (ignore-errors (make-directory nndiary-directory t)))
439 ((not (file-exists-p nndiary-directory))
440 (nndiary-close-server)
441 (nnheader-report 'nndiary "Couldn't create directory: %s"
442 nndiary-directory))
443 ((not (file-directory-p (file-truename nndiary-directory)))
444 (nndiary-close-server)
445 (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory))
447 (nnheader-report 'nndiary "Opened server %s using directory %s"
448 server nndiary-directory)
451 (deffoo nndiary-request-regenerate (server)
452 (nndiary-possibly-change-directory nil server)
453 (nndiary-generate-nov-databases server)
456 (deffoo nndiary-request-article (id &optional group server buffer)
457 (nndiary-possibly-change-directory group server)
460 path gpath group-num)
462 (when (and (setq group-num (nndiary-find-group-number id))
464 (assq (cdr group-num)
467 (nnmail-group-pathname
468 (car group-num)
469 nndiary-directory))))))
470 (setq path (concat gpath (int-to-string (cdr group-num)))))
471 (setq path (nndiary-article-to-file id)))
474 (nnheader-report 'nndiary "No such article: %s" id))
476 (nnheader-report 'nndiary "No such file: %s" path))
478 (nnheader-report 'nndiary "File is a directory: %s" path))
480 nndiary-file-coding-system))
482 (nnheader-report 'nndiary "Couldn't read file: %s" path))
484 (nnheader-report 'nndiary "Article %s retrieved" id)
486 (cons (if group-num (car group-num) group)
489 (deffoo nndiary-request-group (group &optional server dont-check)
492 ((not (nndiary-possibly-change-directory group server))
493 (nnheader-report 'nndiary "Invalid group (no such directory)"))
494 ((not (file-exists-p nndiary-current-directory))
495 (nnheader-report 'nndiary "Directory %s does not exist"
496 nndiary-current-directory))
497 ((not (file-directory-p nndiary-current-directory))
498 (nnheader-report 'nndiary "%s is not a directory"
499 nndiary-current-directory))
501 (nnheader-report 'nndiary "Group %s selected" group)
504 (nnheader-re-read-dir nndiary-current-directory)
505 (nnmail-activate 'nndiary)
506 (let ((active (nth 1 (assoc group nndiary-group-alist))))
508 (nnheader-report 'nndiary "No such group: %s" group)
509 (nnheader-report 'nndiary "Selected group %s" group)
512 (car active) (cdr active) group)))))))
514 (deffoo nndiary-request-scan (&optional group server)
517 (let ((mail-sources nndiary-mail-sources)
518 (nnmail-split-methods nndiary-split-methods))
519 (setq nndiary-article-file-alist nil)
520 (nndiary-possibly-change-directory group server)
521 (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group)))
523 (deffoo nndiary-close-group (group &optional server)
524 (setq nndiary-article-file-alist nil)
527 (deffoo nndiary-request-create-group (group &optional server args)
528 (nndiary-possibly-change-directory nil server)
529 (nnmail-activate 'nndiary)
531 ((assoc group nndiary-group-alist)
533 ((and (file-exists-p (nnmail-group-pathname group nndiary-directory))
534 (not (file-directory-p (nnmail-group-pathname
535 group nndiary-directory))))
536 (nnheader-report 'nndiary "%s is a file"
537 (nnmail-group-pathname group nndiary-directory)))
540 (push (list group (setq active (cons 1 0)))
541 nndiary-group-alist)
542 (nndiary-possibly-create-directory group)
543 (nndiary-possibly-change-directory group server)
544 (let ((articles (nnheader-directory-articles nndiary-current-directory)))
548 (nnmail-save-active nndiary-group-alist nndiary-active-file)
549 (run-hook-with-args 'nndiary-request-create-group-hooks
550 (gnus-group-prefixed-name group
551 (list "nndiary" server)))
555 (deffoo nndiary-request-list (&optional server)
559 (nnmail-find-file nndiary-active-file))
560 (setq nndiary-group-alist (nnmail-get-active))
563 (deffoo nndiary-request-newgroups (date &optional server)
564 (nndiary-request-list server))
566 (deffoo nndiary-request-list-newsgroups (&optional server)
568 (nnmail-find-file nndiary-newsgroups-file)))
570 (deffoo nndiary-request-expire-articles (articles group &optional server force)
571 (nndiary-possibly-change-directory group server)
573 (nnheader-directory-articles nndiary-current-directory))
575 (nnmail-activate 'nndiary)
580 (setq article (nndiary-article-to-file (setq number (pop articles))))
581 (if (and (nndiary-deletable-article-p group number)
584 (or force (nndiary-expired-article-p article)))
586 ;; Allow a special target group.
589 (nndiary-request-article number group server (current-buffer))
590 (let ((nndiary-current-directory nil))
591 (nnmail-expiry-target-group nnmail-expiry-target group)))
592 (nndiary-possibly-change-directory group server))
593 (nnheader-message 5 "Deleting article %s in %s" number group)
598 (nndiary-nov-delete-article group number))
600 (let ((active (nth 1 (assoc group nndiary-group-alist))))
605 (nnmail-save-active nndiary-group-alist nndiary-active-file))
606 (nndiary-save-nov)
609 (deffoo nndiary-request-move-article
610 (article group server accept-form &optional last)
611 (let ((buf (get-buffer-create " *nndiary move*"))
613 (nndiary-possibly-change-directory group server)
614 (nndiary-update-file-alist)
616 (nndiary-deletable-article-p group article)
617 (nndiary-request-article article group server)
618 (let (nndiary-current-directory
619 nndiary-current-group
620 nndiary-article-file-alist)
628 (nndiary-possibly-change-directory group server)
631 (nndiary-article-to-file article))
633 (nndiary-nov-delete-article group article)
635 (nndiary-save-nov)
636 (nnmail-save-active nndiary-group-alist nndiary-active-file))))
639 (deffoo nndiary-request-accept-article (group &optional server last)
640 (nndiary-possibly-change-directory group server)
642 (run-hooks 'nndiary-request-accept-article-hooks)
643 (when (nndiary-schedule)
647 group
649 (if (stringp group)
651 (nnmail-activate 'nndiary)
653 (car (nndiary-save-mail
654 (list (cons group (nndiary-active-number group))))))
656 (nnmail-save-active nndiary-group-alist nndiary-active-file)
657 (and last (nndiary-save-nov))))
659 (nnmail-activate 'nndiary)
661 (nnmail-article-group 'nndiary-active-number)))
662 (yes-or-no-p "Moved to `junk' group; delete article? "))
664 (setq result (car (nndiary-save-mail result))))
666 (nnmail-save-active nndiary-group-alist nndiary-active-file)
669 (nndiary-save-nov))))
673 (deffoo nndiary-request-post (&optional server)
674 (nnmail-do-request-post 'nndiary-request-accept-article server))
676 (deffoo nndiary-request-replace-article (article group buffer)
677 (nndiary-possibly-change-directory group)
680 (nndiary-possibly-create-directory group)
687 (or (nndiary-article-to-file article)
689 nndiary-current-directory))
692 (setq headers (nndiary-parse-head chars article))
695 (set-buffer (nndiary-open-nov group))
713 (nndiary-save-nov)
716 (deffoo nndiary-request-delete-group (group &optional force server)
717 (nndiary-possibly-change-directory group server)
722 nndiary-current-directory t
724 "\\|" (regexp-quote nndiary-nov-file-name) "$")))
729 (nnheader-message 5 "Deleting article %s in %s..." article group)
732 (ignore-errors (delete-directory nndiary-current-directory)))
733 ;; Remove the group from all structures.
734 (setq nndiary-group-alist
735 (delq (assoc group nndiary-group-alist) nndiary-group-alist)
736 nndiary-current-group nil
737 nndiary-current-directory nil)
739 (nnmail-save-active nndiary-group-alist nndiary-active-file)
742 (deffoo nndiary-request-rename-group (group new-name &optional server)
743 (nndiary-possibly-change-directory group server)
744 (let ((new-dir (nnmail-group-pathname new-name nndiary-directory))
745 (old-dir (nnmail-group-pathname group nndiary-directory)))
750 ;; the directory -- there may be subgroups in this group.
759 (let ((overview (concat old-dir nndiary-nov-file-name)))
761 (rename-file overview (concat new-dir nndiary-nov-file-name))))
765 (let ((entry (assoc group nndiary-group-alist)))
768 (setq nndiary-current-directory nil
769 nndiary-current-group nil)
770 ;; Save the new group alist.
771 (nnmail-save-active nndiary-group-alist nndiary-active-file)
774 (deffoo nndiary-set-status (article name value &optional group server)
775 (nndiary-possibly-change-directory group server)
776 (let ((file (nndiary-article-to-file article)))
779 (nnheader-report 'nndiary "File %s does not exist" file))
790 (deffoo nndiary-request-update-info (group info &optional server)
791 (nndiary-possibly-change-directory group)
792 (let ((timestamp (gnus-group-parameter-value (gnus-info-params info)
795 (nnheader-report 'nndiary "Group %s doesn't have a timestamp" group)
798 (let ((articles (nndiary-flatten (gnus-info-read info) 0))
801 (setq buf (nnheader-set-temp-buffer " *nndiary update*"))
803 (setq file (concat nndiary-current-directory
806 (nndiary-renew-article-p file timestamp)
814 (gnus-info-group info) unread t)))
816 (run-hook-with-args 'nndiary-request-update-info-hooks
817 (gnus-info-group info))
825 (defun nndiary-article-to-file (article)
826 (nndiary-update-file-alist)
828 (if (setq file (cdr (assq article nndiary-article-file-alist)))
829 (expand-file-name file nndiary-current-directory)
832 (if nndiary-check-directory-twice
835 nndiary-current-directory)))
836 (nndiary-update-file-alist t)
839 (defun nndiary-deletable-article-p (group article)
842 (when (setq path (nndiary-article-to-file article))
845 (not (eq (cdr (nth 1 (assoc group nndiary-group-alist)))
848 ;; Find an article number in the current group given the Message-ID.
849 (defun nndiary-find-group-number (id)
851 (set-buffer (get-buffer-create " *nndiary id*"))
852 (let ((alist nndiary-group-alist)
856 ;; likely that the article we are looking for is in that group.
857 (if (setq number (nndiary-find-id nndiary-current-group id))
858 (cons nndiary-current-group number)
862 (or (string= (caar alist) nndiary-current-group)
863 (setq number (nndiary-find-id (caar alist) id)))
869 (defun nndiary-find-id (group id)
871 (let ((nov (expand-file-name nndiary-nov-file-name
872 (nnmail-group-pathname group
873 nndiary-directory)))
890 (defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old)
891 (if (or gnus-nov-is-evil nndiary-nov-is-evil)
893 (let ((nov (expand-file-name nndiary-nov-file-name
894 nndiary-current-directory)))
909 (defun nndiary-possibly-change-directory (group &optional server)
911 (not (nndiary-server-opened server)))
912 (nndiary-open-server server))
913 (if (not group)
915 (let ((pathname (nnmail-group-pathname group nndiary-directory))
917 (when (not (equal pathname nndiary-current-directory))
918 (setq nndiary-current-directory pathname
919 nndiary-current-group group
920 nndiary-article-file-alist nil))
921 (file-exists-p nndiary-current-directory))))
923 (defun nndiary-possibly-create-directory (group)
924 (let ((dir (nnmail-group-pathname group nndiary-directory)))
929 (defun nndiary-save-mail (group-art)
933 (nnmail-insert-xref group-art)
934 (run-hooks 'nnmail-prepare-save-mail-hook)
935 (run-hooks 'nndiary-prepare-save-mail-hook)
941 (let ((ga group-art)
944 (nndiary-possibly-create-directory (caar ga))
945 (let ((file (concat (nnmail-group-pathname
946 (caar ga) nndiary-directory)
959 (setq headers (nndiary-parse-head chars))
961 (let ((ga group-art))
963 (nndiary-add-nov (caar ga) (cdar ga) headers)
965 group-art))
967 (defun nndiary-active-number (group)
969 (let ((active (cadr (assoc group nndiary-group-alist))))
970 ;; The group wasn't known to nndiary, so we just create an active
974 ;; there are any articles in this group.
975 (nndiary-possibly-create-directory group)
976 (nndiary-possibly-change-directory group)
977 (unless nndiary-article-file-alist
978 (setq nndiary-article-file-alist
980 (nnheader-article-to-file-alist nndiary-current-directory)
983 (if nndiary-article-file-alist
984 (cons (caar nndiary-article-file-alist)
985 (caar (last nndiary-article-file-alist)))
987 (push (list group active) nndiary-group-alist))
991 (nnmail-group-pathname group nndiary-directory)))
995 (defun nndiary-add-nov (group article headers)
998 (set-buffer (nndiary-open-nov group))
1003 (defsubst nndiary-header-value ()
1006 (defun nndiary-parse-head (chars &optional number)
1019 (defun nndiary-open-nov (group)
1020 (or (cdr (assoc group nndiary-nov-buffer-alist))
1021 (let ((buffer (get-buffer-create (format " *nndiary overview %s*"
1022 group))))
1025 (set (make-local-variable 'nndiary-nov-buffer-file-name)
1027 nndiary-nov-file-name
1028 (nnmail-group-pathname group nndiary-directory)))
1030 (when (file-exists-p nndiary-nov-buffer-file-name)
1031 (nnheader-insert-file-contents nndiary-nov-buffer-file-name)))
1032 (push (cons group buffer) nndiary-nov-buffer-alist)
1035 (defun nndiary-save-nov ()
1037 (while nndiary-nov-buffer-alist
1038 (when (buffer-name (cdar nndiary-nov-buffer-alist))
1039 (set-buffer (cdar nndiary-nov-buffer-alist))
1041 (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name
1045 (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist)))))
1048 (defun nndiary-generate-nov-databases (&optional server)
1049 "Generate NOV databases in all nndiary directories."
1050 (interactive (list (or (nnoo-current-server 'nndiary) "")))
1053 (nnmail-activate 'nndiary)
1054 (unless (nndiary-server-opened server)
1055 (nndiary-open-server server))
1056 (setq nndiary-directory (expand-file-name nndiary-directory))
1058 (nndiary-generate-nov-databases-1 nndiary-directory nil t)
1060 (nnmail-save-active nndiary-group-alist nndiary-active-file))
1062 (defun nndiary-generate-nov-databases-1 (dir &optional seen no-active)
1075 (nndiary-generate-nov-databases-1 dir seen))))
1080 (let* ((group (nnheader-file-to-group
1081 (directory-file-name dir) nndiary-directory))
1082 (info (cadr (assoc group nndiary-group-alist))))
1085 (funcall nndiary-generate-active-function dir)
1087 (nndiary-generate-nov-file dir files)
1089 (nnmail-save-active nndiary-group-alist nndiary-active-file))))))
1092 (defun nndiary-generate-active-info (dir)
1093 ;; Update the active info for this group.
1094 (let* ((group (nnheader-file-to-group
1095 (directory-file-name dir) nndiary-directory))
1096 (entry (assoc group nndiary-group-alist))
1098 (setq nndiary-group-alist (delq entry nndiary-group-alist))
1099 (push (list group
1106 nndiary-group-alist)))
1108 (defun nndiary-generate-nov-file (dir files)
1110 (nov (concat dir nndiary-nov-file-name))
1111 (nov-buffer (get-buffer-create " *nov*"))
1134 (setq headers (nndiary-parse-head chars (caar files)))
1146 (defun nndiary-nov-delete-article (group article)
1148 (set-buffer (nndiary-open-nov group))
1152 (let ((active (cadr (assoc group nndiary-group-alist)))
1162 (defun nndiary-update-file-alist (&optional force)
1163 (when (or (not nndiary-article-file-alist)
1165 (setq nndiary-article-file-alist
1166 (nnheader-article-to-file-alist nndiary-current-directory))))
1169 (defun nndiary-string-to-number (str min &optional max)
1172 ;; Signals are caught by `nndiary-schedule'.
1174 (nndiary-error "not an integer value")
1179 (nndiary-error "value out of range"))
1182 (defun nndiary-parse-schedule-value (str min-or-values max)
1196 (nndiary-error "invalid syntax")))
1203 (nndiary-string-to-number (car res) min-or-values max))
1207 (let ((beg (nndiary-string-to-number (car res) min-or-values max))
1208 (end (nndiary-string-to-number (cadr res) min-or-values max)))
1216 (nndiary-error "invalid syntax")))
1222 (defun nndiary-parse-schedule (head min-or-values max)
1231 (nndiary-error "header missing")
1233 (nndiary-parse-schedule-value (match-string 1) min-or-values max))
1236 (defun nndiary-max (spec)
1248 (defun nndiary-flatten (spec min &optional max)
1272 (defun nndiary-unflatten (spec)
1286 (defun nndiary-compute-reminders (date)
1288 ;; See the comment in `nndiary-reminders' about rounding.
1289 (let* ((reminders nndiary-reminders)
1294 (if nndiary-week-starts-on-monday
1331 (defun nndiary-last-occurence (sched)
1334 (let ((minute (nndiary-max (nth 0 sched)))
1335 (hour (nndiary-max (nth 1 sched)))
1336 (year (nndiary-max (nth 4 sched)))
1347 (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>))
1348 (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>))
1355 (setq dom-list (nndiary-flatten dom-list 1 31)))
1358 (setq dow-list (nndiary-flatten dow-list 0 6)))
1360 (setq dom-list (nndiary-flatten dom-list 1 31))
1361 (setq dow-list (nndiary-flatten dow-list 0 6))))
1407 (nnheader-report 'nndiary "Undecidable schedule")
1411 (defun nndiary-next-occurence (sched now)
1421 (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
1422 (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
1424 (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<))
1426 (sort (nndiary-flatten (nth 4 sched) 1971) '<)
1437 (setq dom-list (nndiary-flatten dom-list 1 31)))
1440 (setq dow-list (nndiary-flatten dow-list 0 6)))
1442 (setq dom-list (nndiary-flatten dom-list 1 31))
1443 (setq dow-list (nndiary-flatten dow-list 0 6))))
1540 (nndiary-last-occurence sched))
1542 (nndiary-last-occurence sched))
1545 (defun nndiary-expired-article-p (file)
1548 (let ((sched (nndiary-schedule)))
1552 (setq sched (nndiary-last-occurence sched))
1555 (nnheader-report 'nndiary "Could not read file %s" file)
1559 (defun nndiary-renew-article-p (file timestamp)
1563 (sched (nndiary-schedule)))
1565 ;; between the group timestamp and the current time.
1566 (when (and sched (setq sched (nndiary-next-occurence sched now)))
1568 (append (nndiary-compute-reminders sched) (list sched))))
1578 (nnheader-report 'nndiary "Could not read file %s" file)
1589 nndiary-headers)
1591 (unless (assoc "nndiary" gnus-valid-select-methods)
1592 (gnus-declare-backend "nndiary" 'post-mail 'respool 'address))
1594 (provide 'nndiary)
1598 ;;; nndiary.el ends here