Rename `mime-playback-entity' -> `mime-raw-play-entity'.
[elisp/semi.git] / mime-play.el
index 29ec2de..25443c0 100644 (file)
@@ -1,14 +1,13 @@
-;;; mime-play.el --- decoder for mime-view.el
+;;; mime-play.el --- Playback processing module for mime-view.el
 
 
-;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
-;; Version: $Id: mime-play.el,v 0.50 1997-09-05 11:41:29 morioka Exp $
 ;; Keywords: MIME, multimedia, mail, news
 
 ;; Keywords: MIME, multimedia, mail, news
 
-;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
+;; This file is part of SEMI (Secretariat of Emacs MIME Interfaces).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
 ;;; @ content decoder
 ;;;
 
 ;;; @ content decoder
 ;;;
 
-(defvar mime-preview/after-decoded-position nil)
+(defvar mime-preview-after-decoded-position nil)
 
 
-(defun mime-view-play-current-entity (&optional mode)
+(defun mime-preview-play-current-entity (&optional mode)
   "Play current entity.
 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
   "Play current entity.
 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")
-      )
-  (let ((cinfo (get-text-property (point) 'mime-view-cinfo)))
-    (if cinfo
+      (setq mode "play"))
+  (let ((entity-info (get-text-property (point) 'mime-view-entity-info)))
+    (if entity-info
        (let ((the-buf (current-buffer))
        (let ((the-buf (current-buffer))
-             (raw-buffer (get-text-property (point) 'mime-view-raw-buffer))
-             )
-         (setq mime-preview/after-decoded-position (point))
+             (raw-buffer (get-text-property (point) 'mime-view-raw-buffer)))
+         (setq mime-preview-after-decoded-position (point))
          (set-buffer raw-buffer)
          (set-buffer raw-buffer)
-         (mime-display-content cinfo mode)
-         (if (eq (current-buffer) raw-buffer)
-             (progn
-               (set-buffer the-buf)
-               (goto-char mime-preview/after-decoded-position)
-               ))
-         ))))
-
-(defun mime-display-content (cinfo &optional mode)
-  (let ((beg (mime-entity-info-point-min cinfo))
-       (end (mime-entity-info-point-max cinfo))
-       (ctype (or (mime-entity-info-type/subtype cinfo) "text/plain"))
-       (params (mime-entity-info-parameters cinfo))
-       (encoding (mime::content-info/encoding cinfo))
+         (mime-raw-play-entity entity-info mode)
+         (when (eq (current-buffer) raw-buffer)
+           (set-buffer the-buf)
+           (goto-char mime-preview-after-decoded-position)
+           )))))
+
+(defun mime-raw-play-entity (entity-info &optional mode)
+  "Play entity specified by ENTITY-INFO.
+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 ((beg (mime-entity-info-point-min entity-info))
+       (end (mime-entity-info-point-max entity-info))
+       (c-type (mime-entity-info-media-type entity-info))
+       (c-subtype (mime-entity-info-media-subtype entity-info))
+       (params (mime-entity-info-parameters entity-info))
+       (encoding (mime-entity-info-encoding entity-info))
        )
        )
+    (or c-type
+       (setq c-type 'text
+             c-subtype 'plain))
     ;; Check for VM
     (if (< beg (point-min))
        (setq beg (point-min))
     ;; Check for VM
     (if (< beg (point-min))
        (setq beg (point-min))
@@ -76,7 +79,8 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
        (setq end (point-max))
       )
     (let (method cal ret)
        (setq end (point-max))
       )
     (let (method cal ret)
-      (setq cal (list* (cons 'type ctype)
+      (setq cal (list* (cons 'type c-type)
+                      (cons 'subtype c-subtype)
                       (cons 'encoding encoding)
                       (cons 'major-mode major-mode)
                       params))
                       (cons 'encoding encoding)
                       (cons 'major-mode major-mode)
                       params))
@@ -90,7 +94,7 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
             (funcall method beg end ret)
             )
            ((and (listp method)(stringp (car method)))
             (funcall method beg end ret)
             )
            ((and (listp method)(stringp (car method)))
-            (mime-article/start-external-method-region beg end ret)
+            (mime-activate-external-method beg end ret)
             )
            (t
             (mime-show-echo-buffer
             )
            (t
             (mime-show-echo-buffer
@@ -111,13 +115,13 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
 ;;; @ external decoder
 ;;;
 
 ;;; @ external decoder
 ;;;
 
-(defun mime-article/start-external-method-region (beg end cal)
+(defun mime-activate-external-method (beg end cal)
   (save-excursion
     (save-restriction
       (narrow-to-region beg end)
       (goto-char beg)
       (let ((method (cdr (assoc 'method cal)))
   (save-excursion
     (save-restriction
       (narrow-to-region beg end)
       (goto-char beg)
       (let ((method (cdr (assoc 'method cal)))
-           (name (mime-article/get-filename cal))
+           (name (mime-raw-get-filename cal))
            )
        (if method
            (let ((file (make-temp-name
            )
        (if method
            (let ((file (make-temp-name
@@ -141,15 +145,15 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
                          (list (car method)
                                mime-echo-buffer-name (car method)
                                )
                          (list (car method)
                                mime-echo-buffer-name (car method)
                                )
-                         (mime-article/make-method-args cal
-                                                        (cdr (cdr method)))
+                         (mime-make-external-method-args
+                          cal (cdr (cdr method)))
                          ))
              (apply (function start-process) args)
              (mime-show-echo-buffer)
              ))
        ))))
 
                          ))
              (apply (function start-process) args)
              (mime-show-echo-buffer)
              ))
        ))))
 
-(defun mime-article/make-method-args (cal format)
+(defun mime-make-external-method-args (cal format)
   (mapcar (function
           (lambda (arg)
             (if (stringp arg)
   (mapcar (function
           (lambda (arg)
             (if (stringp arg)
@@ -192,7 +196,7 @@ window.")
                 (setq win (get-buffer-window bbdb-buffer-name))
                 )
            (set-window-buffer win mime-echo-buffer-name)
                 (setq win (get-buffer-window bbdb-buffer-name))
                 )
            (set-window-buffer win mime-echo-buffer-name)
-         (select-window (get-buffer-window mime-view-buffer))
+         (select-window (get-buffer-window mime-preview-buffer))
          (setq win (split-window-vertically
                     (- (window-height)
                        (if (functionp mime-echo-window-height)
          (setq win (split-window-vertically
                     (- (window-height)
                        (if (functionp mime-echo-window-height)
@@ -223,8 +227,8 @@ window.")
   (concat (regexp-* mime-view-file-name-char-regexp)
          "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
 
   (concat (regexp-* mime-view-file-name-char-regexp)
          "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
 
-(defun mime-article/get-original-filename (param &optional encoding)
-  (or (mime-article/get-uu-filename param encoding)
+(defun mime-raw-get-original-filename (param &optional encoding)
+  (or (mime-raw-get-uu-filename param encoding)
       (let (ret)
        (or (if (or (and (setq ret (mime/Content-Disposition))
                         (setq ret (assoc "filename" (cdr ret)))
       (let (ret)
        (or (if (or (and (setq ret (mime/Content-Disposition))
                         (setq ret (assoc "filename" (cdr ret)))
@@ -244,11 +248,44 @@ window.")
            ))
       ))
 
            ))
       ))
 
-(defun mime-article/get-filename (param)
-  (replace-as-filename (mime-article/get-original-filename param))
+(defun mime-raw-get-filename (param)
+  (replace-as-filename (mime-raw-get-original-filename param))
   )
 
 
   )
 
 
+;;; @ file extraction
+;;;
+
+(defun mime-method-to-save (beg end cal)
+  (goto-char beg)
+  (let* ((name
+         (save-restriction
+           (narrow-to-region beg end)
+           (mime-raw-get-filename cal)
+           ))
+        (encoding (cdr (assq 'encoding cal)))
+        (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))))))
+        )
+    (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)
+    ))
+
+
 ;;; @ mail/news message
 ;;;
 
 ;;; @ mail/news message
 ;;;
 
@@ -256,18 +293,18 @@ window.")
   "Quitting method for mime-view.
 It is registered to variable `mime-view-quitting-method-alist'."
   (let ((mother mime-mother-buffer)
   "Quitting method for mime-view.
 It is registered to variable `mime-view-quitting-method-alist'."
   (let ((mother mime-mother-buffer)
-       (win-conf mime::preview/original-window-configuration)
+       (win-conf mime-preview-original-window-configuration)
        )
     (kill-buffer mime-raw-buffer)
        )
     (kill-buffer mime-raw-buffer)
-    (mime-view-kill-buffer)
+    (mime-preview-kill-buffer)
     (set-window-configuration win-conf)
     (pop-to-buffer mother)
     ))
 
     (set-window-configuration win-conf)
     (pop-to-buffer mother)
     ))
 
-(defun mime-display-message/rfc822 (beg end cal)
-  (let* ((cnum (mime-article/point-content-number beg))
+(defun mime-method-to-display-message/rfc822 (beg end cal)
+  (let* ((cnum (mime-raw-point-to-entity-number beg))
         (new-name (format "%s-%s" (buffer-name) cnum))
         (new-name (format "%s-%s" (buffer-name) cnum))
-        (mother mime-view-buffer)
+        (mother mime-preview-buffer)
         (text-decoder
          (cdr (or (assq major-mode mime-text-decoder-alist)
                   (assq t mime-text-decoder-alist))))
         (text-decoder
          (cdr (or (assq major-mode mime-text-decoder-alist)
                   (assq t mime-text-decoder-alist))))
@@ -289,7 +326,7 @@ It is registered to variable `mime-view-quitting-method-alist'."
 ;;; @ message/partial
 ;;;
 
 ;;; @ message/partial
 ;;;
 
-(defvar mime-article/coding-system-alist
+(defvar mime-raw-coding-system-alist
   (list '(mh-show-mode . no-conversion)
        (cons t (mime-charset-to-coding-system default-mime-charset))
        ))
   (list '(mh-show-mode . no-conversion)
        (cons t (mime-charset-to-coding-system default-mime-charset))
        ))
@@ -297,13 +334,13 @@ It is registered to variable `mime-view-quitting-method-alist'."
 (defun mime-article::write-region (start end file)
   (let ((coding-system-for-write
         (cdr
 (defun mime-article::write-region (start end file)
   (let ((coding-system-for-write
         (cdr
-         (or (assq major-mode mime-article/coding-system-alist)
-             (assq t mime-article/coding-system-alist)
+         (or (assq major-mode mime-raw-coding-system-alist)
+             (assq t mime-raw-coding-system-alist)
              ))))
     (write-region start end file)
     ))
 
              ))))
     (write-region start end file)
     ))
 
-(defun mime-display-message/partial (beg end cal)
+(defun mime-method-to-store-message/partial (beg end cal)
   (goto-char beg)
   (let* ((root-dir
          (expand-file-name
   (goto-char beg)
   (let* ((root-dir
          (expand-file-name
@@ -312,7 +349,7 @@ It is registered to variable `mime-view-quitting-method-alist'."
         (number (cdr (assoc "number" cal)))
         (total (cdr (assoc "total" cal)))
         file
         (number (cdr (assoc "number" cal)))
         (total (cdr (assoc "total" cal)))
         file
-        (mother mime-view-buffer)
+        (mother mime-preview-buffer)
          )
     (or (file-exists-p root-dir)
        (make-directory root-dir)
          )
     (or (file-exists-p root-dir)
        (make-directory root-dir)
@@ -338,13 +375,13 @@ It is registered to variable `mime-view-quitting-method-alist'."
          (set-window-buffer pwin
                             (save-excursion
                               (set-buffer full-buf)
          (set-window-buffer pwin
                             (save-excursion
                               (set-buffer full-buf)
-                              mime-view-buffer))
+                              mime-preview-buffer))
          (select-window pwin)
          )
       (re-search-forward "^$")
       (goto-char (1+ (match-end 0)))
       (setq file (concat root-dir "/" number))
          (select-window pwin)
          )
       (re-search-forward "^$")
       (goto-char (1+ (match-end 0)))
       (setq file (concat root-dir "/" number))
-      (mime-article::write-region (point) (point-max) file)
+      (mime-article::write-region (point) end file)
       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total
       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total
@@ -355,7 +392,7 @@ It is registered to variable `mime-view-quitting-method-alist'."
                           (get-buffer-create mime-temp-buffer-name))
                          (erase-buffer)
                          (insert total)
                           (get-buffer-create mime-temp-buffer-name))
                          (erase-buffer)
                          (insert total)
-                         (write-file total-file)
+                         (write-region (point-min)(point-max) total-file)
                          (kill-buffer (current-buffer))
                          ))
                    (string-to-number total)
                          (kill-buffer (current-buffer))
                          ))
                    (string-to-number total)
@@ -388,7 +425,9 @@ It is registered to variable `mime-view-quitting-method-alist'."
                    (goto-char (point-max))
                    (setq i (1+ i))
                    ))
                    (goto-char (point-max))
                    (setq i (1+ i))
                    ))
-               (as-binary-output-file (write-file (concat root-dir "/FULL")))
+               (as-binary-output-file
+                 (write-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)))
                (let ((i 1))
                  (while (<= i total)
                    (let ((file (format "%s/%d" root-dir i)))
@@ -410,7 +449,7 @@ It is registered to variable `mime-view-quitting-method-alist'."
                                ))
                      (pbuf (save-excursion
                              (set-buffer full-buf)
                                ))
                      (pbuf (save-excursion
                              (set-buffer full-buf)
-                             mime-view-buffer)))
+                             mime-preview-buffer)))
                  (set-window-buffer pwin pbuf)
                  (select-window pwin)
                  )))))
                  (set-window-buffer pwin pbuf)
                  (select-window pwin)
                  )))))
@@ -420,20 +459,20 @@ It is registered to variable `mime-view-quitting-method-alist'."
 ;;; @ message/external-body
 ;;;
 
 ;;; @ message/external-body
 ;;;
 
-(defvar mime-article/dired-function
+(defvar mime-raw-dired-function
   (if mime/use-multi-frame
       (function dired-other-frame)
   (if mime/use-multi-frame
       (function dired-other-frame)
-    (function mime-article/dired-function-for-one-frame)
+    (function mime-raw-dired-function-for-one-frame)
     ))
 
     ))
 
-(defun mime-article/dired-function-for-one-frame (dir)
-  (let ((win (or (get-buffer-window mime-view-buffer)
+(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)
     ))
 
                 (get-largest-window))))
     (select-window win)
     (dired dir)
     ))
 
-(defun mime-display-message/external-ftp (beg end cal)
+(defun mime-method-to-display-message/external-ftp (beg end cal)
   (let* ((site (cdr (assoc "site" cal)))
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
   (let* ((site (cdr (assoc "site" cal)))
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
@@ -441,7 +480,7 @@ It is registered to variable `mime-view-quitting-method-alist'."
         (pathname (concat "/anonymous@" site ":" directory))
         )
     (message (concat "Accessing " (expand-file-name name pathname) "..."))
         (pathname (concat "/anonymous@" site ":" directory))
         )
     (message (concat "Accessing " (expand-file-name name pathname) "..."))
-    (funcall mime-article/dired-function pathname)
+    (funcall mime-raw-dired-function pathname)
     (goto-char (point-min))
     (search-forward name)
     ))
     (goto-char (point-min))
     (search-forward name)
     ))
@@ -450,12 +489,12 @@ It is registered to variable `mime-view-quitting-method-alist'."
 ;;; @ rot13-47
 ;;;
 
 ;;; @ rot13-47
 ;;;
 
-(defun mime-display-caesar (start end cal)
+(defun mime-method-to-display-caesar (start end cal)
   "Internal method for mime-view to display ROT13-47-48 message."
   "Internal method for mime-view to display ROT13-47-48 message."
-  (let* ((cnum (mime-article/point-content-number start))
+  (let* ((cnum (mime-raw-point-to-entity-number start))
         (new-name (format "%s-%s" (buffer-name) cnum))
         (the-buf (current-buffer))
         (new-name (format "%s-%s" (buffer-name) cnum))
         (the-buf (current-buffer))
-        (mother mime-view-buffer)
+        (mother mime-preview-buffer)
         (charset (cdr (assoc "charset" cal)))
         (encoding (cdr (assq 'encoding cal)))
         (mode major-mode)
         (charset (cdr (assoc "charset" cal)))
         (encoding (cdr (assq 'encoding cal)))
         (mode major-mode)