(gnus-point-at-bol, gnus-point-at-eol): Remove.

[gnus] / lisp / nnml.el

diff --git a/lisp/nnml.el b/lisp/nnml.el
index fd74ec0..4e8337e 100644 (file)
--- a/lisp/nnml.el
+++ b/lisp/nnml.el
@@ -1,8 +1,10 @@
 ;;; nnml.el --- mail spool access for Gnus
 ;;; nnml.el --- mail spool access for Gnus

-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
+;;        Free Software Foundation, Inc.

 
 

-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     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.


@@ -30,29 +32,33 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'gnus)

 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
 (eval-when-compile (require 'cl))
 
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
 (eval-when-compile (require 'cl))
 

+(eval-and-compile
+  (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
+

 (nnoo-declare nnml)
 
 (defvoo nnml-directory message-directory
   "Spool directory for the nnml mail backend.")
 
 (defvoo nnml-active-file
 (nnoo-declare nnml)
 
 (defvoo nnml-directory message-directory
   "Spool directory for the nnml mail backend.")
 
 (defvoo nnml-active-file

-  (concat (file-name-as-directory nnml-directory) "active")
+    (expand-file-name "active" nnml-directory)

   "Mail active file.")
 
 (defvoo nnml-newsgroups-file
   "Mail active file.")
 
 (defvoo nnml-newsgroups-file

-  (concat (file-name-as-directory nnml-directory) "newsgroups")
+    (expand-file-name "newsgroups" nnml-directory)

   "Mail newsgroups description file.")
 
 (defvoo nnml-get-new-mail t
   "If non-nil, nnml will check the incoming mail file and split the mail.")
 
 (defvoo nnml-nov-is-evil nil
   "Mail newsgroups description file.")
 
 (defvoo nnml-get-new-mail t
   "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 groups.
+  "If non-nil, Gnus will never generate and use nov databases for mail spools.

 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
 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


@@ -60,12 +66,23 @@ 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.")
 
 through all nnml directories and generate nov databases for them
 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.
+Using marks files makes it possible to backup and restore mail groups
+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
+marks file will be regenerated properly by Gnus.")
+

 (defvoo nnml-prepare-save-mail-hook nil
   "Hook run narrowed to an article before saving.")
 
 (defvoo nnml-inhibit-expiry nil
   "If non-nil, inhibit expiry.")
 
 (defvoo nnml-prepare-save-mail-hook nil
   "Hook run narrowed to an article before saving.")
 
 (defvoo nnml-inhibit-expiry nil
   "If non-nil, inhibit expiry.")
 

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

 
 \f
 
 
 \f
 


@@ -73,6 +90,7 @@ all.  This may very well take some time.")
   "nnml version.")
 
 (defvoo nnml-nov-file-name ".overview")
   "nnml version.")
 
 (defvoo nnml-nov-file-name ".overview")

+(defvoo nnml-marks-file-name ".marks")

 
 (defvoo nnml-current-directory nil)
 (defvoo nnml-current-group nil)
 
 (defvoo nnml-current-directory nil)
 (defvoo nnml-current-group nil)


@@ -84,8 +102,15 @@ all.  This may very well take some time.")
 
 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
 
 
 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
 

-\f
+(defvar nnml-nov-buffer-file-name nil)
+
+(defvoo nnml-file-coding-system nnmail-file-coding-system)
+
+(defvoo nnml-marks nil)
+
+(defvar nnml-marks-modtime (gnus-make-hashtable))

 
 

+\f

 ;;; Interface functions.
 
 (nnoo-define-basics nnml)
 ;;; Interface functions.
 
 (nnoo-define-basics nnml)


@@ -95,11 +120,11 @@ all.  This may very well take some time.")
     (save-excursion
       (set-buffer nntp-server-buffer)
       (erase-buffer)
     (save-excursion
       (set-buffer nntp-server-buffer)
       (erase-buffer)

-      (let ((file nil)
-           (number (length sequence))
-           (count 0)
-           (pathname-coding-system 'binary)
-           beg article)
+      (let* ((file nil)
+            (number (length sequence))
+            (count 0)
+            (file-name-coding-system nnmail-pathname-coding-system)
+            beg article)

        (if (stringp (car sequence))
            'headers
          (if (nnml-retrieve-headers-with-nov sequence fetch-old)
        (if (stringp (car sequence))
            'headers
          (if (nnml-retrieve-headers-with-nov sequence fetch-old)


@@ -114,7 +139,7 @@ all.  This may very well take some time.")
                (setq beg (point))
                (nnheader-insert-head file)
                (goto-char beg)
                (setq beg (point))
                (nnheader-insert-head file)
                (goto-char beg)

-               (if (search-forward "\n\n" nil t)
+               (if (re-search-forward "\n\r?\n" nil t)

                    (forward-char -1)
                  (goto-char (point-max))
                  (insert "\n\n"))
                    (forward-char -1)
                  (goto-char (point-max))
                  (insert "\n\n"))


@@ -138,9 +163,7 @@ all.  This may very well take some time.")
 (deffoo nnml-open-server (server &optional defs)
   (nnoo-change-server 'nnml server defs)
   (when (not (file-exists-p nnml-directory))
 (deffoo nnml-open-server (server &optional defs)
   (nnoo-change-server 'nnml server defs)
   (when (not (file-exists-p nnml-directory))

-    (condition-case ()
-       (make-directory nnml-directory t)
-      (error)))
+    (ignore-errors (make-directory nnml-directory t)))

   (cond
    ((not (file-exists-p nnml-directory))
     (nnml-close-server)
   (cond
    ((not (file-exists-p nnml-directory))
     (nnml-close-server)


@@ -153,17 +176,15 @@ all.  This may very well take some time.")
                     server nnml-directory)
     t)))
 
                     server nnml-directory)
     t)))
 

-(defun nnml-request-regenerate (server)
+(deffoo nnml-request-regenerate (server)

   (nnml-possibly-change-directory nil server)
   (nnml-possibly-change-directory nil server)

-  (nnml-generate-nov-databases)
+  (nnml-generate-nov-databases server)

   t)
 
 (deffoo nnml-request-article (id &optional group server buffer)
   (nnml-possibly-change-directory group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
   t)
 
 (deffoo nnml-request-article (id &optional group server buffer)
   (nnml-possibly-change-directory group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))

-        ;; 1997/8/12 by MORIOKA Tomohiko
-        ;;     for XEmacs/mule.
-        (pathname-coding-system 'binary)
+        (file-name-coding-system nnmail-pathname-coding-system)

         path gpath group-num)
     (if (stringp id)
        (when (and (setq group-num (nnml-find-group-number id))
         path gpath group-num)
     (if (stringp id)
        (when (and (setq group-num (nnml-find-group-number id))


@@ -183,7 +204,9 @@ all.  This may very well take some time.")
       (nnheader-report 'nnml "No such file: %s" path))
      ((file-directory-p path)
       (nnheader-report 'nnml "File is a directory: %s" path))
       (nnheader-report 'nnml "No such file: %s" path))
      ((file-directory-p path)
       (nnheader-report 'nnml "File is a directory: %s" path))

-     ((not (save-excursion (nnmail-find-file path)))
+     ((not (save-excursion (let ((nnmail-file-coding-system
+                                 nnml-file-coding-system))
+                            (nnmail-find-file path))))

       (nnheader-report 'nnml "Couldn't read file: %s" path))
      (t
       (nnheader-report 'nnml "Article %s retrieved" id)
       (nnheader-report 'nnml "Couldn't read file: %s" path))
      (t
       (nnheader-report 'nnml "Article %s retrieved" id)


@@ -192,7 +215,7 @@ all.  This may very well take some time.")
            (string-to-int (file-name-nondirectory path)))))))
 
 (deffoo nnml-request-group (group &optional server dont-check)
            (string-to-int (file-name-nondirectory path)))))))
 
 (deffoo nnml-request-group (group &optional server dont-check)

-  (let ((pathname-coding-system 'binary))
+  (let ((file-name-coding-system nnmail-pathname-coding-system))

     (cond
      ((not (nnml-possibly-change-directory group server))
       (nnheader-report 'nnml "Invalid group (no such directory)"))
     (cond
      ((not (nnml-possibly-change-directory group server))
       (nnheader-report 'nnml "Invalid group (no such directory)"))


@@ -225,28 +248,33 @@ all.  This may very well take some time.")
   t)
 
 (deffoo nnml-request-create-group (group &optional server args)
   t)
 
 (deffoo nnml-request-create-group (group &optional server args)

+  (nnml-possibly-change-directory nil server)

   (nnmail-activate 'nnml)
   (nnmail-activate 'nnml)

-  (unless (assoc group nnml-group-alist)
+  (cond
+   ((assoc group nnml-group-alist)
+    t)
+   ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
+        (not (file-directory-p (nnmail-group-pathname group nnml-directory))))
+    (nnheader-report 'nnml "%s is a file"
+                    (nnmail-group-pathname group nnml-directory)))
+   (t

     (let (active)
       (push (list group (setq active (cons 1 0)))
            nnml-group-alist)
       (nnml-possibly-create-directory group)
       (nnml-possibly-change-directory group server)
     (let (active)
       (push (list group (setq active (cons 1 0)))
            nnml-group-alist)
       (nnml-possibly-create-directory group)
       (nnml-possibly-change-directory group server)

-      (let ((articles (nnheader-directory-articles nnml-current-directory)))
+      (let ((articles (nnml-directory-articles nnml-current-directory)))

        (when articles
          (setcar active (apply 'min articles))
          (setcdr active (apply 'max articles))))
        (when articles
          (setcar active (apply 'min articles))
          (setcdr active (apply 'max articles))))

-      (nnmail-save-active nnml-group-alist nnml-active-file)))
-  t)
+      (nnmail-save-active nnml-group-alist nnml-active-file)
+      t))))

 
 (deffoo nnml-request-list (&optional server)
   (save-excursion
 
 (deffoo nnml-request-list (&optional server)
   (save-excursion

-    ;; 1997/8/12 by MORIOKA Tomohiko
-    ;; for XEmacs/mule.

     (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
     (let ((nnmail-file-coding-system nnmail-active-file-coding-system)

-         (pathname-coding-system 'binary)) ; for XEmacs/mule
-      (nnmail-find-file nnml-active-file)
-      )
+         (file-name-coding-system nnmail-pathname-coding-system))
+      (nnmail-find-file nnml-active-file))

     (setq nnml-group-alist (nnmail-get-active))
     t))
 
     (setq nnml-group-alist (nnmail-get-active))
     t))
 


@@ -257,32 +285,46 @@ all.  This may very well take some time.")
   (save-excursion
     (nnmail-find-file nnml-newsgroups-file)))
 
   (save-excursion
     (nnmail-find-file nnml-newsgroups-file)))
 

-(deffoo nnml-request-expire-articles (articles group
-                                              &optional server force)
+(deffoo nnml-request-expire-articles (articles group &optional server force)

   (nnml-possibly-change-directory group server)
   (let ((active-articles
   (nnml-possibly-change-directory group server)
   (let ((active-articles

-        (nnheader-directory-articles nnml-current-directory))
+        (nnml-directory-articles nnml-current-directory))

        (is-old t)
        article rest mod-time number)
     (nnmail-activate 'nnml)
 
        (is-old t)
        article rest mod-time number)
     (nnmail-activate 'nnml)
 

+    (setq active-articles (sort active-articles '<))
+    ;; Articles not listed in active-articles are already gone,
+    ;; so don't try to expire them.
+    (setq articles (gnus-sorted-intersection articles active-articles))
+

     (while (and articles is-old)
     (while (and articles is-old)

-      (when (setq article (nnml-article-to-file (setq number (pop articles))))
-       (when (setq mod-time (nth 5 (file-attributes article)))
-         (if (and (nnml-deletable-article-p group number)
-                  (setq is-old
-                        (nnmail-expired-article-p group mod-time force
-                                                  nnml-inhibit-expiry)))
-             (progn
-               (nnheader-message 5 "Deleting article %s in %s"
-                                 article group)
-               (condition-case ()
-                   (funcall nnmail-delete-file-function article)
-                 (file-error
-                  (push number rest)))
-               (setq active-articles (delq number active-articles))
-               (nnml-nov-delete-article group number))
-           (push number rest)))))
+      (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
+                                                     nnml-inhibit-expiry)))
+         (progn
+           ;; Allow a special target group.
+           (unless (eq nnmail-expiry-target 'delete)
+             (with-temp-buffer
+               (nnml-request-article number group server (current-buffer))
+               (let (nnml-current-directory
+                     nnml-current-group
+                     nnml-article-file-alist)
+                 (nnmail-expiry-target-group nnmail-expiry-target group)))
+             ;; Maybe directory is changed during nnmail-expiry-target-group.
+             (nnml-possibly-change-directory group server))
+           (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))
+           (nnml-nov-delete-article group number))
+       (push number rest)))

     (let ((active (nth 1 (assoc group nnml-group-alist))))
       (when active
        (setcar active (or (and active-articles
     (let ((active (nth 1 (assoc group nnml-group-alist))))
       (when active
        (setcar active (or (and active-articles


@@ -293,7 +335,7 @@ all.  This may very well take some time.")
     (nconc rest articles)))
 
 (deffoo nnml-request-move-article
     (nconc rest articles)))
 
 (deffoo nnml-request-move-article

-  (article group server accept-form &optional last)
+    (article group server accept-form &optional last)

   (let ((buf (get-buffer-create " *nnml move*"))
        result)
     (nnml-possibly-change-directory group server)
   (let ((buf (get-buffer-create " *nnml move*"))
        result)
     (nnml-possibly-change-directory group server)


@@ -301,12 +343,15 @@ all.  This may very well take some time.")
     (and
      (nnml-deletable-article-p group article)
      (nnml-request-article article group server)
     (and
      (nnml-deletable-article-p group article)
      (nnml-request-article article group server)

-     (save-excursion
-       (set-buffer buf)
-       (insert-buffer-substring nntp-server-buffer)
-       (setq result (eval accept-form))
-       (kill-buffer (current-buffer))
-       result)
+     (let (nnml-current-directory
+          nnml-current-group
+          nnml-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
        (nnml-possibly-change-directory group server)
        (condition-case ()
      (progn
        (nnml-possibly-change-directory group server)
        (condition-case ()


@@ -324,7 +369,10 @@ all.  This may very well take some time.")
   (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)


@@ -346,6 +394,9 @@ all.  This may very well take some time.")
         (nnml-save-nov))))
     result))
 
         (nnml-save-nov))))
     result))
 

+(deffoo nnml-request-post (&optional server)
+  (nnmail-do-request-post 'nnml-request-accept-article server))
+

 (deffoo nnml-request-replace-article (article group buffer)
   (nnml-possibly-change-directory group)
   (save-excursion
 (deffoo nnml-request-replace-article (article group buffer)
   (nnml-possibly-change-directory group)
   (save-excursion


@@ -354,16 +405,14 @@ all.  This may very well take some time.")
     (let ((chars (nnmail-insert-lines))
          (art (concat (int-to-string article) "\t"))
          headers)
     (let ((chars (nnmail-insert-lines))
          (art (concat (int-to-string article) "\t"))
          headers)

-      (when (condition-case ()
-               (progn
-                 (nnmail-write-region
-                  (point-min) (point-max)
-                  (or (nnml-article-to-file article)
-                      (concat nnml-current-directory
-                              (int-to-string article)))
-                  nil (if (nnheader-be-verbose 5) nil 'nomesg))
-                 t)
-             (error nil))
+      (when (ignore-errors
+             (nnmail-write-region
+              (point-min) (point-max)
+              (or (nnml-article-to-file article)
+                  (expand-file-name (int-to-string article)
+       &nbs