Mercurial > emacs
changeset 110198:8867a7812454
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Sun, 05 Sep 2010 01:27:15 +0000 |
| parents | 727cc5d69397 |
| children | 46ace9f35be1 |
| files | lisp/gnus/ChangeLog lisp/gnus/mail-source.el lisp/gnus/nnml.el |
| diffstat | 3 files changed, 77 insertions(+), 28 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Sun Sep 05 01:18:05 2010 +0000 +++ b/lisp/gnus/ChangeLog Sun Sep 05 01:27:15 2010 +0000 @@ -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.
--- a/lisp/gnus/mail-source.el Sun Sep 05 01:18:05 2010 +0000 +++ b/lisp/gnus/mail-source.el Sun Sep 05 01:27:15 2010 +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)))))))
--- a/lisp/gnus/nnml.el Sun Sep 05 01:18:05 2010 +0000 +++ b/lisp/gnus/nnml.el Sun Sep 05 01:27:15 2010 +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))