Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-folder.el @ 36:c53a95d3c46d r19-15b101

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b101
author cvs
date Mon, 13 Aug 2007 08:53:38 +0200
parents ec9a17fef872
children 7e54bd776075
comparison
equal deleted inserted replaced
35:279432d5c479 36:c53a95d3c46d
2736 ;; before we finish. block these attempts. 2736 ;; before we finish. block these attempts.
2737 (vm-block-new-mail t) 2737 (vm-block-new-mail t)
2738 (vm-pop-ok-to-ask interactive) 2738 (vm-pop-ok-to-ask interactive)
2739 crash in maildrop popdrop 2739 crash in maildrop popdrop
2740 (got-mail nil)) 2740 (got-mail nil))
2741 (while triples 2741 (if (and (not (verify-visited-file-modtime (current-buffer)))
2742 (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) 2742 (or (null interactive)
2743 maildrop (nth 1 (car triples)) 2743 (not (yes-or-no-p
2744 crash (nth 2 (car triples))) 2744 (format
2745 (if (eq (current-buffer) (vm-get-file-buffer in)) 2745 "Folder %s changed on disk, discard those changes? "
2746 (let (retrieval-function) 2746 (buffer-name (current-buffer)))))))
2747 (if (file-exists-p crash) 2747 (progn
2748 (progn 2748 (message "Folder %s changed on disk, consider M-x revert-buffer"
2749 (message "Recovering messages from %s..." crash) 2749 (buffer-name (current-buffer)))
2750 (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) 2750 (sleep-for 1)
2751 (message "Recovering messages from %s... done" crash))) 2751 nil )
2752 (setq popdrop (and vm-recognize-pop-maildrops 2752 (while triples
2753 (string-match vm-recognize-pop-maildrops 2753 (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory)
2754 maildrop) 2754 maildrop (nth 1 (car triples))
2755 ;; maildrop with password clipped 2755 crash (nth 2 (car triples)))
2756 (vm-safe-popdrop-string maildrop))) 2756 (if (eq (current-buffer) (vm-get-file-buffer in))
2757 (if (or popdrop 2757 (let (retrieval-function)
2758 (and (not (equal 0 (nth 7 (file-attributes maildrop)))) 2758 (if (file-exists-p crash)
2759 (file-readable-p maildrop))) 2759 (progn
2760 (progn 2760 (message "Recovering messages from %s..." crash)
2761 (setq crash (expand-file-name crash vm-folder-directory)) 2761 (setq got-mail (or (vm-gobble-crash-box crash) got-mail))
2762 (if (not popdrop) 2762 (message "Recovering messages from %s... done" crash)))
2763 (setq maildrop (expand-file-name maildrop) 2763 (setq popdrop (and vm-recognize-pop-maildrops
2764 retrieval-function 'vm-spool-move-mail) 2764 (string-match vm-recognize-pop-maildrops
2765 (setq retrieval-function 'vm-pop-move-mail)) 2765 maildrop)
2766 (if (if got-mail 2766 ;; maildrop with password clipped
2767 ;; don't allow errors to be signaled unless no 2767 (vm-safe-popdrop-string maildrop)))
2768 ;; mail has been appended to the incore 2768 (if (or popdrop
2769 ;; copy of the folder. otherwise the 2769 (and (not (equal 0 (nth 7 (file-attributes maildrop))))
2770 ;; user will wonder where the mail is, 2770 (file-readable-p maildrop)))
2771 ;; since it is not in the crash box or 2771 (progn
2772 ;; the spool file and doesn't _appear_ to 2772 (setq crash (expand-file-name crash vm-folder-directory))
2773 ;; be in the folder either. 2773 (if (not popdrop)
2774 (condition-case error-data 2774 (setq maildrop (expand-file-name maildrop)
2775 (funcall retrieval-function maildrop crash) 2775 retrieval-function 'vm-spool-move-mail)
2776 (error (message "%s signaled: %s" 2776 (setq retrieval-function 'vm-pop-move-mail))
2777 (if popdrop 2777 (if (if got-mail
2778 'vm-pop-move-mail 2778 ;; don't allow errors to be signaled unless no
2779 'vm-spool-move-mail) 2779 ;; mail has been appended to the incore
2780 error-data) 2780 ;; copy of the folder. otherwise the
2781 (sleep-for 2) 2781 ;; user will wonder where the mail is,
2782 ;; we don't know if mail was 2782 ;; since it is not in the crash box or
2783 ;; put into the crash box or 2783 ;; the spool file and doesn't _appear_ to
2784 ;; not, so return t just to be 2784 ;; be in the folder either.
2785 ;; safe. 2785 (condition-case error-data
2786 t ) 2786 (funcall retrieval-function maildrop crash)
2787 (quit (message "quitting from %s..." 2787 (error (message "%s signaled: %s"
2788 (if popdrop 2788 (if popdrop
2789 'vm-pop-move-mail 2789 'vm-pop-move-mail
2790 'vm-spool-move-mail)) 2790 'vm-spool-move-mail)
2791 (sleep-for 1) 2791 error-data)
2792 ;; we don't know if mail was 2792 (sleep-for 2)
2793 ;; put into the crash box or 2793 ;; we don't know if mail was
2794 ;; not, so return t just to be 2794 ;; put into the crash box or
2795 ;; safe. 2795 ;; not, so return t just to be
2796 t )) 2796 ;; safe.
2797 (funcall retrieval-function maildrop crash)) 2797 t )
2798 (if (vm-gobble-crash-box crash) 2798 (quit (message "quitting from %s..."
2799 (progn 2799 (if popdrop
2800 (setq got-mail t) 2800 'vm-pop-move-mail
2801 (message "Got mail from %s." 2801 'vm-spool-move-mail))
2802 (or popdrop maildrop))))))))) 2802 (sleep-for 1)
2803 (setq triples (cdr triples))) 2803 ;; we don't know if mail was
2804 ;; not really correct, but it is what the user expects to see. 2804 ;; put into the crash box or
2805 (if got-mail 2805 ;; not, so return t just to be
2806 (setq vm-spooled-mail-waiting nil)) 2806 ;; safe.
2807 (intern (buffer-name) vm-buffers-needing-display-update) 2807 t ))
2808 (vm-update-summary-and-mode-line) 2808 (funcall retrieval-function maildrop crash))
2809 (if got-mail 2809 (if (vm-gobble-crash-box crash)
2810 (run-hooks 'vm-retrieved-spooled-mail-hook)) 2810 (progn
2811 got-mail )) 2811 (setq got-mail t)
2812 (message "Got mail from %s."
2813 (or popdrop maildrop)))))))))
2814 (setq triples (cdr triples)))
2815 ;; not really correct, but it is what the user expects to see.
2816 (if got-mail
2817 (setq vm-spooled-mail-waiting nil))
2818 (intern (buffer-name) vm-buffers-needing-display-update)
2819 (vm-update-summary-and-mode-line)
2820 (if got-mail
2821 (run-hooks 'vm-retrieved-spooled-mail-hook))
2822 got-mail )))
2812 2823
2813 (defun vm-safe-popdrop-string (drop) 2824 (defun vm-safe-popdrop-string (drop)
2814 (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop) 2825 (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
2815 (concat (substring drop (match-beginning 2) (match-end 2)) 2826 (concat (substring drop (match-beginning 2) (match-end 2))
2816 "@" 2827 "@"