2002-01-27 Richard M. Stallman <rms@gnu.org>
[gnus] / lisp / nnml.el
index b5822d3..1a6f30a 100644 (file)
@@ -1,7 +1,9 @@
 ;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;;        Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 
 
 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
 ;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
+;; Gnus sources.
 
 ;;; Code:
 
+(require 'gnus)
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
-(require 'cl)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
 
 (nnoo-declare nnml)
 
 (defvoo nnml-directory message-directory
-  "Mail spool directory.")
+  "Spool directory for the nnml mail backend.")
 
-(defvoo nnml-active-file 
-  (concat (file-name-as-directory nnml-directory) "active")
+(defvoo nnml-active-file
+    (expand-file-name "active" nnml-directory)
   "Mail active file.")
 
-(defvoo nnml-newsgroups-file 
-  (concat (file-name-as-directory nnml-directory) "newsgroups")
+(defvoo nnml-newsgroups-file
+    (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
-  "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
@@ -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.")
 
+(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-use-compressed-files nil
+  "If non-nil, allow using compressed message files.")
 
 \f
 
@@ -73,6 +90,7 @@ all.  This may very well take some time.")
   "nnml version.")
 
 (defvoo nnml-nov-file-name ".overview")
+(defvoo nnml-marks-file-name ".marks")
 
 (defvoo nnml-current-directory nil)
 (defvoo nnml-current-group nil)
@@ -84,68 +102,69 @@ all.  This may very well take some time.")
 
 (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)
 
-(deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((file nil)
-         (number (length sequence))
-         (count 0)
-         beg article)
-      (if (stringp (car sequence))
-         'headers
-       (nnml-possibly-change-directory newsgroup server)
-       (unless nnml-article-file-alist
-         (setq nnml-article-file-alist
-               (nnheader-article-to-file-alist nnml-current-directory)))
-       (if (nnml-retrieve-headers-with-nov sequence fetch-old)
-           'nov
-         (while sequence
-           (setq article (car sequence))
-           (setq file 
-                 (concat nnml-current-directory 
-                         (or (cdr (assq article nnml-article-file-alist))
-                             "")))
-           (when (and (file-exists-p file)
-                      (not (file-directory-p file)))
-             (insert (format "221 %d Article retrieved.\n" article))
-             (setq beg (point))
-             (nnheader-insert-head file)
-             (goto-char beg)
-             (if (search-forward "\n\n" nil t)
-                 (forward-char -1)
-               (goto-char (point-max))
-               (insert "\n\n"))
-             (insert ".\n")
-             (delete-region (point) (point-max)))
-           (setq sequence (cdr sequence))
-           (setq count (1+ count))
+(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
+  (when (nnml-possibly-change-directory group server)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (erase-buffer)
+      (let* ((file nil)
+            (number (length sequence))
+            (count 0)
+            (file-name-coding-system nnmail-pathname-coding-system)
+            beg article)
+       (if (stringp (car sequence))
+           'headers
+         (if (nnml-retrieve-headers-with-nov sequence fetch-old)
+             'nov
+           (while sequence
+             (setq article (car sequence))
+             (setq file (nnml-article-to-file article))
+             (when (and file
+                        (file-exists-p file)
+                        (not (file-directory-p file)))
+               (insert (format "221 %d Article retrieved.\n" article))
+               (setq beg (point))
+               (nnheader-insert-head file)
+               (goto-char beg)
+               (if (re-search-forward "\n\r?\n" nil t)
+                   (forward-char -1)
+                 (goto-char (point-max))
+                 (insert "\n\n"))
+               (insert ".\n")
+               (delete-region (point) (point-max)))
+             (setq sequence (cdr sequence))
+             (setq count (1+ count))
+             (and (numberp nnmail-large-newsgroup)
+                  (> number nnmail-large-newsgroup)
+                  (zerop (% count 20))
+                  (nnheader-message 6 "nnml: Receiving headers... %d%%"
+                                    (/ (* count 100) number))))
+
            (and (numberp nnmail-large-newsgroup)
                 (> number nnmail-large-newsgroup)
-                (zerop (% count 20))
-                (nnheader-message 6 "nnml: Receiving headers... %d%%"
-                                  (/ (* count 100) number))))
-
-         (and (numberp nnmail-large-newsgroup)
-              (> number nnmail-large-newsgroup)
-              (nnheader-message 6 "nnml: Receiving headers...done"))
+                (nnheader-message 6 "nnml: Receiving headers...done"))
 
-         (nnheader-fold-continuation-lines)
-         'headers)))))
+           (nnheader-fold-continuation-lines)
+           'headers))))))
 
 (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)))
-  (cond 
+    (ignore-errors (make-directory nnml-directory t)))
+  (cond
    ((not (file-exists-p nnml-directory))
     (nnml-close-server)
     (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
@@ -157,13 +176,15 @@ all.  This may very well take some time.")
                     server nnml-directory)
     t)))
 
-(defun nnml-request-regenerate (server)
+(deffoo nnml-request-regenerate (server)
   (nnml-possibly-change-directory nil server)
-  (nnml-generate-nov-databases))
+  (nnml-generate-nov-databases server)
+  t)
 
-(deffoo nnml-request-article (id &optional newsgroup server buffer)
-  (nnml-possibly-change-directory newsgroup server)
+(deffoo nnml-request-article (id &optional group server buffer)
+  (nnml-possibly-change-directory group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
+        (file-name-coding-system nnmail-pathname-coding-system)
         path gpath group-num)
     (if (stringp id)
        (when (and (setq group-num (nnml-find-group-number id))
@@ -176,42 +197,46 @@ all.  This may very well take some time.")
                                  nnml-directory))))))
          (setq path (concat gpath (int-to-string (cdr group-num)))))
       (setq path (nnml-article-to-file id)))
-    (cond 
+    (cond
      ((not path)
       (nnheader-report 'nnml "No such article: %s" id))
      ((not (file-exists-p 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)
       ;; We return the article number.
-      (cons newsgroup (string-to-int (file-name-nondirectory path)))))))
+      (cons (if group-num (car group-num) group)
+           (string-to-int (file-name-nondirectory path)))))))
 
 (deffoo nnml-request-group (group &optional server dont-check)
-  (cond 
-   ((not (nnml-possibly-change-directory group server))
-    (nnheader-report 'nnml "Invalid group (no such directory)"))
-   ((not (file-exists-p nnml-current-directory))
-    (nnheader-report 'nnml "Directory %s does not exist"
-                    nnml-current-directory))
-   ((not (file-directory-p nnml-current-directory))
-    (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
-   (dont-check 
-    (nnheader-report 'nnml "Group %s selected" group)
-    t)
-   (t
-    (nnheader-re-read-dir nnml-current-directory)
-    (nnmail-activate 'nnml)
-    (let ((active (nth 1 (assoc group nnml-group-alist))))
-      (if (not active)
-         (nnheader-report 'nnml "No such group: %s" group)
-       (nnheader-report 'nnml "Selected group %s" group)
-       (nnheader-insert "211 %d %d %d %s\n" 
-                        (max (1+ (- (cdr active) (car active))) 0)
-                        (car active) (cdr active) group))))))
+  (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)"))
+     ((not (file-exists-p nnml-current-directory))
+      (nnheader-report 'nnml "Directory %s does not exist"
+                      nnml-current-directory))
+     ((not (file-directory-p nnml-current-directory))
+      (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
+     (dont-check
+      (nnheader-report 'nnml "Group %s selected" group)
+      t)
+     (t
+      (nnheader-re-read-dir nnml-current-directory)
+      (nnmail-activate 'nnml)
+      (let ((active (nth 1 (assoc group nnml-group-alist))))
+       (if (not active)
+           (nnheader-report 'nnml "No such group: %s" group)
+         (nnheader-report 'nnml "Selected group %s" group)
+         (nnheader-insert "211 %d %d %d %s\n"
+                          (max (1+ (- (cdr active) (car active))) 0)
+                          (car active) (cdr active) group)))))))
 
 (deffoo nnml-request-scan (&optional group server)
   (setq nnml-article-file-alist nil)
@@ -223,23 +248,33 @@ all.  This may very well take some