(mime-view-define-keymap): Add new binding `mime-preview-toggle-body'

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

diff --git a/mime-view.el b/mime-view.el
index 7b6c0fc..5f08648 100644 (file)
--- a/mime-view.el
+++ b/mime-view.el
@@ -1,6 +1,6 @@
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 
-;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1994/07/13
@@ -686,21 +686,32 @@ Each elements are regexp of field-name.")
    (body-presentation-method . mime-display-multipart/alternative)))
 
 (ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . partial)
-                          (body-presentation-method
-                           . mime-display-message/partial-button)))
+ 'mime-preview-condition
+ '((type . multipart)(subtype . t)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . partial)
+   (body . visible)
+   (body-presentation-method . mime-display-message/partial-button)))
 
 (ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . rfc822)
-                          (body-presentation-method . nil)
-                          (childrens-situation (header . visible)
-                                               (entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . rfc822)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)
+   (childrens-situation (header . visible)
+                       (entity-button . invisible))))
 
 (ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . news)
-                          (body-presentation-method . nil)
-                          (childrens-situation (header . visible)
-                                               (entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . news)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)
+   (childrens-situation (header . visible)
+                       (entity-button . invisible))))
 
 
 ;;; @@@ entity presentation
@@ -984,8 +995,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
           (eq (cdr (or (assq '*header situation)
                        (assq 'header situation)))
               'visible))
-         (body-presentation-method
-          (cdr (assq 'body-presentation-method situation)))
+         (body-is-visible
+          (eq (cdr (or (assq '*body situation)
+                       (assq 'body situation)))
+              'visible))
          (children (mime-entity-children entity)))
       (set-buffer preview-buffer)
       (setq nb (point))
@@ -1011,32 +1024,33 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
            (goto-char (point-max))
            (insert "\n")))
       (setq nbb (point))
-      (cond (children)
-            ((functionp body-presentation-method)
-            (funcall body-presentation-method entity situation)
-            )
-           (t
-            (when button-is-invisible
-              (goto-char (point-max))
-              (mime-view-insert-entity-button entity)
-              )
-            (or header-is-visible
-                (progn
-                  (goto-char (point-max))
-                  (insert "\n")
-                  ))
-            ))
+      (unless children
+       (if body-is-visible
+           (let ((body-presentation-method
+                  (cdr (assq 'body-presentation-method situation))))
+             (if (functionp body-presentation-method)
+                 (funcall body-presentation-method entity situation)
+               (mime-display-text/plain entity situation)))
+         (when button-is-invisible
+           (goto-char (point-max))
+           (mime-view-insert-entity-button entity)
+           )
+         (unless header-is-visible
+           (goto-char (point-max))
+           (insert "\n"))
+         ))
       (setq ne (point-max))
       (widen)
       (put-text-property nb ne 'mime-view-entity entity)
       (put-text-property nb ne 'mime-view-situation situation)
       (put-text-property nbb ne 'mime-view-entity-body entity)
       (goto-char ne)
-      (if children
-         (if (functionp body-presentation-method)
-             (funcall body-presentation-method entity situation)
-           (mime-display-multipart/mixed entity situation)
-           ))
+      (if (and children body-is-visible)
+         (let ((body-presentation-method
+                (cdr (assq 'body-presentation-method situation))))
+           (if (functionp body-presentation-method)
+               (funcall body-presentation-method entity situation)
+             (mime-display-multipart/mixed entity situation))))
       )))
 
 
@@ -1128,6 +1142,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (define-key mime-view-mode-map
       "\C-c\C-t\C-h" (function mime-preview-toggle-header))
     (define-key mime-view-mode-map
+      "\C-c\C-t\C-b" (function mime-preview-toggle-body))
+    (define-key mime-view-mode-map
       "a"        (function mime-preview-follow-current-entity))
     (define-key mime-view-mode-map
       "q"        (function mime-preview-quit))
@@ -1687,7 +1703,31 @@ If LINES is negative, scroll up LINES lines."
       (let ((inhibit-read-only t))
        (delete-region p-beg p-end)
        (mime-display-entity entity situation)))
-    ;; (ctree-set-calist-strictly 'mime-preview-condition situation)
+    (let ((ret (assoc situation mime-preview-situation-example-list)))
+      (if ret
+         (setcdr ret (1+ (cdr ret)))
+       (add-to-list 'mime-preview-situation-example-list
+                    (cons situation 0))))))
+
+(defun mime-preview-toggle-body ()
+  (interactive)
+  (let ((situation (mime-preview-find-boundary-info))
+       entity p-beg p-end)
+    (setq p-beg (aref situation 0)
+         p-end (aref situation 1)
+         entity (aref situation 2)
+         situation (get-text-property p-beg 'mime-view-situation))
+    (let ((cell (assq '*body situation)))
+      (if (null cell)
+         (setq cell (assq 'body situation)))
+      (if (eq (cdr cell) 'visible)
+         (setq situation (put-alist '*body 'invisible situation))
+       (setq situation (put-alist '*body 'visible situation))))
+    (save-excursion
+      (let ((inhibit-read-only t))
+       (delete-region p-beg p-end)
+       (mime-display-entity entity situation)
+       ))
     (let ((ret (assoc situation mime-preview-situation-example-list)))
       (if ret
          (setcdr ret (1+ (cdr ret)))