X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=b4a03a292fc4a09bb8981845864c596a2fdf4d3f;hb=86bbd8d3d04a7b9b8a4d16f4c55a00348b025912;hp=6c00a38056fc376eafc3d13940925366ab36e410;hpb=b8ef6e104e0887fc6ecacc5b9516751fbd274bff;p=elisp%2Fsemi.git

diff --git a/mime-play.el b/mime-play.el
index 6c00a38..b4a03a2 100644
--- a/mime-play.el
+++ b/mime-play.el
@@ -64,56 +64,91 @@
 (add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
 
 (defun mime-reduce-acting-situation-examples ()
-  (let* ((rest mime-acting-situation-example-list)
-	 (min-example (car rest))
-	 (min-score (cdr min-example)))
-    (while rest
-      (let* ((example (car rest))
-	     (score (cdr example)))
-	(cond ((< score min-score)
-	       (setq min-score score
-		     min-example example)
-	       )
-	      ((= score min-score)
-	       (if (<= (length (car example))(length (car min-example)))
-		   (setq min-example example)
-		 ))
-	      ))
-      (setq rest (cdr rest)))
-    (setq mime-acting-situation-example-list
-	  (delq min-example mime-acting-situation-example-list))
-    (setq min-example (car min-example))
-    (let ((examples mime-acting-situation-example-list)
-	  (max-score 0)
-	  max-examples)
-      (while examples
-	(let* ((ret (mime-compare-situation-with-example min-example
-							 (caar examples)))
-	       (ret-score (car ret)))
-	  (cond ((> ret-score max-score)
-		 (setq max-score ret-score
-		       max-examples (list (cdr ret)))
+  (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))
 		 )
-		((= ret-score max-score)
-		 (setq max-examples (cons (cdr ret) max-examples))
-		 )))
-	(setq examples (cdr examples)))
-      (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))
-	))))
+		((= 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))
+      )))
 
 
 ;;; @ content decoder
 ;;;
 
+;;;###autoload
 (defun mime-preview-play-current-entity (&optional ignore-examples mode)
   "Play current entity.
 It decodes current entity to call internal or external method.  The
@@ -124,7 +159,15 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
   (interactive "P")
   (let ((entity (get-text-property (point) 'mime-view-entity)))
     (if entity
-	(let ((situation (list (cons 'mode (or mode "play")))))
+	(let ((situation
+	       (get-text-property (point) 'mime-view-situation)))
+	  (or mode
+	      (setq mode "play"))
+	  (setq situation 
+		(if (assq 'mode situation)
+		    (put-alist 'mode mode (copy-alist situation))
+		  (cons (cons 'mode mode)
+			situation)))
 	  (if ignore-examples
 	      (setq situation
 		    (cons (cons 'ignore-examples ignore-examples)
@@ -198,12 +241,14 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
     (cons match example)
     ))
 
+;;;###autoload
 (defun mime-play-entity (entity &optional situation ignored-method)
   "Play entity specified by ENTITY.
 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
@@ -289,7 +334,11 @@ specified, play as it.  Default MODE is \"play\"."
           ;;  )
 	  (t
 	   (mime-show-echo-buffer "No method are specified for %s\n"
-				  (mime-entity-type/subtype entity))
+				  (mime-type/subtype-string
+				   (cdr (assq 'type situation))
+				   (cdr (assq 'subtype situation))))
+	   (if (y-or-n-p "Do you want to save current entity to disk?")
+	       (mime-save-content entity situation))
 	   ))
     ))
 
@@ -370,8 +419,9 @@ window.")
     (select-window win)
     (goto-char (point-max))
     (if forms
-	(insert (apply (function format) forms))
-      )
+	(let ((buffer-read-only nil))
+	  (insert (apply (function format) forms))
+	  ))
     (select-window the-win)
     ))
 
@@ -393,8 +443,8 @@ window.")
   (let ((filename
 	 (or (mime-entity-filename entity)
 	     (let ((subj
-		    (or (mime-read-field 'Content-Description entity)
-			(mime-read-field 'Subject entity))))
+		    (or (mime-entity-read-field entity 'Content-Description)
+			(mime-entity-read-field entity 'Subject))))
 	       (if (and subj
 			(or (string-match mime-view-file-name-regexp-1 subj)
 			    (string-match mime-view-file-name-regexp-2 subj)))
@@ -463,16 +513,14 @@ SUBTYPE is symbol to indicate subtype of media-type.")
 			  )
 		      t)))
 	(setq rest (cdr rest))))
-    (if type
-	(mime-play-entity
-	 entity
-	 (put-alist 'type type
-		    (put-alist 'subtype subtype
-			       (del-alist 'method
-					  (copy-alist situation))))
-	 'mime-detect-content)
-      ))
-  )
+    (setq situation (del-alist 'method (copy-alist situation)))
+    (mime-play-entity entity
+		      (if type
+			  (put-alist 'type type
+				     (put-alist 'subtype subtype
+						situation))
+			situation)
+		      'mime-detect-content)))
 
 
 ;;; @ mail/news message
@@ -481,10 +529,11 @@ SUBTYPE is symbol to indicate subtype of media-type.")
 (defun mime-preview-quitting-method-for-mime-show-message-mode ()
   "Quitting method for mime-view.
 It is registered to variable `mime-preview-quitting-method-alist'."
-  (let ((mother mime-mother-buffer)
-	(win-conf mime-preview-original-window-configuration)
-	)
-    (kill-buffer mime-raw-buffer)
+  (let ((raw-buffer (mime-entity-buffer
+		     (get-text-property (point-min) 'mime-view-entity)))
+	(mother mime-mother-buffer)
+	(win-conf mime-preview-original-window-configuration))
+    (kill-buffer raw-buffer)
     (mime-preview-kill-buffer)
     (set-window-configuration win-conf)
     (pop-to-buffer mother)
@@ -494,22 +543,24 @@ It is registered to variable `mime-preview-quitting-method-alist'."
   (let* ((new-name
 	  (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 	 (mother (current-buffer))
-	 (children (car (mime-entity-children entity))))
-    (set-buffer (get-buffer-create new-name))
-    (erase-buffer)
-    (mime-insert-entity children)
-    (setq mime-message-structure children)
-    (setq major-mode 'mime-show-message-mode)
-    (mime-view-buffer (current-buffer) nil mother
-		      nil (if (mime-entity-cooked-p entity) 'cooked))
-    ))
+	 (children (car (mime-entity-children entity)))
+	 (preview-buffer
+	  (mime-display-message
+	   children new-name mother nil
+	   (cdr (assq 'major-mode
+		      (get-text-property (point) 'mime-view-situation))))))
+    (or (get-buffer-window preview-buffer)
+	(let ((m-win (get-buffer-window mother)))
+	  (if m-win
+	      (set-window-buffer m-win preview-buffer)
+	    (switch-to-buffer preview-buffer)
+	    )))))
 
 
 ;;; @ message/partial
 ;;;
 
 (defun mime-store-message/partial-piece (entity cal)
-  (goto-char (mime-entity-point-min entity))
   (let* ((root-dir
 	  (expand-file-name
 	   (concat "m-prts-" (user-login-name)) temporary-file-directory))
@@ -517,33 +568,28 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 	 (number (cdr (assoc "number" cal)))
 	 (total (cdr (assoc "total" cal)))
 	 file
-	 (mother mime-preview-buffer)
-	 )
+	 (mother (current-buffer)))
     (or (file-exists-p root-dir)
-	(make-directory root-dir)
-	)
+	(make-directory root-dir))
     (setq id (replace-as-filename id))
     (setq root-dir (concat root-dir "/" id))
     (or (file-exists-p root-dir)
-	(make-directory root-dir)
-	)
+	(make-directory root-dir))
     (setq file (concat root-dir "/FULL"))
     (if (file-exists-p file)
 	(let ((full-buf (get-buffer-create "FULL"))
 	      (pwin (or (get-buffer-window mother)
 			(get-largest-window)))
-	      )
+	      pbuf)
 	  (save-window-excursion
 	    (set-buffer full-buf)
 	    (erase-buffer)
 	    (as-binary-input-file (insert-file-contents file))
 	    (setq major-mode 'mime-show-message-mode)
 	    (mime-view-buffer (current-buffer) nil mother)
+	    (setq pbuf (current-buffer))
 	    )
-	  (set-window-buffer pwin
-			     (save-excursion
-			       (set-buffer full-buf)
-			       mime-preview-buffer))
+	  (set-window-buffer pwin pbuf)
 	  (select-window pwin)
 	  )
       (setq file (concat root-dir "/" number))
@@ -575,7 +621,9 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 			 (kill-buffer (current-buffer))
 			 )))
 		)))
-      (if (and total (> total 0))
+      (if (and total (> total 0)
+	       (>= (length (directory-files root-dir nil "^[0-9]+$" t))
+		   total))
 	  (catch 'tag
 	    (save-excursion
 	      (set-buffer (get-buffer-create mime-temp-buffer-name))
@@ -606,15 +654,11 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 		  (and (file-exists-p file)
 		       (delete-file file)
 		       ))
-		(save-window-excursion
-		  (setq major-mode 'mime-show-message-mode)
-		  (mime-view-buffer (current-buffer) nil mother)
-		  )
 		(let ((pwin (or (get-buffer-window mother)
 				(get-largest-window)))
-		      (pbuf (save-excursion
-			      (set-buffer full-buf)
-			      mime-preview-buffer)))
+		      (pbuf (mime-display-message
+			     (mime-open-entity 'buffer (current-buffer))
+			     nil mother nil 'mime-show-message-mode)))
 		  (set-window-buffer pwin pbuf)
 		  (select-window pwin)
 		  )))))