[Emacs-diffs] /srv/bzr/emacs/emacs-23 r100375: Another improvement of MIME handling in rmail.

[Kenichi Handa]

------------------------------------------------------------
revno: 100375 [merge]
committer: Kenichi Handa <address@hidden>
branch nick: emacs-23
timestamp: Wed 2011-01-12 15:12:13 +0900
message:
  Another improvement of MIME handling in rmail.
modified:
  lisp/ChangeLog
  lisp/mail/rmailmm.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-01-11 02:28:48 +0000
+++ b/lisp/ChangeLog    2011-01-12 06:11:40 +0000
@@ -1,3 +1,42 @@
+2011-01-12  Kenichi Handa  <address@hidden>
+
+       * 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  <address@hidden>
+
+       * 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  <address@hidden>
 
        * tmm.el (tmm-get-keymap): Skip bindings without labels (bug#7721).

=== modified file 'lisp/mail/rmailmm.el'
--- a/lisp/mail/rmailmm.el      2011-01-04 07:09:46 +0000
+++ b/lisp/mail/rmailmm.el      2011-01-12 06:08:55 +0000
@@ -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)