update.
[elisp/semi.git] / mime-play.el
index b5f1ac0..b163641 100644 (file)
@@ -34,8 +34,8 @@
   (require 'mime-text)
   (condition-case nil
       (require 'bbdb)
-    (error (defvar bbdb-buffer-name nil))
-    ))
+    (error (defvar bbdb-buffer-name nil)))
+  )
 
 (defvar mime-acting-situation-examples nil)
 
@@ -73,9 +73,7 @@
 It decodes current 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\"."
-  (interactive)
-  (or mode
-      (setq mode "play"))
+  (interactive (list "play"))
   (let ((entity (get-text-property (point) 'mime-view-entity)))
     (if entity
        (let ((the-buf (current-buffer))
@@ -208,13 +206,12 @@ specified, play as it.  Default MODE is \"play\"."
        (let ((method (cdr (assoc 'method situation)))
              (name (mime-entity-safe-filename entity)))
          (setq name
-               (if name
+               (if (and name (not (string= name "")))
                    (expand-file-name name mime-temp-directory)
                  (make-temp-name
                   (expand-file-name "EMI" mime-temp-directory))
                  ))
-         (mime-write-decoded-region (mime-entity-body-start entity) end
-                                    name (cdr (assq 'encoding situation)))
+          (mime-write-entity-content entity name)
          (message "External method is starting...")
          (let ((process
                 (let ((command
@@ -295,14 +292,19 @@ window.")
          "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
 
 (defun mime-entity-safe-filename (entity)
-  (replace-as-filename
-   (or (mime-entity-filename entity)
-       (let ((ret (or (mime-entity-read-field entity 'Content-Description)
-                     (mime-entity-read-field entity 'Subject))))
-        (if (or (string-match mime-view-file-name-regexp-1 ret)
-                (string-match mime-view-file-name-regexp-2 ret))
-            (substring ret (match-beginning 0)(match-end 0))
-          )))))
+  (let ((filename
+        (or (mime-entity-filename entity)
+            (let ((subj
+                   (or (mime-read-field 'Content-Description entity)
+                       (mime-read-field 'Subject entity))))
+              (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))
+                )))))
+    (if filename
+       (replace-as-filename filename)
+      )))
 
 
 ;;; @ file extraction
@@ -310,7 +312,6 @@ window.")
 
 (defun mime-save-content (entity situation)
   (let* ((name (mime-entity-safe-filename entity))
-        (encoding (or (mime-entity-encoding entity) "7bit"))
         (filename (if (and name (not (string-equal name "")))
                       (expand-file-name name
                                         (save-window-excursion
@@ -329,9 +330,7 @@ window.")
     (if (file-exists-p filename)
        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
            (error "")))
-    (mime-write-decoded-region (mime-entity-body-start entity)
-                              (mime-entity-body-end entity)
-                              filename encoding)
+    (mime-write-entity-content entity filename)
     ))
 
 
@@ -339,8 +338,9 @@ window.")
 ;;;
 
 (defvar mime-file-content-type-alist
-  '(("JPEG"    image jpeg)
-    ("GIF"     image gif)
+  '(("JPEG"            image jpeg)
+    ("GIF"             image gif)
+    ("Standard MIDI"   audio midi)
     )
   "*Alist of \"file\" output patterns vs. corresponding media-types.
 Each element looks like (REGEXP TYPE SUBTYPE).
@@ -370,10 +370,12 @@ SUBTYPE is symbol to indicate subtype of media-type.")
          (if (search-forward (concat filename ": ") nil t)
              (let ((rest mime-file-content-type-alist))
                (while (not (let ((cell (car rest)))
-                             (if (looking-at (car cell))
-                                 (setq type (nth 1 cell)
-                                       subtype (nth 2 cell))
-                               )))
+                             (if cell
+                                 (if (looking-at (car cell))
+                                     (setq type (nth 1 cell)
+                                           subtype (nth 2 cell))
+                                   )
+                               t)))
                  (setq rest (cdr rest))))))
        (if type
            (mime-raw-play-entity
@@ -400,49 +402,26 @@ It is registered to variable `mime-preview-quitting-method-alist'."
     (pop-to-buffer mother)
     ))
 
-(defun mime-view-message/rfc822 (entity cal)
-  (let* ((beg (mime-entity-point-min entity))
-        (end (mime-entity-point-max entity))
-        (cnum (mime-raw-point-to-entity-number beg))
-        (new-name (format "%s-%s" (buffer-name) cnum))
+(defun mime-view-message/rfc822 (entity situation)
+  (let* ((new-name
+         (format "%s-%s" (buffer-name) (mime-entity-number entity)))
         (mother mime-preview-buffer)
-        (representation-type
-         (cdr (or (assq major-mode mime-raw-representation-type-alist)
-                  (assq t mime-raw-representation-type-alist))))
-        str)
-    (setq str (buffer-substring beg end))
-    (switch-to-buffer new-name)
+        (children (car (mime-entity-children entity))))
+    (set-buffer (get-buffer-create new-name))
     (erase-buffer)
-    (insert str)
-    (goto-char (point-min))
-    (if (re-search-forward "^\n" nil t)
-       (delete-region (point-min) (match-end 0))
-      )
+    (insert-buffer-substring (mime-entity-buffer children)
+                            (mime-entity-point-min children)
+                            (mime-entity-point-max children))
+    (setq mime-message-structure children)
     (setq major-mode 'mime-show-message-mode)
-    (setq mime-raw-representation-type representation-type)
-    (mime-view-mode mother)
+    (mime-view-buffer (current-buffer) nil mother
+                     nil (if (mime-entity-cooked-p entity) 'cooked))
     ))
 
 
 ;;; @ message/partial
 ;;;
 
-(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-representation-type' or `major-mode
-mime-raw-representation-type-alist'.  If it is `binary', region is
-saved as binary.  Otherwise the region is saved by `write-region'."
-  (let ((presentation-type
-        (or mime-raw-representation-type
-            (cdr (or (assq major-mode mime-raw-representation-type-alist)
-                     (assq t mime-raw-representation-type-alist))))))
-    (if (eq presentation-type 'binary)
-       (write-region-as-binary start end filename)
-      (write-region start end filename)
-      )))
-
 (defun mime-store-message/partial-piece (entity cal)
   (goto-char (mime-entity-point-min entity))
   (let* ((root-dir
@@ -481,10 +460,8 @@ saved as binary.  Otherwise the region is saved by `write-region'."
                               mime-preview-buffer))
          (select-window pwin)
          )
-      (re-search-forward "^$")
-      (goto-char (1+ (match-end 0)))
       (setq file (concat root-dir "/" number))
-      (mime-raw-write-region (point) (mime-entity-point-max entity) file)
+      (mime-write-entity-body entity file)
       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total
@@ -575,17 +552,24 @@ saved as binary.  Otherwise the region is saved by `write-region'."
     (dired dir)
     ))
 
-(defun mime-view-message/external-ftp (entity cal)
+(defun mime-view-message/external-anon-ftp (entity cal)
   (let* ((site (cdr (assoc "site" cal)))
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
         (pathname (concat "/anonymous@" site ":" directory)))
-    (message (concat "Accessing " (expand-file-name name pathname) "..."))
+    (message (concat "Accessing " (expand-file-name name pathname) " ..."))
     (funcall mime-raw-dired-function pathname)
     (goto-char (point-min))
     (search-forward name)
     ))
 
+(defvar mime-raw-browse-url-function (function mime-browse-url))
+
+(defun mime-view-message/external-url (entity cal)
+  (let ((url (cdr (assoc "url" cal))))
+    (message (concat "Accessing " url " ..."))
+    (funcall mime-raw-browse-url-function url)))
+
 
 ;;; @ rot13-47
 ;;;