rmailmm.el: record truncated mime entities.

2 files changed, 38 insertions, 11 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e26ad08244f..080f9494996 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2011-07-06  Richard Stallman  <rms@gnu.org>
+
+        * mail/rmailmm.el: Give entity a new slot, TRUNCATED.
+        (rmail-mime-entity): New arg TRUNCATED.
+        (rmail-mime-entity-truncated, rmail-mime-entity-set-truncated):
+        New functions.
+        (rmail-mime-save): Warn if entity is truncated.
+        (rmail-mime-toggle-hidden): Likewise, for showing.
+        (rmail-mime-process-multipart): Record when an entity is truncated.
+
 2011-07-06  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * progmodes/grep.el (rgrep): Don't bind `process-connection-type',
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 651defeaf46..5b8405dc499 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -153,20 +153,21 @@ MIME entities.")
 ;;; MIME-entity object
 
 (defun rmail-mime-entity (type disposition transfer-encoding
-                               display header tagline body children handler)
+                               display header tagline body children handler
+                               &optional truncated)
   "Retrun a newly created MIME-entity object from arguments.
 
-A MIME-entity is a vector of 9 elements:
+A MIME-entity is a vector of 10 elements:
 
   [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
-   CHILDREN HANDLER]
+   CHILDREN HANDLER TRUNCATED]
 
 TYPE and DISPOSITION correspond to MIME headers Content-Type and
-Cotent-Disposition respectively, and has this format:
+Content-Disposition respectively, and have this format:
 
   \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
 
-VALUE is a string and ATTRIBUTE is a symbol.
+Each VALUE is a string and each ATTRIBUTE is a string.
 
 Consider the following header, for example:
 
@@ -208,9 +209,12 @@ entity have one or more children.  A \"message/rfc822\" entity
 has just one child.  Any other entity has no child.
 
 HANDLER is a function to insert the entity according to DISPLAY.
-It is called with one argument ENTITY."
+It is called with one argument ENTITY.
+
+TRUNCATED is non-nil if the text of this entity was truncated."
+
   (vector type disposition transfer-encoding
-          display header tagline body children handler))
+          display header tagline body children handler truncated))
 
 ;; Accessors for a MIME-entity object.
 (defsubst rmail-mime-entity-type (entity) (aref entity 0))
@@ -222,6 +226,9 @@ It is called with one argument ENTITY."
 (defsubst rmail-mime-entity-body (entity) (aref entity 6))
 (defsubst rmail-mime-entity-children (entity) (aref entity 7))
 (defsubst rmail-mime-entity-handler (entity) (aref entity 8))
+(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
+(defsubst rmail-mime-entity-set-truncated (entity truncated)
+  (aset entity 9 truncated))
 
 (defsubst rmail-mime-message-p ()
   "Non-nil if and only if the current message is a MIME."
@@ -237,6 +244,10 @@ It is called with one argument ENTITY."
          (directory (button-get button 'directory))
          (data (button-get button 'data))
          (ofilename filename))
+    (if (and (not (stringp data))
+             (rmail-mime-entity-truncated data))
+        (unless (y-or-n-p "This entity is truncated; save anyway? ")
+          (error "Aborted")))
     (setq filename (expand-file-name
                     (read-file-name (format "Save as (default: %s): " filename)
                                     directory
@@ -387,6 +398,11 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where
             (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
                 (let ((new (aref (rmail-mime-entity-display entity) 1)))
                   (aset new 0 t))))
+        ;; Query as a warning before showing if truncated.
+        (if (and (not (stringp entity))
+                 (rmail-mime-entity-truncated entity))
+            (unless (y-or-n-p "This entity is truncated; show anyway? ")
+              (error "Aborted")))
         ;; Enter the shown mode.
         (rmail-mime-shown-mode entity)
         ;; Force this body shown.
@@ -816,7 +832,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
   (let ((boundary (cdr (assq 'boundary content-type)))
         (subtype (cadr (split-string (car content-type) "/")))
         (index 0)
-        beg end next entities)
+        beg end next entities truncated)
     (unless boundary
       (rmail-mm-get-boundary-error-message
        "No boundary defined" content-type content-disposition
@@ -845,7 +861,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
     (setq beg (point-min))
 
     (while (or (and (search-forward boundary nil t)
-                    (setq end (match-beginning 0)))
+                    (setq truncated nil end (match-beginning 0)))
                ;; If the boundary does not appear at all,
                ;; the message was truncated.
                ;; Handle the rest of the truncated message
@@ -854,7 +870,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
                (and (save-excursion
                       (skip-chars-forward "\n")
                       (> (point-max) (point)))
-                    (setq end (point-max))))
+                    (setq truncated t end (point-max))))
       ;; If this is the last boundary according to RFC 2046, hide the
       ;; epilogue, else hide the boundary only.  Use a marker for
       ;; `next' because `rmail-mime-show' may change the buffer.
@@ -862,7 +878,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
              (setq next (point-max-marker)))
             ((looking-at "[ \t]*\n")
              (setq next (copy-marker (match-end 0) t)))
-            ((= end (point-max))
+            (truncated
              ;; We're handling what's left of a truncated message.
              (setq next (point-max-marker)))
             (t
@@ -886,6 +902,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
                 ;; Display a tagline.
                 (aset (aref (rmail-mime-entity-display child) 1) 1
                       (aset (rmail-mime-entity-tagline child) 2 t))
+                (rmail-mime-entity-set-truncated child truncated)
                 (push child entities)))
 
           (delete-region end next)