update.
[elisp/semi.git] / mime-play.el
index 1dbd288..c64c4d1 100644 (file)
 (require 'alist)
 (require 'filename)
 
+(eval-when-compile (require 'mime-text))
+
+
+(defvar mime-acting-situation-examples nil)
+
+(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-string "\n\n")
+         (insert ";;; Code:\n\n")
+         (pp `(setq mime-acting-situation-examples
+                    ',mime-acting-situation-examples)
+             (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)
+
   
 ;;; @ content decoder
 ;;;
@@ -87,12 +115,70 @@ specified, play as it.  Default MODE is \"play\"."
       (if mode
          (setq cal (cons (cons 'mode mode) cal))
        )
-      (setq ret (mime/get-content-decoding-alist cal))
+      (setq ret
+           (or (ctree-match-calist mime-acting-situation-examples cal)
+               (ctree-match-calist-partially mime-acting-situation-examples
+                                             cal)
+               cal))
+      (setq ret
+           (or (ctree-find-calist mime-acting-condition ret
+                                  mime-view-find-every-acting-situation)
+               (ctree-find-calist mime-acting-condition cal
+                                  mime-view-find-every-acting-situation)
+               ))
+      (cond ((cdr ret)
+            (setq ret (select-menu-alist
+                       "Methods"
+                       (mapcar (function
+                                (lambda (situation)
+                                  (cons
+                                   (format "%s"
+                                           (cdr (assq 'method situation)))
+                                   situation)))
+                               ret)))
+            (setq ret
+                  (sort ret
+                        #'(lambda (a b)
+                            (let ((a-t (car a))
+                                  (b-t (car b))
+                                  (order '((type . 1)
+                                           (subtype . 2)
+                                           (mode . 3)
+                                           (major-mode . 4)))
+                                  a-order b-order)
+                              (if (symbolp a-t)
+                                  (let ((ret (assq a-t order)))
+                                    (if ret
+                                        (setq a-order (cdr ret))
+                                      (setq a-order 5)
+                                      ))
+                                (setq a-order 6)
+                                )
+                              (if (symbolp b-t)
+                                  (let ((ret (assq b-t order)))
+                                    (if ret
+                                        (setq b-order (cdr ret))
+                                      (setq b-order 5)
+                                      ))
+                                (setq b-order 6)
+                                )
+                              (if (= a-order b-order)
+                                  (string< (format "%s" a-t)(format "%s" b-t))
+                                (< a-order b-order))
+                              ))))
+            (ctree-set-calist-strictly 'mime-acting-situation-examples ret)
+            )
+           (t
+            (setq ret (car ret))
+            ))
       (setq method (cdr (assq 'method ret)))
       (cond ((and (symbolp method)
                  (fboundp method))
             (funcall method beg end ret)
             )
+           ((stringp method)
+            (mime-activate-mailcap-method beg end ret)
+            )
            ((and (listp method)(stringp (car method)))
             (mime-activate-external-method beg end ret)
             )
@@ -105,17 +191,29 @@ specified, play as it.  Default MODE is \"play\"."
     ))
 
 
-;;; @ method selector
-;;;
-
-(defun mime/get-content-decoding-alist (al)
-  (get-unified-alist mime-acting-condition al)
-  )
-
-
 ;;; @ external decoder
 ;;;
 
+(defun mime-activate-mailcap-method (start end situation)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (let ((method (cdr (assoc 'method situation)))
+           (name (mime-raw-get-filename situation)))
+       (mime-write-decoded-region (if (re-search-forward "^$" end t)
+                                      (1+ (match-end 0))
+                                    (point-min))
+                                  end name
+                                  (cdr (assq 'encoding situation)))
+       (message "External method is starting...")
+       (let ((command (format method name)))
+         (start-process command mime-echo-buffer-name
+                        shell-file-name shell-command-switch command)
+         )
+       (mime-show-echo-buffer)
+       ))))
+
 (defun mime-activate-external-method (beg end cal)
   (save-excursion
     (save-restriction
@@ -268,16 +366,18 @@ window.")
         (filename
           (if (and name (not (string-equal name "")))
              (expand-file-name name
-                               (call-interactively
-                                (function
-                                 (lambda (dir)
-                                   (interactive "DDirectory: ")
-                                   dir))))
-           (call-interactively
-            (function
-             (lambda (file)
-               (interactive "FFilename: ")
-               (expand-file-name file))))))
+                               (save-window-excursion
+                                 (call-interactively
+                                  (function
+                                   (lambda (dir)
+                                     (interactive "DDirectory: ")
+                                     dir)))))
+           (save-window-excursion
+             (call-interactively
+              (function
+               (lambda (file)
+                 (interactive "FFilename: ")
+                 (expand-file-name file)))))))
         )
     (if (file-exists-p filename)
         (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
@@ -532,4 +632,19 @@ to write."
 
 (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-current-buffer)
+           ;; format check
+           (or (eq (car mime-acting-situation-examples) 'type)
+               (setq mime-acting-situation-examples nil))
+           )
+       (kill-buffer buffer))))
+
 ;;; mime-play.el ends here