From f4e6f0b3fd6fe905e88db8a05bc56af4d1ac26e8 Mon Sep 17 00:00:00 2001 From: morioka Date: Tue, 7 Jul 1998 22:25:44 +0000 Subject: [PATCH] (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'. --- mime-play.el | 96 +++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 71 insertions(+), 25 deletions(-) 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)))) -- 1.7.10.4