Mercurial > emacs
changeset 112260:b3d66f88eeae
Another improvement of MIME handling in rmail.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Wed, 12 Jan 2011 15:12:13 +0900 |
| parents | 353c9b74c8b3 (current diff) bd264f28aa7d (diff) |
| children | 0071290a6df9 |
| files | |
| diffstat | 2 files changed, 162 insertions(+), 110 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Jan 11 19:53:28 2011 -0800 +++ b/lisp/ChangeLog Wed Jan 12 15:12:13 2011 +0900 @@ -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-11 Stefan Monnier <monnier@iro.umontreal.ca> * tmm.el (tmm-get-keymap): Skip bindings without labels (bug#7721).
--- a/lisp/mail/rmailmm.el Tue Jan 11 19:53:28 2011 -0800 +++ b/lisp/mail/rmailmm.el Wed Jan 12 15:12:13 2011 +0900 @@ -273,11 +273,11 @@ "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 @@ (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 @@ (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 @@ ;; 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ ;; 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 @@ '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 @@ (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 @@ (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 @@ ;; 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 @@ (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 @@ (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 @@ 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)