X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=aaa53ceecceac851c7e81ef83010e1480542027d;hb=refs%2Fheads%2Fremi-1_14;hp=5ea7d3496bcaaf8e21b8f82f6cf25254d8d70cbe;hpb=d4cf089d014d70e48f041f25f6175327c41eb0b2;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index 5ea7d34..aaa53ce 100644
--- 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
@@ -52,9 +52,6 @@
   "MIME view mode"
   :group 'mime)
 
-(defvar mime-view-find-every-situations t
-  "*Find every available situations if non-nil.")
-
 (defcustom mime-situation-examples-file "~/.mime-example"
   "*File name of situation-examples demonstrated by user."
   :group 'mime-view
@@ -90,27 +87,6 @@ major-mode or t.  t means default.  REPRESENTATION-TYPE must be
 `binary' or `cooked'.")
 
 
-;; (defun mime-raw-find-entity-from-point (point &optional message-info)
-;;   "Return entity from POINT in mime-raw-buffer.
-;; If optional argument MESSAGE-INFO is not specified,
-;; `mime-message-structure' is used."
-;;   (or message-info
-;;       (setq message-info mime-message-structure))
-;;   (if (and (<= (mime-entity-point-min message-info) point)
-;;            (<= point (mime-entity-point-max message-info)))
-;;       (let ((children (mime-entity-children message-info)))
-;;         (catch 'tag
-;;           (while children
-;;             (let ((ret
-;;                    (mime-raw-find-entity-from-point point (car children))))
-;;               (if ret
-;;                   (throw 'tag ret)
-;;                 ))
-;;             (setq children (cdr children)))
-;;           message-info))))
-;; (make-obsolete 'mime-raw-find-entity-from-point "don't use it.")
-
-
 ;;; @ in preview-buffer (presentation space)
 ;;;
 
@@ -224,13 +200,13 @@ mother-buffer."
     situation))
 
 (defsubst mime-delq-null-situation (situations field
-					       &optional ignored-value)
+					       &rest ignored-values)
   (let (dest)
     (while situations
       (let* ((situation (car situations))
 	     (cell (assq field situation)))
 	(if cell
-	    (or (eq (cdr cell) ignored-value)
+	    (or (memq (cdr cell) ignored-values)
 		(setq dest (cons situation dest))
 		)))
       (setq situations (cdr situations)))
@@ -291,14 +267,16 @@ mother-buffer."
 
 (defun mime-unify-situations (entity-situation
 			      condition situation-examples
-			      &optional required-name ignored-value)
+			      &optional required-name ignored-value
+			      every-situations)
   (let (ret)
     (in-calist-package 'mime-view)
     (setq ret
 	  (ctree-find-calist condition entity-situation
-			     mime-view-find-every-situations))
+			     every-situations))
     (if required-name
-	(setq ret (mime-delq-null-situation ret required-name ignored-value)))
+	(setq ret (mime-delq-null-situation ret required-name
+					    ignored-value t)))
     (or (assq 'ignore-examples entity-situation)
 	(if (cdr ret)
 	    (let ((rest ret)
@@ -381,34 +359,37 @@ mother-buffer."
   
 (defvar mime-acting-situation-example-list nil)
 (defvar mime-acting-situation-example-list-max-size 16)
+(defvar mime-situation-examples-file-coding-system nil)
 
 (defun mime-save-situation-examples ()
   (if (or mime-preview-situation-example-list
 	  mime-acting-situation-example-list)
-      (let* ((file mime-situation-examples-file)
-	     (buffer (get-buffer-create " *mime-example*")))
-	(unwind-protect
-	    (save-excursion
-	      (set-buffer buffer)
-	      (setq buffer-file-name file)
-	      (erase-buffer)
-	      (insert ";;; " (file-name-nondirectory file) "\n")
-	      (insert "\n;; This file is generated automatically by "
-		      mime-view-version "\n\n")
-	      (insert ";;; Code:\n\n")
-	      (if mime-preview-situation-example-list
-		  (pp `(setq mime-preview-situation-example-list
-			     ',mime-preview-situation-example-list)
-		      (current-buffer)))
-	      (if mime-acting-situation-example-list
-		  (pp `(setq mime-acting-situation-example-list
-			     ',mime-acting-situation-example-list)
-		      (current-buffer)))
-	      (insert "\n;;; "
-		      (file-name-nondirectory file)
-		      " ends here.\n")
-	      (save-buffer))
-	  (kill-buffer buffer)))))
+      (let ((file mime-situation-examples-file))
+	(with-temp-buffer
+	  (insert ";;; " (file-name-nondirectory file) "\n")
+	  (insert "\n;; This file is generated automatically by "
+		  mime-view-version "\n\n")
+	  (insert ";;; Code:\n\n")
+	  (if mime-preview-situation-example-list
+	      (pp `(setq mime-preview-situation-example-list
+			 ',mime-preview-situation-example-list)
+		  (current-buffer)))
+	  (if mime-acting-situation-example-list
+	      (pp `(setq mime-acting-situation-example-list
+			 ',mime-acting-situation-example-list)
+		  (current-buffer)))
+	  (insert "\n;;; "
+		  (file-name-nondirectory file)
+		  " ends here.\n")
+	  (static-cond
+	   ((boundp 'buffer-file-coding-system)
+	    (setq buffer-file-coding-system
+		  mime-situation-examples-file-coding-system))
+	   ((boundp 'file-coding-system)
+	    (setq file-coding-system
+		  mime-situation-examples-file-coding-system)))
+	  (setq buffer-file-name file)
+	  (save-buffer)))))
 
 (add-hook 'kill-emacs-hook 'mime-save-situation-examples)
 
@@ -707,21 +688,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
@@ -730,7 +722,11 @@ Each elements are regexp of field-name.")
 (defun mime-display-text/plain (entity situation)
   (save-restriction
     (narrow-to-region (point-max)(point-max))
-    (mime-insert-text-content entity)
+    (condition-case nil
+	(mime-insert-text-content entity)
+      (error (progn
+	       (message "Can't decode current entity.")
+	       (sit-for 1))))
     (run-hooks 'mime-text-decode-hook)
     (goto-char (point-max))
     (if (not (eq (char-after (1- (point))) ?\n))
@@ -861,13 +857,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 	    (situation (car situations)))
 	(mime-display-entity child (if (= i p)
 				       situation
-				     (del-alist 'body-presentation-method
-						(copy-alist situation))))
-	)
+				     (put-alist 'body 'invisible
+						(copy-alist situation)))))
       (setq children (cdr children)
 	    situations (cdr situations)
-	    i (1+ i))
-      )))
+	    i (1+ i)))))
 
 
 ;;; @ acting-condition
@@ -993,7 +987,6 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
   (or preview-buffer
       (setq preview-buffer (current-buffer)))
   (let* (e nb ne nhb nbb)
-    (mime-goto-header-start-point entity)
     (in-calist-package 'mime-view)
     (or situation
 	(setq situation
@@ -1006,12 +999,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 	   (eq (cdr (or (assq '*header situation)
 			(assq 'header situation)))
 	       'visible))
-	  (header-presentation-method
-	   (or (cdr (assq 'header-presentation-method situation))
-	       (cdr (assq (cdr (assq 'major-mode situation))
-			  mime-header-presentation-method-alist))))
-	  (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))
@@ -1021,45 +1012,49 @@ 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")
-	)
+      (if header-is-visible
+	  (let ((header-presentation-method
+		 (or (cdr (assq 'header-presentation-method situation))
+		     (cdr (assq (cdr (assq 'major-mode situation))
+				mime-header-presentation-method-alist)))))
+	    (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")))
       (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))))
       )))
 
 
@@ -1148,8 +1143,28 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       "e"        (function mime-preview-extract-current-entity))
     (define-key mime-view-mode-map
       "\C-c\C-p" (function mime-preview-print-current-entity))
+
+    (define-key mime-view-mode-map
+      "\C-c\C-t\C-f" (function mime-preview-toggle-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-th" (function mime-preview-toggle-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-t\C-c" (function mime-preview-toggle-content))
+
+    (define-key mime-view-mode-map
+      "\C-c\C-v\C-f" (function mime-preview-show-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-vh" (function mime-preview-show-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-v\C-c" (function mime-preview-show-content))
+
+    (define-key mime-view-mode-map
+      "\C-c\C-d\C-f" (function mime-preview-hide-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-dh" (function mime-preview-hide-header))
     (define-key mime-view-mode-map
-      "\C-c\C-t\C-h" (function mime-preview-toggle-header))
+      "\C-c\C-d\C-c" (function mime-preview-hide-content))
+
     (define-key mime-view-mode-map
       "a"        (function mime-preview-follow-current-entity))
     (define-key mime-view-mode-map
@@ -1241,9 +1256,7 @@ keymap of MIME-View mode."
 	(setq preview-buffer
 	      (concat "*Preview-" (mime-entity-name message) "*")))
     (or original-major-mode
-	(setq original-major-mode
-	      (with-current-buffer (mime-entity-header-buffer message)
-		major-mode)))
+	(setq original-major-mode major-mode))
     (let ((inhibit-read-only t))
       (set-buffer (get-buffer-create preview-buffer))
       (widen)
@@ -1350,11 +1363,10 @@ button-2	Move to point under the mouse cursor
 	  )
 	(setq mime-message-structure (mime-open-entity type raw-buffer))
 	(or (mime-entity-content-type mime-message-structure)
-	    (mime-entity-set-content-type-internal
-	     mime-message-structure ctl))
+	    (mime-entity-set-content-type mime-message-structure ctl))
 	)
       (or (mime-entity-encoding mime-message-structure)
-	  (mime-entity-set-encoding-internal mime-message-structure encoding))
+	  (mime-entity-set-encoding mime-message-structure encoding))
       ))
   (mime-display-message mime-message-structure preview-buffer
 			mother default-keymap-or-function)
@@ -1364,7 +1376,9 @@ button-2	Move to point under the mouse cursor
 ;;; @@ utility
 ;;;
 
-(defun mime-preview-find-boundary-info (&optional get-mother)
+(defun mime-preview-find-boundary-info (&optional with-children)
+  "Return boundary information of current part.
+If WITH-CHILDREN, refer boundary surrounding current part and its branches."
   (let (entity
 	p-beg p-end
 	entity-node-id len)
@@ -1393,22 +1407,23 @@ button-2	Move to point under the mouse cursor
 	  ((null entity-node-id)
 	   (setq p-end (point-max))
 	   )
-	  (get-mother
+	  (with-children
 	   (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 (1- (point))
+			      (get-text-property (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 (or (next-single-property-change
+				    (point) 'mime-view-entity)
+				   (point-max)))))
 	       (setq p-end (point-max))))
 	   ))
     (vector p-beg p-end entity)))
@@ -1449,15 +1464,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
-	  (next-single-property-change p-beg 'mime-view-entity-header))
-    (if (or (null ph-end)
-	    (> ph-end p-end))
-	(setq ph-end p-end))
+    (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
@@ -1468,46 +1485,25 @@ 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)
 			(eq (mime-entity-media-subtype entity) 'rfc822))
 		   (car (mime-entity-children entity))
-		 entity))
-	      str)
+		 entity)))
 	  (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
@@ -1529,7 +1525,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)
@@ -1713,31 +1708,60 @@ If LINES is negative, scroll up LINES lines."
 ;;; @@ display
 ;;;
 
-(defun mime-preview-toggle-header ()
-  (interactive)
+(defun mime-preview-toggle-display (type &optional display)
   (let ((situation (mime-preview-find-boundary-info))
+	(sym (intern (concat "*" (symbol-name type))))
 	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 '*header situation)))
-      (if (null cell)
-	  (setq cell (assq 'header situation)))
-      (if (eq (cdr cell) 'visible)
-	  (setq situation (put-alist '*header 'invisible situation))
-	(setq situation (put-alist '*header 'visible situation))))
+    (cond ((eq display 'invisible)
+	   (setq display nil))
+	  (display)
+	  (t
+	   (setq display
+		 (eq (cdr (or (assq sym situation)
+			      (assq type situation)))
+		     'invisible))))
+    (setq situation (put-alist sym (if display
+				       'visible
+				     'invisible)
+			       situation))
     (save-excursion
       (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-header (&optional force-visible)
+  (interactive "P")
+  (mime-preview-toggle-display 'header force-visible))
+
+(defun mime-preview-toggle-content (&optional force-visible)
+  (interactive "P")
+  (mime-preview-toggle-display 'body force-visible))
+
+(defun mime-preview-show-header ()
+  (interactive)
+  (mime-preview-toggle-display 'header 'visible))
+
+(defun mime-preview-show-content ()
+  (interactive)
+  (mime-preview-toggle-display 'body 'visible))
+
+(defun mime-preview-hide-header ()
+  (interactive)
+  (mime-preview-toggle-display 'header 'invisible))
+
+(defun mime-preview-hide-content ()
+  (interactive)
+  (mime-preview-toggle-display 'body 'invisible))
+
     
 ;;; @@ quitting
 ;;;
@@ -1764,44 +1788,43 @@ It calls function registered in variable
 
 (provide 'mime-view)
 
-(let* ((file mime-situation-examples-file)
-       (buffer (get-buffer-create " *mime-example*")))
+(let ((file mime-situation-examples-file))
   (if (file-readable-p file)
-      (unwind-protect
-	  (save-excursion
-	    (set-buffer buffer)
-	    (erase-buffer)
-	    (insert-file-contents file)
-	    (eval-buffer)
-	    ;; format check
-	    (condition-case nil
-		(let ((i 0))
-		  (while (and (> (length mime-preview-situation-example-list)
-				 mime-preview-situation-example-list-max-size)
-			      (< i 16))
-		    (setq mime-preview-situation-example-list
-			  (mime-reduce-situation-examples
-			   mime-preview-situation-example-list))
-		    (setq i (1+ i))
-		    ))
-	      (error (setq mime-preview-situation-example-list nil)))
-            ;; (let ((rest mime-preview-situation-example-list))
-            ;;   (while rest
-            ;;     (ctree-set-calist-strictly 'mime-preview-condition
-            ;;                                (caar rest))
-            ;;     (setq rest (cdr rest))))
-	    (condition-case nil
-		(let ((i 0))
-		  (while (and (> (length mime-acting-situation-example-list)
-				 mime-acting-situation-example-list-max-size)
-			      (< i 16))
-		    (setq mime-acting-situation-example-list
-			  (mime-reduce-situation-examples
-			   mime-acting-situation-example-list))
-		    (setq i (1+ i))
-		    ))
-	      (error (setq mime-acting-situation-example-list nil)))
-	    )
-	(kill-buffer buffer))))
+      (with-temp-buffer
+	(insert-file-contents file)
+	(setq mime-situation-examples-file-coding-system
+	      (static-cond
+	       ((boundp 'buffer-file-coding-system)
+		(symbol-value 'buffer-file-coding-system))
+	       ((boundp 'file-coding-system)
+		(symbol-value 'file-coding-system))
+	       (t nil)))
+	(eval-buffer)
+	;; format check
+	(condition-case nil
+	    (let ((i 0))
+	      (while (and (> (length mime-preview-situation-example-list)
+			     mime-preview-situation-example-list-max-size)
+			  (< i 16))
+		(setq mime-preview-situation-example-list
+		      (mime-reduce-situation-examples
+		       mime-preview-situation-example-list))
+		(setq i (1+ i))))
+	  (error (setq mime-preview-situation-example-list nil)))
+	;; (let ((rest mime-preview-situation-example-list))
+	;;   (while rest
+	;;     (ctree-set-calist-strictly 'mime-preview-condition
+	;;                                (caar rest))
+	;;     (setq rest (cdr rest))))
+	(condition-case nil
+	    (let ((i 0))
+	      (while (and (> (length mime-acting-situation-example-list)
+			     mime-acting-situation-example-list-max-size)
+			  (< i 16))
+		(setq mime-acting-situation-example-list
+		      (mime-reduce-situation-examples
+		       mime-acting-situation-example-list))
+		(setq i (1+ i))))
+	  (error (setq mime-acting-situation-example-list nil))))))
 
 ;;; mime-view.el ends here