X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=a476a05bac74e6f58fe4dc5c70becbaa532b34be;hb=de4ec97d1f570a28961107041a0aae9d3e5dac2d;hp=fc55edd29aba79a7bb810b32b00b3a4b58fbb5f1;hpb=3da364256829116ebf3946c2bfb99eccebc8c589;p=elisp%2Fsemi.git

diff --git a/mime-play.el b/mime-play.el
index fc55edd..a476a05 100644
--- a/mime-play.el
+++ b/mime-play.el
@@ -33,8 +33,7 @@
 (eval-when-compile
   (condition-case nil
       (require 'bbdb)
-    (error (defvar bbdb-buffer-name nil)))
-  )
+    (error (defvar bbdb-buffer-name nil))))
 
 (defcustom mime-save-directory "~/"
   "*Name of the directory where MIME entity will be saved in.
@@ -43,113 +42,11 @@ 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.")
+
+(defvar mime-play-messages-coding-system nil
+  "Coding system to be used for external MIME playback method.")
 
 
 ;;; @ content decoder
@@ -179,8 +76,7 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
 	      (setq situation
 		    (cons (cons 'ignore-examples ignore-examples)
 			  situation)))
-	  (mime-play-entity entity situation)
-	  ))))
+	  (mime-play-entity entity situation)))))
 
 ;;;###autoload
 (defun mime-play-entity (entity &optional situation ignored-method)
@@ -188,88 +84,34 @@ 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 menu)
+    (setq mime-acting-situation-example-list (cdr ret)
+	  ret (car ret))
     (cond ((cdr ret)
-	   (setq ret (select-menu-alist
-		      "Methods"
-		      (mapcar (function
-			       (lambda (situation)
-				 (cons
-				  (format "%s"
-					  (cdr (assq 'method situation)))
-				  situation)))
-			      ret)))
-	   (setq ret (mime-sort-situation ret))
-	   (add-to-list 'mime-acting-situation-example-list (cons ret 0))
-	   )
+	   (while ret
+	     (or (vassoc (setq method
+			       (format "%s"
+				       (cdr (assq 'method (pop ret)))))
+			 menu)
+		 (push (vector method situation t) menu)))
+	   (setq ret (mime-sort-situation
+		      (mime-menu-select "Play entity with: "
+					(cons "Methods" menu))))
+	   (add-to-list 'mime-acting-situation-example-list (cons ret 0)))
 	  (t
-	   (setq ret (car ret))
-	   ))
+	   (setq ret (car ret))))
     (setq method (cdr (assq 'method ret)))
     (cond ((and (symbolp method)
 		(fboundp method))
-	   (funcall method entity ret)
-	   )
+	   (funcall method entity ret))
 	  ((stringp method)
-	   (mime-activate-mailcap-method entity ret)
-	   )
+	   (mime-activate-mailcap-method entity ret))
           ;; ((and (listp method)(stringp (car method)))
           ;;  (mime-activate-external-method entity ret)
           ;;  )
@@ -279,9 +121,7 @@ specified, play as it.  Default MODE is \"play\"."
 				   (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))
-	   ))
-    ))
+	       (mime-save-content entity situation))))))
 
 
 ;;; @ external decoder
@@ -296,28 +136,25 @@ specified, play as it.  Default MODE is \"play\"."
 	  (if (and name (not (string= name "")))
 	      (expand-file-name name temporary-file-directory)
 	    (make-temp-name
-	     (expand-file-name "EMI" temporary-file-directory))
-	    ))
+	     (expand-file-name "EMI" temporary-file-directory))))
     (mime-write-entity-content entity name)
     (message "External method is starting...")
     (let ((process
 	   (let ((command
-		  (mailcap-format-command
+		  (mime-format-mailcap-command
 		   method
 		   (cons (cons 'filename name) situation))))
-	     (start-process command mime-echo-buffer-name
-			    shell-file-name shell-command-switch command)
-	     )))
+	     (binary-to-text-funcall
+	      mime-play-messages-coding-system
+	      #'start-process command mime-echo-buffer-name
+	      shell-file-name shell-command-switch command))))
       (set-alist 'mime-mailcap-method-filename-alist process name)
-      (set-process-sentinel process 'mime-mailcap-method-sentinel)
-      )
-    ))
+      (set-process-sentinel process 'mime-mailcap-method-sentinel))))
 
 (defun mime-mailcap-method-sentinel (process event)
   (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
     (if (file-exists-p file)
-	(delete-file file)
-      ))
+	(delete-file file)))
   (remove-alist 'mime-mailcap-method-filename-alist process)
   (message (format "%s %s" process event)))
 
@@ -328,8 +165,7 @@ specified, play as it.  Default MODE is \"play\"."
 (defvar mime-echo-window-height
   (function
    (lambda ()
-     (/ (window-height) 5)
-     ))
+     (/ (window-height) 5)))
   "*Size of mime-echo window.
 It allows function or integer.  If it is function,
 `mime-show-echo-buffer' calls it to get height of mime-echo window.
@@ -352,19 +188,14 @@ window.")
 		   (- (window-height)
 		      (if (functionp mime-echo-window-height)
 			  (funcall mime-echo-window-height)
-			mime-echo-window-height)
-		      )))
-	)
-      (set-window-buffer win mime-echo-buffer-name)
-      )
+			mime-echo-window-height)))))
+      (set-window-buffer win mime-echo-buffer-name))
     (select-window win)
     (goto-char (point-max))
     (if forms
 	(let ((buffer-read-only nil))
-	  (insert (apply (function format) forms))
-	  ))
-    (select-window the-win)
-    ))
+	  (insert (apply (function format) forms))))
+    (select-window the-win)))
 
 
 ;;; @ file name
@@ -389,11 +220,9 @@ window.")
 	       (if (and subj
 			(or (string-match mime-view-file-name-regexp-1 subj)
 			    (string-match mime-view-file-name-regexp-2 subj)))
-		   (substring subj (match-beginning 0)(match-end 0))
-		 )))))
+		   (substring subj (match-beginning 0)(match-end 0)))))))
     (if filename
-	(replace-as-filename filename)
-      )))
+	(replace-as-filename filename))))
 
 
 ;;; @ file extraction
@@ -418,8 +247,7 @@ window.")
     (if (file-exists-p filename)
 	(or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
 	    (error "")))
-    (mime-write-entity-content entity (expand-file-name filename))
-    ))
+    (mime-write-entity-content entity (expand-file-name filename))))
 
 
 ;;; @ file detection
@@ -432,8 +260,7 @@ window.")
     ("^II\\*\000"			image tiff)
     ("^MM\000\\*"			image tiff)
     ("^MThd"				audio midi)
-    ("^\000\000\001\263"		video mpeg)
-    )
+    ("^\000\000\001\263"		video mpeg))
   "*Alist of regexp about magic-number vs. corresponding media-types.
 Each element looks like (REGEXP TYPE SUBTYPE).
 REGEXP is a regular expression to match against the beginning of the
@@ -449,8 +276,7 @@ SUBTYPE is symbol to indicate subtype of media-type.")
 		    (if cell
 			(if (string-match (car cell) mdata)
 			    (setq type (nth 1 cell)
-				  subtype (nth 2 cell))
-			  )
+				  subtype (nth 2 cell)))
 		      t)))
 	(setq rest (cdr rest))))
     (setq situation (del-alist 'method (copy-alist situation)))
@@ -469,15 +295,14 @@ 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 ((raw-buffer (mime-entity-buffer
-		     (get-text-property (point-min) 'mime-view-entity)))
-	(mother mime-mother-buffer)
+  (let ((mother mime-mother-buffer)
 	(win-conf mime-preview-original-window-configuration))
-    (kill-buffer raw-buffer)
+    (if (and (boundp 'mime-view-temp-message-buffer)
+	     (buffer-live-p mime-view-temp-message-buffer))
+	(kill-buffer mime-view-temp-message-buffer))
     (mime-preview-kill-buffer)
     (set-window-configuration win-conf)
-    (pop-to-buffer mother)
-    ))
+    (pop-to-buffer mother)))
 
 (defun mime-view-message/rfc822 (entity situation)
   (let* ((new-name
@@ -493,8 +318,7 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 	(let ((m-win (get-buffer-window mother)))
 	  (if m-win
 	      (set-window-buffer m-win preview-buffer)
-	    (switch-to-buffer preview-buffer)
-	    )))))
+	    (switch-to-buffer preview-buffer))))))
 
 
 ;;; @ message/partial
@@ -524,14 +348,14 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 	  (save-window-excursion
 	    (set-buffer full-buf)
 	    (erase-buffer)
-	    (as-binary-input-file (insert-file-contents file))
+	    (binary-insert-encoded-file file)
 	    (setq major-mode 'mime-show-message-mode)
 	    (mime-view-buffer (current-buffer) nil mother)
 	    (setq pbuf (current-buffer))
-	    )
+	    (make-local-variable 'mime-view-temp-message-buffer)
+	    (setq mime-view-temp-message-buffer full-buf))
 	  (set-window-buffer pwin pbuf)
-	  (select-window pwin)
-	  )
+	  (select-window pwin))
       (setq file (concat root-dir "/" number))
       (mime-write-entity-body entity file)
       (let ((total-file (concat root-dir "/CT")))
@@ -545,10 +369,8 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 			  (erase-buffer)
 			  (insert total)
 			  (write-region (point-min)(point-max) total-file)
-			  (kill-buffer (current-buffer))
-			  ))
-		    (string-to-number total)
-		    )
+			  (kill-buffer (current-buffer))))
+		    (string-to-number total))
 		(and (file-exists-p total-file)
 		     (save-excursion
 		       (set-buffer (find-file-noselect total-file))
@@ -556,11 +378,8 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 			   (and (re-search-forward "[0-9]+" nil t)
 				(string-to-number
 				 (buffer-substring (match-beginning 0)
-						   (match-end 0)))
-				)
-			 (kill-buffer (current-buffer))
-			 )))
-		)))
+						   (match-end 0))))
+			 (kill-buffer (current-buffer))))))))
       (if (and total (> total 0)
 	       (>= (length (directory-files root-dir nil "^[0-9]+$" t))
 		   total))
@@ -573,36 +392,33 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 		  (while (<= i total)
 		    (setq file (concat root-dir "/" (int-to-string i)))
 		    (or (file-exists-p file)
-			(throw 'tag nil)
-			)
-		    (as-binary-input-file (insert-file-contents file))
+			(throw 'tag nil))
+		    (binary-insert-encoded-file file)
 		    (goto-char (point-max))
-		    (setq i (1+ i))
-		    ))
-		(as-binary-output-file
-		 (write-region (point-min)(point-max)
-			       (expand-file-name "FULL" root-dir)))
+		    (setq i (1+ i))))
+		(binary-write-decoded-region
+		 (point-min)(point-max)
+		 (expand-file-name "FULL" root-dir))
 		(let ((i 1))
 		  (while (<= i total)
 		    (let ((file (format "%s/%d" root-dir i)))
 		      (and (file-exists-p file)
-			   (delete-file file)
-			   ))
-		    (setq i (1+ i))
-		    ))
+			   (delete-file file)))
+		    (setq i (1+ i))))
 		(let ((file (expand-file-name "CT" root-dir)))
 		  (and (file-exists-p file)
-		       (delete-file file)
-		       ))
-		(let ((pwin (or (get-buffer-window mother)
+		       (delete-file file)))
+		(let ((buf (current-buffer))
+		      (pwin (or (get-buffer-window mother)
 				(get-largest-window)))
 		      (pbuf (mime-display-message
 			     (mime-open-entity 'buffer (current-buffer))
 			     nil mother nil 'mime-show-message-mode)))
+		  (with-current-buffer pbuf
+		    (make-local-variable 'mime-view-temp-message-buffer)
+		    (setq mime-view-temp-message-buffer buf))
 		  (set-window-buffer pwin pbuf)
-		  (select-window pwin)
-		  )))))
-      )))
+		  (select-window pwin)))))))))
 
 
 ;;; @ message/external-body
@@ -611,15 +427,13 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 (defvar mime-raw-dired-function
   (if (and (>= emacs-major-version 19) window-system)
       (function dired-other-frame)
-    (function mime-raw-dired-function-for-one-frame)
-    ))
+    (function mime-raw-dired-function-for-one-frame)))
 
 (defun mime-raw-dired-function-for-one-frame (dir)
   (let ((win (or (get-buffer-window mime-preview-buffer)
 		 (get-largest-window))))
     (select-window win)
-    (dired dir)
-    ))
+    (dired dir)))
 
 (defun mime-view-message/external-anon-ftp (entity cal)
   (let* ((site (cdr (assoc "site" cal)))
@@ -629,8 +443,7 @@ It is registered to variable `mime-preview-quitting-method-alist'."
     (message (concat "Accessing " (expand-file-name name pathname) " ..."))
     (funcall mime-raw-dired-function pathname)
     (goto-char (point-min))
-    (search-forward name)
-    ))
+    (search-forward name)))
 
 (defvar mime-raw-browse-url-function mime-browse-url-function)
 
@@ -652,15 +465,12 @@ It is registered to variable `mime-preview-quitting-method-alist'."
       (erase-buffer)
       (mime-insert-text-content entity)
       (mule-caesar-region (point-min) (point-max))
-      (set-buffer-modified-p nil)
-      )
+      (set-buffer-modified-p nil))
     (let ((win (get-buffer-window (current-buffer))))
       (or (eq (selected-window) win)
-	  (select-window (or win (get-largest-window)))
-	  ))
+	  (select-window (or win (get-largest-window)))))
     (view-buffer buf)
-    (goto-char (point-min))
-    ))
+    (goto-char (point-min))))
 
 
 ;;; @ end
@@ -668,26 +478,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