# HG changeset patch # User Alex Schroeder # Date 1138058456 0 # Node ID 2d481143eb0858815292221b4b55c422e1d7788c # Parent e664e2e2ae900b4700eb47060bb4a9c6ece89762 (rmail-narrow-to-non-pruned-header): Deleted. (rmail-unknown-mail-followup-to, rmail-retry-failure): No longer call rmail-narrow-to-non-pruned-header and replace mail-fetch-field with rmail-header-get-header because that one ignores the intangible property when searching. (rmail-show-message): Simplify x-coding-system handling. (rmail-redecode-body): No longer call rmail-header-show-headers because rmail-header-get-header handles the intanglible property. (rmail-reply): Simplify code at the price of some efficiency when setting up the variable bindings. No longer toggle visibility of headers, because rmail-header-show-headers is no longer necessary. diff -r e664e2e2ae90 -r 2d481143eb08 lisp/mail/rmail.el --- a/lisp/mail/rmail.el Mon Jan 23 23:19:45 2006 +0000 +++ b/lisp/mail/rmail.el Mon Jan 23 23:20:56 2006 +0000 @@ -1838,25 +1838,6 @@ (interactive "P") (rmail-header-toggle-visibility arg)) -(defun rmail-narrow-to-non-pruned-header () - "Narrow to the whole (original) header of the current message." - (let (start end) - (narrow-to-region (rmail-desc-get-start rmail-current-message) (point-max)) - (goto-char (point-min)) - (forward-line 1) - (if (= (following-char) ?1) - (progn - (forward-line 1) - (setq start (point)) - (search-forward "*** EOOH ***\n") - (setq end (match-beginning 0))) - (forward-line 2) - (setq start (point)) - (search-forward "\n\n") - (setq end (1- (point)))) - (narrow-to-region start end) - (goto-char start))) - ;; Lifted from repos-count-screen-lines. (defun rmail-count-screen-lines (start end) "Return number of screen lines between START and END." @@ -2117,8 +2098,7 @@ "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. Ask the user whether to add that list name to `mail-mailing-lists'." (save-restriction - (rmail-narrow-to-non-pruned-header) - (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t))) + (let ((mail-followup-to (rmail-header-get-header "mail-followup-to" nil t))) (when mail-followup-to (let ((addresses (split-string @@ -2165,15 +2145,14 @@ (widen) (narrow-to-region beg end) (goto-char (point-min)) - (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) - (let ((coding-system (intern (match-string 1)))) - (condition-case nil - (progn - (check-coding-system coding-system) - (setq buffer-file-coding-system coding-system)) - (error - (setq buffer-file-coding-system nil)))) - (setq buffer-file-coding-system nil)) + (condition-case nil + (let* ((coding-system-name (rmail-header-get-header "X-Coding-System")) + (coding-system (intern coding-system-name))) + (check-coding-system coding-system) + (setq buffer-file-coding-system coding-system)) + ;; no coding system or invalid coding system + (error + (setq buffer-file-coding-system nil))) ;; Clear the "unseen" attribute when we show a message, unless ;; it is already cleared. (when (rmail-desc-attr-p rmail-desc-unseen-index n) @@ -2229,39 +2208,33 @@ (unless rmail-enable-mime (with-current-buffer rmail-buffer (save-excursion - (unwind-protect - (let ((start (rmail-desc-get-start rmail-current-message)) - (end (rmail-desc-get-end rmail-current-message)) - header) - ;; We need the message headers pruned (we later restore - ;; the pruned stat to what it was, see the end of - ;; unwind-protect form). - (rmail-header-show-headers) - (narrow-to-region start end) - (setq header (rmail-header-get-header "X-Coding-System")) - (if header - (let ((old-coding (intern header)) - (buffer-read-only nil)) - (check-coding-system old-coding) - ;; Make sure the new coding system uses the same EOL - ;; conversion, to prevent ^M characters from popping - ;; up all over the place. - (setq coding - (coding-system-change-eol-conversion - coding - (coding-system-eol-type old-coding))) + (let ((start (rmail-desc-get-start rmail-current-message)) + (end (rmail-desc-get-end rmail-current-message)) + header) + (narrow-to-region start end) + (setq header (rmail-header-get-header "X-Coding-System")) + (if header + (let ((old-coding (intern header)) + (buffer-read-only nil)) + (check-coding-system old-coding) + ;; Make sure the new coding system uses the same EOL + ;; conversion, to prevent ^M characters from popping + ;; up all over the place. + (setq coding + (coding-system-change-eol-conversion + coding + (coding-system-eol-type old-coding))) ;; Do the actual recoding. - (encode-coding-region start end old-coding) - (decode-coding-region start end coding) - ;; Rewrite the x-coding-system header according to - ;; what we did. - (setq last-coding-system-used coding) - (rmail-header-add-header - "X-Coding-System" - (symbol-name last-coding-system-used)) - (rmail-show-message rmail-current-message)) - (error "No X-Coding-System header found"))) - (rmail-header-hide-headers)))))) + (encode-coding-region start end old-coding) + (decode-coding-region start end coding) + ;; Rewrite the x-coding-system header according to + ;; what we did. + (setq last-coding-system-used coding) + (rmail-header-add-header + "X-Coding-System" + (symbol-name last-coding-system-used)) + (rmail-show-message rmail-current-message)) + (error "No X-Coding-System header found"))))))) ;;; mbox ready (defun rmail-auto-file () @@ -2732,7 +2705,6 @@ (interactive) (rmail-start-mail t)) -;;; mbox: ready -pmr (defun rmail-reply (just-sender) "Reply to the current message. Normally include CC: to all other recipients of original message; @@ -2743,28 +2715,20 @@ (error "No messages in this file")) (save-excursion (save-restriction - (let ((msgnum rmail-current-message) - (display-state (rmail-desc-get-header-display-state - rmail-current-message)) - from reply-to cc subject date to message-id references - resent-to resent-cc resent-reply-to) - (rmail-header-show-headers) - (setq from (mail-fetch-field "from") - reply-to (or (mail-fetch-field "reply-to" nil t) from) - cc (and (not just-sender) - (mail-fetch-field "cc" nil t)) - subject (mail-fetch-field "subject") - date (mail-fetch-field "date") - to (or (mail-fetch-field "to" nil t) "") - message-id (mail-fetch-field "message-id") - references (mail-fetch-field "references" nil nil t) - resent-reply-to (mail-fetch-field "resent-reply-to" nil t) - resent-cc (and (not just-sender) - (mail-fetch-field "resent-cc" nil t)) - resent-to (or (mail-fetch-field "resent-to" nil t) "")) -;;; resent-subject (mail-fetch-field "resent-subject") -;;; resent-date (mail-fetch-field "resent-date") -;;; resent-message-id (mail-fetch-field "resent-message-id") + (let* ((msgnum rmail-current-message) + (from (rmail-header-get-header "from")) + (reply-to (or (rmail-header-get-header "reply-to" nil t) from)) + (cc (unless just-sender + (rmail-header-get-header "cc" nil t))) + (subject (rmail-header-get-header "subject")) + (date (rmail-header-get-header "date")) + (to (or (rmail-header-get-header "to" nil t) "")) + (message-id (rmail-header-get-header "message-id")) + (references (rmail-header-get-header "references" nil nil t)) + (resent-to (rmail-header-get-header "resent-reply-to" nil t)) + (resent-cc (unless just-sender + (rmail-header-get-header "resent-cc" nil t))) + (resent-reply-to (or (rmail-header-get-header "resent-to" nil t) ""))) ;; Merge the resent-to and resent-cc into the to and cc. (if (and resent-to (not (equal resent-to ""))) (if (not (equal to "")) @@ -2782,24 +2746,20 @@ (string-match rmail-reply-regexp subject)) (substring subject (match-end 0)) subject)))) - ;; Reset the headers display state before switching to the - ;; reply buffer. - (rmail-header-toggle-visibility (if display-state 1 0)) - ;; Now setup the mail reply buffer. (rmail-start-mail nil - ;; Using mail-strip-quoted-names is undesirable with newer mailers - ;; since they can handle the names unstripped. - ;; I don't know whether there are other mailers that still - ;; need the names to be stripped. + ;; Using mail-strip-quoted-names is undesirable with newer + ;; mailers since they can handle the names unstripped. I + ;; don't know whether there are other mailers that still need + ;; the names to be stripped. (mail-strip-quoted-names reply-to) subject (rmail-make-in-reply-to-field from date message-id) (if just-sender nil - ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to - ;; to do its job. + ;; mail-strip-quoted-names is NOT necessary for + ;; rmail-dont-reply-to to do its job. (let* ((cc-list (rmail-dont-reply-to (mail-strip-quoted-names (if (null cc) to (concat to ", " cc)))))) @@ -3064,7 +3024,6 @@ (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" "A regexp that matches the header of a MIME body part with a failed message.") -;;; NOT DONE (defun rmail-retry-failure () "Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and @@ -3082,13 +3041,10 @@ (let ((rmail-this-buffer (current-buffer)) (msgnum rmail-current-message) bounce-start bounce-end bounce-indent resending - ;; Fetch any content-type header in current message - ;; Must search thru the whole unpruned header. (content-type (save-excursion (save-restriction - (rmail-narrow-to-non-pruned-header) - (mail-fetch-field "Content-Type") )))) + (rmail-header-get-header "Content-Type"))))) (save-excursion (goto-char (point-min)) (let ((case-fold-search t))