[Emacs-diffs] /srv/bzr/emacs/trunk r104990: rmailmm.el: record truncated mime entities.

[Richard Stallman]

------------------------------------------------------------
revno: 104990
committer: Richard Stallman <address@hidden>
branch nick: trunk
timestamp: Wed 2011-07-06 12:44:33 -0400
message:
  rmailmm.el: record truncated mime entities.
modified:
  lisp/ChangeLog
  lisp/mail/rmailmm.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-07-06 15:49:19 +0000
+++ b/lisp/ChangeLog    2011-07-06 16:44:33 +0000
@@ -1,3 +1,13 @@
+2011-07-06  Richard Stallman  <address@hidden>
+
+       * 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  <address@hidden>
 
        * progmodes/grep.el (rgrep): Don't bind `process-connection-type',

=== modified file 'lisp/mail/rmailmm.el'
--- a/lisp/mail/rmailmm.el      2011-06-27 08:01:30 +0000
+++ b/lisp/mail/rmailmm.el      2011-07-06 16:44:33 +0000
@@ -153,20 +153,21 @@
 ;;; 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 @@
 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 @@
 (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 @@
         (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 @@
            (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 @@
   (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 @@
     (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 @@
               (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 @@
             (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 @@
                ;; 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)