X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=mime-view.el;h=2a30e18c73bddf2ad5d57dd38c2b5082f14b428a;hb=39725d24b7906f6cc7b92869604ae1372c8a28a8;hp=a6913f45fb36e028ca65ff4e435269f5d3a493f9;hpb=9aa9e17b0b2ec63933a4883b019d03c3f5d149c3;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index a6913f4..2a30e18 100644
--- 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)