From: morioka <morioka>
Date: Tue, 7 Jul 1998 22:25:44 +0000 (+0000)
Subject: (mime-acting-situation-example-list): New variable; abolish
X-Git-Tag: remi-1_8_2~2
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f4e6f0b3fd6fe905e88db8a05bc56af4d1ac26e8;p=elisp%2Fsemi.git

(mime-acting-situation-example-list): New variable; abolish
`mime-acting-situation-examples'.
(mime-save-acting-situation-examples): Modify for
`mime-acting-situation-example-list'.
(mime-compare-situation-with-example): New function.
(mime-raw-play-entity): Change algorithm to compare with
acting-situation-examples.
(mime-store-message/partial-piece): Use `mime-view-buffer' instead of
`mime-view-mode'.
---

diff --git a/mime-play.el b/mime-play.el
index 221920f..57ea22a 100644
--- a/mime-play.el
+++ b/mime-play.el
@@ -37,7 +37,7 @@
     (error (defvar bbdb-buffer-name nil)))
   )
 
-(defvar mime-acting-situation-examples nil)
+(defvar mime-acting-situation-example-list nil)
 
 (defun mime-save-acting-situation-examples ()
   (let* ((file mime-acting-situation-examples-file)
@@ -51,8 +51,8 @@
           (insert "\n;; This file is generated automatically by "
                   mime-view-version-string "\n\n")
 	  (insert ";;; Code:\n\n")
-	  (pp `(setq mime-acting-situation-examples
-		     ',mime-acting-situation-examples)
+	  (pp `(setq mime-acting-situation-example-list
+		     ',mime-acting-situation-example-list)
 	      (current-buffer))
 	  (insert "\n;;; "
                   (file-name-nondirectory file)
@@ -131,6 +131,24 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
       (setq situations (cdr situations)))
     dest))
 
+(defun mime-compare-situation-with-example (situation example)
+  (let ((example (copy-alist example))
+	(match 0))
+    (while situation
+      (let* ((cell (car situation))
+	     (key (car cell))
+	     (ecell (assoc key example)))
+	(when ecell
+	  (if (equal cell ecell)
+	      (setq match (1+ match))
+	    (setq example (delq ecell example))
+	    ))
+	)
+      (setq situation (cdr situation))
+      )
+    (cons match example)
+    ))
+
 (defun mime-raw-play-entity (entity &optional mode situation)
   "Play entity specified by ENTITY.
 It decodes the entity to call internal or external method.  The method
@@ -143,20 +161,49 @@ specified, play as it.  Default MODE is \"play\"."
 	(setq situation (cons (cons 'mode mode) situation))
       )
     (setq ret
-	  (or (ctree-match-calist mime-acting-situation-examples situation)
-	      (ctree-match-calist-partially mime-acting-situation-examples
-					    situation)
-	      situation))
-    (setq ret
-	  (or (mime-delq-null-situation
-	       (ctree-find-calist mime-acting-condition ret
-				  mime-view-find-every-acting-situation)
-	       'method)
-	      (mime-delq-null-situation
-	       (ctree-find-calist mime-acting-condition situation
-				  mime-view-find-every-acting-situation)
-	       'method)
-	      ))
+	  (mime-delq-null-situation
+	   (ctree-find-calist mime-acting-condition situation
+			      mime-view-find-every-acting-situation)
+	   'method))
+    (if (cdr ret)
+	(let ((rest ret)
+	      (max-score 0)
+	      max-examples
+	      max-situations)
+	  (while rest
+	    (let ((situation (car rest))
+		  (examples mime-acting-situation-example-list))
+	      (while examples
+		(let* ((ret
+			(mime-compare-situation-with-example situation
+							     (caar examples)))
+		       (ret-score (car ret)))
+		  (cond ((> ret-score max-score)
+			 (setq max-score ret-score
+			       max-examples (list (cdr ret))
+			       max-situations (list situation))
+			 )
+			((= ret-score max-score)
+			 (setq max-examples (cons (cdr ret) max-examples))
+			 (or (member situation max-situations)
+			     (setq max-situations
+				   (cons situation max-situations)))
+			 )))
+		(setq examples (cdr examples))))
+	    (setq rest (cdr rest)))
+	  (when max-situations
+	    (setq ret max-situations)
+	    (while max-examples
+	      (let* ((example (car max-examples))
+		     (cell (assoc example mime-acting-situation-example-list)))
+		(if cell
+		    (setcdr cell (1+ (cdr cell)))
+		  (setq mime-acting-situation-example-list
+			(cons (cons example 0)
+			      mime-acting-situation-example-list))
+		  ))
+	      (setq max-examples (cdr max-examples))
+	      ))))
     (cond ((cdr ret)
 	   (setq ret (select-menu-alist
 		      "Methods"
@@ -168,7 +215,7 @@ specified, play as it.  Default MODE is \"play\"."
 				  situation)))
 			      ret)))
 	   (setq ret (mime-sort-situation ret))
-	   (ctree-set-calist-strictly 'mime-acting-situation-examples ret)
+	   (add-to-list 'mime-acting-situation-example-list (cons ret 0))
 	   )
 	  (t
 	   (setq ret (car ret))
@@ -382,7 +429,7 @@ SUBTYPE is symbol to indicate subtype of media-type.")
 	     entity "play"
 	     (put-alist 'type type
 			(put-alist 'subtype subtype
-				   (mime-entity-situation entity))))
+				   (copy-alist situation))))
 	  ))
       )))
 
@@ -452,7 +499,7 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 	    (erase-buffer)
 	    (as-binary-input-file (insert-file-contents file))
 	    (setq major-mode 'mime-show-message-mode)
-	    (mime-view-mode mother)
+	    (mime-view-buffer (current-buffer) nil mother)
 	    )
 	  (set-window-buffer pwin
 			     (save-excursion
@@ -522,11 +569,10 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 		       ))
 		(save-window-excursion
 		  (setq major-mode 'mime-show-message-mode)
-		  (mime-view-mode mother)
+		  (mime-view-buffer (current-buffer) nil mother)
 		  )
 		(let ((pwin (or (get-buffer-window mother)
-				(get-largest-window)
-				))
+				(get-largest-window)))
 		      (pbuf (save-excursion
 			      (set-buffer full-buf)
 			      mime-preview-buffer)))
@@ -611,8 +657,8 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 	    (insert-file-contents file)
 	    (eval-buffer)
 	    ;; format check
-	    (or (eq (car mime-acting-situation-examples) 'type)
-		(setq mime-acting-situation-examples nil))
+	    (or (consp (car (car mime-acting-situation-example-list)))
+		(setq mime-acting-situation-example-list nil))
 	    )
 	(kill-buffer buffer))))