Sync up with SEMI 1.3.4.9.
[elisp/semi.git] / mime-play.el
index 1e0ea60..17bc7b1 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
 ;;;
@@ -44,7 +72,7 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
   (interactive)
   (or mode
       (setq mode "play"))
-  (let ((entity-info (get-text-property (point) 'mime-view-entity-info)))
+  (let ((entity-info (get-text-property (point) 'mime-view-entity)))
     (if entity-info
        (let ((the-buf (current-buffer))
              (raw-buffer (get-text-property (point) 'mime-view-raw-buffer)))
@@ -87,7 +115,62 @@ 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))
@@ -98,20 +181,13 @@ specified, play as it.  Default MODE is \"play\"."
             )
            (t
             (mime-show-echo-buffer
-             "No method are specified for %s\n" ctype)
+             "No method are specified for %s\n"
+             (mime-type/subtype-string c-type c-subtype))
             ))
       )
     ))
 
 
-;;; @ method selector
-;;;
-
-(defun mime/get-content-decoding-alist (al)
-  (get-unified-alist mime-acting-condition al)
-  )
-
-
 ;;; @ external decoder
 ;;;
 
@@ -263,26 +339,28 @@ window.")
            (narrow-to-region beg end)
            (mime-raw-get-filename cal)
            ))
-        (encoding (cdr (assq 'encoding cal)))
+        (encoding (or (cdr (assq 'encoding cal)) "7bit"))
         (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))
             (error "")))
     (re-search-forward "\n\n")
-    (mime-write-decoded-region (match-end 0)(point-max) filename encoding)
+    (mime-write-decoded-region (match-end 0) end filename encoding)
     ))
 
 
@@ -326,21 +404,16 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 ;;; @ message/partial
 ;;;
 
-(defvar mime-raw-coding-system-alist
-  `((mh-show-mode . no-conversion)
-    (t . ,(mime-charset-to-coding-system default-mime-charset)))
-  "Alist of major-mode vs. corresponding coding-system.")
-
 (defun mime-raw-write-region (start end filename)
   "Write current region into specified file.
 When called from a program, takes three arguments:
 START, END and FILENAME.  START and END are buffer positions.
-It refer `mime-raw-coding-system-alist' to choose coding-system to
-write."
+It refer `mime-raw-buffer-coding-system-alist' to choose coding-system
+to write."
   (let ((coding-system-for-write
         (cdr
-         (or (assq major-mode mime-raw-coding-system-alist)
-             (assq t mime-raw-coding-system-alist)
+         (or (assq major-mode mime-raw-buffer-coding-system-alist)
+             (assq t mime-raw-buffer-coding-system-alist)
              ))))
     (write-region start end filename)
     ))
@@ -536,4 +609,19 @@ 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