Improve rmail's MIME handling.
This commit is contained in:
Kenichi Handa
parent
e957f9ae90
commit
d1be4ec274
4 changed files with 419 additions and 66 deletions
|
|
@ -1,3 +1,46 @@
|
|||
2010-11-26 Kenichi Handa <handa@m17n.org>
|
||||
|
||||
* mail/rmailmm.el (rmail-mime-entity, rmail-mime-entity-type)
|
||||
(rmail-mime-entity-disposition)
|
||||
(rmail-mime-entity-transfer-encoding, rmail-mime-entity-header)
|
||||
(rmail-mime-entity-body, rmail-mime-entity-children): New functions.
|
||||
(rmail-mime-save): Handle the case that the button's `data' is a
|
||||
MIME entity.
|
||||
(rmail-mime-insert-text): New function.
|
||||
(rmail-mime-insert-image): Handle the case that DATA is a MIME
|
||||
entity.
|
||||
(rmail-mime-bulk-handler): Just call rmail-mime-insert-bulk.
|
||||
(rmail-mime-insert-bulk): New function mostly copied from the old
|
||||
rmail-mime-bulk-handler.
|
||||
(rmail-mime-multipart-handler): Just call
|
||||
rmail-mime-process-multipart.
|
||||
(rmail-mime-process-multipart): New funciton mostly copied from
|
||||
the old rmail-mime-multipart-handler.
|
||||
(rmail-mime-show): Just call rmail-mime-process.
|
||||
(rmail-mime-process): New funciton mostly copied from the old
|
||||
rmail-mime-show.
|
||||
(rmail-mime-insert-multipart, rmail-mime-parse)
|
||||
(rmail-mime-insert, rmail-show-mime)
|
||||
(rmail-insert-mime-forwarded-message)
|
||||
(rmail-insert-mime-resent-message): New functions.
|
||||
(rmail-insert-mime-forwarded-message-function): Set to
|
||||
rmail-insert-mime-forwarded-message.
|
||||
(rmail-insert-mime-resent-message-function): Set to
|
||||
rmail-insert-mime-resent-message.
|
||||
|
||||
* mail/rmailsum.el: Require rfc2047.
|
||||
(rmail-header-summary): Handle multiline Subject: field.
|
||||
(rmail-summary-line-decoder): Change the default to
|
||||
rfc2047-decode-string.
|
||||
|
||||
* mail/rmail.el (rmail-enable-mime): Change the default to t.
|
||||
(rmail-mime-feature): Change the default to `rmailmm'.
|
||||
(rmail-quit): Delete the specifal code for rmail-enable-mime.
|
||||
(rmail-display-labels): Likewise.
|
||||
(rmail-show-message-1): Check rmail-enable-mime, and use
|
||||
rmail-show-mime-function for a MIME message. Decode the headers
|
||||
according to RFC2047.
|
||||
|
||||
2010-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* progmodes/which-func.el (which-func-imenu-joiner-function):
|
||||
|
|
|
|||
|
|
@ -638,7 +638,7 @@ Element N specifies the summary line for message N+1.")
|
|||
|
||||
This is set to nil by default.")
|
||||
|
||||
(defcustom rmail-enable-mime nil
|
||||
(defcustom rmail-enable-mime t
|
||||
"If non-nil, RMAIL uses MIME features.
|
||||
If the value is t, RMAIL automatically shows MIME decoded message.
|
||||
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."
|
|||
:type '(choice (const :tag "on" t)
|
||||
(const :tag "off" nil)
|
||||
(other :tag "when asked" ask))
|
||||
:version "23.3"
|
||||
:group 'rmail)
|
||||
|
||||
(defvar rmail-enable-mime-composing nil
|
||||
|
|
@ -693,13 +694,12 @@ start of the header) with three arguments MSG, REGEXP, and LIMIT,
|
|||
where MSG is the message number, REGEXP is the regular
|
||||
expression, LIMIT is the position specifying the end of header.")
|
||||
|
||||
(defvar rmail-mime-feature 'rmail-mime
|
||||
(defvar rmail-mime-feature 'rmailmm
|
||||
"Feature to require to load MIME support in Rmail.
|
||||
When starting Rmail, if `rmail-enable-mime' is non-nil,
|
||||
this feature is required with `require'.
|
||||
|
||||
The default value is `rmail-mime'. This feature is provided by
|
||||
the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.")
|
||||
The default value is `rmailmm'")
|
||||
|
||||
;; FIXME this is unused.
|
||||
(defvar rmail-decode-mime-charset t
|
||||
|
|
@ -1509,17 +1509,9 @@ Hook `rmail-quit-hook' is run after expunging."
|
|||
(set-buffer-modified-p nil))
|
||||
(replace-buffer-in-windows rmail-summary-buffer)
|
||||
(bury-buffer rmail-summary-buffer))
|
||||
(if rmail-enable-mime
|
||||
(let ((obuf rmail-buffer)
|
||||
(ovbuf rmail-view-buffer))
|
||||
(set-buffer rmail-view-buffer)
|
||||
(quit-window)
|
||||
(replace-buffer-in-windows ovbuf)
|
||||
(replace-buffer-in-windows obuf)
|
||||
(bury-buffer obuf))
|
||||
(let ((obuf (current-buffer)))
|
||||
(quit-window)
|
||||
(replace-buffer-in-windows obuf))))
|
||||
(let ((obuf (current-buffer)))
|
||||
(quit-window)
|
||||
(replace-buffer-in-windows obuf)))
|
||||
|
||||
(defun rmail-bury ()
|
||||
"Bury current Rmail buffer and its summary buffer."
|
||||
|
|
@ -2219,15 +2211,7 @@ If nil, that means the current message."
|
|||
(let ((blurb (rmail-get-labels)))
|
||||
(setq mode-line-process
|
||||
(format " %d/%d%s"
|
||||
rmail-current-message rmail-total-messages blurb))
|
||||
;; If rmail-enable-mime is non-nil, we may have to update
|
||||
;; `mode-line-process' of rmail-view-buffer too.
|
||||
(if (and rmail-enable-mime
|
||||
(not (eq (current-buffer) rmail-view-buffer))
|
||||
(buffer-live-p rmail-view-buffer))
|
||||
(let ((mlp mode-line-process))
|
||||
(with-current-buffer rmail-view-buffer
|
||||
(setq mode-line-process mlp))))))
|
||||
rmail-current-message rmail-total-messages blurb))))
|
||||
|
||||
(defun rmail-get-attr-value (attr state)
|
||||
"Return the character value for ATTR.
|
||||
|
|
@ -2706,6 +2690,11 @@ The current mail message becomes the message displayed."
|
|||
(message "Showing message %d" msg))
|
||||
(narrow-to-region beg end)
|
||||
(goto-char beg)
|
||||
(if (and rmail-enable-mime
|
||||
(re-search-forward "mime-version: 1.0" nil t))
|
||||
(let ((rmail-buffer mbox-buf)
|
||||
(rmail-view-buffer view-buf))
|
||||
(funcall rmail-show-mime-function))
|
||||
(setq body-start (search-forward "\n\n" nil t))
|
||||
(narrow-to-region beg (point))
|
||||
(goto-char beg)
|
||||
|
|
@ -2722,11 +2711,6 @@ The current mail message becomes the message displayed."
|
|||
;; unibyte temporary buffer where the character decoding takes
|
||||
;; place.
|
||||
(with-current-buffer rmail-view-buffer
|
||||
;; We give the view buffer a buffer-local value of
|
||||
;; rmail-header-style based on the binding in effect when
|
||||
;; this function is called; `rmail-toggle-headers' can
|
||||
;; inspect this value to determine how to toggle.
|
||||
(set (make-local-variable 'rmail-header-style) header-style)
|
||||
(erase-buffer))
|
||||
(if (null character-coding)
|
||||
;; Do it directly since that is fast.
|
||||
|
|
@ -2749,8 +2733,13 @@ The current mail message becomes the message displayed."
|
|||
(error "uuencoded messages are not supported yet"))
|
||||
(t))
|
||||
(rmail-decode-region (point-min) (point-max)
|
||||
coding-system view-buf)))
|
||||
coding-system view-buf))))
|
||||
(with-current-buffer rmail-view-buffer
|
||||
;; We give the view buffer a buffer-local value of
|
||||
;; rmail-header-style based on the binding in effect when
|
||||
;; this function is called; `rmail-toggle-headers' can
|
||||
;; inspect this value to determine how to toggle.
|
||||
(set (make-local-variable 'rmail-header-style) header-style)
|
||||
;; Unquote quoted From lines
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^>+From " nil t)
|
||||
|
|
@ -2766,6 +2755,10 @@ The current mail message becomes the message displayed."
|
|||
(with-current-buffer rmail-view-buffer
|
||||
(insert "\n")
|
||||
(goto-char (point-min))
|
||||
;; Decode the headers according to RFC2047.
|
||||
(save-excursion
|
||||
(search-forward "\n\n" nil 'move)
|
||||
(rfc2047-decode-region (point-min) (point)))
|
||||
(rmail-highlight-headers)
|
||||
;(rmail-activate-urls)
|
||||
;(rmail-process-quoted-material)
|
||||
|
|
|
|||
|
|
@ -26,17 +26,57 @@
|
|||
|
||||
;; Essentially based on the design of Alexander Pohoyda's MIME
|
||||
;; extensions (mime-display.el and mime.el).
|
||||
;; Call `M-x rmail-mime' when viewing an Rmail message.
|
||||
|
||||
;; This file provides two operation modes for viewing a MIME message.
|
||||
|
||||
;; (1) When rmail-enable-mime is non-nil (now it is the default), the
|
||||
;; function `rmail-show-mime' is automatically called. That function
|
||||
;; shows a MIME message directly in RMAIL's view buffer.
|
||||
|
||||
;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x
|
||||
;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*".
|
||||
|
||||
;; Both operations share the intermediate functions rmail-mime-process
|
||||
;; and rmail-mime-process-multipart as below.
|
||||
|
||||
;; rmail-show-mime
|
||||
;; +- rmail-mime-parse
|
||||
;; | +- rmail-mime-process <--+------------+
|
||||
;; | | +---------+ |
|
||||
;; | + rmail-mime-process-multipart --+
|
||||
;; |
|
||||
;; + rmail-mime-insert <----------------+
|
||||
;; +- rmail-mime-insert-text |
|
||||
;; +- rmail-mime-insert-bulk |
|
||||
;; +- rmail-mime-insert-multipart --+
|
||||
;;
|
||||
;; rmail-mime
|
||||
;; +- rmail-mime-show <----------------------------------+
|
||||
;; +- rmail-mime-process |
|
||||
;; +- rmail-mime-handle |
|
||||
;; +- rmail-mime-text-handler |
|
||||
;; +- rmail-mime-bulk-handler |
|
||||
;; | + rmail-mime-insert-bulk
|
||||
;; +- rmail-mime-multipart-handler |
|
||||
;; +- rmail-mime-process-multipart --+
|
||||
|
||||
;; In addition, for the case of rmail-enable-mime being non-nil, this
|
||||
;; file provides two functions rmail-insert-mime-forwarded-message and
|
||||
;; rmail-insert-mime-resent-message for composing forwarded and resent
|
||||
;; messages respectively.
|
||||
|
||||
;; Todo:
|
||||
|
||||
;; Handle multipart/alternative.
|
||||
;; Make rmail-mime-media-type-handlers-alist usable in the first
|
||||
;; operation mode.
|
||||
;; Handle multipart/alternative in the second operation mode.
|
||||
;; Offer the option to call external/internal viewers (doc-view, xpdf, etc).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'rmail)
|
||||
(require 'mail-parse)
|
||||
(require 'message)
|
||||
|
||||
;;; User options.
|
||||
|
||||
|
|
@ -90,6 +130,52 @@ automatically display the image in the buffer."
|
|||
|
||||
;;; End of user options.
|
||||
|
||||
;;; MIME-entity object
|
||||
|
||||
(defun rmail-mime-entity (type disposition transfer-encoding
|
||||
header body children)
|
||||
"Retrun a newly created MIME-entity object.
|
||||
|
||||
A MIME-entity is a vector of 6 elements:
|
||||
|
||||
[ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ]
|
||||
|
||||
TYPE and DISPOSITION correspond to MIME headers Content-Type: and
|
||||
Cotent-Disposition: respectively, and has this format:
|
||||
|
||||
\(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
|
||||
|
||||
VALUE is a string and ATTRIBUTE is a symbol.
|
||||
|
||||
Consider the following header, for example:
|
||||
|
||||
Content-Type: multipart/mixed;
|
||||
boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
|
||||
|
||||
The corresponding TYPE argument must be:
|
||||
|
||||
\(\"multipart/mixed\"
|
||||
\(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
|
||||
|
||||
TRANSFER-ENCODING corresponds to MIME header
|
||||
Content-Transfer-Encoding, and is a lowercased string.
|
||||
|
||||
HEADER and BODY are a cons (BEG . END), where BEG and END specify
|
||||
the region of the corresponding part in RMAIL's data (mbox)
|
||||
buffer. BODY may be nil. In that case, the current buffer is
|
||||
narrowed to the body part.
|
||||
|
||||
CHILDREN is a list of MIME-entities for a \"multipart\" entity, and
|
||||
nil for the other types."
|
||||
(vector type disposition transfer-encoding header body children))
|
||||
|
||||
;; Accessors for a MIME-entity object.
|
||||
(defsubst rmail-mime-entity-type (entity) (aref entity 0))
|
||||
(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
|
||||
(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
|
||||
(defsubst rmail-mime-entity-header (entity) (aref entity 3))
|
||||
(defsubst rmail-mime-entity-body (entity) (aref entity 4))
|
||||
(defsubst rmail-mime-entity-children (entity) (aref entity 5))
|
||||
|
||||
;;; Buttons
|
||||
|
||||
|
|
@ -98,6 +184,7 @@ automatically display the image in the buffer."
|
|||
(let* ((filename (button-get button 'filename))
|
||||
(directory (button-get button 'directory))
|
||||
(data (button-get button 'data))
|
||||
(mbox-buf rmail-view-buffer)
|
||||
(ofilename filename))
|
||||
(setq filename (expand-file-name
|
||||
(read-file-name (format "Save as (default: %s): " filename)
|
||||
|
|
@ -116,7 +203,17 @@ automatically display the image in the buffer."
|
|||
;; file, the magic signature compares equal with the unibyte
|
||||
;; signature string recorded in jka-compr-compression-info-list.
|
||||
(set-buffer-multibyte nil)
|
||||
(insert data)
|
||||
(setq buffer-undo-list t)
|
||||
(if (stringp data)
|
||||
(insert data)
|
||||
;; DATA is a MIME-entity object.
|
||||
(let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
|
||||
(body (rmail-mime-entity-body data)))
|
||||
(insert-buffer-substring mbox-buf (car body) (cdr body))
|
||||
(cond ((string= transfer-encoding "base64")
|
||||
(ignore-errors (base64-decode-region (point-min) (point-max))))
|
||||
((string= transfer-encoding "quoted-printable")
|
||||
(quoted-printable-decode-region (point-min) (point-max))))))
|
||||
(write-region nil nil filename nil nil nil t))))
|
||||
|
||||
(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
|
||||
|
|
@ -133,6 +230,23 @@ automatically display the image in the buffer."
|
|||
(when (coding-system-p coding-system)
|
||||
(decode-coding-region (point-min) (point-max) coding-system))))
|
||||
|
||||
(defun rmail-mime-insert-text (entity)
|
||||
"Insert MIME-entity ENTITY as a plain text MIME part in the current buffer."
|
||||
(let* ((content-type (rmail-mime-entity-type entity))
|
||||
(charset (cdr (assq 'charset (cdr content-type))))
|
||||
(coding-system (if charset (intern (downcase charset))))
|
||||
(transfer-encoding (rmail-mime-entity-transfer-encoding entity))
|
||||
(body (rmail-mime-entity-body entity)))
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(insert-buffer-substring rmail-buffer (car body) (cdr body))
|
||||
(cond ((string= transfer-encoding "base64")
|
||||
(ignore-errors (base64-decode-region (point-min) (point-max))))
|
||||
((string= transfer-encoding "quoted-printable")
|
||||
(quoted-printable-decode-region (point-min) (point-max))))
|
||||
(if (coding-system-p coding-system)
|
||||
(decode-coding-region (point-min) (point-max) coding-system)))))
|
||||
|
||||
;; FIXME move to the test/ directory?
|
||||
(defun test-rmail-mime-handler ()
|
||||
"Test of a mail using no MIME parts at all."
|
||||
|
|
@ -151,10 +265,28 @@ MIME-Version: 1.0
|
|||
|
||||
|
||||
(defun rmail-mime-insert-image (type data)
|
||||
"Insert an image of type TYPE, where DATA is the image data."
|
||||
"Insert an image of type TYPE, where DATA is the image data.
|
||||
If DATA is not a string, it is a MIME-entity object."
|
||||
(end-of-line)
|
||||
(insert ?\n)
|
||||
(insert-image (create-image data type t)))
|
||||
(let ((modified (buffer-modified-p)))
|
||||
(insert ?\n)
|
||||
(unless (stringp data)
|
||||
;; DATA is a MIME-entity.
|
||||
(let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
|
||||
(body (rmail-mime-entity-body data))
|
||||
(mbox-buffer rmail-view-buffer))
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(setq buffer-undo-list t)
|
||||
(insert-buffer-substring mbox-buffer (car body) (cdr body))
|
||||
(cond ((string= transfer-encoding "base64")
|
||||
(ignore-errors (base64-decode-region (point-min) (point-max))))
|
||||
((string= transfer-encoding "quoted-printable")
|
||||
(quoted-printable-decode-region (point-min) (point-max))))
|
||||
(setq data
|
||||
(buffer-substring-no-properties (point-min) (point-max))))))
|
||||
(insert-image (create-image data type t))
|
||||
(set-buffer-modified-p modified)))
|
||||
|
||||
(defun rmail-mime-image (button)
|
||||
"Display the image associated with BUTTON."
|
||||
|
|
@ -171,8 +303,19 @@ MIME-Version: 1.0
|
|||
"Handle the current buffer as an attachment to download.
|
||||
For images that Emacs is capable of displaying, the behavior
|
||||
depends upon the value of `rmail-mime-show-images'."
|
||||
(rmail-mime-insert-bulk
|
||||
(rmail-mime-entity content-type content-disposition content-transfer-encoding
|
||||
nil nil nil)))
|
||||
|
||||
(defun rmail-mime-insert-bulk (entity)
|
||||
"Inesrt a MIME-entity ENTITY as an attachment.
|
||||
The optional second arg DATA, if non-nil, is a string containing
|
||||
the attachment data that is already decoded."
|
||||
;; Find the default directory for this media type.
|
||||
(let* ((directory (catch 'directory
|
||||
(let* ((content-type (rmail-mime-entity-type entity))
|
||||
(content-disposition (rmail-mime-entity-disposition entity))
|
||||
(body (rmail-mime-entity-body entity))
|
||||
(directory (catch 'directory
|
||||
(dolist (entry rmail-mime-attachment-dirs-alist)
|
||||
(when (string-match (car entry) (car content-type))
|
||||
(dolist (dir (cdr entry))
|
||||
|
|
@ -182,17 +325,21 @@ depends upon the value of `rmail-mime-show-images'."
|
|||
(cdr (assq 'filename (cdr content-disposition)))
|
||||
"noname"))
|
||||
(label (format "\nAttached %s file: " (car content-type)))
|
||||
(data (buffer-string))
|
||||
(udata (string-as-unibyte data))
|
||||
(size (length udata))
|
||||
(osize size)
|
||||
(units '(B kB MB GB))
|
||||
type)
|
||||
(while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
|
||||
data udata size osize type)
|
||||
(if body
|
||||
(setq data entity
|
||||
udata entity
|
||||
size (- (cdr body) (car body)))
|
||||
(setq data (buffer-string)
|
||||
udata (string-as-unibyte data)
|
||||
size (length udata))
|
||||
(delete-region (point-min) (point-max)))
|
||||
(setq osize size)
|
||||
(while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
|
||||
(cdr units))
|
||||
(setq size (/ size 1024.0)
|
||||
units (cdr units)))
|
||||
(delete-region (point-min) (point-max))
|
||||
(insert label)
|
||||
(insert-button filename
|
||||
:type 'rmail-mime-save
|
||||
|
|
@ -248,6 +395,22 @@ The current buffer should be narrowed to the body. CONTENT-TYPE,
|
|||
CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
|
||||
of the respective parsed headers. See `rmail-mime-handle' for their
|
||||
format."
|
||||
(rmail-mime-process-multipart
|
||||
content-type content-disposition content-transfer-encoding nil))
|
||||
|
||||
(defun rmail-mime-process-multipart (content-type
|
||||
content-disposition
|
||||
content-transfer-encoding
|
||||
parse-only)
|
||||
"Process the current buffer as a multipart MIME body.
|
||||
|
||||
If PARSE-ONLY is nil, modify the current buffer directly for showing
|
||||
the MIME body and return nil.
|
||||
|
||||
Otherwise, just parse the current buffer and return a list of
|
||||
MIME-entity objects.
|
||||
|
||||
The other arguments are the same as `rmail-mime-multipart-handler'."
|
||||
;; Some MUAs start boundaries with "--", while it should start
|
||||
;; with "CRLF--", as defined by RFC 2046:
|
||||
;; The boundary delimiter MUST occur at the beginning of a line,
|
||||
|
|
@ -256,7 +419,7 @@ format."
|
|||
;; of the preceding part.
|
||||
;; We currently don't handle that.
|
||||
(let ((boundary (cdr (assq 'boundary content-type)))
|
||||
beg end next)
|
||||
beg end next entities)
|
||||
(unless boundary
|
||||
(rmail-mm-get-boundary-error-message
|
||||
"No boundary defined" content-type content-disposition
|
||||
|
|
@ -266,7 +429,9 @@ format."
|
|||
(goto-char (point-min))
|
||||
(when (and (search-forward boundary nil t)
|
||||
(looking-at "[ \t]*\n"))
|
||||
(delete-region (point-min) (match-end 0)))
|
||||
(if parse-only
|
||||
(narrow-to-region (match-end 0) (point-max))
|
||||
(delete-region (point-min) (match-end 0))))
|
||||
;; Loop over all body parts, where beg points at the beginning of
|
||||
;; the part and end points at the end of the part. next points at
|
||||
;; the beginning of the next part.
|
||||
|
|
@ -284,13 +449,17 @@ format."
|
|||
(rmail-mm-get-boundary-error-message
|
||||
"Malformed boundary" content-type content-disposition
|
||||
content-transfer-encoding)))
|
||||
(delete-region end next)
|
||||
;; Handle the part.
|
||||
(save-restriction
|
||||
(narrow-to-region beg end)
|
||||
(rmail-mime-show))
|
||||
(goto-char (setq beg next)))))
|
||||
|
||||
(if parse-only
|
||||
(save-restriction
|
||||
(narrow-to-region beg end)
|
||||
(setq entities (cons (rmail-mime-process nil t) entities)))
|
||||
(delete-region end next)
|
||||
(save-restriction
|
||||
(narrow-to-region beg end)
|
||||
(rmail-mime-show)))
|
||||
(goto-char (setq beg next)))
|
||||
(nreverse entities)))
|
||||
|
||||
(defun test-rmail-mime-multipart-handler ()
|
||||
"Test of a mail used as an example in RFC 2046."
|
||||
|
|
@ -393,6 +562,9 @@ called recursively if multiple parts are available.
|
|||
|
||||
The current buffer must contain a single message. It will be
|
||||
modified."
|
||||
(rmail-mime-process show-headers nil))
|
||||
|
||||
(defun rmail-mime-process (show-headers parse-only)
|
||||
(let ((end (point-min))
|
||||
content-type
|
||||
content-transfer-encoding
|
||||
|
|
@ -436,14 +608,105 @@ modified."
|
|||
;; attachment according to RFC 2183.
|
||||
(unless (member (car content-disposition) '("inline" "attachment"))
|
||||
(setq content-disposition '("attachment")))
|
||||
;; Hide headers and handle the part.
|
||||
(save-restriction
|
||||
(cond ((string= (car content-type) "message/rfc822")
|
||||
(narrow-to-region end (point-max)))
|
||||
((not show-headers)
|
||||
(delete-region (point-min) end)))
|
||||
(rmail-mime-handle content-type content-disposition
|
||||
content-transfer-encoding))))
|
||||
|
||||
(if parse-only
|
||||
(cond ((string-match "multipart/.*" (car content-type))
|
||||
(setq end (1- end))
|
||||
(save-restriction
|
||||
(let ((header (if show-headers (cons (point-min) end))))
|
||||
(narrow-to-region end (point-max))
|
||||
(rmail-mime-entity content-type
|
||||
content-disposition
|
||||
content-transfer-encoding
|
||||
header nil
|
||||
(rmail-mime-process-multipart
|
||||
content-type content-disposition
|
||||
content-transfer-encoding t)))))
|
||||
((string-match "message/rfc822" (car content-type))
|
||||
(or show-headers
|
||||
(narrow-to-region end (point-max)))
|
||||
(rmail-mime-process t t))
|
||||
(t
|
||||
(rmail-mime-entity content-type
|
||||
content-disposition
|
||||
content-transfer-encoding
|
||||
nil
|
||||
(cons end (point-max))
|
||||
nil)))
|
||||
;; Hide headers and handle the part.
|
||||
(save-restriction
|
||||
(cond ((string= (car content-type) "message/rfc822")
|
||||
(narrow-to-region end (point-max)))
|
||||
((not show-headers)
|
||||
(delete-region (point-min) end)))
|
||||
(rmail-mime-handle content-type content-disposition
|
||||
content-transfer-encoding)))))
|
||||
|
||||
(defun rmail-mime-insert-multipart (entity)
|
||||
"Insert MIME-entity ENTITY of multipart type in the current buffer."
|
||||
(let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity))
|
||||
"/")))
|
||||
(disposition (rmail-mime-entity-disposition entity))
|
||||
(header (rmail-mime-entity-header entity))
|
||||
(children (rmail-mime-entity-children entity)))
|
||||
(if header
|
||||
(let ((pos (point)))
|
||||
(or (bolp)
|
||||
(insert "\n"))
|
||||
(insert-buffer-substring rmail-buffer (car header) (cdr header))
|
||||
(rfc2047-decode-region pos (point))
|
||||
(insert "\n")))
|
||||
(cond
|
||||
((string= subtype "mixed")
|
||||
(dolist (child children)
|
||||
(rmail-mime-insert child '("text/plain") disposition)))
|
||||
((string= subtype "digest")
|
||||
(dolist (child children)
|
||||
(rmail-mime-insert child '("message/rfc822") disposition)))
|
||||
((string= subtype "alternative")
|
||||
(let (best-plain-text best-text)
|
||||
(dolist (child children)
|
||||
(if (string= (or (car (rmail-mime-entity-disposition child))
|
||||
(car disposition))
|
||||
"inline")
|
||||
(if (string-match "text/plain"
|
||||
(car (rmail-mime-entity-type child)))
|
||||
(setq best-plain-text child)
|
||||
(if (string-match "text/.*"
|
||||
(car (rmail-mime-entity-type child)))
|
||||
(setq best-text child)))))
|
||||
(if (or best-plain-text best-text)
|
||||
(rmail-mime-insert (or best-plain-text best-text))
|
||||
;; No child could be handled. Insert all.
|
||||
(dolist (child children)
|
||||
(rmail-mime-insert child nil disposition)))))
|
||||
(t
|
||||
;; Unsupported subtype. Insert all as attachment.
|
||||
(dolist (child children)
|
||||
(rmail-mime-insert-bulk child))))))
|
||||
|
||||
(defun rmail-mime-parse ()
|
||||
"Parse the current Rmail message as a MIME message.
|
||||
The value is a MIME-entiy object (see `rmail-mime-enty-new')."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(rmail-mime-process nil t)))
|
||||
|
||||
(defun rmail-mime-insert (entity &optional content-type disposition)
|
||||
"Insert a MIME-entity ENTITY in the current buffer.
|
||||
|
||||
This function will be called recursively if multiple parts are
|
||||
available."
|
||||
(if (rmail-mime-entity-children entity)
|
||||
(rmail-mime-insert-multipart entity)
|
||||
(setq content-type
|
||||
(or (rmail-mime-entity-type entity) content-type))
|
||||
(setq disposition
|
||||
(or (rmail-mime-entity-disposition entity) disposition))
|
||||
(if (and (string= (car disposition) "inline")
|
||||
(string-match "text/.*" (car content-type)))
|
||||
(rmail-mime-insert-text entity)
|
||||
(rmail-mime-insert-bulk entity))))
|
||||
|
||||
(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
|
||||
"Major mode used in `rmail-mime' buffers."
|
||||
|
|
@ -479,6 +742,50 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
|
|||
(error "%s; type: %s; disposition: %s; encoding: %s"
|
||||
message type disposition encoding))
|
||||
|
||||
(defun rmail-show-mime ()
|
||||
(let ((mbox-buf rmail-buffer))
|
||||
(condition-case nil
|
||||
(let ((entity (rmail-mime-parse)))
|
||||
(with-current-buffer rmail-view-buffer
|
||||
(let ((inhibit-read-only t)
|
||||
(rmail-buffer mbox-buf))
|
||||
(erase-buffer)
|
||||
(rmail-mime-insert entity))))
|
||||
(error
|
||||
;; Decoding failed. Insert the original message body as is.
|
||||
(let ((region (with-current-buffer mbox-buf
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "^$" nil t)
|
||||
(forward-line 1)
|
||||
(cons (point) (point-max)))))
|
||||
(with-current-buffer rmail-view-buffer
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring mbox-buf (car region) (cdr region))))
|
||||
(message "MIME decoding failed"))))))
|
||||
|
||||
(setq rmail-show-mime-function 'rmail-show-mime)
|
||||
|
||||
(defun rmail-insert-mime-forwarded-message (forward-buffer)
|
||||
(let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer)))
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(message-forward-make-body-mime mbox-buf))))
|
||||
|
||||
(setq rmail-insert-mime-forwarded-message-function
|
||||
'rmail-insert-mime-forwarded-message)
|
||||
|
||||
(defun rmail-insert-mime-resent-message (forward-buffer)
|
||||
(insert-buffer-substring
|
||||
(with-current-buffer forward-buffer rmail-view-buffer))
|
||||
(goto-char (point-min))
|
||||
(when (looking-at "From ")
|
||||
(forward-line 1)
|
||||
(delete-region (point-min) (point))))
|
||||
|
||||
(setq rmail-insert-mime-resent-message-function
|
||||
'rmail-insert-mime-resent-message)
|
||||
|
||||
(provide 'rmailmm)
|
||||
|
||||
;; Local Variables:
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@
|
|||
|
||||
;; For rmail-select-summary.
|
||||
(require 'rmail)
|
||||
(require 'rfc2047)
|
||||
|
||||
(defcustom rmail-summary-scroll-between-messages t
|
||||
"Non-nil means Rmail summary scroll commands move between messages.
|
||||
|
|
@ -363,13 +364,15 @@ The current buffer contains the unrestricted message collection."
|
|||
(aset rmail-summary-vector (1- msgnum) line))
|
||||
line))
|
||||
|
||||
(defcustom rmail-summary-line-decoder (function identity)
|
||||
(defcustom rmail-summary-line-decoder (function rfc2047-decode-string)
|
||||
"Function to decode a Rmail summary line.
|
||||
It receives the summary line for one message as a string
|
||||
and should return the decoded string.
|
||||
|
||||
By default, it is `identity', which returns the string unaltered."
|
||||
By default, it is `rfc2047-decode-string', which decodes MIME-encoded
|
||||
subject."
|
||||
:type 'function
|
||||
:version "23.3"
|
||||
:group 'rmail-summary)
|
||||
|
||||
(defun rmail-create-summary-line (msgnum)
|
||||
|
|
@ -588,10 +591,17 @@ the message being processed."
|
|||
(t (- mch 14))))
|
||||
(min len (+ lo 25)))))))))
|
||||
(concat (if (re-search-forward "^Subject:" nil t)
|
||||
(progn (skip-chars-forward " \t")
|
||||
(buffer-substring (point)
|
||||
(progn (end-of-line)
|
||||
(point))))
|
||||
(let (pos str)
|
||||
(skip-chars-forward " \t")
|
||||
(setq pos (point))
|
||||
(forward-line 1)
|
||||
(setq str (buffer-substring pos (1- (point))))
|
||||
(while (looking-at "\\s ")
|
||||
(setq str (concat str " "
|
||||
(buffer-substring (match-end 0)
|
||||
(line-end-position))))
|
||||
(forward-line 1))
|
||||
str)
|
||||
(re-search-forward "[\n][\n]+" nil t)
|
||||
(buffer-substring (point) (progn (end-of-line) (point))))
|
||||
"\n")))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue