*** empty log message ***

[gnus] / lisp / nnml.el

diff --git a/lisp/nnml.el b/lisp/nnml.el
index 043912e..e47448c 100644 (file)
--- a/lisp/nnml.el
+++ b/lisp/nnml.el
@@ -1,7 +1,7 @@
 ;;; 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,96,97,98,99 Free Software Foundation, Inc.

 
 

-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 


@@ -33,12 +33,12 @@
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)

-(require 'cl)
+(eval-when-compile (require 'cl))

 
 (nnoo-declare nnml)
 
 (defvoo nnml-directory message-directory
 
 (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
   (concat (file-name-as-directory nnml-directory) "active")


@@ -84,6 +84,10 @@ 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)
 

+(defvar nnml-nov-buffer-file-name nil)
+
+(defvoo nnml-file-coding-system nnmail-file-coding-system-1)
+

 \f
 
 ;;; Interface functions.
 \f
 
 ;;; Interface functions.


@@ -98,6 +102,7 @@ all.  This may very well take some time.")
       (let ((file nil)
            (number (length sequence))
            (count 0)
       (let ((file nil)
            (number (length sequence))
            (count 0)

+           (pathname-coding-system 'binary)

            beg article)
        (if (stringp (car sequence))
            'headers
            beg article)
        (if (stringp (car sequence))
            'headers


@@ -137,9 +142,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)


@@ -160,6 +163,7 @@ all.  This may very well take some time.")
 (deffoo nnml-request-article (id &optional group server buffer)
   (nnml-possibly-change-directory group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
 (deffoo nnml-request-article (id &optional group server buffer)
   (nnml-possibly-change-directory group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))

+        (pathname-coding-system 'binary)

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


@@ -179,7 +183,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)


@@ -188,27 +194,28 @@ 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)

-  (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 ((pathname-coding-system 'binary))
+    (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)
 
 (deffoo nnml-request-scan (&optional group server)
   (setq nnml-article-file-alist nil)


@@ -220,8 +227,16 @@ 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)
     (let (active)
       (push (list group (setq active (cons 1 0)))
            nnml-group-alist)


@@ -231,12 +246,14 @@ all.  This may very well take some time.")
        (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

-    (nnmail-find-file nnml-active-file)
+    (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
+         (pathname-coding-system 'binary))
+      (nnmail-find-file nnml-active-file))

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


@@ -247,15 +264,19 @@ 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)
   (nnml-possibly-change-directory group server)

-  (let* ((active-articles
-         (nnheader-directory-articles nnml-current-directory))
-        (is-old t)
-        article rest mod-time number)
+  (let ((active-articles
+        (nnheader-directory-articles nnml-current-directory))
+       (is-old t)
+       article rest mod-time number)

     (nnmail-activate 'nnml)
 
     (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)
       (when (setq article (nnml-article-to-file (setq number (pop articles))))
        (when (setq mod-time (nth 5 (file-attributes article)))
     (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)))


@@ -344,16 +365,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)
+                  (concat nnml-current-directory
+                          (int-to-string article)))
+              nil (if (nnheader-be-verbose 5) nil 'nomesg))
+             t)

        (setq headers (nnml-parse-head chars article))
        ;; Replace the NOV line in the NOV file.
        (save-excursion
        (setq headers (nnml-parse-head chars article))
        ;; Replace the NOV line in the NOV file.
        (save-excursion


@@ -394,9 +413,7 @@ all.  This may very well take some time.")
          (nnheader-message 5 "Deleting article %s in %s..." article group)
          (funcall nnmail-delete-file-function article))))
     ;; Try to delete the directory itself.
          (nnheader-message 5 "Deleting article %s in %s..." article group)
          (funcall nnmail-delete-file-function article))))
     ;; Try to delete the directory itself.

-    (condition-case ()
-       (delete-directory nnml-current-directory)
-      (error nil)))
+    (ignore-errors (delete-directory nnml-current-directory)))

   ;; Remove the group from all structures.
   (setq nnml-group-alist
        (delq (assoc group nnml-group-alist) nnml-group-alist)
   ;; Remove the group from all structures.
   (setq nnml-group-alist
        (delq (assoc group nnml-group-alist) nnml-group-alist)


@@ -410,11 +427,9 @@ all.  This may very well take some time.")
   (nnml-possibly-change-directory group server)
   (let ((new-dir (nnmail-group-pathname new-name nnml-directory))
        (old-dir (nnmail-group-pathname group nnml-directory)))
   (nnml-possibly-change-directory group server)
   (let ((new-dir (nnmail-group-pathname new-name nnml-directory))
        (old-dir (nnmail-group-pathname group nnml-directory)))

-    (when (condition-case ()
-             (progn
-               (make-directory new-dir t)
-               t)
-           (error nil))
+    (when (ignore-errors
+           (make-directory new-dir t)
+           t)

       ;; We move the articles file by file instead of renaming
       ;; the directory -- there may be subgroups in this group.
       ;; One might be more clever, I guess.
       ;; We move the articles file by file instead of renaming
       ;; the directory -- there may be subgroups in this group.
       ;; One might be more clever, I guess.


@@ -429,9 +444,7 @@ all.  This may very well take some time.")
        (when (file-exists-p overview)
          (rename-file overview (concat new-dir nnml-nov-file-name))))
       (when (<= (length (directory-files old-dir)) 2)
        (when (file-exists-p overview)
          (rename-file overview (concat new-dir nnml-nov-file-name))))
       (when (<= (length (directory-files old-dir)) 2)

-       (condition-case ()
-           (delete-directory old-dir)
-         (error nil)))
+       (ignore-errors (delete-directory old-dir)))

       ;; That went ok, so we change the internal structures.
       (let ((entry (assoc group nnml-group-alist)))
        (when entry
       ;; That went ok, so we change the internal structures.
       (let ((entry (assoc group nnml-group-alist)))
        (when entry


@@ -449,7 +462,7 @@ all.  This may very well take some time.")
      ((not (file-exists-p file))
       (nnheader-report 'nnml "File %s does not exist" file))
      (t
      ((not (file-exists-p file))
       (nnheader-report 'nnml "File %s does not exist" file))
      (t

-      (nnheader-temp-write file
+      (with-temp-file file

        (nnheader-insert-file-contents file)
        (nnmail-replace-status name value))
       t))))
        (nnheader-insert-file-contents file)
        (nnmail-replace-status name value))
       t))))


@@ -465,8 +478,8 @@ all.  This may very well take some time.")
       ;; Just to make sure nothing went wrong when reading over NFS --
       ;; check once more.
       (when (file-exists-p
       ;; Just to make sure nothing went wrong when reading over NFS --
       ;; check once more.
       (when (file-exists-p

-            (setq file (concat nnml-current-directory "/"
-                               (number-to-string article))))
+            (setq file (expand-file-name (number-to-string article)
+                                         nnml-current-directory)))

        (nnml-update-file-alist t)
        file))))
 
        (nnml-update-file-alist t)
        file))))
 


@@ -483,7 +496,6 @@ all.  This may very well take some time.")
 (defun nnml-find-group-number (id)
   (save-excursion
     (set-buffer (get-buffer-create " *nnml id*"))
 (defun nnml-find-group-number (id)
   (save-excursion
     (set-buffer (get-buffer-create " *nnml id*"))

-    (buffer-disable-undo (current-buffer))

     (let ((alist nnml-group-alist)
          number)
       ;; We want to look through all .overview files, but we want to
     (let ((alist nnml-group-alist)
          number)
       ;; We want to look through all .overview files, but we want to


@@ -518,9 +530,7 @@ all.  This may very well take some time.")
          (setq found t)
          ;; We return the article number.
          (setq number
          (setq found t)
          ;; We return the article number.
          (setq number

-               (condition-case ()
-                   (read (current-buffer))
-                 (error nil)))))
+               (ignore-errors (read (current-buffer))))))

       number)))
 
 (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
       number)))
 
 (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)


@@ -547,7 +557,8 @@ all.  This may very well take some time.")
     (nnml-open-server server))
   (if (not group)
       t
     (nnml-open-server server))
   (if (not group)
       t

-    (let ((pathname (nnmail-group-pathname group nnml-directory)))
+    (let ((pathname (nnmail-group-pathname group nnml-directory))
+         (pathname-coding-system 'binary))

       (when (not (equal pathname nnml-current-directory))
        (setq nnml-current-directory pathname
              nnml-current-group group
       (when (not (equal pathname nnml-current-directory))
        (setq nnml-current-directory pathname
              nnml-current-group group


@@ -555,15 +566,10 @@ all.  This may very well take some time.")
       (file-exists-p nnml-current-directory))))
 
 (defun nnml-possibly-create-directory (group)
       (file-exists-p nnml-current-directory))))
 
 (defun nnml-possibly-create-directory (group)

-  (let (dir dirs)
-    (setq dir (nnmail-group-pathname group nnml-directory))
-    (while (not (file-directory-p dir))
-      (push dir dirs)
-      (setq dir (file-name-directory (directory-file-name dir))))
-    (while dirs
-      (make-directory (directory-file-name (car dirs)))
-      (nnheader-message 5 "Creating mail directory %s" (car dirs))
-      (setq dirs (cdr dirs)))))
+  (let ((dir (nnmail-group-pathname group nnml-directory)))
+    (unless (file-exists-p dir)
+      (make-directory (directory-file-name dir) t)
+      (nnheader-message 5 "Creating mail directory %s" dir))))

 
 (defun nnml-save-mail (group-art)
   "Called narrowed to an article."
 
 (defun nnml-save-mail (group-art)
   "Called narrowed to an article."


@@ -617,7 +623,7 @@ all.  This may very well take some time.")
        (setq nnml-article-file-alist
              (sort
               (nnheader-article-to-file-alist nnml-current-directory)
        (setq nnml-article-file-alist
              (sort
               (nnheader-article-to-file-alist nnml-current-directory)

-              (lambda (a1 a2) (< (car a1) (car a2))))))
+              'car-less-than-car)))

       (setq active
            (if nnml-article-file-alist
                (cons (caar nnml-article-file-alist)
       (setq active
            (if nnml-article-file-alist
                (cons (caar nnml-article-file-alist)


@@ -646,10 +652,10 @@ all.  This may very well take some time.")
   "Parse the head of the current buffer."
   (save-excursion
     (save-restriction
   "Parse the head of the current buffer."
   (save-excursion
     (save-restriction

-      (goto-char (point-min))
-      (narrow-to-region
-       (point)
-       (1- (or (search-forward "\n\n" nil t) (point-max))))
+      (unless (zerop (buffer-size))
+       (narrow-to-region
+        (goto-char (point-min))
+        (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))

       ;; Fold continuation lines.
       (goto-char (point-min))
       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
       ;; Fold continuation lines.
       (goto-char (point-min))
       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)


@@ -663,12 +669,15 @@ all.  This may very well take some time.")
 
 (defun nnml-open-nov (group)
   (or (cdr (assoc group nnml-nov-buffer-alist))
 
 (defun nnml-open-nov (group)
   (or (cdr (assoc group nnml-nov-buffer-alist))

-      (let ((buffer (nnheader-find-file-noselect
-                    (concat (nnmail-group-pathname group nnml-directory)
-                            nnml-nov-file-name))))
+      (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))

        (save-excursion
          (set-buffer buffer)
        (save-excursion
          (set-buffer buffer)

-         (buffer-disable-undo (current-buffer)))
+         (set (make-local-variable 'nnml-nov-buffer-file-name)
+              (concat (nnmail-group-pathname group nnml-directory)
+                      nnml-nov-file-name))
+         (erase-buffer)
+         (when (file-exists-p nnml-nov-buffer-file-name)
+           (nnheader-insert-file-contents nnml-nov-buffer-file-name)))

        (push (cons group buffer) nnml-nov-buffer-alist)
        buffer)))
 
        (push (cons group buffer) nnml-nov-buffer-alist)
        buffer)))
 


@@ -678,7 +687,8 @@ all.  This may very well take some time.")
       (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) (buffer-file-name) nil 'nomesg))
+         (nnmail-write-region 1 (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)))))


@@ -708,13 +718,18 @@ all.  This may very well take some time.")
     (let ((dirs (directory-files dir t nil t))
          dir)
       (while (setq dir (pop dirs))
     (let ((dirs (directory-files dir t nil t))
          dir)
       (while (setq dir (pop dirs))

-       (when (and (not (member (file-name-nondirectory dir) '("." "..")))
+       (when (and (not (string-match "^\\." (file-name-nondirectory dir)))

                   (file-directory-p dir))
          (nnml-generate-nov-databases-1 dir seen))))
     ;; Do this directory.
     (let ((files (sort (nnheader-article-to-file-alist dir)
                   (file-directory-p dir))
          (nnml-generate-nov-databases-1 dir seen))))
     ;; Do this directory.
     (let ((files (sort (nnheader-article-to-file-alist dir)

-                      (lambda (a b) (< (car a) (car b))))))
-      (when files
+                      'car-less-than-car)))
+      (if (not files)
+         (let* ((group (nnheader-file-to-group
+                        (directory-file-name dir) nnml-directory))
+                (info (cadr (assoc group nnml-group-alist))))
+           (when info
+             (setcar info (1+ (cdr info)))))

        (funcall nnml-generate-active-function dir)
        ;; Generate the nov file.
        (nnml-generate-nov-file dir files)
        (funcall nnml-generate-active-function dir)
        ;; Generate the nov file.
        (nnml-generate-nov-file dir files)


@@ -743,7 +758,7 @@ all.  This may very well take some time.")
     (save-excursion
       ;; Init the nov buffer.
       (set-buffer nov-buffer)
     (save-excursion
       ;; Init the nov buffer.
       (set-buffer nov-buffer)

-      (buffer-disable-undo (current-buffer))
+      (buffer-disable-undo)

       (erase-buffer)
       (set-buffer nntp-server-buffer)
       ;; Delete the old NOV file.
       (erase-buffer)
       (set-buffer nntp-server-buffer)
       ;; Delete the old NOV file.


@@ -759,8 +774,7 @@ all.  This may very well take some time.")
             (search-forward "\n\n" nil t)
             (setq chars (- (point-max) (point)))
             (max 1 (1- (point)))))
             (search-forward "\n\n" nil t)
             (setq chars (- (point-max) (point)))
             (max 1 (1- (point)))))

-         (when (and (not (= 0 chars))  ; none of them empty files...
-                    (not (= (point-min) (point-max))))
+         (unless (zerop (buffer-size))

            (goto-char (point-min))
            (setq headers (nnml-parse-head chars (caar files)))
            (save-excursion
            (goto-char (point-min))
            (setq headers (nnml-parse-head chars (caar files)))
            (save-excursion