mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
Fix Rmail editing with reapplying encoding to message body
* lisp/mail/rmailedit.el (rmail-cease-edit): If no content-type in edited headers, look for one in original headers and add it to edited headers. (Bug #26918) Use a marker to track start of new body, so that content-transfer-encoding gets applied only to body. (Bug #27353). Ensure blank line at end of message after encoding, not before.
This commit is contained in:
parent
37cde9c6a2
commit
f82d9323af
1 changed files with 50 additions and 20 deletions
|
|
@ -188,10 +188,6 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
|
|||
(beginning-of-line)
|
||||
(insert ">")
|
||||
(forward-line)))
|
||||
;; Make sure buffer ends with a blank line so as not to run this
|
||||
;; message together with the following one.
|
||||
(goto-char (point-max))
|
||||
(rmail-ensure-blank-line)
|
||||
(let ((old rmail-old-text)
|
||||
(pruned rmail-old-pruned)
|
||||
(mime-state rmail-old-mime-state)
|
||||
|
|
@ -224,10 +220,9 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
|
|||
(setq old nil)
|
||||
(goto-char (point-min))
|
||||
(search-forward "\n\n")
|
||||
(setq headers-end (point-marker))
|
||||
(goto-char (point-min))
|
||||
(setq headers-end (point-marker)) ; first character of body
|
||||
(save-restriction
|
||||
(narrow-to-region (point) headers-end)
|
||||
(narrow-to-region (point-min) headers-end)
|
||||
;; If they changed the message's encoding, rewrite the charset=
|
||||
;; header for them, so that subsequent rmail-show-message
|
||||
;; decodes it correctly.
|
||||
|
|
@ -240,6 +235,38 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
|
|||
'us-ascii
|
||||
new-coding))))
|
||||
old-coding mime-beg mime-end content-type)
|
||||
;; If there's no content-type in the edited headers, look for one
|
||||
;; in the original headers and add it to the edited headers
|
||||
;; (Bug #26918)
|
||||
(unless (mail-fetch-field "Content-Type")
|
||||
(let (old-content-type
|
||||
(msgbeg (rmail-msgbeg rmail-current-message))
|
||||
(msgend (rmail-msgend rmail-current-message)))
|
||||
(with-current-buffer rmail-view-buffer ; really the mbox buffer
|
||||
(save-restriction
|
||||
(narrow-to-region msgbeg msgend)
|
||||
(goto-char (point-min))
|
||||
(setq limit (search-forward "\n\n"))
|
||||
(narrow-to-region (point-min) limit)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^content-type:" limit t)
|
||||
(forward-line)
|
||||
(setq old-content-type (buffer-substring
|
||||
(match-beginning 0) (point))))))
|
||||
(when old-content-type
|
||||
(save-excursion
|
||||
(goto-char headers-end) ; first char of body
|
||||
(backward-char) ; add header before second newline
|
||||
(insert old-content-type)
|
||||
;;Add it to rmail-old-headers as though it had been
|
||||
;;there originally, to avoid rmail-edit-update-headers
|
||||
;;an extra copy
|
||||
(let ((header (substring old-content-type 0
|
||||
(length "content-type"))))
|
||||
(unless (assoc header rmail-old-headers)
|
||||
(push (cons header old-content-type) rmail-old-headers)))
|
||||
))))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward rmail-mime-charset-pattern nil 'move)
|
||||
(setq mime-beg (match-beginning 1)
|
||||
mime-end (match-end 1)
|
||||
|
|
@ -281,29 +308,32 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
|
|||
(setq character-coding (downcase character-coding)))
|
||||
|
||||
(goto-char limit)
|
||||
(let ((inhibit-read-only t))
|
||||
(let ((data-buffer (current-buffer))
|
||||
(end (copy-marker (point) t)))
|
||||
(with-current-buffer rmail-view-buffer
|
||||
(encode-coding-region headers-end (point-max) coding-system
|
||||
data-buffer))
|
||||
(delete-region end (point-max)))
|
||||
|
||||
(let ((inhibit-read-only t)
|
||||
(data-buffer (current-buffer))
|
||||
(start (copy-marker (point) nil)) ; new body will be between
|
||||
(end (copy-marker (point) t))) ; these two markers
|
||||
(with-current-buffer rmail-view-buffer
|
||||
(encode-coding-region headers-end (point-max) coding-system
|
||||
data-buffer))
|
||||
(delete-region end (point-max))
|
||||
;; Apply to the mbox buffer any changes in header fields
|
||||
;; that the user made while editing in the view buffer.
|
||||
(rmail-edit-update-headers (rmail-edit-diff-headers
|
||||
rmail-old-headers new-headers))
|
||||
|
||||
;; Re-apply content-transfer-encoding, if any, on the message body.
|
||||
(cond
|
||||
((string= character-coding "quoted-printable")
|
||||
(mail-quote-printable-region (point) (point-max)))
|
||||
(mail-quote-printable-region start (point-max)))
|
||||
((and (string= character-coding "base64") is-text-message)
|
||||
(base64-encode-region (point) (point-max)))
|
||||
(base64-encode-region start (point-max)))
|
||||
((and (eq character-coding 'uuencode) is-text-message)
|
||||
(error "uuencoded messages are not supported"))))
|
||||
(error "uuencoded messages are not supported")))
|
||||
;; After encoding, make sure buffer ends with a blank line so as not to
|
||||
;; run this message together with the following one.
|
||||
(goto-char (point-max))
|
||||
(rmail-ensure-blank-line))
|
||||
(rmail-set-attribute rmail-edited-attr-index t))
|
||||
;;??? BROKEN perhaps.
|
||||
;;;??? BROKEN perhaps.
|
||||
;;; (if (boundp 'rmail-summary-vector)
|
||||
;;; (aset rmail-summary-vector (1- rmail-current-message) nil))
|
||||
(rmail-show-message)
|
||||
|
|
|
|||
Loading…
Reference in a new issue