X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=mime-play.el;h=e3774de3e0e18796138da8d541a28a3047b93c91;hb=c485d80cd354d0bfffa47a9269db284af90903e9;hp=fc55edd29aba79a7bb810b32b00b3a4b58fbb5f1;hpb=3da364256829116ebf3946c2bfb99eccebc8c589;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index fc55edd..e3774de 100644 --- a/mime-play.el +++ b/mime-play.el @@ -43,113 +43,8 @@ If t, it means current directory." :type '(choice (const :tag "Current directory" t) (directory))) -(defvar mime-acting-situation-example-list nil) - -(defvar mime-acting-situation-example-list-max-size 16) - -(defun mime-save-acting-situation-examples () - (let* ((file mime-acting-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") - (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)))) - -(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples) - -(defun mime-reduce-acting-situation-examples () - (let ((len (length mime-acting-situation-example-list)) - i ir ic j jr jc ret - dest d-i d-j - (max-sim 0) sim - min-det-ret det-ret - min-det-org det-org - min-freq freq) - (setq i 0 - ir mime-acting-situation-example-list) - (while (< i len) - (setq ic (car ir) - j 0 - jr mime-acting-situation-example-list) - (while (< j len) - (unless (= i j) - (setq jc (car jr)) - (setq ret (mime-compare-situation-with-example (car ic)(car jc)) - sim (car ret) - det-ret (+ (length (car ic))(length (car jc))) - det-org (length (cdr ret)) - freq (+ (cdr ic)(cdr jc))) - (cond ((< max-sim sim) - (setq max-sim sim - min-det-ret det-ret - min-det-org det-org - min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - ) - ((= max-sim sim) - (cond ((> min-det-ret det-ret) - (setq min-det-ret det-ret - min-det-org det-org - min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - ) - ((= min-det-ret det-ret) - (cond ((> min-det-org det-org) - (setq min-det-org det-org - min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - ) - ((= min-det-org det-org) - (cond ((> min-freq freq) - (setq min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - )) - )) - )) - )) - ) - (setq jr (cdr jr) - j (1+ j))) - (setq ir (cdr ir) - i (1+ i))) - (if (> d-i d-j) - (setq i d-i - d-i d-j - d-j i)) - (setq jr (nthcdr (1- d-j) mime-acting-situation-example-list)) - (setcdr jr (cddr jr)) - (if (= d-i 0) - (setq mime-acting-situation-example-list - (cdr mime-acting-situation-example-list)) - (setq ir (nthcdr (1- d-i) mime-acting-situation-example-list)) - (setcdr ir (cddr ir)) - ) - (if (setq ir (assoc (car dest) mime-acting-situation-example-list)) - (setcdr ir (+ (cdr ir)(cdr dest))) - (setq mime-acting-situation-example-list - (cons dest mime-acting-situation-example-list)) - ))) +(defvar mime-play-find-every-situations t + "*Find every available situations if non-nil.") ;;; @ content decoder @@ -188,64 +83,15 @@ If MODE is specified, play as it. Default MODE is \"play\"." It decodes the entity to call internal or external method. The method is selected from variable `mime-acting-condition'. If MODE is specified, play as it. Default MODE is \"play\"." - (let (method ret) - (in-calist-package 'mime-view) - (setq ret - (mime-delq-null-situation - (ctree-find-calist mime-acting-condition - (mime-entity-situation entity situation) - mime-view-find-every-acting-situation) - 'method ignored-method)) - (or (assq 'ignore-examples situation) - (if (cdr ret) - (let ((rest ret) - (max-score 0) - (max-escore 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-escore (cdar examples) - max-examples (list (cdr ret)) - max-situations (list situation)) - ) - ((= ret-score max-score) - (cond ((> (cdar examples) max-escore) - (setq max-escore (cdar examples) - max-examples (list (cdr ret)) - max-situations (list situation)) - ) - ((= (cdar examples) max-escore) - (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)) - ))))) + (let ((ret + (mime-unify-situations (mime-entity-situation entity situation) + mime-acting-condition + mime-acting-situation-example-list + 'method ignored-method + mime-play-find-every-situations)) + method) + (setq mime-acting-situation-example-list (cdr ret) + ret (car ret)) (cond ((cdr ret) (setq ret (select-menu-alist "Methods" @@ -668,26 +514,4 @@ It is registered to variable `mime-preview-quitting-method-alist'." (provide 'mime-play) -(let* ((file mime-acting-situation-examples-file) - (buffer (get-buffer-create " *mime-example*"))) - (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-acting-situation-example-list) - mime-acting-situation-example-list-max-size) - (< i 16)) - (mime-reduce-acting-situation-examples) - (setq i (1+ i)) - )) - (error (setq mime-acting-situation-example-list nil))) - ) - (kill-buffer buffer)))) - ;;; mime-play.el ends here