Mercurial > emacs
changeset 88282:a17247f2d0c2
(rmail-decode-mbox-format): Rename from `rmail-decode-mail-file'.
(rmail-process-new-messages): Don't add missing headers here.
(rmail-convert-mbox-format): Rename from `rmail-decode-messages'.
Add missing headers here. Remove FROM and TO arguments.
(rmail-get-new-mail): Simplify.
(rmail-convert-file): New function.
(rmail-revert): Use it.
(rmail): Change logic for avoiding selecting new messages twice.
(rmail-display-labels): Avoid space in mode-line if there are no
keywords.
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 23 Jan 2006 10:52:31 +0000 |
parents | 3c661fd46ca7 |
children | ae06377861e0 |
files | lisp/mail/rmail.el |
diffstat | 1 files changed, 176 insertions(+), 152 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mail/rmail.el Mon Jan 23 03:45:49 2006 +0000 +++ b/lisp/mail/rmail.el Mon Jan 23 10:52:31 2006 +0000 @@ -787,7 +787,7 @@ ;; on reading. So, at first, we read the file without text ;; code conversion, then decode the messages one by one. (coding-system-for-read (and rmail-enable-multibyte 'raw-text)) - run-mail-hook msg-shown new-mail) + run-mail-hook msg-shown) ;; This is how we used to do it. I reverted to the original Rmail ;; way of reading in the mail file, as it's the only way I can think ;; of to avoid needless modification of the mail file. However, the @@ -845,7 +845,6 @@ (when (and rmail-enable-multibyte (not enable-multibyte-characters)) (set-buffer-multibyte t))) - ;; Make sure we're in rmail-mode, even if the buffer did exist and ;; the file was not changed. (unless (eq major-mode 'rmail-mode) @@ -866,35 +865,58 @@ (insert-file-contents-literally new-file)) (message "Replacing BABYL format with mbox format...done")) (delete-file old-file) - (delete-file new-file))) - ;; Go through the converted file and decode each message - ;; according to its mime charset. - (rmail-decode-messages (point-min) (point-max))) + (delete-file new-file)))) (goto-char (point-max)) (rmail-mode-2) - ;; setup files coding system - (rmail-decode-mail-file) + ;; Convert all or parts of file to a format Rmail understands + (rmail-convert-file) ;; We use `run-mail-hook' to remember whether we should run ;; `rmail-mode-hook' at the end. (setq run-mail-hook t) - ;; Initialize the Rmail state and process any messages in the - ;; buffer. + ;; Initialize the Rmail state. (rmail-initialize-messages)) ;; Now we're back in business. The happens even if we had a ;; perfectly fine file. - (unless file-name-arg - (setq new-mail (rmail-get-new-mail))) - (when rmail-display-summary - (rmail-summary)) - ;; If new mail was found, display of the correct message was done - ;; elsewhere. - (unless new-mail - (rmail-show-message (or (rmail-first-unseen-message) - rmail-total-messages))) - (rmail-construct-io-menu) - ;; Run any callbacks if the buffer was not in rmail-mode - (if run-mail-hook - (run-hooks 'rmail-mode-hook)))) + (unwind-protect + (unless (and (not file-name-arg) (rmail-get-new-mail)) + (rmail-show-message (or (rmail-first-unseen-message) + rmail-total-messages))) + (when rmail-display-summary + (rmail-summary)) + (rmail-construct-io-menu) + ;; Run any callbacks if the buffer was not in rmail-mode + (when run-mail-hook + (run-hooks 'rmail-mode-hook))))) + +(defun rmail-convert-file () + (let ((convert + (save-restriction + (widen) + (let ((case-fold-search nil) + (start (point-max)) + end) + (catch 'convert + (goto-char start) + (while (re-search-backward + rmail-unix-mail-delimiter nil t) + (setq end start) + (setq start (point)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let ((attribute (rmail-header-get-header + rmail-header-attribute-header)) + (coding (rmail-header-get-header + "X-Coding-System"))) + (unless (and attribute attribute) + (throw 'convert t))))))))))) + (if convert + (let ((inhibit-read-only t)) + (rmail-convert-mbox-format)) + (when (and (not rmail-enable-mime) + rmail-enable-multibyte) + (rmail-decode-mbox-format))))) (defun rmail-initialize-messages () "Initialize message state based on messages in the buffer." @@ -1212,7 +1234,7 @@ (progn (set-buffer rmail-buffer) (rmail-mode-2) - + (rmail-convert-file) ;; We have read the file as raw-text, so the buffer is set to ;; unibyte. Make it multibyte if necessary. (if (and rmail-enable-multibyte @@ -1476,21 +1498,21 @@ ;; Process newly found messages and save them into the ;; RMAIL file. (unless (equal (point-min) (point-max)) - ;; Go through the region and decode each message. - (rmail-decode-messages (point-min) (point-max)) - ;; Update state and save buffer - (setq new-messages (rmail-process-new-messages) - rmail-current-message (1+ rmail-total-messages) - rmail-total-messages (rmail-desc-get-count)) - (run-hooks 'rmail-get-new-mail-hook) + (setq new-messages (rmail-convert-mbox-format)) + (unless (zerop new-messages) + (rmail-process-new-messages) + (setq rmail-current-message (1+ rmail-total-messages) + rmail-total-messages (rmail-desc-get-count))) (save-buffer)) ;; Delete the old files, now that the RMAIL file is ;; saved. (when delete-files (rmail-delete-inbox-files delete-files)))) - (if (= new-messages 0) + + (if (zerop new-messages) (when (or file-name rmail-inbox-list) (message "(No new mail has arrived)")) + ;; Process the new messages for spam using the integrated ;; spam filter. The spam filter can mark messages for ;; deletion and can output a message. @@ -1717,7 +1739,7 @@ (coding-system-change-eol-conversion coding 'unix)))) -(defun rmail-decode-mail-file () +(defun rmail-decode-mbox-format () "Decode mail file to a suitable conding system." (when (and (not rmail-enable-mime) rmail-enable-multibyte) (let ((modifiedp (buffer-modified-p)) @@ -1756,56 +1778,6 @@ (point-min) (point-max) coding))))) (setq last-coding-system-used coding-system-used)))) - -;; NB: this function may only be called on a region containing fresh, -;; never before seen messages. Using it on old messages will mess up -;; encoding. -(defun rmail-decode-messages (from to) - ;; Process each message in turn starting from the back and - ;; proceeding to the front of the region. This is especially a good - ;; approach since the buffer will likely have new headers added. - (save-restriction - (narrow-to-region from to) - (let ((inhibit-read-only t) - (case-fold-search nil) - (start (point-max)) - end) - (goto-char start) - (while (re-search-backward rmail-unix-mail-delimiter nil t) - (setq end start) - (setq start (point)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - ;; Detect messages that have been added with DOS line endings - ;; and convert the line endings for such messages. - (when (save-excursion (end-of-line) (= (preceding-char) ?\r)) - (let ((buffer-read-only nil) - (buffer-undo t) - (end-marker (copy-marker end))) - (message - "Processing new messages...(converting line endings)") - (save-excursion - (goto-char (point-max)) - (while (search-backward "\r\n" (point-min) t) - (delete-char 1))) - (setq end (marker-position end-marker)) - (set-marker end-marker nil))) - - ;; Decode message according to content type, and make sure we - ;; have a coding-system header. - (let ((coding (rmail-decode-by-content-type - (point-min) (point-max)))) - (unless (rmail-header-get-header "X-Coding-System") - (rmail-header-add-header "X-Coding-System" - (symbol-name coding)))) - - ;; encoded-words in from and subject - (dolist (header '("Subject" "From")) - (let ((value (rmail-header-get-header header))) - (rmail-header-add-header - header (mail-decode-encoded-word-string value)))))))))) ;;;; *** Rmail Message Formatting and Header Manipulation *** @@ -1908,8 +1880,9 @@ ;; Update the mode line to display the keywords, the current ;; message index and the total number of messages. (setq mode-line-process - (format " %d/%d %s" - rmail-current-message rmail-total-messages result)) + (format " %d/%d%s" + rmail-current-message rmail-total-messages + (if keyword-list (concat " " result) ""))) ;; If rmail-enable-mime is non-nil, we may have to update ;; `mode-line-process' of rmail-view-buffer too. (if (and rmail-enable-mime @@ -1984,80 +1957,131 @@ (case-fold-search nil) (new-message-counter 0) (start (point-max)) - end attributes keywords message-descriptor-list - date coding sender) + end date keywords message-descriptor-list) (or nomsg (message "Processing new messages...")) ;; Process each message in turn starting from the back and ;; proceeding to the front of the region. This is especially a ;; good approach since the buffer will likely have new headers ;; added. - (goto-char start) - (while (re-search-backward rmail-unix-mail-delimiter nil t) - ;; Cache the message date to facilitate generating a message - ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON - ;; YEAR TIME) - (setq date - (list (buffer-substring (match-beginning 2) (match-end 2)) - (buffer-substring (match-beginning 4) (match-end 4)) - (buffer-substring (match-beginning 3) (match-end 3)) - (buffer-substring (match-beginning 7) (match-end 7)) - (buffer-substring (match-beginning 5) (match-end 5)))) - ;;Set start and end to bracket this message. - (setq end start) - (setq start (point)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - ;; Bump the new message counter. - (setq new-message-counter (1+ new-message-counter)) + (save-excursion + (goto-char start) + (while (re-search-backward rmail-unix-mail-delimiter nil t) + ;; Cache the message date to facilitate generating a message + ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON + ;; YEAR TIME) + (setq date + (list (buffer-substring (match-beginning 2) (match-end 2)) + (buffer-substring (match-beginning 4) (match-end 4)) + (buffer-substring (match-beginning 3) (match-end 3)) + (buffer-substring (match-beginning 7) (match-end 7)) + (buffer-substring (match-beginning 5) (match-end 5)))) + ;;Set start and end to bracket this message. + (setq end start) + (setq start (point)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + ;; Bump the new message counter. + (setq new-message-counter (1+ new-message-counter)) + + ;; Set up keywords, if any. The keywords are provided via a + ;; comma separated list and returned as a list of strings. + (setq keywords (rmail-header-get-keywords)) + (when keywords + ;; Keywords do exist. Register them with the keyword + ;; management library. + (rmail-keyword-register-keywords keywords)) + + ;; Insure that we have From and Date headers. + ;;(rmail-decode-from-line) + + ;; Perform User defined filtering. + (save-excursion + (if rmail-message-filter (funcall rmail-message-filter))) + ;; Accumulate the message attributes along with the message + ;; markers and the message date list. + (setq message-descriptor-list + (vconcat (list (list (point-min-marker) + (rmail-header-get-header + rmail-header-attribute-header) + keywords + date + (count-lines start end) + (cadr (mail-extract-address-components + (rmail-header-get-header "from"))) + (or (rmail-header-get-header "subject") + "none"))) + message-descriptor-list))))) + ;; Add the new message data lists to the Rmail message descriptor + ;; vector. + (rmail-desc-add-descriptors message-descriptor-list) + ;; Unless requested otherwise, show the number of new messages. + ;; Return the number of new messages. + (or nomsg (message "Processing new messages...done (%d)" + new-message-counter)) + new-message-counter))) - ;; Make sure we have an Rmail BABYL attribute header field. - ;; All we can assume is that the Rmail BABYL header field is - ;; in the header section. It's placement can be modified by - ;; another mailer. - (setq attributes (rmail-header-get-header - rmail-header-attribute-header)) - (unless attributes - ;; No suitable header exists. Append the default BABYL - ;; data header for a new message. - (setq attributes rmail-desc-default-attrs) - (rmail-header-add-header rmail-header-attribute-header attributes)) - ;; Set up keywords, if any. The keywords are provided via a - ;; comma separated list and returned as a list of strings. - (setq keywords (rmail-header-get-keywords)) - (when keywords - ;; Keywords do exist. Register them with the keyword - ;; management library. - (rmail-keyword-register-keywords keywords)) - - ;; Insure that we have From and Date headers. - ;;(rmail-decode-from-line) +;; NB: this function may only be called on a region containing fresh, +;; never before seen messages. Using it on old messages will mess up +;; encoding. +(defun rmail-convert-mbox-format () + (let ((case-fold-search nil) + (message-count 0) + (start (point-max)) + end) + (save-excursion + (goto-char start) + (while (re-search-backward rmail-unix-mail-delimiter nil t) + (setq end start) + (setq start (point)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + ;; Bump the new message counter. + (setq message-count (1+ message-count)) + ;; Detect messages that have been added with DOS line endings + ;; and convert the line endings for such messages. + (when (save-excursion (end-of-line) (= (preceding-char) ?\r)) + (let ((buffer-read-only nil) + (buffer-undo t) + (end-marker (copy-marker end))) + (message + "Processing new messages...(converting line endings)") + (save-excursion + (goto-char (point-max)) + (while (search-backward "\r\n" (point-min) t) + (delete-char 1))) + (setq end (marker-position end-marker)) + (set-marker end-marker nil))) - ;; Perform User defined filtering. - (save-excursion - (if rmail-message-filter (funcall rmail-message-filter))) - ;; Accumulate the message attributes along with the message - ;; markers and the message date list. - (setq message-descriptor-list - (vconcat (list (list (point-min-marker) - attributes - keywords - date - (count-lines start end) - (cadr (mail-extract-address-components - (rmail-header-get-header "from"))) - (or (rmail-header-get-header "subject") - "none"))) - message-descriptor-list))))) - ;; Add the new message data lists to the Rmail message descriptor - ;; vector. - (rmail-desc-add-descriptors message-descriptor-list) - ;; Unless requested otherwise, show the number of new messages. - ;; Return the number of new messages. - (or nomsg (message "Processing new messages...done (%d)" - new-message-counter)) - new-message-counter)) + ;; encoded-words in from and subject + (dolist (header '("Subject" "From")) + (let ((value (rmail-header-get-header header))) + (rmail-header-add-header + header (mail-decode-encoded-word-string value)))) + + ;; Make sure we have an Rmail BABYL attribute header field. + ;; All we can assume is that the Rmail BABYL header field is + ;; in the header section. It's placement can be modified by + ;; another mailer. + (let ((attributes (rmail-header-get-header + rmail-header-attribute-header))) + (unless attributes + ;; No suitable header exists. Append the default BABYL + ;; data header for a new message. + (rmail-header-add-header rmail-header-attribute-header + rmail-desc-default-attrs))) + + ;; Decode message according to content type, and make sure we + ;; have a coding-system header. + (let ((coding (rmail-decode-by-content-type + (point-min) (point-max)))) + (unless (rmail-header-get-header "X-Coding-System") + (rmail-header-add-header "X-Coding-System" + (symbol-name coding))))))) + message-count))) ;;; mbox: deprecated (defun rmail-maybe-set-message-counters ()