mail-source.el (mail-source-delete-crash-box): Always move the crash box to the Incoming file. Fixes mistake in previous checkin; Do incremental NOV updates when scanning new male. (nnml-save-incremental-nov, nnml-open-incremental-nov, nnml-add-incremental-nov): New functions to do "incremental" nov updates, where we just append to the end of the existing nov files without reading/writing them in full.

3 files changed, 77 insertions, 28 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 192c2c04646..2c4d98b4d16 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,7 +1,17 @@
 2010-09-04  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+        * mail-source.el (mail-source-delete-crash-box): Always move the crash
+        box to the Incoming file.  Fixes mistake in previous checkin.
+
+        * pop3.el (pop3-send-streaming-command): Off-by-one error on the
+        request loop (for debugging purposes) removed.
+
         * nnml.el (nnml-save-nov): Message around nnml-save-nov so that the
         culprit is more visible.
+        (nnml-save-incremental-nov, nnml-open-incremental-nov)
+        (nnml-add-incremental-nov): New functions to do "incremental" nov
+        updates, where we just append to the end of the existing nov files
+        without reading/writing them in full.
 
         * mail-source.el (mail-source-delete-crash-box): Really only check the
         incoming files once in a while.
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index a8db55b182c..7a626869347 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -631,23 +631,23 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
     ;; Delete or move the incoming mail out of the way.
     (if (eq mail-source-delete-incoming t)
         (delete-file mail-source-crash-box)
-      ;; Don't check for old incoming files more than once per day to
-      ;; save a lot of file accesses.
-      (when (or (null mail-source-incoming-last-checked-time)
-                (> (time-to-seconds
-                    (time-since mail-source-incoming-last-checked-time))
-                   (* 24 60 60)))
-        (setq mail-source-incoming-last-checked-time (current-time))
-        (let ((incoming
-               (mm-make-temp-file
-                (expand-file-name
-                 mail-source-incoming-file-prefix
-                 mail-source-directory))))
-          (unless (file-exists-p (file-name-directory incoming))
-            (make-directory (file-name-directory incoming) t))
-          (rename-file mail-source-crash-box incoming t)
-          ;; remove old incoming files?
-          (when (natnump mail-source-delete-incoming)
+      (let ((incoming
+             (mm-make-temp-file
+              (expand-file-name
+               mail-source-incoming-file-prefix
+               mail-source-directory))))
+        (unless (file-exists-p (file-name-directory incoming))
+          (make-directory (file-name-directory incoming) t))
+        (rename-file mail-source-crash-box incoming t)
+        ;; remove old incoming files?
+        (when (natnump mail-source-delete-incoming)
+          ;; Don't check for old incoming files more than once per day to
+          ;; save a lot of file accesses.
+          (when (or (null mail-source-incoming-last-checked-time)
+                    (> (time-to-seconds
+                        (time-since mail-source-incoming-last-checked-time))
+                       (* 24 60 60)))
+            (setq mail-source-incoming-last-checked-time (current-time))
             (mail-source-delete-old-incoming
              mail-source-delete-incoming
              mail-source-delete-old-incoming-confirm)))))))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 6d5a8d20d2a..1c9513d2191 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -283,7 +283,7 @@ non-nil.")
 (deffoo nnml-request-scan (&optional group server)
   (setq nnml-article-file-alist nil)
   (nnml-possibly-change-directory group server)
-  (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
+  (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group))
 
 (deffoo nnml-close-group (group &optional server)
   (setq nnml-article-file-alist nil)
@@ -438,7 +438,7 @@ non-nil.")
          (setq result (car (nnml-save-mail
                             (list (cons group (nnml-active-number group
                                                                   server)))
-                            server)))
+                            server t)))
          (progn
            (nnmail-save-active nnml-group-alist nnml-active-file)
            (and last (nnml-save-nov))))
@@ -449,7 +449,7 @@ non-nil.")
                                       (nnml-active-number group ,server)))))
                 (yes-or-no-p "Moved to `junk' group; delete article? "))
            (setq result 'junk)
-         (setq result (car (nnml-save-mail result server))))
+         (setq result (car (nnml-save-mail result server t))))
        (when last
          (nnmail-save-active nnml-group-alist nnml-active-file)
          (when nnmail-cache-accepted-message-ids
@@ -691,7 +691,7 @@ non-nil.")
       (make-directory (directory-file-name dir) t)
       (nnheader-message 5 "Creating mail directory %s" dir))))
 
-(defun nnml-save-mail (group-art &optional server)
+(defun nnml-save-mail (group-art &optional server full-nov)
   "Save a mail into the groups GROUP-ART in the nnml server SERVER.
 GROUP-ART is a list that each element is a cons of a group name and an
 article number.  This function is called narrowed to an article."
@@ -742,11 +742,14 @@ article number.  This function is called narrowed to an article."
     ;; header.
     (setq headers (nnml-parse-head chars))
     ;; Output the nov line to all nov databases that should have it.
-    (if nnmail-group-names-not-encoded-p
+    (let ((func (if full-nov
+                    'nnml-add-nov
+                  'nnml-add-incremental-nov)))
+      (if nnmail-group-names-not-encoded-p
+          (dolist (ga group-art)
+            (funcall func (pop dec) (cdr ga) headers))
         (dolist (ga group-art)
-          (nnml-add-nov (pop dec) (cdr ga) headers))
-      (dolist (ga group-art)
-        (nnml-add-nov (car ga) (cdr ga) headers))))
+          (funcall func (car ga) (cdr ga) headers)))))
   group-art)
 
 (defun nnml-active-number (group &optional server)
@@ -778,6 +781,37 @@ article number.  This function is called narrowed to an article."
       (setcdr active (1+ (cdr active))))
     (cdr active)))
 
+(defvar nnml-incremental-nov-buffer-alist nil)
+
+(defun nnml-save-incremental-nov ()
+  (message "nnml saving incremental nov...")
+  (save-excursion
+    (while nnml-incremental-nov-buffer-alist
+      (when (buffer-name (cdar nnml-incremental-nov-buffer-alist))
+        (set-buffer (cdar nnml-incremental-nov-buffer-alist))
+        (when (buffer-modified-p)
+          (nnmail-write-region (point-min) (point-max)
+                               nnml-nov-buffer-file-name t 'nomesg))
+        (set-buffer-modified-p nil)
+        (kill-buffer (current-buffer)))
+      (setq nnml-incremental-nov-buffer-alist
+            (cdr nnml-incremental-nov-buffer-alist))))
+  (message "nnml saving incremental nov...done"))
+
+(defun nnml-open-incremental-nov (group)
+  (or (cdr (assoc group nnml-incremental-nov-buffer-alist))
+      (let ((buffer (nnml-get-nov-buffer group t)))
+        (push (cons group buffer) nnml-incremental-nov-buffer-alist)
+        buffer)))
+
+(defun nnml-add-incremental-nov (group article headers)
+  "Add a nov line for the GROUP nov headers, incrementally."
+  (save-excursion
+    (set-buffer (nnml-open-incremental-nov group))
+    (goto-char (point-max))
+    (mail-header-set-number headers article)
+    (nnheader-insert-nov headers)))
+
 (defun nnml-add-nov (group article headers)
   "Add a nov line for the GROUP base."
   (save-excursion
@@ -804,16 +838,21 @@ article number.  This function is called narrowed to an article."
         (mail-header-set-number headers number)
         headers))))
 
-(defun nnml-get-nov-buffer (group)
+(defun nnml-get-nov-buffer (group &optional incrementalp)
   (let* ((decoded (nnml-decoded-group-name group))
-         (buffer (get-buffer-create (format " *nnml overview %s*" decoded)))
+         (buffer (get-buffer-create (format " *nnml %soverview %s*"
+                                            (if incrementalp
+                                                "incremental "
+                                              "")
+                                            decoded)))
          (file-name-coding-system nnmail-pathname-coding-system))
     (save-excursion
       (set-buffer buffer)
       (set (make-local-variable 'nnml-nov-buffer-file-name)
            (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
       (erase-buffer)
-      (when (file-exists-p nnml-nov-buffer-file-name)
+      (when (and (not incrementalp)
+                 (file-exists-p nnml-nov-buffer-file-name))
         (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
     buffer))