diff lisp/gnus/nnml.el @ 24357:15fc6acbae7a

Upgrading to Gnus 5.7; see ChangeLog

--- a/lisp/gnus/nnml.el	Sat Feb 20 13:52:45 1999 +0000
+++ b/lisp/gnus/nnml.el	Sat Feb 20 14:05:57 1999 +0000
@@ -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 <[e-mail]>
+;; Author: Lars Magne Ingebrigtsen <[e-mail]>
 ;; 	Masanobu UMEDA <[e-mail]>
 ;; Keywords: news, mail
 
@@ -84,6 +84,8 @@
 
 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
 
+(defvar nnml-nov-buffer-file-name nil)
+
 
 
 ;;; Interface functions.
@@ -98,9 +100,8 @@
       (let ((file nil)
 	    (number (length sequence))
 	    (count 0)
-	    ;; 1997/8/12 by MORIOKA Tomohiko
-	    (file-name-coding-system 'binary) ; for Emacs 20
-	    (pathname-coding-system 'binary)  ; for XEmacs/mule
+	    (file-name-coding-system 'binary)
+	    (pathname-coding-system 'binary)
 	    beg article)
 	(if (stringp (car sequence))
 	    'headers
@@ -163,9 +164,8 @@
 (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
-	 (file-name-coding-system 'binary) ; for Emacs 20
-	 (pathname-coding-system 'binary)  ; for XEmacs/mule
+	 (file-name-coding-system 'binary)
+	 (pathname-coding-system 'binary)
 	 path gpath group-num)
     (if (stringp id)
 	(when (and (setq group-num (nnml-find-group-number id))
@@ -194,9 +194,8 @@
 	    (string-to-int (file-name-nondirectory path)))))))
 
 (deffoo nnml-request-group (group &optional server dont-check)
-  ;; 1997/8/12 by MORIOKA Tomohiko
-  (let ((file-name-coding-system 'binary) ; for Emacs 20
-	(pathname-coding-system 'binary)) ; for XEmacs/mule
+  (let ((pathname-coding-system 'binary)
+	(file-name-coding-system 'binary))
     (cond
      ((not (nnml-possibly-change-directory group server))
       (nnheader-report 'nnml "Invalid group (no such directory)"))
@@ -230,7 +229,14 @@
 
 (deffoo nnml-request-create-group (group &optional server args)
   (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)
@@ -240,16 +246,14 @@
 	(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
-    ;; 1997/8/12 by MORIOKA Tomohiko
-    ;;	for XEmacs/mule.
     (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
-	  (file-name-coding-system 'binary) ; for Emacs 20
-	  (pathname-coding-system 'binary)) ; for XEmacs/mule
+	  (file-name-coding-system 'binary)
+	  (pathname-coding-system 'binary))
       (nnmail-find-file nnml-active-file)
       )
     (setq nnml-group-alist (nnmail-get-active))
@@ -265,12 +269,17 @@
 (deffoo nnml-request-expire-articles (articles group
 					       &optional server force)
   (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)
 
+    (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)))
@@ -480,8 +489,8 @@
       ;; 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))))
 
@@ -563,9 +572,8 @@
   (if (not group)
       t
     (let ((pathname (nnmail-group-pathname group nnml-directory))
-	  ;; 1997/8/14 by MORIOKA Tomohiko
-	  (file-name-coding-system 'binary) ; for Emacs 20
-	  (pathname-coding-system 'binary)) ; for XEmacs/mule
+	  (file-name-coding-system 'binary)
+	  (pathname-coding-system 'binary))
       (when (not (equal pathname nnml-current-directory))
 	(setq nnml-current-directory pathname
 	      nnml-current-group group
@@ -635,7 +643,7 @@
 	(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)
@@ -664,10 +672,10 @@
   "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)
@@ -681,12 +689,15 @@
 
 (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)
-	  (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)))
 
@@ -696,7 +707,8 @@
       (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)))))
@@ -731,8 +743,13 @@
 	  (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)