diff options
| author | Kenichi Handa | 2010-11-26 13:06:59 +0900 |
|---|---|---|
| committer | Kenichi Handa | 2010-11-26 13:06:59 +0900 |
| commit | d1be4ec2743387d7b8c0c5c83ca97fb345a0b4b2 (patch) | |
| tree | 825910f5efd00c0518b6661081ee8d742eb7254a | |
| parent | e957f9ae90f3cab1584c06877cbff075d52a6a9a (diff) | |
| download | emacs-d1be4ec2743387d7b8c0c5c83ca97fb345a0b4b2.tar.gz emacs-d1be4ec2743387d7b8c0c5c83ca97fb345a0b4b2.zip | |
Improve rmail's MIME handling.
| -rw-r--r-- | lisp/ChangeLog | 43 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 53 | ||||
| -rw-r--r-- | lisp/mail/rmailmm.el | 367 | ||||
| -rw-r--r-- | lisp/mail/rmailsum.el | 22 |
4 files changed, 419 insertions, 66 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fc460eaaf3d..812c66d3df6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,46 @@ | |||
| 1 | 2010-11-26 Kenichi Handa <handa@m17n.org> | ||
| 2 | |||
| 3 | * mail/rmailmm.el (rmail-mime-entity, rmail-mime-entity-type) | ||
| 4 | (rmail-mime-entity-disposition) | ||
| 5 | (rmail-mime-entity-transfer-encoding, rmail-mime-entity-header) | ||
| 6 | (rmail-mime-entity-body, rmail-mime-entity-children): New functions. | ||
| 7 | (rmail-mime-save): Handle the case that the button's `data' is a | ||
| 8 | MIME entity. | ||
| 9 | (rmail-mime-insert-text): New function. | ||
| 10 | (rmail-mime-insert-image): Handle the case that DATA is a MIME | ||
| 11 | entity. | ||
| 12 | (rmail-mime-bulk-handler): Just call rmail-mime-insert-bulk. | ||
| 13 | (rmail-mime-insert-bulk): New function mostly copied from the old | ||
| 14 | rmail-mime-bulk-handler. | ||
| 15 | (rmail-mime-multipart-handler): Just call | ||
| 16 | rmail-mime-process-multipart. | ||
| 17 | (rmail-mime-process-multipart): New funciton mostly copied from | ||
| 18 | the old rmail-mime-multipart-handler. | ||
| 19 | (rmail-mime-show): Just call rmail-mime-process. | ||
| 20 | (rmail-mime-process): New funciton mostly copied from the old | ||
| 21 | rmail-mime-show. | ||
| 22 | (rmail-mime-insert-multipart, rmail-mime-parse) | ||
| 23 | (rmail-mime-insert, rmail-show-mime) | ||
| 24 | (rmail-insert-mime-forwarded-message) | ||
| 25 | (rmail-insert-mime-resent-message): New functions. | ||
| 26 | (rmail-insert-mime-forwarded-message-function): Set to | ||
| 27 | rmail-insert-mime-forwarded-message. | ||
| 28 | (rmail-insert-mime-resent-message-function): Set to | ||
| 29 | rmail-insert-mime-resent-message. | ||
| 30 | |||
| 31 | * mail/rmailsum.el: Require rfc2047. | ||
| 32 | (rmail-header-summary): Handle multiline Subject: field. | ||
| 33 | (rmail-summary-line-decoder): Change the default to | ||
| 34 | rfc2047-decode-string. | ||
| 35 | |||
| 36 | * mail/rmail.el (rmail-enable-mime): Change the default to t. | ||
| 37 | (rmail-mime-feature): Change the default to `rmailmm'. | ||
| 38 | (rmail-quit): Delete the specifal code for rmail-enable-mime. | ||
| 39 | (rmail-display-labels): Likewise. | ||
| 40 | (rmail-show-message-1): Check rmail-enable-mime, and use | ||
| 41 | rmail-show-mime-function for a MIME message. Decode the headers | ||
| 42 | according to RFC2047. | ||
| 43 | |||
| 1 | 2010-11-24 Stefan Monnier <monnier@iro.umontreal.ca> | 44 | 2010-11-24 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 45 | ||
| 3 | * progmodes/which-func.el (which-func-imenu-joiner-function): | 46 | * progmodes/which-func.el (which-func-imenu-joiner-function): |
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 3ab87fa21f7..70c84a242f5 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -638,7 +638,7 @@ Element N specifies the summary line for message N+1.") | |||
| 638 | 638 | ||
| 639 | This is set to nil by default.") | 639 | This is set to nil by default.") |
| 640 | 640 | ||
| 641 | (defcustom rmail-enable-mime nil | 641 | (defcustom rmail-enable-mime t |
| 642 | "If non-nil, RMAIL uses MIME features. | 642 | "If non-nil, RMAIL uses MIME features. |
| 643 | If the value is t, RMAIL automatically shows MIME decoded message. | 643 | If the value is t, RMAIL automatically shows MIME decoded message. |
| 644 | If the value is neither t nor nil, RMAIL does not show MIME decoded message | 644 | If the value is neither t nor nil, RMAIL does not show MIME decoded message |
| @@ -649,6 +649,7 @@ unless the feature specified by `rmail-mime-feature' is available." | |||
| 649 | :type '(choice (const :tag "on" t) | 649 | :type '(choice (const :tag "on" t) |
| 650 | (const :tag "off" nil) | 650 | (const :tag "off" nil) |
| 651 | (other :tag "when asked" ask)) | 651 | (other :tag "when asked" ask)) |
| 652 | :version "23.3" | ||
| 652 | :group 'rmail) | 653 | :group 'rmail) |
| 653 | 654 | ||
| 654 | (defvar rmail-enable-mime-composing nil | 655 | (defvar rmail-enable-mime-composing nil |
| @@ -693,13 +694,12 @@ start of the header) with three arguments MSG, REGEXP, and LIMIT, | |||
| 693 | where MSG is the message number, REGEXP is the regular | 694 | where MSG is the message number, REGEXP is the regular |
| 694 | expression, LIMIT is the position specifying the end of header.") | 695 | expression, LIMIT is the position specifying the end of header.") |
| 695 | 696 | ||
| 696 | (defvar rmail-mime-feature 'rmail-mime | 697 | (defvar rmail-mime-feature 'rmailmm |
| 697 | "Feature to require to load MIME support in Rmail. | 698 | "Feature to require to load MIME support in Rmail. |
| 698 | When starting Rmail, if `rmail-enable-mime' is non-nil, | 699 | When starting Rmail, if `rmail-enable-mime' is non-nil, |
| 699 | this feature is required with `require'. | 700 | this feature is required with `require'. |
| 700 | 701 | ||
| 701 | The default value is `rmail-mime'. This feature is provided by | 702 | The default value is `rmailmm'") |
| 702 | the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.") | ||
| 703 | 703 | ||
| 704 | ;; FIXME this is unused. | 704 | ;; FIXME this is unused. |
| 705 | (defvar rmail-decode-mime-charset t | 705 | (defvar rmail-decode-mime-charset t |
| @@ -1509,17 +1509,9 @@ Hook `rmail-quit-hook' is run after expunging." | |||
| 1509 | (set-buffer-modified-p nil)) | 1509 | (set-buffer-modified-p nil)) |
| 1510 | (replace-buffer-in-windows rmail-summary-buffer) | 1510 | (replace-buffer-in-windows rmail-summary-buffer) |
| 1511 | (bury-buffer rmail-summary-buffer)) | 1511 | (bury-buffer rmail-summary-buffer)) |
| 1512 | (if rmail-enable-mime | 1512 | (let ((obuf (current-buffer))) |
| 1513 | (let ((obuf rmail-buffer) | 1513 | (quit-window) |
| 1514 | (ovbuf rmail-view-buffer)) | 1514 | (replace-buffer-in-windows obuf))) |
| 1515 | (set-buffer rmail-view-buffer) | ||
| 1516 | (quit-window) | ||
| 1517 | (replace-buffer-in-windows ovbuf) | ||
| 1518 | (replace-buffer-in-windows obuf) | ||
| 1519 | (bury-buffer obuf)) | ||
| 1520 | (let ((obuf (current-buffer))) | ||
| 1521 | (quit-window) | ||
| 1522 | (replace-buffer-in-windows obuf)))) | ||
| 1523 | 1515 | ||
| 1524 | (defun rmail-bury () | 1516 | (defun rmail-bury () |
| 1525 | "Bury current Rmail buffer and its summary buffer." | 1517 | "Bury current Rmail buffer and its summary buffer." |
| @@ -2219,15 +2211,7 @@ If nil, that means the current message." | |||
| 2219 | (let ((blurb (rmail-get-labels))) | 2211 | (let ((blurb (rmail-get-labels))) |
| 2220 | (setq mode-line-process | 2212 | (setq mode-line-process |
| 2221 | (format " %d/%d%s" | 2213 | (format " %d/%d%s" |
| 2222 | rmail-current-message rmail-total-messages blurb)) | 2214 | rmail-current-message rmail-total-messages blurb)))) |
| 2223 | ;; If rmail-enable-mime is non-nil, we may have to update | ||
| 2224 | ;; `mode-line-process' of rmail-view-buffer too. | ||
| 2225 | (if (and rmail-enable-mime | ||
| 2226 | (not (eq (current-buffer) rmail-view-buffer)) | ||
| 2227 | (buffer-live-p rmail-view-buffer)) | ||
| 2228 | (let ((mlp mode-line-process)) | ||
| 2229 | (with-current-buffer rmail-view-buffer | ||
| 2230 | (setq mode-line-process mlp)))))) | ||
| 2231 | 2215 | ||
| 2232 | (defun rmail-get-attr-value (attr state) | 2216 | (defun rmail-get-attr-value (attr state) |
| 2233 | "Return the character value for ATTR. | 2217 | "Return the character value for ATTR. |
| @@ -2706,6 +2690,11 @@ The current mail message becomes the message displayed." | |||
| 2706 | (message "Showing message %d" msg)) | 2690 | (message "Showing message %d" msg)) |
| 2707 | (narrow-to-region beg end) | 2691 | (narrow-to-region beg end) |
| 2708 | (goto-char beg) | 2692 | (goto-char beg) |
| 2693 | (if (and rmail-enable-mime | ||
| 2694 | (re-search-forward "mime-version: 1.0" nil t)) | ||
| 2695 | (let ((rmail-buffer mbox-buf) | ||
| 2696 | (rmail-view-buffer view-buf)) | ||
| 2697 | (funcall rmail-show-mime-function)) | ||
| 2709 | (setq body-start (search-forward "\n\n" nil t)) | 2698 | (setq body-start (search-forward "\n\n" nil t)) |
| 2710 | (narrow-to-region beg (point)) | 2699 | (narrow-to-region beg (point)) |
| 2711 | (goto-char beg) | 2700 | (goto-char beg) |
| @@ -2722,11 +2711,6 @@ The current mail message becomes the message displayed." | |||
| 2722 | ;; unibyte temporary buffer where the character decoding takes | 2711 | ;; unibyte temporary buffer where the character decoding takes |
| 2723 | ;; place. | 2712 | ;; place. |
| 2724 | (with-current-buffer rmail-view-buffer | 2713 | (with-current-buffer rmail-view-buffer |
| 2725 | ;; We give the view buffer a buffer-local value of | ||
| 2726 | ;; rmail-header-style based on the binding in effect when | ||
| 2727 | ;; this function is called; `rmail-toggle-headers' can | ||
| 2728 | ;; inspect this value to determine how to toggle. | ||
| 2729 | (set (make-local-variable 'rmail-header-style) header-style) | ||
| 2730 | (erase-buffer)) | 2714 | (erase-buffer)) |
| 2731 | (if (null character-coding) | 2715 | (if (null character-coding) |
| 2732 | ;; Do it directly since that is fast. | 2716 | ;; Do it directly since that is fast. |
| @@ -2749,8 +2733,13 @@ The current mail message becomes the message displayed." | |||
| 2749 | (error "uuencoded messages are not supported yet")) | 2733 | (error "uuencoded messages are not supported yet")) |
| 2750 | (t)) | 2734 | (t)) |
| 2751 | (rmail-decode-region (point-min) (point-max) | 2735 | (rmail-decode-region (point-min) (point-max) |
| 2752 | coding-system view-buf))) | 2736 | coding-system view-buf)))) |
| 2753 | (with-current-buffer rmail-view-buffer | 2737 | (with-current-buffer rmail-view-buffer |
| 2738 | ;; We give the view buffer a buffer-local value of | ||
| 2739 | ;; rmail-header-style based on the binding in effect when | ||
| 2740 | ;; this function is called; `rmail-toggle-headers' can | ||
| 2741 | ;; inspect this value to determine how to toggle. | ||
| 2742 | (set (make-local-variable 'rmail-header-style) header-style) | ||
| 2754 | ;; Unquote quoted From lines | 2743 | ;; Unquote quoted From lines |
| 2755 | (goto-char (point-min)) | 2744 | (goto-char (point-min)) |
| 2756 | (while (re-search-forward "^>+From " nil t) | 2745 | (while (re-search-forward "^>+From " nil t) |
| @@ -2766,6 +2755,10 @@ The current mail message becomes the message displayed." | |||
| 2766 | (with-current-buffer rmail-view-buffer | 2755 | (with-current-buffer rmail-view-buffer |
| 2767 | (insert "\n") | 2756 | (insert "\n") |
| 2768 | (goto-char (point-min)) | 2757 | (goto-char (point-min)) |
| 2758 | ;; Decode the headers according to RFC2047. | ||
| 2759 | (save-excursion | ||
| 2760 | (search-forward "\n\n" nil 'move) | ||
| 2761 | (rfc2047-decode-region (point-min) (point))) | ||
| 2769 | (rmail-highlight-headers) | 2762 | (rmail-highlight-headers) |
| 2770 | ;(rmail-activate-urls) | 2763 | ;(rmail-activate-urls) |
| 2771 | ;(rmail-process-quoted-material) | 2764 | ;(rmail-process-quoted-material) |
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index e8ca11ee349..6dfa92aa93a 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el | |||
| @@ -26,17 +26,57 @@ | |||
| 26 | 26 | ||
| 27 | ;; Essentially based on the design of Alexander Pohoyda's MIME | 27 | ;; Essentially based on the design of Alexander Pohoyda's MIME |
| 28 | ;; extensions (mime-display.el and mime.el). | 28 | ;; extensions (mime-display.el and mime.el). |
| 29 | ;; Call `M-x rmail-mime' when viewing an Rmail message. | 29 | |
| 30 | ;; This file provides two operation modes for viewing a MIME message. | ||
| 31 | |||
| 32 | ;; (1) When rmail-enable-mime is non-nil (now it is the default), the | ||
| 33 | ;; function `rmail-show-mime' is automatically called. That function | ||
| 34 | ;; shows a MIME message directly in RMAIL's view buffer. | ||
| 35 | |||
| 36 | ;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x | ||
| 37 | ;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*". | ||
| 38 | |||
| 39 | ;; Both operations share the intermediate functions rmail-mime-process | ||
| 40 | ;; and rmail-mime-process-multipart as below. | ||
| 41 | |||
| 42 | ;; rmail-show-mime | ||
| 43 | ;; +- rmail-mime-parse | ||
| 44 | ;; | +- rmail-mime-process <--+------------+ | ||
| 45 | ;; | | +---------+ | | ||
| 46 | ;; | + rmail-mime-process-multipart --+ | ||
| 47 | ;; | | ||
| 48 | ;; + rmail-mime-insert <----------------+ | ||
| 49 | ;; +- rmail-mime-insert-text | | ||
| 50 | ;; +- rmail-mime-insert-bulk | | ||
| 51 | ;; +- rmail-mime-insert-multipart --+ | ||
| 52 | ;; | ||
| 53 | ;; rmail-mime | ||
| 54 | ;; +- rmail-mime-show <----------------------------------+ | ||
| 55 | ;; +- rmail-mime-process | | ||
| 56 | ;; +- rmail-mime-handle | | ||
| 57 | ;; +- rmail-mime-text-handler | | ||
| 58 | ;; +- rmail-mime-bulk-handler | | ||
| 59 | ;; | + rmail-mime-insert-bulk | ||
| 60 | ;; +- rmail-mime-multipart-handler | | ||
| 61 | ;; +- rmail-mime-process-multipart --+ | ||
| 62 | |||
| 63 | ;; In addition, for the case of rmail-enable-mime being non-nil, this | ||
| 64 | ;; file provides two functions rmail-insert-mime-forwarded-message and | ||
| 65 | ;; rmail-insert-mime-resent-message for composing forwarded and resent | ||
| 66 | ;; messages respectively. | ||
| 30 | 67 | ||
| 31 | ;; Todo: | 68 | ;; Todo: |
| 32 | 69 | ||
| 33 | ;; Handle multipart/alternative. | 70 | ;; Make rmail-mime-media-type-handlers-alist usable in the first |
| 71 | ;; operation mode. | ||
| 72 | ;; Handle multipart/alternative in the second operation mode. | ||
| 34 | ;; Offer the option to call external/internal viewers (doc-view, xpdf, etc). | 73 | ;; Offer the option to call external/internal viewers (doc-view, xpdf, etc). |
| 35 | 74 | ||
| 36 | ;;; Code: | 75 | ;;; Code: |
| 37 | 76 | ||
| 38 | (require 'rmail) | 77 | (require 'rmail) |
| 39 | (require 'mail-parse) | 78 | (require 'mail-parse) |
| 79 | (require 'message) | ||
| 40 | 80 | ||
| 41 | ;;; User options. | 81 | ;;; User options. |
| 42 | 82 | ||
| @@ -90,6 +130,52 @@ automatically display the image in the buffer." | |||
| 90 | 130 | ||
| 91 | ;;; End of user options. | 131 | ;;; End of user options. |
| 92 | 132 | ||
| 133 | ;;; MIME-entity object | ||
| 134 | |||
| 135 | (defun rmail-mime-entity (type disposition transfer-encoding | ||
| 136 | header body children) | ||
| 137 | "Retrun a newly created MIME-entity object. | ||
| 138 | |||
| 139 | A MIME-entity is a vector of 6 elements: | ||
| 140 | |||
| 141 | [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ] | ||
| 142 | |||
| 143 | TYPE and DISPOSITION correspond to MIME headers Content-Type: and | ||
| 144 | Cotent-Disposition: respectively, and has this format: | ||
| 145 | |||
| 146 | \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) | ||
| 147 | |||
| 148 | VALUE is a string and ATTRIBUTE is a symbol. | ||
| 149 | |||
| 150 | Consider the following header, for example: | ||
| 151 | |||
| 152 | Content-Type: multipart/mixed; | ||
| 153 | boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\" | ||
| 154 | |||
| 155 | The corresponding TYPE argument must be: | ||
| 156 | |||
| 157 | \(\"multipart/mixed\" | ||
| 158 | \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\")) | ||
| 159 | |||
| 160 | TRANSFER-ENCODING corresponds to MIME header | ||
| 161 | Content-Transfer-Encoding, and is a lowercased string. | ||
| 162 | |||
| 163 | HEADER and BODY are a cons (BEG . END), where BEG and END specify | ||
| 164 | the region of the corresponding part in RMAIL's data (mbox) | ||
| 165 | buffer. BODY may be nil. In that case, the current buffer is | ||
| 166 | narrowed to the body part. | ||
| 167 | |||
| 168 | CHILDREN is a list of MIME-entities for a \"multipart\" entity, and | ||
| 169 | nil for the other types." | ||
| 170 | (vector type disposition transfer-encoding header body children)) | ||
| 171 | |||
| 172 | ;; Accessors for a MIME-entity object. | ||
| 173 | (defsubst rmail-mime-entity-type (entity) (aref entity 0)) | ||
| 174 | (defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) | ||
| 175 | (defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) | ||
| 176 | (defsubst rmail-mime-entity-header (entity) (aref entity 3)) | ||
| 177 | (defsubst rmail-mime-entity-body (entity) (aref entity 4)) | ||
| 178 | (defsubst rmail-mime-entity-children (entity) (aref entity 5)) | ||
| 93 | 179 | ||
| 94 | ;;; Buttons | 180 | ;;; Buttons |
| 95 | 181 | ||
| @@ -98,6 +184,7 @@ automatically display the image in the buffer." | |||
| 98 | (let* ((filename (button-get button 'filename)) | 184 | (let* ((filename (button-get button 'filename)) |
| 99 | (directory (button-get button 'directory)) | 185 | (directory (button-get button 'directory)) |
| 100 | (data (button-get button 'data)) | 186 | (data (button-get button 'data)) |
| 187 | (mbox-buf rmail-view-buffer) | ||
| 101 | (ofilename filename)) | 188 | (ofilename filename)) |
| 102 | (setq filename (expand-file-name | 189 | (setq filename (expand-file-name |
| 103 | (read-file-name (format "Save as (default: %s): " filename) | 190 | (read-file-name (format "Save as (default: %s): " filename) |
| @@ -116,7 +203,17 @@ automatically display the image in the buffer." | |||
| 116 | ;; file, the magic signature compares equal with the unibyte | 203 | ;; file, the magic signature compares equal with the unibyte |
| 117 | ;; signature string recorded in jka-compr-compression-info-list. | 204 | ;; signature string recorded in jka-compr-compression-info-list. |
| 118 | (set-buffer-multibyte nil) | 205 | (set-buffer-multibyte nil) |
| 119 | (insert data) | 206 | (setq buffer-undo-list t) |
| 207 | (if (stringp data) | ||
| 208 | (insert data) | ||
| 209 | ;; DATA is a MIME-entity object. | ||
| 210 | (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) | ||
| 211 | (body (rmail-mime-entity-body data))) | ||
| 212 | (insert-buffer-substring mbox-buf (car body) (cdr body)) | ||
| 213 | (cond ((string= transfer-encoding "base64") | ||
| 214 | (ignore-errors (base64-decode-region (point-min) (point-max)))) | ||
| 215 | ((string= transfer-encoding "quoted-printable") | ||
| 216 | (quoted-printable-decode-region (point-min) (point-max)))))) | ||
| 120 | (write-region nil nil filename nil nil nil t)))) | 217 | (write-region nil nil filename nil nil nil t)))) |
| 121 | 218 | ||
| 122 | (define-button-type 'rmail-mime-save 'action 'rmail-mime-save) | 219 | (define-button-type 'rmail-mime-save 'action 'rmail-mime-save) |
| @@ -133,6 +230,23 @@ automatically display the image in the buffer." | |||
| 133 | (when (coding-system-p coding-system) | 230 | (when (coding-system-p coding-system) |
| 134 | (decode-coding-region (point-min) (point-max) coding-system)))) | 231 | (decode-coding-region (point-min) (point-max) coding-system)))) |
| 135 | 232 | ||
| 233 | (defun rmail-mime-insert-text (entity) | ||
| 234 | "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer." | ||
| 235 | (let* ((content-type (rmail-mime-entity-type entity)) | ||
| 236 | (charset (cdr (assq 'charset (cdr content-type)))) | ||
| 237 | (coding-system (if charset (intern (downcase charset)))) | ||
| 238 | (transfer-encoding (rmail-mime-entity-transfer-encoding entity)) | ||
| 239 | (body (rmail-mime-entity-body entity))) | ||
| 240 | (save-restriction | ||
| 241 | (narrow-to-region (point) (point)) | ||
| 242 | (insert-buffer-substring rmail-buffer (car body) (cdr body)) | ||
| 243 | (cond ((string= transfer-encoding "base64") | ||
| 244 | (ignore-errors (base64-decode-region (point-min) (point-max)))) | ||
| 245 | ((string= transfer-encoding "quoted-printable") | ||
| 246 | (quoted-printable-decode-region (point-min) (point-max)))) | ||
| 247 | (if (coding-system-p coding-system) | ||
| 248 | (decode-coding-region (point-min) (point-max) coding-system))))) | ||
| 249 | |||
| 136 | ;; FIXME move to the test/ directory? | 250 | ;; FIXME move to the test/ directory? |
| 137 | (defun test-rmail-mime-handler () | 251 | (defun test-rmail-mime-handler () |
| 138 | "Test of a mail using no MIME parts at all." | 252 | "Test of a mail using no MIME parts at all." |
| @@ -151,10 +265,28 @@ MIME-Version: 1.0 | |||
| 151 | 265 | ||
| 152 | 266 | ||
| 153 | (defun rmail-mime-insert-image (type data) | 267 | (defun rmail-mime-insert-image (type data) |
| 154 | "Insert an image of type TYPE, where DATA is the image data." | 268 | "Insert an image of type TYPE, where DATA is the image data. |
| 269 | If DATA is not a string, it is a MIME-entity object." | ||
| 155 | (end-of-line) | 270 | (end-of-line) |
| 156 | (insert ?\n) | 271 | (let ((modified (buffer-modified-p))) |
| 157 | (insert-image (create-image data type t))) | 272 | (insert ?\n) |
| 273 | (unless (stringp data) | ||
| 274 | ;; DATA is a MIME-entity. | ||
| 275 | (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) | ||
| 276 | (body (rmail-mime-entity-body data)) | ||
| 277 | (mbox-buffer rmail-view-buffer)) | ||
| 278 | (with-temp-buffer | ||
| 279 | (set-buffer-multibyte nil) | ||
| 280 | (setq buffer-undo-list t) | ||
| 281 | (insert-buffer-substring mbox-buffer (car body) (cdr body)) | ||
| 282 | (cond ((string= transfer-encoding "base64") | ||
| 283 | (ignore-errors (base64-decode-region (point-min) (point-max)))) | ||
| 284 | ((string= transfer-encoding "quoted-printable") | ||
| 285 | (quoted-printable-decode-region (point-min) (point-max)))) | ||
| 286 | (setq data | ||
| 287 | (buffer-substring-no-properties (point-min) (point-max)))))) | ||
| 288 | (insert-image (create-image data type t)) | ||
| 289 | (set-buffer-modified-p modified))) | ||
| 158 | 290 | ||
| 159 | (defun rmail-mime-image (button) | 291 | (defun rmail-mime-image (button) |
| 160 | "Display the image associated with BUTTON." | 292 | "Display the image associated with BUTTON." |
| @@ -171,8 +303,19 @@ MIME-Version: 1.0 | |||
| 171 | "Handle the current buffer as an attachment to download. | 303 | "Handle the current buffer as an attachment to download. |
| 172 | For images that Emacs is capable of displaying, the behavior | 304 | For images that Emacs is capable of displaying, the behavior |
| 173 | depends upon the value of `rmail-mime-show-images'." | 305 | depends upon the value of `rmail-mime-show-images'." |
| 306 | (rmail-mime-insert-bulk | ||
| 307 | (rmail-mime-entity content-type content-disposition content-transfer-encoding | ||
| 308 | nil nil nil))) | ||
| 309 | |||
| 310 | (defun rmail-mime-insert-bulk (entity) | ||
| 311 | "Inesrt a MIME-entity ENTITY as an attachment. | ||
| 312 | The optional second arg DATA, if non-nil, is a string containing | ||
| 313 | the attachment data that is already decoded." | ||
| 174 | ;; Find the default directory for this media type. | 314 | ;; Find the default directory for this media type. |
| 175 | (let* ((directory (catch 'directory | 315 | (let* ((content-type (rmail-mime-entity-type entity)) |
| 316 | (content-disposition (rmail-mime-entity-disposition entity)) | ||
| 317 | (body (rmail-mime-entity-body entity)) | ||
| 318 | (directory (catch 'directory | ||
| 176 | (dolist (entry rmail-mime-attachment-dirs-alist) | 319 | (dolist (entry rmail-mime-attachment-dirs-alist) |
| 177 | (when (string-match (car entry) (car content-type)) | 320 | (when (string-match (car entry) (car content-type)) |
| 178 | (dolist (dir (cdr entry)) | 321 | (dolist (dir (cdr entry)) |
| @@ -182,17 +325,21 @@ depends upon the value of `rmail-mime-show-images'." | |||
| 182 | (cdr (assq 'filename (cdr content-disposition))) | 325 | (cdr (assq 'filename (cdr content-disposition))) |
| 183 | "noname")) | 326 | "noname")) |
| 184 | (label (format "\nAttached %s file: " (car content-type))) | 327 | (label (format "\nAttached %s file: " (car content-type))) |
| 185 | (data (buffer-string)) | ||
| 186 | (udata (string-as-unibyte data)) | ||
| 187 | (size (length udata)) | ||
| 188 | (osize size) | ||
| 189 | (units '(B kB MB GB)) | 328 | (units '(B kB MB GB)) |
| 190 | type) | 329 | data udata size osize type) |
| 191 | (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message | 330 | (if body |
| 331 | (setq data entity | ||
| 332 | udata entity | ||
| 333 | size (- (cdr body) (car body))) | ||
| 334 | (setq data (buffer-string) | ||
| 335 | udata (string-as-unibyte data) | ||
| 336 | size (length udata)) | ||
| 337 | (delete-region (point-min) (point-max))) | ||
| 338 | (setq osize size) | ||
| 339 | (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message | ||
| 192 | (cdr units)) | 340 | (cdr units)) |
| 193 | (setq size (/ size 1024.0) | 341 | (setq size (/ size 1024.0) |
| 194 | units (cdr units))) | 342 | units (cdr units))) |
| 195 | (delete-region (point-min) (point-max)) | ||
| 196 | (insert label) | 343 | (insert label) |
| 197 | (insert-button filename | 344 | (insert-button filename |
| 198 | :type 'rmail-mime-save | 345 | :type 'rmail-mime-save |
| @@ -248,6 +395,22 @@ The current buffer should be narrowed to the body. CONTENT-TYPE, | |||
| 248 | CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values | 395 | CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values |
| 249 | of the respective parsed headers. See `rmail-mime-handle' for their | 396 | of the respective parsed headers. See `rmail-mime-handle' for their |
| 250 | format." | 397 | format." |
| 398 | (rmail-mime-process-multipart | ||
| 399 | content-type content-disposition content-transfer-encoding nil)) | ||
| 400 | |||
| 401 | (defun rmail-mime-process-multipart (content-type | ||
| 402 | content-disposition | ||
| 403 | content-transfer-encoding | ||
| 404 | parse-only) | ||
| 405 | "Process the current buffer as a multipart MIME body. | ||
| 406 | |||
| 407 | If PARSE-ONLY is nil, modify the current buffer directly for showing | ||
| 408 | the MIME body and return nil. | ||
| 409 | |||
| 410 | Otherwise, just parse the current buffer and return a list of | ||
| 411 | MIME-entity objects. | ||
| 412 | |||
| 413 | The other arguments are the same as `rmail-mime-multipart-handler'." | ||
| 251 | ;; Some MUAs start boundaries with "--", while it should start | 414 | ;; Some MUAs start boundaries with "--", while it should start |
| 252 | ;; with "CRLF--", as defined by RFC 2046: | 415 | ;; with "CRLF--", as defined by RFC 2046: |
| 253 | ;; The boundary delimiter MUST occur at the beginning of a line, | 416 | ;; The boundary delimiter MUST occur at the beginning of a line, |
| @@ -256,7 +419,7 @@ format." | |||
| 256 | ;; of the preceding part. | 419 | ;; of the preceding part. |
| 257 | ;; We currently don't handle that. | 420 | ;; We currently don't handle that. |
| 258 | (let ((boundary (cdr (assq 'boundary content-type))) | 421 | (let ((boundary (cdr (assq 'boundary content-type))) |
| 259 | beg end next) | 422 | beg end next entities) |
| 260 | (unless boundary | 423 | (unless boundary |
| 261 | (rmail-mm-get-boundary-error-message | 424 | (rmail-mm-get-boundary-error-message |
| 262 | "No boundary defined" content-type content-disposition | 425 | "No boundary defined" content-type content-disposition |
| @@ -266,7 +429,9 @@ format." | |||
| 266 | (goto-char (point-min)) | 429 | (goto-char (point-min)) |
| 267 | (when (and (search-forward boundary nil t) | 430 | (when (and (search-forward boundary nil t) |
| 268 | (looking-at "[ \t]*\n")) | 431 | (looking-at "[ \t]*\n")) |
| 269 | (delete-region (point-min) (match-end 0))) | 432 | (if parse-only |
| 433 | (narrow-to-region (match-end 0) (point-max)) | ||
| 434 | (delete-region (point-min) (match-end 0)))) | ||
| 270 | ;; Loop over all body parts, where beg points at the beginning of | 435 | ;; Loop over all body parts, where beg points at the beginning of |
| 271 | ;; the part and end points at the end of the part. next points at | 436 | ;; the part and end points at the end of the part. next points at |
| 272 | ;; the beginning of the next part. | 437 | ;; the beginning of the next part. |
| @@ -284,13 +449,17 @@ format." | |||
| 284 | (rmail-mm-get-boundary-error-message | 449 | (rmail-mm-get-boundary-error-message |
| 285 | "Malformed boundary" content-type content-disposition | 450 | "Malformed boundary" content-type content-disposition |
| 286 | content-transfer-encoding))) | 451 | content-transfer-encoding))) |
| 287 | (delete-region end next) | ||
| 288 | ;; Handle the part. | 452 | ;; Handle the part. |
| 289 | (save-restriction | 453 | (if parse-only |
| 290 | (narrow-to-region beg end) | 454 | (save-restriction |
| 291 | (rmail-mime-show)) | 455 | (narrow-to-region beg end) |
| 292 | (goto-char (setq beg next))))) | 456 | (setq entities (cons (rmail-mime-process nil t) entities))) |
| 293 | 457 | (delete-region end next) | |
| 458 | (save-restriction | ||
| 459 | (narrow-to-region beg end) | ||
| 460 | (rmail-mime-show))) | ||
| 461 | (goto-char (setq beg next))) | ||
| 462 | (nreverse entities))) | ||
| 294 | 463 | ||
| 295 | (defun test-rmail-mime-multipart-handler () | 464 | (defun test-rmail-mime-multipart-handler () |
| 296 | "Test of a mail used as an example in RFC 2046." | 465 | "Test of a mail used as an example in RFC 2046." |
| @@ -393,6 +562,9 @@ called recursively if multiple parts are available. | |||
| 393 | 562 | ||
| 394 | The current buffer must contain a single message. It will be | 563 | The current buffer must contain a single message. It will be |
| 395 | modified." | 564 | modified." |
| 565 | (rmail-mime-process show-headers nil)) | ||
| 566 | |||
| 567 | (defun rmail-mime-process (show-headers parse-only) | ||
| 396 | (let ((end (point-min)) | 568 | (let ((end (point-min)) |
| 397 | content-type | 569 | content-type |
| 398 | content-transfer-encoding | 570 | content-transfer-encoding |
| @@ -436,14 +608,105 @@ modified." | |||
| 436 | ;; attachment according to RFC 2183. | 608 | ;; attachment according to RFC 2183. |
| 437 | (unless (member (car content-disposition) '("inline" "attachment")) | 609 | (unless (member (car content-disposition) '("inline" "attachment")) |
| 438 | (setq content-disposition '("attachment"))) | 610 | (setq content-disposition '("attachment"))) |
| 439 | ;; Hide headers and handle the part. | 611 | |
| 440 | (save-restriction | 612 | (if parse-only |
| 441 | (cond ((string= (car content-type) "message/rfc822") | 613 | (cond ((string-match "multipart/.*" (car content-type)) |
| 442 | (narrow-to-region end (point-max))) | 614 | (setq end (1- end)) |
| 443 | ((not show-headers) | 615 | (save-restriction |
| 444 | (delete-region (point-min) end))) | 616 | (let ((header (if show-headers (cons (point-min) end)))) |
| 445 | (rmail-mime-handle content-type content-disposition | 617 | (narrow-to-region end (point-max)) |
| 446 | content-transfer-encoding)))) | 618 | (rmail-mime-entity content-type |
| 619 | content-disposition | ||
| 620 | content-transfer-encoding | ||
| 621 | header nil | ||
| 622 | (rmail-mime-process-multipart | ||
| 623 | content-type content-disposition | ||
| 624 | content-transfer-encoding t))))) | ||
| 625 | ((string-match "message/rfc822" (car content-type)) | ||
| 626 | (or show-headers | ||
| 627 | (narrow-to-region end (point-max))) | ||
| 628 | (rmail-mime-process t t)) | ||
| 629 | (t | ||
| 630 | (rmail-mime-entity content-type | ||
| 631 | content-disposition | ||
| 632 | content-transfer-encoding | ||
| 633 | nil | ||
| 634 | (cons end (point-max)) | ||
| 635 | nil))) | ||
| 636 | ;; Hide headers and handle the part. | ||
| 637 | (save-restriction | ||
| 638 | (cond ((string= (car content-type) "message/rfc822") | ||
| 639 | (narrow-to-region end (point-max))) | ||
| 640 | ((not show-headers) | ||
| 641 | (delete-region (point-min) end))) | ||
| 642 | (rmail-mime-handle content-type content-disposition | ||
| 643 | content-transfer-encoding))))) | ||
| 644 | |||
| 645 | (defun rmail-mime-insert-multipart (entity) | ||
| 646 | "Insert MIME-entity ENTITY of multipart type in the current buffer." | ||
| 647 | (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity)) | ||
| 648 | "/"))) | ||
| 649 | (disposition (rmail-mime-entity-disposition entity)) | ||
| 650 | (header (rmail-mime-entity-header entity)) | ||
| 651 | (children (rmail-mime-entity-children entity))) | ||
| 652 | (if header | ||
| 653 | (let ((pos (point))) | ||
| 654 | (or (bolp) | ||
| 655 | (insert "\n")) | ||
| 656 | (insert-buffer-substring rmail-buffer (car header) (cdr header)) | ||
| 657 | (rfc2047-decode-region pos (point)) | ||
| 658 | (insert "\n"))) | ||
| 659 | (cond | ||
| 660 | ((string= subtype "mixed") | ||
| 661 | (dolist (child children) | ||
| 662 | (rmail-mime-insert child '("text/plain") disposition))) | ||
| 663 | ((string= subtype "digest") | ||
| 664 | (dolist (child children) | ||
| 665 | (rmail-mime-insert child '("message/rfc822") disposition))) | ||
| 666 | ((string= subtype "alternative") | ||
| 667 | (let (best-plain-text best-text) | ||
| 668 | (dolist (child children) | ||
| 669 | (if (string= (or (car (rmail-mime-entity-disposition child)) | ||
| 670 | (car disposition)) | ||
| 671 | "inline") | ||
| 672 | (if (string-match "text/plain" | ||
| 673 | (car (rmail-mime-entity-type child))) | ||
| 674 | (setq best-plain-text child) | ||
| 675 | (if (string-match "text/.*" | ||
| 676 | (car (rmail-mime-entity-type child))) | ||
| 677 | (setq best-text child))))) | ||
| 678 | (if (or best-plain-text best-text) | ||
| 679 | (rmail-mime-insert (or best-plain-text best-text)) | ||
| 680 | ;; No child could be handled. Insert all. | ||
| 681 | (dolist (child children) | ||
| 682 | (rmail-mime-insert child nil disposition))))) | ||
| 683 | (t | ||
| 684 | ;; Unsupported subtype. Insert all as attachment. | ||
| 685 | (dolist (child children) | ||
| 686 | (rmail-mime-insert-bulk child)))))) | ||
| 687 | |||
| 688 | (defun rmail-mime-parse () | ||
| 689 | "Parse the current Rmail message as a MIME message. | ||
| 690 | The value is a MIME-entiy object (see `rmail-mime-enty-new')." | ||
| 691 | (save-excursion | ||
| 692 | (goto-char (point-min)) | ||
| 693 | (rmail-mime-process nil t))) | ||
| 694 | |||
| 695 | (defun rmail-mime-insert (entity &optional content-type disposition) | ||
| 696 | "Insert a MIME-entity ENTITY in the current buffer. | ||
| 697 | |||
| 698 | This function will be called recursively if multiple parts are | ||
| 699 | available." | ||
| 700 | (if (rmail-mime-entity-children entity) | ||
| 701 | (rmail-mime-insert-multipart entity) | ||
| 702 | (setq content-type | ||
| 703 | (or (rmail-mime-entity-type entity) content-type)) | ||
| 704 | (setq disposition | ||
| 705 | (or (rmail-mime-entity-disposition entity) disposition)) | ||
| 706 | (if (and (string= (car disposition) "inline") | ||
| 707 | (string-match "text/.*" (car content-type))) | ||
| 708 | (rmail-mime-insert-text entity) | ||
| 709 | (rmail-mime-insert-bulk entity)))) | ||
| 447 | 710 | ||
| 448 | (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" | 711 | (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" |
| 449 | "Major mode used in `rmail-mime' buffers." | 712 | "Major mode used in `rmail-mime' buffers." |
| @@ -479,6 +742,50 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." | |||
| 479 | (error "%s; type: %s; disposition: %s; encoding: %s" | 742 | (error "%s; type: %s; disposition: %s; encoding: %s" |
| 480 | message type disposition encoding)) | 743 | message type disposition encoding)) |
| 481 | 744 | ||
| 745 | (defun rmail-show-mime () | ||
| 746 | (let ((mbox-buf rmail-buffer)) | ||
| 747 | (condition-case nil | ||
| 748 | (let ((entity (rmail-mime-parse))) | ||
| 749 | (with-current-buffer rmail-view-buffer | ||
| 750 | (let ((inhibit-read-only t) | ||
| 751 | (rmail-buffer mbox-buf)) | ||
| 752 | (erase-buffer) | ||
| 753 | (rmail-mime-insert entity)))) | ||
| 754 | (error | ||
| 755 | ;; Decoding failed. Insert the original message body as is. | ||
| 756 | (let ((region (with-current-buffer mbox-buf | ||
| 757 | (goto-char (point-min)) | ||
| 758 | (re-search-forward "^$" nil t) | ||
| 759 | (forward-line 1) | ||
| 760 | (cons (point) (point-max))))) | ||
| 761 | (with-current-buffer rmail-view-buffer | ||
| 762 | (let ((inhibit-read-only t)) | ||
| 763 | (erase-buffer) | ||
| 764 | (insert-buffer-substring mbox-buf (car region) (cdr region)))) | ||
| 765 | (message "MIME decoding failed")))))) | ||
| 766 | |||
| 767 | (setq rmail-show-mime-function 'rmail-show-mime) | ||
| 768 | |||
| 769 | (defun rmail-insert-mime-forwarded-message (forward-buffer) | ||
| 770 | (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer))) | ||
| 771 | (save-restriction | ||
| 772 | (narrow-to-region (point) (point)) | ||
| 773 | (message-forward-make-body-mime mbox-buf)))) | ||
| 774 | |||
| 775 | (setq rmail-insert-mime-forwarded-message-function | ||
| 776 | 'rmail-insert-mime-forwarded-message) | ||
| 777 | |||
| 778 | (defun rmail-insert-mime-resent-message (forward-buffer) | ||
| 779 | (insert-buffer-substring | ||
| 780 | (with-current-buffer forward-buffer rmail-view-buffer)) | ||
| 781 | (goto-char (point-min)) | ||
| 782 | (when (looking-at "From ") | ||
| 783 | (forward-line 1) | ||
| 784 | (delete-region (point-min) (point)))) | ||
| 785 | |||
| 786 | (setq rmail-insert-mime-resent-message-function | ||
| 787 | 'rmail-insert-mime-resent-message) | ||
| 788 | |||
| 482 | (provide 'rmailmm) | 789 | (provide 'rmailmm) |
| 483 | 790 | ||
| 484 | ;; Local Variables: | 791 | ;; Local Variables: |
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 80c65cdfb57..2d8019b6834 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el | |||
| @@ -31,6 +31,7 @@ | |||
| 31 | 31 | ||
| 32 | ;; For rmail-select-summary. | 32 | ;; For rmail-select-summary. |
| 33 | (require 'rmail) | 33 | (require 'rmail) |
| 34 | (require 'rfc2047) | ||
| 34 | 35 | ||
| 35 | (defcustom rmail-summary-scroll-between-messages t | 36 | (defcustom rmail-summary-scroll-between-messages t |
| 36 | "Non-nil means Rmail summary scroll commands move between messages. | 37 | "Non-nil means Rmail summary scroll commands move between messages. |
| @@ -363,13 +364,15 @@ The current buffer contains the unrestricted message collection." | |||
| 363 | (aset rmail-summary-vector (1- msgnum) line)) | 364 | (aset rmail-summary-vector (1- msgnum) line)) |
| 364 | line)) | 365 | line)) |
| 365 | 366 | ||
| 366 | (defcustom rmail-summary-line-decoder (function identity) | 367 | (defcustom rmail-summary-line-decoder (function rfc2047-decode-string) |
| 367 | "Function to decode a Rmail summary line. | 368 | "Function to decode a Rmail summary line. |
| 368 | It receives the summary line for one message as a string | 369 | It receives the summary line for one message as a string |
| 369 | and should return the decoded string. | 370 | and should return the decoded string. |
| 370 | 371 | ||
| 371 | By default, it is `identity', which returns the string unaltered." | 372 | By default, it is `rfc2047-decode-string', which decodes MIME-encoded |
| 373 | subject." | ||
| 372 | :type 'function | 374 | :type 'function |
| 375 | :version "23.3" | ||
| 373 | :group 'rmail-summary) | 376 | :group 'rmail-summary) |
| 374 | 377 | ||
| 375 | (defun rmail-create-summary-line (msgnum) | 378 | (defun rmail-create-summary-line (msgnum) |
| @@ -588,10 +591,17 @@ the message being processed." | |||
| 588 | (t (- mch 14)))) | 591 | (t (- mch 14)))) |
| 589 | (min len (+ lo 25))))))))) | 592 | (min len (+ lo 25))))))))) |
| 590 | (concat (if (re-search-forward "^Subject:" nil t) | 593 | (concat (if (re-search-forward "^Subject:" nil t) |
| 591 | (progn (skip-chars-forward " \t") | 594 | (let (pos str) |
| 592 | (buffer-substring (point) | 595 | (skip-chars-forward " \t") |
| 593 | (progn (end-of-line) | 596 | (setq pos (point)) |
| 594 | (point)))) | 597 | (forward-line 1) |
| 598 | (setq str (buffer-substring pos (1- (point)))) | ||
| 599 | (while (looking-at "\\s ") | ||
| 600 | (setq str (concat str " " | ||
| 601 | (buffer-substring (match-end 0) | ||
| 602 | (line-end-position)))) | ||
| 603 | (forward-line 1)) | ||
| 604 | str) | ||
| 595 | (re-search-forward "[\n][\n]+" nil t) | 605 | (re-search-forward "[\n][\n]+" nil t) |
| 596 | (buffer-substring (point) (progn (end-of-line) (point)))) | 606 | (buffer-substring (point) (progn (end-of-line) (point)))) |
| 597 | "\n"))) | 607 | "\n"))) |