Revision: miles@gnu.org--gnu-2004/gnus--devo--0--patch-21

[gnus] / lisp / nnml.el

diff --git a/lisp/nnml.el b/lisp/nnml.el
index 3fa8584..3662db9 100644 (file)
--- a/lisp/nnml.el
+++ b/lisp/nnml.el
@@ -1,10 +1,10 @@
 ;;; nnml.el --- mail spool access for Gnus
 ;;; nnml.el --- mail spool access for Gnus

-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003

 ;;        Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>

-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>

 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.


@@ -44,26 +44,18 @@
 (nnoo-declare nnml)
 
 (defvoo nnml-directory message-directory
 (nnoo-declare nnml)
 
 (defvoo nnml-directory message-directory

-  "Spool directory for the nnml mail backend.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "Spool directory for the nnml mail backend.")

 
 (defvoo nnml-active-file
     (expand-file-name "active" nnml-directory)
 
 (defvoo nnml-active-file
     (expand-file-name "active" nnml-directory)

-  "Mail active file.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "Mail active file.")

 
 (defvoo nnml-newsgroups-file
     (expand-file-name "newsgroups" nnml-directory)
 
 (defvoo nnml-newsgroups-file
     (expand-file-name "newsgroups" nnml-directory)

-  "Mail newsgroups description file.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "Mail newsgroups description file.")

 
 (defvoo nnml-get-new-mail t
 
 (defvoo nnml-get-new-mail t

-  "If non-nil, nnml will check the incoming mail file and split the mail.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "If non-nil, nnml will check the incoming mail file and split the mail.")

 
 (defvoo nnml-nov-is-evil nil
   "If non-nil, Gnus will never generate and use nov databases for mail spools.
 
 (defvoo nnml-nov-is-evil nil
   "If non-nil, Gnus will never generate and use nov databases for mail spools.


@@ -72,9 +64,7 @@ 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 `nnml-generate-nov-databases' command.  The function will go
 through all nnml directories and generate nov databases for them
 set this to t, and want to set it to nil again, you should always run
 the `nnml-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.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+all.  This may very well take some time.")

 
 (defvoo nnml-marks-is-evil nil
   "If non-nil, Gnus will never generate and use marks file for mail spools.
 
 (defvoo nnml-marks-is-evil nil
   "If non-nil, Gnus will never generate and use marks file for mail spools.


@@ -83,27 +73,16 @@ separately from `.newsrc.eld'.  If you have, for some reason, set this
 to t, and want to set it to nil again, you should always remove the
 corresponding marks file (usually named `.marks' in the nnml group
 directory, but see `nnml-marks-file-name') for the group.  Then the
 to t, and want to set it to nil again, you should always remove the
 corresponding marks file (usually named `.marks' in the nnml group
 directory, but see `nnml-marks-file-name') for the group.  Then the

-marks file will be regenerated properly by Gnus.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
-
-(defvoo nnml-filenames-are-evil t
-  "If non-nil, Gnus will not assume that the articles file name 
-is the same as the article number listed in the nov database.  This 
-variable should be set if any of the files are compressed.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+marks file will be regenerated properly by Gnus.")

 
 (defvoo nnml-prepare-save-mail-hook nil
 
 (defvoo nnml-prepare-save-mail-hook nil

-  "Hook run narrowed to an article before saving.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "Hook run narrowed to an article before saving.")

 
 (defvoo nnml-inhibit-expiry nil
 
 (defvoo nnml-inhibit-expiry nil

-  "If non-nil, inhibit expiry.
-
-This variable is a virtual server slot.  See the Gnus manual for details.")
+  "If non-nil, inhibit expiry.")

 
 

+(defvoo nnml-use-compressed-files nil
+  "If non-nil, allow using compressed message files.")

 
 \f
 
 
 \f
 


@@ -320,7 +299,8 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
     (setq articles (gnus-sorted-intersection articles active-articles))
 
     (while (and articles is-old)
     (setq articles (gnus-sorted-intersection articles active-articles))
 
     (while (and articles is-old)

-      (if (and (setq article (nnml-article-to-file (setq number (pop articles))))
+      (if (and (setq article (nnml-article-to-file
+                             (setq number (pop articles))))

               (setq mod-time (nth 5 (file-attributes article)))
               (nnml-deletable-article-p group number)
               (setq is-old (nnmail-expired-article-p group mod-time force
               (setq mod-time (nth 5 (file-attributes article)))
               (nnml-deletable-article-p group number)
               (setq is-old (nnmail-expired-article-p group mod-time force


@@ -389,7 +369,10 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
   (nnmail-check-syntax)
   (let (result)
     (when nnmail-cache-accepted-message-ids
   (nnmail-check-syntax)
   (let (result)
     (when nnmail-cache-accepted-message-ids

-      (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+      (nnmail-cache-insert (nnmail-fetch-field "message-id") 
+                          group
+                          (nnmail-fetch-field "subject")
+                          (nnmail-fetch-field "from")))

     (if (stringp group)
        (and
         (nnmail-activate 'nnml)
     (if (stringp group)
        (and
         (nnmail-activate 'nnml)


@@ -438,8 +421,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
          (if (or (looking-at art)
                  (search-forward (concat "\n" art) nil t))
              ;; Delete the old NOV line.
          (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)))
+             (gnus-delete-line)

            ;; 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...)
            ;; 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...)


@@ -535,16 +517,19 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 (defun nnml-article-to-file (article)
   (nnml-update-file-alist)
   (let (file)
 (defun nnml-article-to-file (article)
   (nnml-update-file-alist)
   (let (file)

-    (if (setq file (cdr (assq article nnml-article-file-alist)))
+    (if (setq file
+             (if nnml-use-compressed-files
+                 (cdr (assq article nnml-article-file-alist))
+               (number-to-string article)))

        (expand-file-name file nnml-current-directory)
        (expand-file-name file nnml-current-directory)

-      (if (not nnheader-directory-files-is-safe)
-         ;; Just to make sure nothing went wrong when reading over NFS --
-         ;; check once more.
-         (when (file-exists-p
-                (setq file (expand-file-name (number-to-string article)
-                                             nnml-current-directory)))
-           (nnml-update-file-alist t)
-           file)))))
+      (when (not nnheader-directory-files-is-safe)
+       ;; Just to make sure nothing went wrong when reading over NFS --
+       ;; check once more.
+       (when (file-exists-p
+              (setq file (expand-file-name (number-to-string article)
+                                           nnml-current-directory)))
+         (nnml-update-file-alist t)
+         file)))))

 
 (defun nnml-deletable-article-p (group article)
   "Say whether ARTICLE in GROUP can be deleted."
 
 (defun nnml-deletable-article-p (group article)
   "Say whether ARTICLE in GROUP can be deleted."


@@ -587,7 +572,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
                  (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)
                  (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))))
+                     (not (search-backward "\t" (point-at-bol) t))))

            (forward-line 1)
          (beginning-of-line)
          (setq found t)
            (forward-line 1)
          (beginning-of-line)
          (setq found t)


@@ -636,8 +621,12 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
 
 (defun nnml-save-mail (group-art)
   "Called narrowed to an article."
 
 (defun nnml-save-mail (group-art)
   "Called narrowed to an article."

-  (let (chars headers)
+  (let (chars headers extension)

     (setq chars (nnmail-insert-lines))
     (setq chars (nnmail-insert-lines))

+    (setq extension
+         (and nnml-use-compressed-files
+              (> chars 1000)
+              ".gz"))

     (nnmail-insert-xref group-art)
     (run-hooks 'nnmail-prepare-save-mail-hook)
     (run-hooks 'nnml-prepare-save-mail-hook)
     (nnmail-insert-xref group-art)
     (run-hooks 'nnmail-prepare-save-mail-hook)
     (run-hooks 'nnml-prepare-save-mail-hook)


@@ -652,7 +641,8 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
        (nnml-possibly-create-directory (caar ga))
        (let ((file (concat (nnmail-group-pathname
                             (caar ga) nnml-directory)
        (nnml-possibly-create-directory (caar ga))
        (let ((file (concat (nnmail-group-pathname
                             (caar ga) nnml-directory)

-                           (int-to-string (cdar ga)))))
+                           (int-to-string (cdar ga))
+                           extension)))

          (if first
              ;; It was already saved, so we just make a hard link.
              (funcall nnmail-crosspost-link-function first file t)
          (if first
              ;; It was already saved, so we just make a hard link.
              (funcall nnmail-crosspost-link-function first file t)


@@ -709,7 +699,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
     (nnheader-insert-nov headers)))
 
 (defsubst nnml-header-value ()
     (nnheader-insert-nov headers)))
 
 (defsubst nnml-header-value ()

-  (buffer-substring (match-end 0) (progn (end-of-line) (point))))
+  (buffer-substring (match-end 0) (point-at-eol)))

 
 (defun nnml-parse-head (chars &optional number)
   "Parse the head of the current buffer."
 
 (defun nnml-parse-head (chars &optional number)
   "Parse the head of the current buffer."


@@ -718,16 +708,10 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
       (unless (zerop (buffer-size))
        (narrow-to-region
         (goto-char (point-min))
       (unless (zerop (buffer-size))
        (narrow-to-region
         (goto-char (point-min))

-        (if (re-search-forward "\n\r?\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 ? )
-      ;; Remove any ^M's; they are too confusing.
-      (subst-char-in-region (point-min) (point-max) ?\r ? )
-      (let ((headers (nnheader-parse-head t)))
+        (if (re-search-forward "\n\r?\n" nil t)
+            (1- (point))
+          (point-max))))
+      (let ((headers (nnheader-parse-naked-head)))

        (mail-header-set-chars headers chars)
        (mail-header-set-number headers number)
        headers))))
        (mail-header-set-chars headers chars)
        (mail-header-set-number headers number)
        headers))))


@@ -757,8 +741,8 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
       (when (buffer-name (cdar nnml-nov-buffer-alist))
        (set-buffer (cdar nnml-nov-buffer-alist))
        (when (buffer-modified-p)
       (when (buffer-name (cdar nnml-nov-buffer-alist))
        (set-buffer (cdar nnml-nov-buffer-alist))
        (when (buffer-modified-p)

-         (nnmail-write-region 1 (point-max) nnml-nov-buffer-file-name
-                              nil 'nomesg))
+         (nnmail-write-region (point-min) (point-max)
+                              nnml-nov-buffer-file-name nil 'nomesg))

        (set-buffer-modified-p nil)
        (kill-buffer (current-buffer)))
       (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
        (set-buffer-modified-p nil)
        (kill-buffer (current-buffer)))
       (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))


@@ -847,7 +831,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
           (progn
             (re-search-forward "\n\r?\n" nil t)
             (setq chars (- (point-max) (point)))
           (progn
             (re-search-forward "\n\r?\n" nil t)
             (setq chars (- (point-max) (point)))

-            (max 1 (1- (point)))))
+            (max (point-min) (1- (point)))))

          (unless (zerop (buffer-size))
            (goto-char (point-min))
            (setq headers (nnml-parse-head chars (caar files)))
          (unless (zerop (buffer-size))
            (goto-char (point-min))
            (setq headers (nnml-parse-head chars (caar files)))


@@ -859,7 +843,7 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
        (setq files (cdr files)))
       (save-excursion
        (set-buffer nov-buffer)
        (setq files (cdr files)))
       (save-excursion
        (set-buffer nov-buffer)

-       (nnmail-write-region 1 (point-max) nov nil 'nomesg)
+       (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)

        (kill-buffer (current-buffer))))))
 
 (defun nnml-nov-delete-article (group article)
        (kill-buffer (current-buffer))))))
 
 (defun nnml-nov-delete-article (group article)


@@ -879,10 +863,11 @@ This variable is a virtual server slot.  See the Gnus manual for details.")
     t))
 
 (defun nnml-update-file-alist (&optional force)
     t))
 
 (defun nnml-update-file-alist (&optional force)

-  (when (or (not nnml-article-file-alist)
-           force)
-    (setq nnml-article-file-alist
-         (nnml-current-group-article-to-file-alist))))
+  (when nnml-use-compressed-files
+    (when (or (not nnml-article-file-alist)
+             force)
+      (setq nnml-article-file-alist
+           (nnml-current-group-article-to-file-alist)))))

 
 (defun nnml-directory-articles (dir)
   "Return a list of all article files in a directory.
 
 (defun nnml-directory-articles (dir)
   "Return a list of all article files in a directory.


@@ -909,9 +894,9 @@ Use the nov database for that directory if available."
 (defun nnml-current-group-article-to-file-alist ()
   "Return an alist of article/file pairs in the current group.
 Use the nov database for the current group if available."
 (defun nnml-current-group-article-to-file-alist ()
   "Return an alist of article/file pairs in the current group.
 Use the nov database for the current group if available."

-  (if (or gnus-nov-is-evil 
+  (if (or nnml-use-compressed-files
+         gnus-nov-is-evil

          nnml-nov-is-evil
          nnml-nov-is-evil

-         nnml-filenames-are-evil

          (not (file-exists-p
                (expand-file-name nnml-nov-file-name
                                  nnml-current-directory))))
          (not (file-exists-p
                (expand-file-name nnml-nov-file-name
                                  nnml-current-directory))))


@@ -919,8 +904,8 @@ Use the nov database for the current group if available."
     ;; build list from .overview if available
     (save-excursion
       (let ((alist nil)
     ;; build list from .overview if available
     (save-excursion
       (let ((alist nil)

-           art
-           (buffer (nnml-get-nov-buffer nnml-current-group)))
+           (buffer (nnml-get-nov-buffer nnml-current-group))
+           art)

        (set-buffer buffer)
        (goto-char (point-min))
        (while (not (eobp))
        (set-buffer buffer)
        (goto-char (point-min))
        (while (not (eobp))


@@ -938,7 +923,7 @@ Use the nov database for the current group if available."
       (let ((range (nth 0 action))
            (what  (nth 1 action))
            (marks (nth 2 action)))
       (let ((range (nth 0 action))
            (what  (nth 1 action))
            (marks (nth 2 action)))

-       (assert (or (eq what 'add) (eq what 'del)) t
+       (assert (or (eq what 'add) (eq what 'del)) nil

                "Unknown request-set-mark action: %s" what)
        (dolist (mark marks)
          (setq nnml-marks (gnus-update-alist-soft
                "Unknown request-set-mark action: %s" what)
        (dolist (mark marks)
          (setq nnml-marks (gnus-update-alist-soft


@@ -956,15 +941,16 @@ Use the nov database for the current group if available."
     (nnheader-message 8 "Updating marks for %s..." group)
     (nnml-open-marks group server)
     ;; Update info using `nnml-marks'.
     (nnheader-message 8 "Updating marks for %s..." group)
     (nnml-open-marks group server)
     ;; Update info using `nnml-marks'.

-    (mapcar (lambda (pred)
+    (mapc (lambda (pred)
+           (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)

              (gnus-info-set-marks
               info
               (gnus-update-alist-soft
                (cdr pred)
                (cdr (assq (cdr pred) nnml-marks))
                (gnus-info-marks info))
              (gnus-info-set-marks
               info
               (gnus-update-alist-soft
                (cdr pred)
                (cdr (assq (cdr pred) nnml-marks))
                (gnus-info-marks info))

-              t))
-           gnus-article-mark-lists)
+              t)))
+         gnus-article-mark-lists)

     (let ((seen (cdr (assq 'read nnml-marks))))
       (gnus-info-set-read info
                          (if (and (integerp (car seen))
     (let ((seen (cdr (assq 'read nnml-marks))))
       (gnus-info-set-read info
                          (if (and (integerp (car seen))


@@ -979,8 +965,8 @@ Use the nov database for the current group if available."
                                (nnmail-group-pathname group nnml-directory))))
     (if (null (gnus-gethash file nnml-marks-modtime))
        t ;; never looked at marks file, assume it has changed
                                (nnmail-group-pathname group nnml-directory))))
     (if (null (gnus-gethash file nnml-marks-modtime))
        t ;; never looked at marks file, assume it has changed

-      (not (eq (gnus-gethash file nnml-marks-modtime)
-              (nth 5 (file-attributes file)))))))
+      (not (equal (gnus-gethash file nnml-marks-modtime)
+                 (nth 5 (file-attributes file)))))))

 
 (defun nnml-save-marks (group server)
   (let ((file-name-coding-system nnmail-pathname-coding-system)
 
 (defun nnml-save-marks (group server)
   (let ((file-name-coding-system nnmail-pathname-coding-system)


@@ -991,18 +977,18 @@ Use the nov database for the current group if available."
          (nnml-possibly-create-directory group)
          (with-temp-file file
            (erase-buffer)
          (nnml-possibly-create-directory group)
          (with-temp-file file
            (erase-buffer)

-           (princ nnml-marks (current-buffer))
+           (gnus-prin1 nnml-marks)

            (insert "\n"))
          (gnus-sethash file
                        (nth 5 (file-attributes file))
                        nnml-marks-modtime))
       (error (or (gnus-yes-or-no-p
                  (format "Could not write to %s (%s).  Continue? " file err))
            (insert "\n"))
          (gnus-sethash file
                        (nth 5 (file-attributes file))
                        nnml-marks-modtime))
       (error (or (gnus-yes-or-no-p
                  (format "Could not write to %s (%s).  Continue? " file err))

-                (error "Cannot write to %s (%s)" err))))))
+                (error "Cannot write to %s (%s)" file err))))))

 
 (defun nnml-open-marks (group server)
 
 (defun nnml-open-marks (group server)

-  (let ((file (expand-file-name 
-              nnml-marks-file-name 
+  (let ((file (expand-file-name
+              nnml-marks-file-name

               (nnmail-group-pathname group nnml-directory))))
     (if (file-exists-p file)
        (condition-case err
               (nnmail-group-pathname group nnml-directory))))
     (if (file-exists-p file)
        (condition-case err


@@ -1027,8 +1013,10 @@ Use the nov database for the current group if available."
        (push (cons 'read (gnus-info-read info)) nnml-marks)
        (dolist (el gnus-article-unpropagated-mark-lists)
          (setq nnml-marks (gnus-remassoc el nnml-marks)))
        (push (cons 'read (gnus-info-read info)) nnml-marks)
        (dolist (el gnus-article-unpropagated-mark-lists)
          (setq nnml-marks (gnus-remassoc el nnml-marks)))

-       (nnml-save-marks group server)))))
+       (nnml-save-marks group server)
+       (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))

 
 (provide 'nnml)
 
 
 (provide 'nnml)
 

+;;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004

 ;;; nnml.el ends here
 ;;; nnml.el ends here