Sync up with the latest semi-1_13.

[elisp/semi.git] / mime-view.el

diff --git a/mime-view.el b/mime-view.el
index a6913f4..2a30e18 100644 (file)
--- a/mime-view.el
+++ b/mime-view.el
@@ -368,6 +368,8 @@ Each elements are regexp of field-name.")
 ;;; @@@ predicate function
 ;;;
 
+(in-calist-package 'mime-view)
+
 (defun mime-calist::field-match-method-as-default-rule (calist
                                                        field-type field-value)
   (let ((s-field (assq field-type calist)))
@@ -735,9 +737,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (setq preview-buffer (current-buffer)))
   (let* ((raw-buffer (mime-entity-buffer entity))
         (start (mime-entity-point-min entity))
-        e nb ne)
+        e nb ne nhb nbb)
     (set-buffer raw-buffer)
     (goto-char start)
+    (in-calist-package 'mime-view)
     (or situation
        (setq situation
              (or (ctree-match-calist mime-preview-condition
@@ -762,15 +765,18 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
              (mime-view-insert-entity-button entity)
            ))
       (when header-is-visible
+       (setq nhb (point))
        (if header-presentation-method
            (funcall header-presentation-method entity situation)
          (mime-insert-header entity
                              mime-view-ignored-field-list
                              mime-view-visible-field-list))
+       (run-hooks 'mime-display-header-hook)
+       (put-text-property nhb (point-max) 'mime-view-entity-header entity)
        (goto-char (point-max))
        (insert "\n")
-       (run-hooks 'mime-display-header-hook)
        )
+      (setq nbb (point))
       (cond (children)
             ((functionp body-presentation-method)
             (funcall body-presentation-method entity situation)
@@ -789,6 +795,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (setq ne (point-max))
       (widen)
       (put-text-property nb ne 'mime-view-entity entity)
+      (put-text-property nbb ne 'mime-view-entity-body entity)
       (goto-char ne)
       (if children
          (if (functionp body-presentation-method)
@@ -933,8 +940,20 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 
 (defvar mime-view-redisplay nil)
 
+;;;###autoload
 (defun mime-display-message (message &optional preview-buffer
                                     mother default-keymap-or-function)
+  "View MESSAGE in MIME-View mode.
+
+Optional argument PREVIEW-BUFFER specifies the buffer of the
+presentation.  It must be either nil or a name of preview buffer.
+
+Optional argument MOTHER specifies mother-buffer of the preview-buffer.
+
+Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or
+function.  If it is a keymap, keymap of MIME-View mode will be added
+to it.  If it is a function, it will be bound as default binding of
+keymap of MIME-View mode."
   (mime-maybe-hide-echo-buffer)
   (let ((win-conf (current-window-configuration))
        (raw-buffer (mime-entity-buffer message)))
@@ -980,6 +999,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                  )))))
       )))
 
+;;;###autoload
 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
                                   default-keymap-or-function
                                   representation-type)
@@ -1100,6 +1120,7 @@ It calls following-method selected from variable
     (let* ((p-beg
            (previous-single-property-change (point) 'mime-view-entity))
           p-end
+          ph-end
           (entity-node-id (mime-entity-node-id entity))
           (len (length entity-node-id))
           )
@@ -1143,6 +1164,12 @@ It calls following-method selected from variable
                 (setq p-end (point-max))
                 ))
             ))
+      (setq ph-end
+           (previous-single-property-change p-end 'mime-view-entity-header))
+      (if (or (null ph-end)
+             (< ph-end p-beg))
+         (setq ph-end p-beg)
+       )
       (let* ((mode (mime-preview-original-major-mode 'recursive))
             (new-name
              (format "%s-%s" (buffer-name) (reverse entity-node-id)))
@@ -1153,7 +1180,10 @@ It calls following-method selected from variable
        (save-excursion
          (set-buffer (setq new-buf (get-buffer-create new-name)))
          (erase-buffer)
-         (insert-buffer-substring the-buf p-beg p-end)
+         (insert-buffer-substring the-buf ph-end p-end)
+         (when (= ph-end p-beg)
+           (goto-char (point-min))
+           (insert ?\n))
          (goto-char (point-min))
           (let ((entity-node-id (mime-entity-node-id entity)) ci str)
            (while (progn
@@ -1172,9 +1202,8 @@ It calls following-method selected from variable
                           (concat "^"
                                   (apply (function regexp-or) fields)
                                   ":") ""))))
-                    (if (and
-                         (eq (mime-entity-media-type ci) 'message)
-                         (eq (mime-entity-media-subtype ci) 'rfc822))
+                    (if (and (eq (mime-entity-media-type ci) 'message)
+                             (eq (mime-entity-media-subtype ci) 'rfc822))
                         nil
                       (if str
                           (insert str)