mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-04 22:50:59 -08:00
Another improvement of MIME handling in rmail.
This commit is contained in:
Kenichi Handa
parent
8434f23924
commit
e7ca0062a4
2 changed files with 163 additions and 111 deletions
|
|
@ -1,3 +1,42 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
(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)))
|
||||
(aset new 2 (aref (rmail-mime-entity-body entity) 2)))
|
||||
(dolist (child (rmail-mime-entity-children entity))
|
||||
(rmail-mime-hidden-mode child nil)))
|
||||
(rmail-mime-shown-mode child)))
|
||||
|
||||
(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)))
|
||||
|
||||
(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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue