*** empty log message ***
[gnus] / lisp / nnml.el
index cee1e1f..d208e26 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -84,6 +84,8 @@ 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)
+
 \f
 
 ;;; Interface functions.
 \f
 
 ;;; Interface functions.
@@ -98,8 +100,6 @@ all.  This may very well take some time.")
       (let ((file nil)
            (number (length sequence))
            (count 0)
       (let ((file nil)
            (number (length sequence))
            (count 0)
-           ;; 1997/8/12 by MORIOKA Tomohiko
-           ;;  for XEmacs/mule.
            (pathname-coding-system 'binary)
            beg article)
        (if (stringp (car sequence))
            (pathname-coding-system 'binary)
            beg article)
        (if (stringp (car sequence))
@@ -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))
 (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)
         (pathname-coding-system 'binary)
         path gpath group-num)
     (if (stringp id)
@@ -228,7 +226,14 @@ all.  This may very well take some time.")
 
 (deffoo nnml-request-create-group (group &optional server args)
   (nnmail-activate 'nnml)
 
 (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)
     (let (active)
       (push (list group (setq active (cons 1 0)))
            nnml-group-alist)
@@ -238,13 +243,11 @@ 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
-    ;; 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)
     (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
          (pathname-coding-system 'binary)) ; for XEmacs/mule
       (nnmail-find-file nnml-active-file)
@@ -560,8 +563,6 @@ all.  This may very well take some time.")
   (if (not group)
       t
     (let ((pathname (nnmail-group-pathname group nnml-directory))
   (if (not group)
       t
     (let ((pathname (nnmail-group-pathname group nnml-directory))
-         ;; 1997/8/14 by MORIOKA Tomohiko
-         ;;    for XEmacs/mule.
          (pathname-coding-system 'binary))
       (when (not (equal pathname nnml-current-directory))
        (setq nnml-current-directory pathname
          (pathname-coding-system 'binary))
       (when (not (equal pathname nnml-current-directory))
        (setq nnml-current-directory pathname
@@ -585,8 +586,8 @@ all.  This may very well take some time.")
   (let (chars headers)
     (setq chars (nnmail-insert-lines))
     (nnmail-insert-xref group-art)
   (let (chars headers)
     (setq chars (nnmail-insert-lines))
     (nnmail-insert-xref group-art)
-    (run-hooks 'nnmail-prepare-save-mail-hook)
-    (run-hooks 'nnml-prepare-save-mail-hook)
+    (gnus-run-hooks 'nnmail-prepare-save-mail-hook)
+    (gnus-run-hooks 'nnml-prepare-save-mail-hook)
     (goto-char (point-min))
     (while (looking-at "From ")
       (replace-match "X-From-Line: ")
     (goto-char (point-min))
     (while (looking-at "From ")
       (replace-match "X-From-Line: ")
@@ -661,10 +662,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)
@@ -678,12 +679,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)))
 
@@ -693,7 +697,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)))))
@@ -729,7 +734,12 @@ all.  This may very well take some time.")
     ;; Do this directory.
     (let ((files (sort (nnheader-article-to-file-alist dir)
                       'car-less-than-car)))
     ;; 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)
        (funcall nnml-generate-active-function dir)
        ;; Generate the nov file.
        (nnml-generate-nov-file dir files)