Importing Pterodactyl Gnus v0.56.
[elisp/gnus.git-] / lisp / nnml.el
index 8b73f7a..4e847bf 100644 (file)
@@ -1,7 +1,7 @@
 ;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 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
 
@@ -163,8 +163,6 @@ 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))
-        ;; 1997/8/12 by MORIOKA Tomohiko
-        ;;     for XEmacs/mule.
         (pathname-coding-system 'binary)
         path gpath group-num)
     (if (stringp id)
@@ -227,6 +225,7 @@ all.  This may very well take some time.")
   t)
 
 (deffoo nnml-request-create-group (group &optional server args)
+  (nnml-possibly-change-directory nil server)
   (nnmail-activate 'nnml)
   (cond
    ((assoc group nnml-group-alist)
@@ -250,12 +249,9 @@ all.  This may very well take some time.")
 
 (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)
-         (pathname-coding-system 'binary)) ; for XEmacs/mule
-      (nnmail-find-file nnml-active-file)
-      )
+         (pathname-coding-system 'binary)) 
+      (nnmail-find-file nnml-active-file))
     (setq nnml-group-alist (nnmail-get-active))
     t))
 
@@ -275,6 +271,11 @@ all.  This may very well take some time.")
        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)
       (when (setq article (nnml-article-to-file (setq number (pop articles))))
        (when (setq mod-time (nth 5 (file-attributes article)))
@@ -468,7 +469,7 @@ all.  This may very well take some time.")
      ((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))))
@@ -484,8 +485,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
-            (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))))
 
@@ -502,7 +503,6 @@ all.  This may very well take some time.")
 (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
@@ -575,15 +575,10 @@ all.  This may very well take some time.")
       (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."
@@ -732,13 +727,18 @@ all.  This may very well take some time.")
     (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)
                       'car-less-than-car)))
-      (when files
+      (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)
@@ -767,7 +767,7 @@ all.  This may very well take some time.")
     (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.