1 |
;;; nnml.el --- mail spool access for Gnus |
;;; nnml.el --- mail spool access for Gnus |
2 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS) |
6 |
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
7 |
|
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
8 |
;; Keywords: news, mail |
;; Keywords: news, mail |
9 |
|
|
10 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
32 |
|
|
33 |
;;; Code: |
;;; Code: |
34 |
|
|
35 |
|
(require 'gnus) |
36 |
(require 'nnheader) |
(require 'nnheader) |
37 |
(require 'nnmail) |
(require 'nnmail) |
38 |
(require 'nnoo) |
(require 'nnoo) |
39 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
40 |
|
|
41 |
(eval-and-compile |
(eval-and-compile |
42 |
(autoload 'gnus-sorted-intersection "gnus-range")) |
(autoload 'gnus-article-unpropagatable-p "gnus-sum")) |
43 |
|
|
44 |
(nnoo-declare nnml) |
(nnoo-declare nnml) |
45 |
|
|
58 |
"If non-nil, nnml will check the incoming mail file and split the mail.") |
"If non-nil, nnml will check the incoming mail file and split the mail.") |
59 |
|
|
60 |
(defvoo nnml-nov-is-evil nil |
(defvoo nnml-nov-is-evil nil |
61 |
"If non-nil, Gnus will never generate and use nov databases for mail groups. |
"If non-nil, Gnus will never generate and use nov databases for mail spools. |
62 |
Using nov databases will speed up header fetching considerably. |
Using nov databases will speed up header fetching considerably. |
63 |
This variable shouldn't be flipped much. If you have, for some reason, |
This variable shouldn't be flipped much. If you have, for some reason, |
64 |
set this to t, and want to set it to nil again, you should always run |
set this to t, and want to set it to nil again, you should always run |
66 |
through all nnml directories and generate nov databases for them |
through all nnml directories and generate nov databases for them |
67 |
all. This may very well take some time.") |
all. This may very well take some time.") |
68 |
|
|
69 |
|
(defvoo nnml-marks-is-evil nil |
70 |
|
"If non-nil, Gnus will never generate and use marks file for mail spools. |
71 |
|
Using marks files makes it possible to backup and restore mail groups |
72 |
|
separately from `.newsrc.eld'. If you have, for some reason, set this |
73 |
|
to t, and want to set it to nil again, you should always remove the |
74 |
|
corresponding marks file (usually named `.marks' in the nnml group |
75 |
|
directory, but see `nnml-marks-file-name') for the group. Then the |
76 |
|
marks file will be regenerated properly by Gnus.") |
77 |
|
|
78 |
(defvoo nnml-prepare-save-mail-hook nil |
(defvoo nnml-prepare-save-mail-hook nil |
79 |
"Hook run narrowed to an article before saving.") |
"Hook run narrowed to an article before saving.") |
80 |
|
|
81 |
(defvoo nnml-inhibit-expiry nil |
(defvoo nnml-inhibit-expiry nil |
82 |
"If non-nil, inhibit expiry.") |
"If non-nil, inhibit expiry.") |
83 |
|
|
84 |
|
(defvoo nnml-use-compressed-files nil |
85 |
|
"If non-nil, allow using compressed message files.") |
86 |
|
|
87 |
|
|
88 |
|
|
90 |
"nnml version.") |
"nnml version.") |
91 |
|
|
92 |
(defvoo nnml-nov-file-name ".overview") |
(defvoo nnml-nov-file-name ".overview") |
93 |
|
(defvoo nnml-marks-file-name ".marks") |
94 |
|
|
95 |
(defvoo nnml-current-directory nil) |
(defvoo nnml-current-directory nil) |
96 |
(defvoo nnml-current-group nil) |
(defvoo nnml-current-group nil) |
106 |
|
|
107 |
(defvoo nnml-file-coding-system nnmail-file-coding-system) |
(defvoo nnml-file-coding-system nnmail-file-coding-system) |
108 |
|
|
109 |
|
(defvoo nnml-marks nil) |
110 |
|
|
111 |
|
(defvar nnml-marks-modtime (gnus-make-hashtable)) |
112 |
|
|
113 |
|
|
114 |
;;; Interface functions. |
;;; Interface functions. |
115 |
|
|
116 |
(nnoo-define-basics nnml) |
(nnoo-define-basics nnml) |
120 |
(save-excursion |
(save-excursion |
121 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
122 |
(erase-buffer) |
(erase-buffer) |
123 |
(let ((file nil) |
(let* ((file nil) |
124 |
(number (length sequence)) |
(number (length sequence)) |
125 |
(count 0) |
(count 0) |
126 |
(file-name-coding-system nnmail-pathname-coding-system) |
(file-name-coding-system nnmail-pathname-coding-system) |
127 |
beg article) |
beg article) |
128 |
(if (stringp (car sequence)) |
(if (stringp (car sequence)) |
129 |
'headers |
'headers |
130 |
(if (nnml-retrieve-headers-with-nov sequence fetch-old) |
(if (nnml-retrieve-headers-with-nov sequence fetch-old) |
139 |
(setq beg (point)) |
(setq beg (point)) |
140 |
(nnheader-insert-head file) |
(nnheader-insert-head file) |
141 |
(goto-char beg) |
(goto-char beg) |
142 |
(if (search-forward "\n\n" nil t) |
(if (re-search-forward "\n\r?\n" nil t) |
143 |
(forward-char -1) |
(forward-char -1) |
144 |
(goto-char (point-max)) |
(goto-char (point-max)) |
145 |
(insert "\n\n")) |
(insert "\n\n")) |
176 |
server nnml-directory) |
server nnml-directory) |
177 |
t))) |
t))) |
178 |
|
|
179 |
(defun nnml-request-regenerate (server) |
(deffoo nnml-request-regenerate (server) |
180 |
(nnml-possibly-change-directory nil server) |
(nnml-possibly-change-directory nil server) |
181 |
(nnml-generate-nov-databases) |
(nnml-generate-nov-databases server) |
182 |
t) |
t) |
183 |
|
|
184 |
(deffoo nnml-request-article (id &optional group server buffer) |
(deffoo nnml-request-article (id &optional group server buffer) |
263 |
nnml-group-alist) |
nnml-group-alist) |
264 |
(nnml-possibly-create-directory group) |
(nnml-possibly-create-directory group) |
265 |
(nnml-possibly-change-directory group server) |
(nnml-possibly-change-directory group server) |
266 |
(let ((articles (nnheader-directory-articles nnml-current-directory))) |
(let ((articles (nnml-directory-articles nnml-current-directory))) |
267 |
(when articles |
(when articles |
268 |
(setcar active (apply 'min articles)) |
(setcar active (apply 'min articles)) |
269 |
(setcdr active (apply 'max articles)))) |
(setcdr active (apply 'max articles)))) |
288 |
(deffoo nnml-request-expire-articles (articles group &optional server force) |
(deffoo nnml-request-expire-articles (articles group &optional server force) |
289 |
(nnml-possibly-change-directory group server) |
(nnml-possibly-change-directory group server) |
290 |
(let ((active-articles |
(let ((active-articles |
291 |
(nnheader-directory-articles nnml-current-directory)) |
(nnml-directory-articles nnml-current-directory)) |
292 |
(is-old t) |
(is-old t) |
293 |
article rest mod-time number) |
article rest mod-time number) |
294 |
(nnmail-activate 'nnml) |
(nnmail-activate 'nnml) |
299 |
(setq articles (gnus-sorted-intersection articles active-articles)) |
(setq articles (gnus-sorted-intersection articles active-articles)) |
300 |
|
|
301 |
(while (and articles is-old) |
(while (and articles is-old) |
302 |
(when (setq article (nnml-article-to-file (setq number (pop articles)))) |
(if (and (setq article (nnml-article-to-file |
303 |
(when (setq mod-time (nth 5 (file-attributes article))) |
(setq number (pop articles)))) |
304 |
(if (and (nnml-deletable-article-p group number) |
(setq mod-time (nth 5 (file-attributes article))) |
305 |
(setq is-old |
(nnml-deletable-article-p group number) |
306 |
(nnmail-expired-article-p group mod-time force |
(setq is-old (nnmail-expired-article-p group mod-time force |
307 |
nnml-inhibit-expiry))) |
nnml-inhibit-expiry))) |
308 |
(progn |
(progn |
309 |
;; Allow a special target group. |
;; Allow a special target group. |
310 |
(unless (eq nnmail-expiry-target 'delete) |
(unless (eq nnmail-expiry-target 'delete) |
311 |
(with-temp-buffer |
(with-temp-buffer |
312 |
(nnml-request-article number group server |
(nnml-request-article number group server (current-buffer)) |
313 |
(current-buffer)) |
(let (nnml-current-directory |
314 |
(let ((nnml-current-directory nil)) |
nnml-current-group |
315 |
(nnmail-expiry-target-group |
nnml-article-file-alist) |
316 |
nnmail-expiry-target group)))) |
(nnmail-expiry-target-group nnmail-expiry-target group))) |
317 |
(nnheader-message 5 "Deleting article %s in %s" |
;; Maybe directory is changed during nnmail-expiry-target-group. |
318 |
number group) |
(nnml-possibly-change-directory group server)) |
319 |
(condition-case () |
(nnheader-message 5 "Deleting article %s in %s" |
320 |
(funcall nnmail-delete-file-function article) |
number group) |
321 |
(file-error |
(condition-case () |
322 |
(push number rest))) |
(funcall nnmail-delete-file-function article) |
323 |
(setq active-articles (delq number active-articles)) |
(file-error |
324 |
(nnml-nov-delete-article group number)) |
(push number rest))) |
325 |
(push number rest))))) |
(setq active-articles (delq number active-articles)) |
326 |
|
(nnml-nov-delete-article group number)) |
327 |
|
(push number rest))) |
328 |
(let ((active (nth 1 (assoc group nnml-group-alist)))) |
(let ((active (nth 1 (assoc group nnml-group-alist)))) |
329 |
(when active |
(when active |
330 |
(setcar active (or (and active-articles |
(setcar active (or (and active-articles |
369 |
(nnmail-check-syntax) |
(nnmail-check-syntax) |
370 |
(let (result) |
(let (result) |
371 |
(when nnmail-cache-accepted-message-ids |
(when nnmail-cache-accepted-message-ids |
372 |
(nnmail-cache-insert (nnmail-fetch-field "message-id"))) |
(nnmail-cache-insert (nnmail-fetch-field "message-id") |
373 |
|
group |
374 |
|
(nnmail-fetch-field "subject") |
375 |
|
(nnmail-fetch-field "from"))) |
376 |
(if (stringp group) |
(if (stringp group) |
377 |
(and |
(and |
378 |
(nnmail-activate 'nnml) |
(nnmail-activate 'nnml) |
394 |
(nnml-save-nov)))) |
(nnml-save-nov)))) |
395 |
result)) |
result)) |
396 |
|
|
397 |
|
(deffoo nnml-request-post (&optional server) |
398 |
|
(nnmail-do-request-post 'nnml-request-accept-article server)) |
399 |
|
|
400 |
(deffoo nnml-request-replace-article (article group buffer) |
(deffoo nnml-request-replace-article (article group buffer) |
401 |
(nnml-possibly-change-directory group) |
(nnml-possibly-change-directory group) |
402 |
(save-excursion |
(save-excursion |
421 |
(if (or (looking-at art) |
(if (or (looking-at art) |
422 |
(search-forward (concat "\n" art) nil t)) |
(search-forward (concat "\n" art) nil t)) |
423 |
;; Delete the old NOV line. |
;; Delete the old NOV line. |
424 |
(delete-region (progn (beginning-of-line) (point)) |
(gnus-delete-line) |
|
(progn (forward-line 1) (point))) |
|
425 |
;; The line isn't here, so we have to find out where |
;; The line isn't here, so we have to find out where |
426 |
;; we should insert it. (This situation should never |
;; we should insert it. (This situation should never |
427 |
;; occur, but one likes to make sure...) |
;; occur, but one likes to make sure...) |
444 |
(directory-files |
(directory-files |
445 |
nnml-current-directory t |
nnml-current-directory t |
446 |
(concat nnheader-numerical-short-files |
(concat nnheader-numerical-short-files |
447 |
"\\|" (regexp-quote nnml-nov-file-name) "$"))) |
"\\|" (regexp-quote nnml-nov-file-name) "$" |
448 |
|
"\\|" (regexp-quote nnml-marks-file-name) "$"))) |
449 |
article) |
article) |
450 |
(while articles |
(while articles |
451 |
(setq article (pop articles)) |
(setq article (pop articles)) |
483 |
(let ((overview (concat old-dir nnml-nov-file-name))) |
(let ((overview (concat old-dir nnml-nov-file-name))) |
484 |
(when (file-exists-p overview) |
(when (file-exists-p overview) |
485 |
(rename-file overview (concat new-dir nnml-nov-file-name)))) |
(rename-file overview (concat new-dir nnml-nov-file-name)))) |
486 |
|
;; Move .marks file. |
487 |
|
(let ((marks (concat old-dir nnml-marks-file-name))) |
488 |
|
(when (file-exists-p marks) |
489 |
|
(rename-file marks (concat new-dir nnml-marks-file-name)))) |
490 |
(when (<= (length (directory-files old-dir)) 2) |
(when (<= (length (directory-files old-dir)) 2) |
491 |
(ignore-errors (delete-directory old-dir))) |
(ignore-errors (delete-directory old-dir))) |
492 |
;; That went ok, so we change the internal structures. |
;; That went ok, so we change the internal structures. |
517 |
(defun nnml-article-to-file (article) |
(defun nnml-article-to-file (article) |
518 |
(nnml-update-file-alist) |
(nnml-update-file-alist) |
519 |
(let (file) |
(let (file) |
520 |
(if (setq file (cdr (assq article nnml-article-file-alist))) |
(if (setq file |
521 |
|
(if nnml-use-compressed-files |
522 |
|
(cdr (assq article nnml-article-file-alist)) |
523 |
|
(number-to-string article))) |
524 |
(expand-file-name file nnml-current-directory) |
(expand-file-name file nnml-current-directory) |
525 |
;; Just to make sure nothing went wrong when reading over NFS -- |
(when (not nnheader-directory-files-is-safe) |
526 |
;; check once more. |
;; Just to make sure nothing went wrong when reading over NFS -- |
527 |
(when (file-exists-p |
;; check once more. |
528 |
(setq file (expand-file-name (number-to-string article) |
(when (file-exists-p |
529 |
nnml-current-directory))) |
(setq file (expand-file-name (number-to-string article) |
530 |
(nnml-update-file-alist t) |
nnml-current-directory))) |
531 |
file)))) |
(nnml-update-file-alist t) |
532 |
|
file))))) |
533 |
|
|
534 |
(defun nnml-deletable-article-p (group article) |
(defun nnml-deletable-article-p (group article) |
535 |
"Say whether ARTICLE in GROUP can be deleted." |
"Say whether ARTICLE in GROUP can be deleted." |
551 |
;; likely that the article we are looking for is in that group. |
;; likely that the article we are looking for is in that group. |
552 |
(if (setq number (nnml-find-id nnml-current-group id)) |
(if (setq number (nnml-find-id nnml-current-group id)) |
553 |
(cons nnml-current-group number) |
(cons nnml-current-group number) |
554 |
;; It wasn't there, so we look through the other groups as well. |
;; It wasn't there, so we look through the other groups as well. |
555 |
(while (and (not number) |
(while (and (not number) |
556 |
alist) |
alist) |
557 |
(or (string= (caar alist) nnml-current-group) |
(or (string= (caar alist) nnml-current-group) |
621 |
|
|
622 |
(defun nnml-save-mail (group-art) |
(defun nnml-save-mail (group-art) |
623 |
"Called narrowed to an article." |
"Called narrowed to an article." |
624 |
(let (chars headers) |
(let (chars headers extension) |
625 |
(setq chars (nnmail-insert-lines)) |
(setq chars (nnmail-insert-lines)) |
626 |
|
(setq extension |
627 |
|
(and nnml-use-compressed-files |
628 |
|
(> chars 1000) |
629 |
|
".gz")) |
630 |
(nnmail-insert-xref group-art) |
(nnmail-insert-xref group-art) |
631 |
(run-hooks 'nnmail-prepare-save-mail-hook) |
(run-hooks 'nnmail-prepare-save-mail-hook) |
632 |
(run-hooks 'nnml-prepare-save-mail-hook) |
(run-hooks 'nnml-prepare-save-mail-hook) |
641 |
(nnml-possibly-create-directory (caar ga)) |
(nnml-possibly-create-directory (caar ga)) |
642 |
(let ((file (concat (nnmail-group-pathname |
(let ((file (concat (nnmail-group-pathname |
643 |
(caar ga) nnml-directory) |
(caar ga) nnml-directory) |
644 |
(int-to-string (cdar ga))))) |
(int-to-string (cdar ga)) |
645 |
|
extension))) |
646 |
(if first |
(if first |
647 |
;; It was already saved, so we just make a hard link. |
;; It was already saved, so we just make a hard link. |
648 |
(funcall nnmail-crosspost-link-function first file t) |
(funcall nnmail-crosspost-link-function first file t) |
675 |
(unless nnml-article-file-alist |
(unless nnml-article-file-alist |
676 |
(setq nnml-article-file-alist |
(setq nnml-article-file-alist |
677 |
(sort |
(sort |
678 |
(nnheader-article-to-file-alist nnml-current-directory) |
(nnml-current-group-article-to-file-alist) |
679 |
'car-less-than-car))) |
'car-less-than-car))) |
680 |
(setq active |
(setq active |
681 |
(if nnml-article-file-alist |
(if nnml-article-file-alist |
699 |
(nnheader-insert-nov headers))) |
(nnheader-insert-nov headers))) |
700 |
|
|
701 |
(defsubst nnml-header-value () |
(defsubst nnml-header-value () |
702 |
(buffer-substring (match-end 0) (progn (end-of-line) (point)))) |
(buffer-substring (match-end 0) (gnus-point-at-eol))) |
703 |
|
|
704 |
(defun nnml-parse-head (chars &optional number) |
(defun nnml-parse-head (chars &optional number) |
705 |
"Parse the head of the current buffer." |
"Parse the head of the current buffer." |
708 |
(unless (zerop (buffer-size)) |
(unless (zerop (buffer-size)) |
709 |
(narrow-to-region |
(narrow-to-region |
710 |
(goto-char (point-min)) |
(goto-char (point-min)) |
711 |
(if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) |
(if (re-search-forward "\n\r?\n" nil t) |
712 |
;; Fold continuation lines. |
(1- (point)) |
713 |
(goto-char (point-min)) |
(point-max)))) |
714 |
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) |
(let ((headers (nnheader-parse-naked-head))) |
|
(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))) |
|
715 |
(mail-header-set-chars headers chars) |
(mail-header-set-chars headers chars) |
716 |
(mail-header-set-number headers number) |
(mail-header-set-number headers number) |
717 |
headers)))) |
headers)))) |
718 |
|
|
719 |
|
(defun nnml-get-nov-buffer (group) |
720 |
|
(let ((buffer (get-buffer-create (format " *nnml overview %s*" group)))) |
721 |
|
(save-excursion |
722 |
|
(set-buffer buffer) |
723 |
|
(set (make-local-variable 'nnml-nov-buffer-file-name) |
724 |
|
(expand-file-name |
725 |
|
nnml-nov-file-name |
726 |
|
(nnmail-group-pathname group nnml-directory))) |
727 |
|
(erase-buffer) |
728 |
|
(when (file-exists-p nnml-nov-buffer-file-name) |
729 |
|
(nnheader-insert-file-contents nnml-nov-buffer-file-name))) |
730 |
|
buffer)) |
731 |
|
|
732 |
(defun nnml-open-nov (group) |
(defun nnml-open-nov (group) |
733 |
(or (cdr (assoc group nnml-nov-buffer-alist)) |
(or (cdr (assoc group nnml-nov-buffer-alist)) |
734 |
(let ((buffer (get-buffer-create (format " *nnml overview %s*" group)))) |
(let ((buffer (nnml-get-nov-buffer group))) |
|
(save-excursion |
|
|
(set-buffer buffer) |
|
|
(set (make-local-variable 'nnml-nov-buffer-file-name) |
|
|
(expand-file-name |
|
|
nnml-nov-file-name |
|
|
(nnmail-group-pathname group nnml-directory))) |
|
|
(erase-buffer) |
|
|
(when (file-exists-p nnml-nov-buffer-file-name) |
|
|
(nnheader-insert-file-contents nnml-nov-buffer-file-name))) |
|
735 |
(push (cons group buffer) nnml-nov-buffer-alist) |
(push (cons group buffer) nnml-nov-buffer-alist) |
736 |
buffer))) |
buffer))) |
737 |
|
|
748 |
(setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) |
(setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) |
749 |
|
|
750 |
;;;###autoload |
;;;###autoload |
751 |
(defun nnml-generate-nov-databases () |
(defun nnml-generate-nov-databases (&optional server) |
752 |
"Generate NOV databases in all nnml directories." |
"Generate NOV databases in all nnml directories." |
753 |
(interactive) |
(interactive (list (or (nnoo-current-server 'nnml) ""))) |
754 |
;; Read the active file to make sure we don't re-use articles |
;; Read the active file to make sure we don't re-use articles |
755 |
;; numbers in empty groups. |
;; numbers in empty groups. |
756 |
(nnmail-activate 'nnml) |
(nnmail-activate 'nnml) |
757 |
(nnml-open-server (or (nnoo-current-server 'nnml) "")) |
(unless (nnml-server-opened server) |
758 |
|
(nnml-open-server server)) |
759 |
(setq nnml-directory (expand-file-name nnml-directory)) |
(setq nnml-directory (expand-file-name nnml-directory)) |
760 |
;; Recurse down the directories. |
;; Recurse down the directories. |
761 |
(nnml-generate-nov-databases-1 nnml-directory nil t) |
(nnml-generate-nov-databases-1 nnml-directory nil t) |
794 |
(eval-when-compile (defvar files)) |
(eval-when-compile (defvar files)) |
795 |
(defun nnml-generate-active-info (dir) |
(defun nnml-generate-active-info (dir) |
796 |
;; Update the active info for this group. |
;; Update the active info for this group. |
797 |
(let ((group (nnheader-file-to-group |
(let* ((group (nnheader-file-to-group |
798 |
(directory-file-name dir) nnml-directory))) |
(directory-file-name dir) nnml-directory)) |
799 |
(setq nnml-group-alist |
(entry (assoc group nnml-group-alist)) |
800 |
(delq (assoc group nnml-group-alist) nnml-group-alist)) |
(last (or (caadr entry) 0))) |
801 |
|
(setq nnml-group-alist (delq entry nnml-group-alist)) |
802 |
(push (list group |
(push (list group |
803 |
(cons (caar files) |
(cons (or (caar files) (1+ last)) |
804 |
(let ((f files)) |
(max last |
805 |
(while (cdr f) (setq f (cdr f))) |
(or (let ((f files)) |
806 |
(caar f)))) |
(while (cdr f) (setq f (cdr f))) |
807 |
|
(caar f)) |
808 |
|
0)))) |
809 |
nnml-group-alist))) |
nnml-group-alist))) |
810 |
|
|
811 |
(defun nnml-generate-nov-file (dir files) |
(defun nnml-generate-nov-file (dir files) |
829 |
(narrow-to-region |
(narrow-to-region |
830 |
(goto-char (point-min)) |
(goto-char (point-min)) |
831 |
(progn |
(progn |
832 |
(search-forward "\n\n" nil t) |
(re-search-forward "\n\r?\n" nil t) |
833 |
(setq chars (- (point-max) (point))) |
(setq chars (- (point-max) (point))) |
834 |
(max (point-min) (1- (point))))) |
(max (point-min) (1- (point))))) |
835 |
(unless (zerop (buffer-size)) |
(unless (zerop (buffer-size)) |
863 |
t)) |
t)) |
864 |
|
|
865 |
(defun nnml-update-file-alist (&optional force) |
(defun nnml-update-file-alist (&optional force) |
866 |
(when (or (not nnml-article-file-alist) |
(when nnml-use-compressed-files |
867 |
force) |
(when (or (not nnml-article-file-alist) |
868 |
(setq nnml-article-file-alist |
force) |
869 |
(nnheader-article-to-file-alist nnml-current-directory)))) |
(setq nnml-article-file-alist |
870 |
|
(nnml-current-group-article-to-file-alist))))) |
871 |
|
|
872 |
|
(defun nnml-directory-articles (dir) |
873 |
|
"Return a list of all article files in a directory. |
874 |
|
Use the nov database for that directory if available." |
875 |
|
(if (or gnus-nov-is-evil nnml-nov-is-evil |
876 |
|
(not (file-exists-p |
877 |
|
(expand-file-name nnml-nov-file-name dir)))) |
878 |
|
(nnheader-directory-articles dir) |
879 |
|
;; build list from .overview if available |
880 |
|
;; We would use nnml-open-nov, except that nnml-nov-buffer-alist is |
881 |
|
;; defvoo'd, and we might get called when it hasn't been swapped in. |
882 |
|
(save-excursion |
883 |
|
(let ((list nil) |
884 |
|
art |
885 |
|
(buffer (nnml-get-nov-buffer nnml-current-group))) |
886 |
|
(set-buffer buffer) |
887 |
|
(goto-char (point-min)) |
888 |
|
(while (not (eobp)) |
889 |
|
(setq art (read (current-buffer))) |
890 |
|
(push art list) |
891 |
|
(forward-line 1)) |
892 |
|
list)))) |
893 |
|
|
894 |
|
(defun nnml-current-group-article-to-file-alist () |
895 |
|
"Return an alist of article/file pairs in the current group. |
896 |
|
Use the nov database for the current group if available." |
897 |
|
(if (or nnml-use-compressed-files |
898 |
|
gnus-nov-is-evil |
899 |
|
nnml-nov-is-evil |
900 |
|
(not (file-exists-p |
901 |
|
(expand-file-name nnml-nov-file-name |
902 |
|
nnml-current-directory)))) |
903 |
|
(nnheader-article-to-file-alist nnml-current-directory) |
904 |
|
;; build list from .overview if available |
905 |
|
(save-excursion |
906 |
|
(let ((alist nil) |
907 |
|
(buffer (nnml-get-nov-buffer nnml-current-group)) |
908 |
|
art) |
909 |
|
(set-buffer buffer) |
910 |
|
(goto-char (point-min)) |
911 |
|
(while (not (eobp)) |
912 |
|
(setq art (read (current-buffer))) |
913 |
|
;; assume file name is unadorned (ie. not compressed etc) |
914 |
|
(push (cons art (int-to-string art)) alist) |
915 |
|
(forward-line 1)) |
916 |
|
alist)))) |
917 |
|
|
918 |
|
(deffoo nnml-request-set-mark (group actions &optional server) |
919 |
|
(nnml-possibly-change-directory group server) |
920 |
|
(unless nnml-marks-is-evil |
921 |
|
(nnml-open-marks group server) |
922 |
|
(dolist (action actions) |
923 |
|
(let ((range (nth 0 action)) |
924 |
|
(what (nth 1 action)) |
925 |
|
(marks (nth 2 action))) |
926 |
|
(assert (or (eq what 'add) (eq what 'del)) t |
927 |
|
"Unknown request-set-mark action: %s" what) |
928 |
|
(dolist (mark marks) |
929 |
|
(setq nnml-marks (gnus-update-alist-soft |
930 |
|
mark |
931 |
|
(funcall (if (eq what 'add) 'gnus-range-add |
932 |
|
'gnus-remove-from-range) |
933 |
|
(cdr (assoc mark nnml-marks)) range) |
934 |
|
nnml-marks))))) |
935 |
|
(nnml-save-marks group server)) |
936 |
|
nil) |
937 |
|
|
938 |
|
(deffoo nnml-request-update-info (group info &optional server) |
939 |
|
(nnml-possibly-change-directory group server) |
940 |
|
(when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group)) |
941 |
|
(nnheader-message 8 "Updating marks for %s..." group) |
942 |
|
(nnml-open-marks group server) |
943 |
|
;; Update info using `nnml-marks'. |
944 |
|
(mapcar (lambda (pred) |
945 |
|
(unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) |
946 |
|
(gnus-info-set-marks |
947 |
|
info |
948 |
|
(gnus-update-alist-soft |
949 |
|
(cdr pred) |
950 |
|
(cdr (assq (cdr pred) nnml-marks)) |
951 |
|
(gnus-info-marks info)) |
952 |
|
t))) |
953 |
|
gnus-article-mark-lists) |
954 |
|
(let ((seen (cdr (assq 'read nnml-marks)))) |
955 |
|
(gnus-info-set-read info |
956 |
|
(if (and (integerp (car seen)) |
957 |
|
(null (cdr seen))) |
958 |
|
(list (cons (car seen) (car seen))) |
959 |
|
seen))) |
960 |
|
(nnheader-message 8 "Updating marks for %s...done" group)) |
961 |
|
info) |
962 |
|
|
963 |
|
(defun nnml-marks-changed-p (group) |
964 |
|
(let ((file (expand-file-name nnml-marks-file-name |
965 |
|
(nnmail-group-pathname group nnml-directory)))) |
966 |
|
(if (null (gnus-gethash file nnml-marks-modtime)) |
967 |
|
t ;; never looked at marks file, assume it has changed |
968 |
|
(not (equal (gnus-gethash file nnml-marks-modtime) |
969 |
|
(nth 5 (file-attributes file))))))) |
970 |
|
|
971 |
|
(defun nnml-save-marks (group server) |
972 |
|
(let ((file-name-coding-system nnmail-pathname-coding-system) |
973 |
|
(file (expand-file-name nnml-marks-file-name |
974 |
|
(nnmail-group-pathname group nnml-directory)))) |
975 |
|
(condition-case err |
976 |
|
(progn |
977 |
|
(nnml-possibly-create-directory group) |
978 |
|
(with-temp-file file |
979 |
|
(erase-buffer) |
980 |
|
(gnus-prin1 nnml-marks) |
981 |
|
(insert "\n")) |
982 |
|
(gnus-sethash file |
983 |
|
(nth 5 (file-attributes file)) |
984 |
|
nnml-marks-modtime)) |
985 |
|
(error (or (gnus-yes-or-no-p |
986 |
|
(format "Could not write to %s (%s). Continue? " file err)) |
987 |
|
(error "Cannot write to %s (%s)" err)))))) |
988 |
|
|
989 |
|
(defun nnml-open-marks (group server) |
990 |
|
(let ((file (expand-file-name |
991 |
|
nnml-marks-file-name |
992 |
|
(nnmail-group-pathname group nnml-directory)))) |
993 |
|
(if (file-exists-p file) |
994 |
|
(condition-case err |
995 |
|
(with-temp-buffer |
996 |
|
(gnus-sethash file (nth 5 (file-attributes file)) |
997 |
|
nnml-marks-modtime) |
998 |
|
(nnheader-insert-file-contents file) |
999 |
|
(setq nnml-marks (read (current-buffer))) |
1000 |
|
(dolist (el gnus-article-unpropagated-mark-lists) |
1001 |
|
(setq nnml-marks (gnus-remassoc el nnml-marks)))) |
1002 |
|
(error (or (gnus-yes-or-no-p |
1003 |
|
(format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) |
1004 |
|
(error "Cannot read nnml marks file %s (%s)" file err)))) |
1005 |
|
;; User didn't have a .marks file. Probably first time |
1006 |
|
;; user of the .marks stuff. Bootstrap it from .newsrc.eld. |
1007 |
|
(let ((info (gnus-get-info |
1008 |
|
(gnus-group-prefixed-name |
1009 |
|
group |
1010 |
|
(gnus-server-to-method (format "nnml:%s" server)))))) |
1011 |
|
(nnheader-message 7 "Bootstrapping marks for %s..." group) |
1012 |
|
(setq nnml-marks (gnus-info-marks info)) |
1013 |
|
(push (cons 'read (gnus-info-read info)) nnml-marks) |
1014 |
|
(dolist (el gnus-article-unpropagated-mark-lists) |
1015 |
|
(setq nnml-marks (gnus-remassoc el nnml-marks))) |
1016 |
|
(nnml-save-marks group server) |
1017 |
|
(nnheader-message 7 "Bootstrapping marks for %s...done" group))))) |
1018 |
|
|
1019 |
(provide 'nnml) |
(provide 'nnml) |
1020 |
|
|