[Emacs-diffs] /srv/bzr/emacs/trunk r101349: 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.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 101349
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Sun 2010-09-05 01:27:15 +0000
message:
  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.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/mail-source.el
  lisp/gnus/nnml.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-09-05 01:18:05 +0000
+++ b/lisp/gnus/ChangeLog       2010-09-05 01:27:15 +0000
@@ -1,7 +1,17 @@
 2010-09-04  Lars Magne Ingebrigtsen  <address@hidden>
 
+       * 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.

=== modified file 'lisp/gnus/mail-source.el'
--- a/lisp/gnus/mail-source.el  2010-09-05 01:18:05 +0000
+++ b/lisp/gnus/mail-source.el  2010-09-05 01:27:15 +0000
@@ -631,23 +631,23 @@
     ;; 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)))))))

=== modified file 'lisp/gnus/nnml.el'
--- a/lisp/gnus/nnml.el 2010-09-05 01:18:05 +0000
+++ b/lisp/gnus/nnml.el 2010-09-05 01:27:15 +0000
@@ -283,7 +283,7 @@
 (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 @@
         (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 @@
                                      (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 @@
       (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 @@
     ;; 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 @@
       (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 @@
        (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))