(mime-preview-follow-current-entity): Use `mime-insert-header' to

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

diff --git a/mime-view.el b/mime-view.el
index acb9e2d..83afc8c 100644 (file)
--- a/mime-view.el
+++ b/mime-view.el
@@ -363,7 +363,7 @@ mother-buffer."
 
 (defvar mime-preview-situation-example-list nil)
 (defvar mime-preview-situation-example-list-max-size 16)
-(defvar mime-preview-situation-example-condition nil)
+;; (defvar mime-preview-situation-example-condition nil)
 
 (defun mime-find-entity-preview-situation (entity
                                           &optional default-situation)
@@ -505,21 +505,21 @@ mother-buffer."
 ;;; @@@ predicate function
 ;;;
 
-(defun mime-view-entity-button-visible-p (entity)
-  "Return non-nil if header of ENTITY is visible.
-Please redefine this function if you want to change default setting."
-  (let ((media-type (mime-entity-media-type entity))
-       (media-subtype (mime-entity-media-subtype entity)))
-    (or (not (eq media-type 'application))
-       (and (not (eq media-subtype 'x-selection))
-            (or (not (eq media-subtype 'octet-stream))
-                (let ((mother-entity (mime-entity-parent entity)))
-                  (or (not (eq (mime-entity-media-type mother-entity)
-                               'multipart))
-                      (not (eq (mime-entity-media-subtype mother-entity)
-                               'encrypted)))
-                  )
-                )))))
+;; (defun mime-view-entity-button-visible-p (entity)
+;;   "Return non-nil if header of ENTITY is visible.
+;; Please redefine this function if you want to change default setting."
+;;   (let ((media-type (mime-entity-media-type entity))
+;;         (media-subtype (mime-entity-media-subtype entity)))
+;;     (or (not (eq media-type 'application))
+;;         (and (not (eq media-subtype 'x-selection))
+;;              (or (not (eq media-subtype 'octet-stream))
+;;                  (let ((mother-entity (mime-entity-parent entity)))
+;;                    (or (not (eq (mime-entity-media-type mother-entity)
+;;                                 'multipart))
+;;                        (not (eq (mime-entity-media-subtype mother-entity)
+;;                                 'encrypted)))
+;;                    )
+;;                  )))))
 
 ;;; @@@ entity button generator
 ;;;
@@ -1017,9 +1017,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (setq nb (point))
       (narrow-to-region nb nb)
       (or button-is-invisible
-         (if (mime-view-entity-button-visible-p entity)
-             (mime-view-insert-entity-button entity)
-           ))
+          ;; (if (mime-view-entity-button-visible-p entity)
+         (mime-view-insert-entity-button entity)
+          ;;   )
+         )
       (when header-is-visible
        (setq nhb (point))
        (if header-presentation-method
@@ -1148,7 +1149,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (define-key mime-view-mode-map
       "\C-c\C-p" (function mime-preview-print-current-entity))
     (define-key mime-view-mode-map
-      "\C-ch" (function mime-preview-toggle-header))
+      "\C-c\C-t\C-h" (function mime-preview-toggle-header))
     (define-key mime-view-mode-map
       "a"        (function mime-preview-follow-current-entity))
     (define-key mime-view-mode-map
@@ -1396,16 +1397,16 @@ button-2        Move to point under the mouse cursor
           (save-excursion
             (goto-char p-end)
             (catch 'tag
-              (let (e)
+              (let (e i)
                 (while (setq e
                              (next-single-property-change
                               (point) 'mime-view-entity))
                   (goto-char e)
                   (let ((rc (mime-entity-node-id
-                             (get-text-property (point)
+                             (get-text-property (1- (point))
                                                 'mime-view-entity))))
-                    (or (equal entity-node-id
-                               (nthcdr (- (length rc) len) rc))
+                    (or (and (>= (setq i (- (length rc) len)) 0)
+                             (equal entity-node-id (nthcdr i rc)))
                         (throw 'tag nil)))
                   (setq p-end e)))
               (setq p-end (point-max))))
@@ -1448,15 +1449,17 @@ It calls following-method selected from variable
   (interactive)
   (let ((entity (mime-preview-find-boundary-info t))
        p-beg p-end
-       ph-end)
+       pb-beg)
     (setq p-beg (aref entity 0)
          p-end (aref entity 1)
          entity (aref entity 2))
-    (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))
+    (if (get-text-property p-beg 'mime-view-entity-body)
+       (setq pb-beg p-beg)
+      (setq pb-beg
+           (next-single-property-change
+            p-beg 'mime-view-entity-body nil
+            (or (next-single-property-change p-beg 'mime-view-entity)
+                p-end))))
     (let* ((mode (mime-preview-original-major-mode 'recursive))
           (entity-node-id (mime-entity-node-id entity))
           (new-name
@@ -1467,10 +1470,8 @@ 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 ph-end p-end)
-       (when (= ph-end p-beg)
-         (goto-char (point-min))
-         (insert ?\n))
+       (insert ?\n)
+       (insert-buffer-substring the-buf pb-beg p-end)
        (goto-char (point-min))
        (let ((current-entity
               (if (and (eq (mime-entity-media-type entity) 'message)
@@ -1479,34 +1480,16 @@ It calls following-method selected from variable
                 entity))
              str)
          (while (and current-entity
-                     (progn
-                       (setq str
-                             (with-current-buffer
-                                 (mime-entity-header-buffer current-entity)
-                               (save-restriction
-                                 (narrow-to-region
-                                  (mime-entity-header-start-point
-                                   current-entity)
-                                  (mime-entity-header-end-point
-                                   current-entity))
-                                 (std11-header-string-except
-                                  (concat
-                                   "^"
-                                   (apply (function regexp-or) fields)
-                                   ":") ""))))
-                       (if (and (eq (mime-entity-media-type
-                                     current-entity) 'message)
-                                (eq (mime-entity-media-subtype
-                                     current-entity) 'rfc822))
-                           nil
-                         (if str
-                             (insert str)
-                           )
-                         t)))
+                     (if (and (eq (mime-entity-media-type
+                                   current-entity) 'message)
+                              (eq (mime-entity-media-subtype
+                                   current-entity) 'rfc822))
+                         nil
+                       (mime-insert-header current-entity fields)
+                       t))
            (setq fields (std11-collect-field-names)
                  current-entity (mime-entity-parent current-entity))
-           )
-         )
+           ))
        (let ((rest mime-view-following-required-fields-list)
              field-name ret)
          (while rest
@@ -1528,7 +1511,6 @@ It calls following-method selected from variable
                    )))
            (setq rest (cdr rest))
            ))
-       (mime-decode-header-in-buffer)
        )
       (let ((f (cdr (assq mode mime-preview-following-method-alist))))
        (if (functionp f)