diff options
Diffstat (limited to 'lisp/gnus/mml.el')
| -rw-r--r-- | lisp/gnus/mml.el | 98 |
1 files changed, 59 insertions, 39 deletions
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 6d13d892b5a..3a31349d378 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el | |||
| @@ -486,7 +486,8 @@ be \"related\" or \"alternate\"." | |||
| 486 | (equal (cdr (assq 'type (car cont))) "text/html")) | 486 | (equal (cdr (assq 'type (car cont))) "text/html")) |
| 487 | (setq cont (mml-expand-html-into-multipart-related (car cont)))) | 487 | (setq cont (mml-expand-html-into-multipart-related (car cont)))) |
| 488 | (prog1 | 488 | (prog1 |
| 489 | (mm-with-multibyte-buffer | 489 | (with-temp-buffer |
| 490 | (set-buffer-multibyte nil) | ||
| 490 | (setq message-options options) | 491 | (setq message-options options) |
| 491 | (cond | 492 | (cond |
| 492 | ((and (consp (car cont)) | 493 | ((and (consp (car cont)) |
| @@ -605,28 +606,38 @@ be \"related\" or \"alternate\"." | |||
| 605 | (intern (downcase charset)))))) | 606 | (intern (downcase charset)))))) |
| 606 | (if (and (not raw) | 607 | (if (and (not raw) |
| 607 | (member (car (split-string type "/")) '("text" "message"))) | 608 | (member (car (split-string type "/")) '("text" "message"))) |
| 609 | ;; We have a text-like MIME part, so we need to do | ||
| 610 | ;; charset encoding. | ||
| 608 | (progn | 611 | (progn |
| 609 | (with-temp-buffer | 612 | (with-temp-buffer |
| 610 | (cond | 613 | (set-buffer-multibyte nil) |
| 611 | ((cdr (assq 'buffer cont)) | 614 | ;; First insert the data into the buffer. |
| 612 | (insert-buffer-substring (cdr (assq 'buffer cont)))) | 615 | (if (and filename |
| 613 | ((and filename | 616 | (not (equal (cdr (assq 'nofile cont)) "yes"))) |
| 614 | (not (equal (cdr (assq 'nofile cont)) "yes"))) | 617 | (mm-insert-file-contents filename) |
| 615 | (let ((coding-system-for-read coding)) | 618 | (insert |
| 616 | (mm-insert-file-contents filename))) | 619 | (with-temp-buffer |
| 617 | ((eq 'mml (car cont)) | 620 | (cond |
| 618 | (insert (cdr (assq 'contents cont)))) | 621 | ((cdr (assq 'buffer cont)) |
| 619 | (t | 622 | (insert-buffer-substring (cdr (assq 'buffer cont)))) |
| 620 | (save-restriction | 623 | ((eq 'mml (car cont)) |
| 621 | (narrow-to-region (point) (point)) | 624 | (insert (cdr (assq 'contents cont)))) |
| 622 | (insert (cdr (assq 'contents cont))) | 625 | (t |
| 623 | ;; Remove quotes from quoted tags. | 626 | (insert (cdr (assq 'contents cont))) |
| 624 | (goto-char (point-min)) | 627 | ;; Remove quotes from quoted tags. |
| 625 | (while (re-search-forward | 628 | (goto-char (point-min)) |
| 626 | "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" | 629 | (while (re-search-forward |
| 627 | nil t) | 630 | "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" |
| 628 | (delete-region (+ (match-beginning 0) 2) | 631 | nil t) |
| 629 | (+ (match-beginning 0) 3)))))) | 632 | (delete-region (+ (match-beginning 0) 2) |
| 633 | (+ (match-beginning 0) 3))))) | ||
| 634 | (setq charset | ||
| 635 | (mm-coding-system-to-mime-charset | ||
| 636 | (detect-coding-region | ||
| 637 | (point-min) (point-max) t))) | ||
| 638 | (encode-coding-region (point-min) (point-max) | ||
| 639 | charset) | ||
| 640 | (buffer-string)))) | ||
| 630 | (cond | 641 | (cond |
| 631 | ((eq (car cont) 'mml) | 642 | ((eq (car cont) 'mml) |
| 632 | (let ((mml-boundary (mml-compute-boundary cont)) | 643 | (let ((mml-boundary (mml-compute-boundary cont)) |
| @@ -667,21 +678,22 @@ be \"related\" or \"alternate\"." | |||
| 667 | ;; insert a "; format=flowed" string unless the | 678 | ;; insert a "; format=flowed" string unless the |
| 668 | ;; user has already specified it. | 679 | ;; user has already specified it. |
| 669 | (setq flowed (null (assq 'format cont))))) | 680 | (setq flowed (null (assq 'format cont))))) |
| 670 | ;; Prefer `utf-8' for text/calendar parts. | 681 | (unless charset |
| 671 | (if (or charset | 682 | (setq charset |
| 672 | (not (string= type "text/calendar"))) | 683 | ;; Prefer `utf-8' for text/calendar parts. |
| 673 | (setq charset (mm-encode-body charset)) | 684 | (if (string= type "text/calendar") |
| 674 | (let ((mm-coding-system-priorities | 685 | 'utf-8 |
| 675 | (cons 'utf-8 mm-coding-system-priorities))) | 686 | (mm-coding-system-to-mime-charset |
| 676 | (setq charset (mm-encode-body)))) | 687 | (detect-coding-region |
| 677 | (mm-disable-multibyte) | 688 | (point-min) (point-max) t))))) |
| 678 | (setq encoding (mm-body-encoding | 689 | (setq encoding (mm-body-encoding |
| 679 | charset (cdr (assq 'encoding cont)))))) | 690 | charset (cdr (assq 'encoding cont)))))) |
| 680 | (setq coded (buffer-string))) | 691 | (setq coded (buffer-string))) |
| 681 | (mml-insert-mime-headers cont type charset encoding flowed) | 692 | (mml-insert-mime-headers cont type charset encoding flowed) |
| 682 | (insert "\n") | 693 | (insert "\n") |
| 683 | (insert coded)) | 694 | (insert coded)) |
| 684 | (mm-with-unibyte-buffer | 695 | (with-temp-buffer |
| 696 | (set-buffer-multibyte nil) | ||
| 685 | (cond | 697 | (cond |
| 686 | ((cdr (assq 'buffer cont)) | 698 | ((cdr (assq 'buffer cont)) |
| 687 | (insert (string-as-unibyte | 699 | (insert (string-as-unibyte |
| @@ -690,11 +702,7 @@ be \"related\" or \"alternate\"." | |||
| 690 | ((and filename | 702 | ((and filename |
| 691 | (not (equal (cdr (assq 'nofile cont)) "yes"))) | 703 | (not (equal (cdr (assq 'nofile cont)) "yes"))) |
| 692 | (let ((coding-system-for-read mm-binary-coding-system)) | 704 | (let ((coding-system-for-read mm-binary-coding-system)) |
| 693 | (mm-insert-file-contents filename nil nil nil nil t)) | 705 | (mm-insert-file-contents filename nil nil nil nil t))) |
| 694 | (unless charset | ||
| 695 | (setq charset (mm-coding-system-to-mime-charset | ||
| 696 | (mm-find-buffer-file-coding-system | ||
| 697 | filename))))) | ||
| 698 | (t | 706 | (t |
| 699 | (let ((contents (cdr (assq 'contents cont)))) | 707 | (let ((contents (cdr (assq 'contents cont)))) |
| 700 | (if (multibyte-string-p contents) | 708 | (if (multibyte-string-p contents) |
| @@ -1244,6 +1252,7 @@ If not set, `default-directory' will be used." | |||
| 1244 | 1252 | ||
| 1245 | (defun mml-minibuffer-read-file (prompt) | 1253 | (defun mml-minibuffer-read-file (prompt) |
| 1246 | (let* ((completion-ignored-extensions nil) | 1254 | (let* ((completion-ignored-extensions nil) |
| 1255 | (buffer-file-name nil) | ||
| 1247 | (file (read-file-name prompt | 1256 | (file (read-file-name prompt |
| 1248 | (or mml-default-directory default-directory) | 1257 | (or mml-default-directory default-directory) |
| 1249 | nil t))) | 1258 | nil t))) |
| @@ -1378,12 +1387,23 @@ content-type, a string of the form \"type/subtype\". DESCRIPTION | |||
| 1378 | is a one-line description of the attachment. The DISPOSITION | 1387 | is a one-line description of the attachment. The DISPOSITION |
| 1379 | specifies how the attachment is intended to be displayed. It can | 1388 | specifies how the attachment is intended to be displayed. It can |
| 1380 | be either \"inline\" (displayed automatically within the message | 1389 | be either \"inline\" (displayed automatically within the message |
| 1381 | body) or \"attachment\" (separate from the body)." | 1390 | body) or \"attachment\" (separate from the body). |
| 1391 | |||
| 1392 | If given a prefix interactively, no prompting will be done for | ||
| 1393 | the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults | ||
| 1394 | will be computed and used." | ||
| 1382 | (interactive | 1395 | (interactive |
| 1383 | (let* ((file (mml-minibuffer-read-file "Attach file: ")) | 1396 | (let* ((file (mml-minibuffer-read-file "Attach file: ")) |
| 1384 | (type (mml-minibuffer-read-type file)) | 1397 | (type (if current-prefix-arg |
| 1385 | (description (mml-minibuffer-read-description)) | 1398 | (or (mm-default-file-encoding file) |
| 1386 | (disposition (mml-minibuffer-read-disposition type nil file))) | 1399 | "application/octet-stream") |
| 1400 | (mml-minibuffer-read-type file))) | ||
| 1401 | (description (if current-prefix-arg | ||
| 1402 | nil | ||
| 1403 | (mml-minibuffer-read-description))) | ||
| 1404 | (disposition (if current-prefix-arg | ||
| 1405 | (mml-content-disposition type file) | ||
| 1406 | (mml-minibuffer-read-disposition type nil file)))) | ||
| 1387 | (list file type description disposition))) | 1407 | (list file type description disposition))) |
| 1388 | ;; If in the message header, attach at the end and leave point unchanged. | 1408 | ;; If in the message header, attach at the end and leave point unchanged. |
| 1389 | (let ((head (unless (message-in-body-p) (point)))) | 1409 | (let ((head (unless (message-in-body-p) (point)))) |