Mercurial > hg > xemacs-beta
diff lisp/vm/vm-folder.el @ 36:c53a95d3c46d r19-15b101
Import from CVS: tag r19-15b101
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:53:38 +0200 |
parents | ec9a17fef872 |
children | 7e54bd776075 |
line wrap: on
line diff
--- a/lisp/vm/vm-folder.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 08:53:38 2007 +0200 @@ -2738,77 +2738,88 @@ (vm-pop-ok-to-ask interactive) crash in maildrop popdrop (got-mail nil)) - (while triples - (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) - maildrop (nth 1 (car triples)) - crash (nth 2 (car triples))) - (if (eq (current-buffer) (vm-get-file-buffer in)) - (let (retrieval-function) - (if (file-exists-p crash) - (progn - (message "Recovering messages from %s..." crash) - (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) - (message "Recovering messages from %s... done" crash))) - (setq popdrop (and vm-recognize-pop-maildrops - (string-match vm-recognize-pop-maildrops - maildrop) - ;; maildrop with password clipped - (vm-safe-popdrop-string maildrop))) - (if (or popdrop - (and (not (equal 0 (nth 7 (file-attributes maildrop)))) - (file-readable-p maildrop))) - (progn - (setq crash (expand-file-name crash vm-folder-directory)) - (if (not popdrop) - (setq maildrop (expand-file-name maildrop) - retrieval-function 'vm-spool-move-mail) - (setq retrieval-function 'vm-pop-move-mail)) - (if (if got-mail - ;; don't allow errors to be signaled unless no - ;; mail has been appended to the incore - ;; copy of the folder. otherwise the - ;; user will wonder where the mail is, - ;; since it is not in the crash box or - ;; the spool file and doesn't _appear_ to - ;; be in the folder either. - (condition-case error-data - (funcall retrieval-function maildrop crash) - (error (message "%s signaled: %s" - (if popdrop - 'vm-pop-move-mail - 'vm-spool-move-mail) - error-data) - (sleep-for 2) - ;; we don't know if mail was - ;; put into the crash box or - ;; not, so return t just to be - ;; safe. - t ) - (quit (message "quitting from %s..." - (if popdrop - 'vm-pop-move-mail - 'vm-spool-move-mail)) - (sleep-for 1) - ;; we don't know if mail was - ;; put into the crash box or - ;; not, so return t just to be - ;; safe. - t )) - (funcall retrieval-function maildrop crash)) - (if (vm-gobble-crash-box crash) - (progn - (setq got-mail t) - (message "Got mail from %s." - (or popdrop maildrop))))))))) - (setq triples (cdr triples))) - ;; not really correct, but it is what the user expects to see. - (if got-mail - (setq vm-spooled-mail-waiting nil)) - (intern (buffer-name) vm-buffers-needing-display-update) - (vm-update-summary-and-mode-line) - (if got-mail - (run-hooks 'vm-retrieved-spooled-mail-hook)) - got-mail )) + (if (and (not (verify-visited-file-modtime (current-buffer))) + (or (null interactive) + (not (yes-or-no-p + (format + "Folder %s changed on disk, discard those changes? " + (buffer-name (current-buffer))))))) + (progn + (message "Folder %s changed on disk, consider M-x revert-buffer" + (buffer-name (current-buffer))) + (sleep-for 1) + nil ) + (while triples + (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) + maildrop (nth 1 (car triples)) + crash (nth 2 (car triples))) + (if (eq (current-buffer) (vm-get-file-buffer in)) + (let (retrieval-function) + (if (file-exists-p crash) + (progn + (message "Recovering messages from %s..." crash) + (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) + (message "Recovering messages from %s... done" crash))) + (setq popdrop (and vm-recognize-pop-maildrops + (string-match vm-recognize-pop-maildrops + maildrop) + ;; maildrop with password clipped + (vm-safe-popdrop-string maildrop))) + (if (or popdrop + (and (not (equal 0 (nth 7 (file-attributes maildrop)))) + (file-readable-p maildrop))) + (progn + (setq crash (expand-file-name crash vm-folder-directory)) + (if (not popdrop) + (setq maildrop (expand-file-name maildrop) + retrieval-function 'vm-spool-move-mail) + (setq retrieval-function 'vm-pop-move-mail)) + (if (if got-mail + ;; don't allow errors to be signaled unless no + ;; mail has been appended to the incore + ;; copy of the folder. otherwise the + ;; user will wonder where the mail is, + ;; since it is not in the crash box or + ;; the spool file and doesn't _appear_ to + ;; be in the folder either. + (condition-case error-data + (funcall retrieval-function maildrop crash) + (error (message "%s signaled: %s" + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail) + error-data) + (sleep-for 2) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t ) + (quit (message "quitting from %s..." + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail)) + (sleep-for 1) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t )) + (funcall retrieval-function maildrop crash)) + (if (vm-gobble-crash-box crash) + (progn + (setq got-mail t) + (message "Got mail from %s." + (or popdrop maildrop))))))))) + (setq triples (cdr triples))) + ;; not really correct, but it is what the user expects to see. + (if got-mail + (setq vm-spooled-mail-waiting nil)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (if got-mail + (run-hooks 'vm-retrieved-spooled-mail-hook)) + got-mail ))) (defun vm-safe-popdrop-string (drop) (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)