(mime-acting-situation-example-list): New variable; abolish
authormorioka <morioka>
Tue, 7 Jul 1998 22:25:44 +0000 (22:25 +0000)
committermorioka <morioka>
Tue, 7 Jul 1998 22:25:44 +0000 (22:25 +0000)
`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'.

mime-play.el

index 221920f..57ea22a 100644 (file)
@@ -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))))