Skip to content

GitLab

Commit e7ca0062 authored by Kenichi Handa's avatar Kenichi Handa
Browse files

Another improvement of MIME handling in rmail.

parent 8434f239
Hide whitespace changes
Inline Side-by-side
Showing with 162 additions and 110 deletions
lisp/ChangeLog
View file @ e7ca0062
2011-01-12 Kenichi Handa <handa@m17n.org>
* mail/rmailmm.el (rmail-mime-next-item)
(rmail-mime-previous-item): Delete them.
(rmail-mime-shown-mode): Recursively call for children.
(rmail-mime-hidden-mode): Delete the 2nd arg TOP. Callers
changed.
(rmail-mime-raw-mode): Recursively call for children.
(rmail-mode-map): Change mapping of tab and backtab to
forward-button and backward-button respectively.
(rmail-mime-insert-tagline): Always insert "Hide" or "Show"
button.
(rmail-mime-update-tagline): New function.
(rmail-mime-insert-text): Call rmail-mime-update-tagline if the
body display is changed.
(rmail-mime-toggle-button): Renamed from rmail-mime-image.
(rmail-mime-image): Delete this button type.
(rmail-mime-toggle): New button type.
(rmail-mime-insert-bulk): Call rmail-mime-update-tagline if the
body display is changed. Change the save button label to "Save".
Don't process show/hide button here.
(rmail-mime-insert-multipart): Call rmail-mime-update-tagline if
the body display is changed. Unconditionally call
rmail-mime-insert for children.
(rmail-mime-handle): Update `display' vector of the just inserted
entity.
(rmail-mime-process): If mail-header-parse-content-type returns
nil, use "text/plain" as the fallback type.
(rmail-mime-insert): For raw-mode, recursively call
rmail-mim-insert for children.
(rmail-mime): Handle the case that the current buffer is not rmail
buffer (e.g. in summary buffer).
2011-01-05 Kenichi Handa <handa@m17n.org>
* mail/rmailmm.el (rmail-mime-next-item)
(rmail-mime-previous-item): Skip the body of a non-multipart
entity if a tagline is shown.
2011-01-04 Kenichi Handa <handa@m17n.org>
* mail/rmailmm.el (rmail-mime-insert-bulk): Display an unknown
......
lisp/mail/rmailmm.el
View file @ e7ca0062
......@@ -273,11 +273,11 @@ It is called with one argument ENTITY."
"Return a vector describing the displayed region of a MIME-entity at POS.
Optional 2nd argument ENTITY is the MIME-entity at POS.
The value is a vector [ INDEX HEADER TAGLINE BODY END], where
INDEX: index into the returned vector indicating where POS is (1..3).
HEADER: the position of the beginning of a header
TAGLINE: the position of the beginning of a tagline
BODY: the position of the beginning of a body
END: the position of the end of the entity.
INDEX: index into the returned vector indicating where POS is."
END: the position of the end of the entity."
(save-excursion
(or entity
(setq entity (get-text-property pos 'rmail-mime-entity)))
......@@ -318,74 +318,32 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where
(setq end body-beg))
(vector index beg tagline-beg body-beg end)))))
(defun rmail-mime-next-item ()
"Move point to the next displayed item of the current MIME entity.
A MIME entity has three items; header, tagline, and body.
If we are in the last item of the entity, move point to the first
item of the next entity. If we reach the end of buffer, move
point to the first item of the first entity (i.e. the beginning
of buffer)."
(interactive)
(if (rmail-mime-message-p)
(let* ((segment (rmail-mime-entity-segment (point)))
(next-pos (aref segment (1+ (aref segment 0))))
(button (next-button (point))))
(goto-char (if (and button (< (button-start button) next-pos))
(button-start button)
next-pos))
(if (eobp)
(goto-char (point-min))))))
(defun rmail-mime-previous-item ()
"Move point to the previous displayed item of the current MIME message.
A MIME entity has three items; header, tagline, and body.
If we are at the beginning of the first item of the entity, move
point to the last item of the previous entity. If we reach the
beginning of buffer, move point to the last item of the last
entity."
(interactive)
(when (rmail-mime-message-p)
(if (bobp)
(goto-char (point-max)))
(let* ((segment (rmail-mime-entity-segment (1- (point))))
(prev-pos (aref segment (aref segment 0)))
(button (previous-button (point))))
(goto-char (if (and button (> (button-start button) prev-pos))
(button-start button)
prev-pos)))))
(defun rmail-mime-shown-mode (entity)
"Make MIME-entity ENTITY displayed by the default way."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
(aset new 0 (aref (rmail-mime-entity-header entity) 2))
(aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
(aset new 2 (aref (rmail-mime-entity-body entity) 2))))
(aset new 2 (aref (rmail-mime-entity-body entity) 2)))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-shown-mode child)))
(defun rmail-mime-hidden-mode (entity top)
"Make MIME-entity ENTITY displayed in the hidden mode.
If TOP is non-nil, display ENTITY only by the tagline.
Otherwise, don't display ENTITY."
(if top
(let ((new (aref (rmail-mime-entity-display entity) 1)))
(aset new 0 nil)
(aset new 1 top)
(aset new 2 nil)
(aset (rmail-mime-entity-body entity) 2 nil))
(let ((current (aref (rmail-mime-entity-display entity) 0)))
(aset current 0 nil)
(aset current 1 nil)
(aset current 2 nil)))
(defun rmail-mime-hidden-mode (entity)
"Make MIME-entity ENTITY displayed in the hidden mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
(aset new 0 nil)
(aset new 1 t)
(aset new 2 nil))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-hidden-mode child nil)))
(rmail-mime-hidden-mode child)))
(defun rmail-mime-raw-mode (entity)
"Make MIME-entity ENTITY displayed in the raw mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
(aset new 0 'raw)
(aset new 1 nil)
(aset new 2 'raw)
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-hidden-mode child nil))))
(aset new 2 'raw))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-raw-mode child)))
(defun rmail-mime-toggle-raw (entity)
"Toggle on and off the raw display mode of MIME-entity ENTITY."
......@@ -406,7 +364,7 @@ Otherwise, don't display ENTITY."
(restore-buffer-modified-p modified)))))
(defun rmail-mime-toggle-hidden ()
"Toggle on and off the hidden display mode of MIME-entity ENTITY."
"Hide or show the body of MIME-entity at point."
(interactive)
(when (rmail-mime-message-p)
(let* ((rmail-mime-mbox-buffer rmail-view-buffer)
......@@ -419,18 +377,19 @@ Otherwise, don't display ENTITY."
;; Enter the hidden mode.
(progn
;; If point is in the body part, move it to the tagline
;; (or the header if headline is not displayed).
;; (or the header if tagline is not displayed).
(if (= (aref segment 0) 3)
(goto-char (aref segment 2)))
(rmail-mime-hidden-mode entity t)
(rmail-mime-hidden-mode entity)
;; If the current entity is the topmost one, display the
;; header.
(if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
(let ((new (aref (rmail-mime-entity-display entity) 1)))
(aset new 0 t))))
;; Enter the shown mode.
(aset (rmail-mime-entity-body entity) 2 t)
(rmail-mime-shown-mode entity))
(rmail-mime-shown-mode entity)
;; Force this body shown.
(aset (aref (rmail-mime-entity-display entity) 1) 2 t))
(let ((inhibit-read-only t)
(modified (buffer-modified-p))
(rmail-mime-mbox-buffer rmail-view-buffer)
......@@ -440,8 +399,8 @@ Otherwise, don't display ENTITY."
(rmail-mime-insert entity)
(restore-buffer-modified-p modified))))))
(define-key rmail-mode-map "\t" 'rmail-mime-next-item)
(define-key rmail-mode-map [backtab] 'rmail-mime-previous-item)
(define-key rmail-mode-map "\t" 'forward-button)
(define-key rmail-mode-map [backtab] 'backward-button)
(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
;;; Handlers
......@@ -453,7 +412,11 @@ to the tag line."
(insert "[")
(let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
(if (> (length tag) 0) (insert (substring tag 1) ":")))
(insert (car (rmail-mime-entity-type entity)))
(insert (car (rmail-mime-entity-type entity)) " ")
(insert-button (let ((new (aref (rmail-mime-entity-display entity) 1)))
(if (aref new 2) "Hide" "Show"))
:type 'rmail-mime-toggle
'help-echo "mouse-2, RET: Toggle show/hide")
(dolist (item item-list)
(when item
(if (stringp item)
......@@ -461,6 +424,26 @@ to the tag line."
(apply 'insert-button item))))
(insert "]\n"))
(defun rmail-mime-update-tagline (entity)
"Update the current tag line for MIME-entity ENTITY."
(let ((inhibit-read-only t)
(modified (buffer-modified-p))
;; If we are going to show the body, the new button label is
;; "Hide". Otherwise, it's "Show".
(label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
"Show"))
(button (next-button (point))))
;; Go to the second character of the button "Show" or "Hide".
(goto-char (1+ (button-start button)))
(setq button (button-at (point)))
(save-excursion
(insert label)
(delete-region (point) (button-end button)))
(delete-region (button-start button) (point))
(put-text-property (point) (button-end button) 'rmail-mime-entity entity)
(restore-buffer-modified-p modified)
(forward-line 1)))
(defun rmail-mime-insert-header (header)
"Decode and insert a MIME-entity header HEADER in the current buffer.
HEADER is a vector [BEG END DEFAULT-STATUS].
......@@ -543,7 +526,10 @@ See `rmail-mime-entity' for the detail."
(rmail-mime-insert-header header)))
;; tagline
(if (eq (aref current 1) (aref new 1))
(forward-char (- (aref segment 3) (aref segment 2)))
(if (or (not (aref current 1))
(eq (aref current 2) (aref new 2)))
(forward-char (- (aref segment 3) (aref segment 2)))
(rmail-mime-update-tagline entity))
(if (aref current 1)
(delete-char (- (aref segment 3) (aref segment 2))))
(if (aref new 1)
......@@ -598,13 +584,13 @@ MIME-Version: 1.0
(insert-image (create-image data (cdr bulk-data) t))
(insert "\n")))
(defun rmail-mime-image (button)
"Display the image associated with BUTTON."
(defun rmail-mime-toggle-button (button)
"Hide or show the body of the MIME-entity associated with BUTTON."
(save-excursion
(goto-char (button-end button))
(goto-char (button-start button))
(rmail-mime-toggle-hidden)))
(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
(define-button-type 'rmail-mime-toggle 'action 'rmail-mime-toggle-button)
(defun rmail-mime-bulk-handler (content-type
......@@ -627,7 +613,7 @@ directly."
(size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
(bulk-data (aref (rmail-mime-entity-tagline entity) 1))
(body (rmail-mime-entity-body entity))
size type to-show)
type to-show)
(cond (size
(setq size (string-to-number size)))
((stringp (aref body 0))
......@@ -661,7 +647,6 @@ directly."
(defun rmail-mime-insert-bulk (entity)
"Presentation handler for an attachment MIME entity."
;; Find the default directory for this media type.
(let* ((content-type (rmail-mime-entity-type entity))
(content-disposition (rmail-mime-entity-disposition entity))
(current (aref (rmail-mime-entity-display entity) 0))
......@@ -670,6 +655,7 @@ directly."
(tagline (rmail-mime-entity-tagline entity))
(bulk-data (aref tagline 1))
(body (rmail-mime-entity-body entity))
;; Find the default directory for this media type.
(directory (catch 'directory
(dolist (entry rmail-mime-attachment-dirs-alist)
(when (string-match (car entry) (car content-type))
......@@ -710,13 +696,16 @@ directly."
;; tagline
(if (eq (aref current 1) (aref new 1))
(forward-char (- (aref segment 3) (aref segment 2)))
(if (or (not (aref current 1))
(eq (aref current 2) (aref new 2)))
(forward-char (- (aref segment 3) (aref segment 2)))
(rmail-mime-update-tagline entity))
(if (aref current 1)
(delete-char (- (aref segment 3) (aref segment 2))))
(if (aref new 1)
(rmail-mime-insert-tagline
entity
" file:"
" Save:"
(list filename
:type 'rmail-mime-save
'help-echo "mouse-2, RET: Save attachment"
......@@ -724,14 +713,17 @@ directly."
'directory (file-name-as-directory directory)
'data data)
(format " (%.0f%s)" size (car units))
(if (cdr bulk-data)
" ")
(if (cdr bulk-data)
(list "Toggle show/hide"
:type 'rmail-mime-image
'help-echo "mouse-2, RET: Toggle show/hide"
'image-type (cdr bulk-data)
'image-data data)))))
;; We don't need this button because the "type" string of a
;; tagline is the button to do this.
;; (if (cdr bulk-data)
;; " ")
;; (if (cdr bulk-data)
;; (list "Toggle show/hide"
;; :type 'rmail-mime-image
;; 'help-echo "mouse-2, RET: Toggle show/hide"
;; 'image-type (cdr bulk-data)
;; 'image-data data))
)))
;; body
(if (eq (aref current 2) (aref new 2))
(forward-char (- (aref segment 4) (aref segment 3)))
......@@ -882,8 +874,9 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
(setq second child)))))
(or best (not second) (setq best second))
(dolist (child entities)
(or (eq best child)
(rmail-mime-hidden-mode child t)))))
(unless (eq best child)
(aset (rmail-mime-entity-body child) 2 nil)
(rmail-mime-hidden-mode child)))))
entities)))
(defun test-rmail-mime-multipart-handler ()
......@@ -935,21 +928,23 @@ This is the epilogue. It is also to be ignored."))
(rmail-mime-insert-header header)))
;; tagline
(if (eq (aref current 1) (aref new 1))
(forward-char (- (aref segment 3) (aref segment 2)))
(if (or (not (aref current 1))
(eq (aref current 2) (aref new 2)))
(forward-char (- (aref segment 3) (aref segment 2)))
(rmail-mime-update-tagline entity))
(if (aref current 1)
(delete-char (- (aref segment 3) (aref segment 2))))
(if (aref new 1)
(rmail-mime-insert-tagline entity)))
(put-text-property beg (point) 'rmail-mime-entity entity)
;; body
(if (eq (aref current 2) (aref new 2))
(forward-char (- (aref segment 4) (aref segment 3)))
(if (aref current 2)
(delete-char (- (aref segment 4) (aref segment 3))))
(if (aref new 2)
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-insert child))))))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-insert child)))
entity))
;;; Main code
......@@ -1010,7 +1005,16 @@ The parsed header value:
;; Everything else is an attachment.
(rmail-mime-bulk-handler content-type
content-disposition
content-transfer-encoding)))
content-transfer-encoding))
(save-restriction
(widen)
(let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
current new)
(when entity
(setq current (aref (rmail-mime-entity-display entity) 0)
new (aref (rmail-mime-entity-display entity) 1))
(dotimes (i 3)
(aset current i (aref new i)))))))
(defun rmail-mime-show (&optional show-headers)
"Handle the current buffer as a MIME message.
......@@ -1055,7 +1059,8 @@ modified."
(setq content-transfer-encoding (downcase content-transfer-encoding)))
(setq content-type
(if content-type
(mail-header-parse-content-type content-type)
(or (mail-header-parse-content-type content-type)
'("text/plain"))
(or default-content-type '("text/plain"))))
(setq content-disposition
(if content-disposition
......@@ -1183,13 +1188,20 @@ available."
(if (aref current 1)
(delete-char (- (aref segment 3) (aref segment 2))))
;; body
(if (eq (aref current 2) (aref new 2))
(forward-char (- (aref segment 4) (aref segment 3)))
(if (aref current 2)
(delete-char (- (aref segment 4) (aref segment 3))))
(insert-buffer-substring rmail-mime-mbox-buffer
(aref body 0) (aref body 1)))
(put-text-property beg (point) 'rmail-mime-entity entity)))
(let ((children (rmail-mime-entity-children entity)))
(if children
(progn
(put-text-property beg (point) 'rmail-mime-entity entity)
(dolist (child children)
(rmail-mime-insert child)))
(if (eq (aref current 2) (aref new 2))
(forward-char (- (aref segment 4) (aref segment 3)))
(if (aref current 2)
(delete-char (- (aref segment 4) (aref segment 3))))
(insert-buffer-substring rmail-mime-mbox-buffer
(aref body 0) (aref body 1))
(or (bolp) (insert "\n")))
(put-text-property beg (point) 'rmail-mime-entity entity)))))
(dotimes (i 3)
(aset current i (aref new i)))))
......@@ -1217,17 +1229,18 @@ displays text and multipart messages, and offers to download
attachments as specfied by `rmail-mime-attachment-dirs-alist'."
(interactive "P")
(if rmail-enable-mime
(if (rmail-mime-message-p)
(let ((rmail-mime-mbox-buffer rmail-view-buffer)
(rmail-mime-view-buffer rmail-buffer)
(entity (get-text-property (point) 'rmail-mime-entity)))
(if arg
(if entity
(rmail-mime-toggle-raw entity))
(goto-char (point-min))
(rmail-mime-toggle-raw
(get-text-property (point) 'rmail-mime-entity))))
(message "Not a MIME message"))
(with-current-buffer rmail-buffer
(if (rmail-mime-message-p)
(let ((rmail-mime-mbox-buffer rmail-view-buffer)
(rmail-mime-view-buffer rmail-buffer)
(entity (get-text-property (point) 'rmail-mime-entity)))
(if arg
(if entity
(rmail-mime-toggle-raw entity))
(goto-char (point-min))
(rmail-mime-toggle-raw
(get-text-property (point) 'rmail-mime-entity))))
(message "Not a MIME message")))
(let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
(buf (get-buffer-create "*RMAIL*"))
(rmail-mime-mbox-buffer rmail-view-buffer)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment