aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKen Olum2017-09-08 12:08:49 +0300
committerEli Zaretskii2017-09-08 12:08:49 +0300
commitf82d9323afff7a51e9303d43d7952f42acef843d (patch)
treea3ee101badeaa06596936dd8f8ab253d6754f47b
parent37cde9c6a20a7114ac6fb958c80eedf2c66feb68 (diff)
downloademacs-f82d9323afff7a51e9303d43d7952f42acef843d.tar.gz
emacs-f82d9323afff7a51e9303d43d7952f42acef843d.zip
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.
-rw-r--r--lisp/mail/rmailedit.el70
1 files changed, 50 insertions, 20 deletions
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index df1577fa915..e9bb5560df8 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -188,10 +188,6 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
188 (beginning-of-line) 188 (beginning-of-line)
189 (insert ">") 189 (insert ">")
190 (forward-line))) 190 (forward-line)))
191 ;; Make sure buffer ends with a blank line so as not to run this
192 ;; message together with the following one.
193 (goto-char (point-max))
194 (rmail-ensure-blank-line)
195 (let ((old rmail-old-text) 191 (let ((old rmail-old-text)
196 (pruned rmail-old-pruned) 192 (pruned rmail-old-pruned)
197 (mime-state rmail-old-mime-state) 193 (mime-state rmail-old-mime-state)
@@ -224,10 +220,9 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
224 (setq old nil) 220 (setq old nil)
225 (goto-char (point-min)) 221 (goto-char (point-min))
226 (search-forward "\n\n") 222 (search-forward "\n\n")
227 (setq headers-end (point-marker)) 223 (setq headers-end (point-marker)) ; first character of body
228 (goto-char (point-min))
229 (save-restriction 224 (save-restriction
230 (narrow-to-region (point) headers-end) 225 (narrow-to-region (point-min) headers-end)
231 ;; If they changed the message's encoding, rewrite the charset= 226 ;; If they changed the message's encoding, rewrite the charset=
232 ;; header for them, so that subsequent rmail-show-message 227 ;; header for them, so that subsequent rmail-show-message
233 ;; decodes it correctly. 228 ;; decodes it correctly.
@@ -240,6 +235,38 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
240 'us-ascii 235 'us-ascii
241 new-coding)))) 236 new-coding))))
242 old-coding mime-beg mime-end content-type) 237 old-coding mime-beg mime-end content-type)
238 ;; If there's no content-type in the edited headers, look for one
239 ;; in the original headers and add it to the edited headers
240 ;; (Bug #26918)
241 (unless (mail-fetch-field "Content-Type")
242 (let (old-content-type
243 (msgbeg (rmail-msgbeg rmail-current-message))
244 (msgend (rmail-msgend rmail-current-message)))
245 (with-current-buffer rmail-view-buffer ; really the mbox buffer
246 (save-restriction
247 (narrow-to-region msgbeg msgend)
248 (goto-char (point-min))
249 (setq limit (search-forward "\n\n"))
250 (narrow-to-region (point-min) limit)
251 (goto-char (point-min))
252 (when (re-search-forward "^content-type:" limit t)
253 (forward-line)
254 (setq old-content-type (buffer-substring
255 (match-beginning 0) (point))))))
256 (when old-content-type
257 (save-excursion
258 (goto-char headers-end) ; first char of body
259 (backward-char) ; add header before second newline
260 (insert old-content-type)
261 ;;Add it to rmail-old-headers as though it had been
262 ;;there originally, to avoid rmail-edit-update-headers
263 ;;an extra copy
264 (let ((header (substring old-content-type 0
265 (length "content-type"))))
266 (unless (assoc header rmail-old-headers)
267 (push (cons header old-content-type) rmail-old-headers)))
268 ))))
269 (goto-char (point-min))
243 (if (re-search-forward rmail-mime-charset-pattern nil 'move) 270 (if (re-search-forward rmail-mime-charset-pattern nil 'move)
244 (setq mime-beg (match-beginning 1) 271 (setq mime-beg (match-beginning 1)
245 mime-end (match-end 1) 272 mime-end (match-end 1)
@@ -281,29 +308,32 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
281 (setq character-coding (downcase character-coding))) 308 (setq character-coding (downcase character-coding)))
282 309
283 (goto-char limit) 310 (goto-char limit)
284 (let ((inhibit-read-only t)) 311 (let ((inhibit-read-only t)
285 (let ((data-buffer (current-buffer)) 312 (data-buffer (current-buffer))
286 (end (copy-marker (point) t))) 313 (start (copy-marker (point) nil)) ; new body will be between
287 (with-current-buffer rmail-view-buffer 314 (end (copy-marker (point) t))) ; these two markers
288 (encode-coding-region headers-end (point-max) coding-system 315 (with-current-buffer rmail-view-buffer
289 data-buffer)) 316 (encode-coding-region headers-end (point-max) coding-system
290 (delete-region end (point-max))) 317 data-buffer))
291 318 (delete-region end (point-max))
292 ;; Apply to the mbox buffer any changes in header fields 319 ;; Apply to the mbox buffer any changes in header fields
293 ;; that the user made while editing in the view buffer. 320 ;; that the user made while editing in the view buffer.
294 (rmail-edit-update-headers (rmail-edit-diff-headers 321 (rmail-edit-update-headers (rmail-edit-diff-headers
295 rmail-old-headers new-headers)) 322 rmail-old-headers new-headers))
296
297 ;; Re-apply content-transfer-encoding, if any, on the message body. 323 ;; Re-apply content-transfer-encoding, if any, on the message body.
298 (cond 324 (cond
299 ((string= character-coding "quoted-printable") 325 ((string= character-coding "quoted-printable")
300 (mail-quote-printable-region (point) (point-max))) 326 (mail-quote-printable-region start (point-max)))
301 ((and (string= character-coding "base64") is-text-message) 327 ((and (string= character-coding "base64") is-text-message)
302 (base64-encode-region (point) (point-max))) 328 (base64-encode-region start (point-max)))
303 ((and (eq character-coding 'uuencode) is-text-message) 329 ((and (eq character-coding 'uuencode) is-text-message)
304 (error "uuencoded messages are not supported")))) 330 (error "uuencoded messages are not supported")))
331 ;; After encoding, make sure buffer ends with a blank line so as not to
332 ;; run this message together with the following one.
333 (goto-char (point-max))
334 (rmail-ensure-blank-line))
305 (rmail-set-attribute rmail-edited-attr-index t)) 335 (rmail-set-attribute rmail-edited-attr-index t))
306 ;;??? BROKEN perhaps. 336;;;??? BROKEN perhaps.
307;;; (if (boundp 'rmail-summary-vector) 337;;; (if (boundp 'rmail-summary-vector)
308;;; (aset rmail-summary-vector (1- rmail-current-message) nil)) 338;;; (aset rmail-summary-vector (1- rmail-current-message) nil))
309 (rmail-show-message) 339 (rmail-show-message)