X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=65b9fcfef610acd0e36d07cc33cd1ba405d1bb65;hb=276c4cba23af602cdeedb033e29386ec8ca96a5d;hp=6d06072b745ae6fedc0f79e39317edf4269e5744;hpb=6fa7e3a38803bf0841cede1beeb3d7e19aa72646;p=elisp%2Fsemi.git

diff --git a/mime-play.el b/mime-play.el
index 6d06072..65b9fcf 100644
--- a/mime-play.el
+++ b/mime-play.el
@@ -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
-;; Version: $Id: mime-play.el,v 0.9 1997-02-28 04:56:22 tmorioka Exp $
 ;; 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
@@ -29,6 +28,7 @@
 
 (require 'mime-view)
 (require 'alist)
+(require 'filename)
 
   
 ;;; @ content decoder
@@ -36,29 +36,36 @@
 
 (defvar mime-preview/after-decoded-position nil)
 
-(defun mime-preview/decode-content ()
+(defun mime-view-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)
-  (let ((pc (mime-preview/point-pcinfo (point))))
-    (if pc
-	(let ((the-buf (current-buffer)))
+  (or mode
+      (setq mode "play")
+      )
+  (let ((cinfo (get-text-property (point) 'mime-view-cinfo)))
+    (if cinfo
+	(let ((the-buf (current-buffer))
+	      (raw-buffer (get-text-property (point) 'mime-view-raw-buffer))
+	      )
 	  (setq mime-preview/after-decoded-position (point))
-	  (set-buffer (mime::preview-content-info/buffer pc))
-	  (mime-article/decode-content
-	   (mime::preview-content-info/content-info pc))
-	  (if (eq (current-buffer)
-		  (mime::preview-content-info/buffer pc))
+	  (set-buffer raw-buffer)
+	  (mime-playback-entity cinfo mode)
+	  (if (eq (current-buffer) raw-buffer)
 	      (progn
 		(set-buffer the-buf)
 		(goto-char mime-preview/after-decoded-position)
 		))
 	  ))))
 
-(defun mime-article/decode-content (cinfo)
-  (let ((beg (mime::content-info/point-min cinfo))
-	(end (mime::content-info/point-max cinfo))
-	(ctype (or (mime::content-info/type cinfo) "text/plain"))
-	(params (mime::content-info/parameters cinfo))
-	(encoding (mime::content-info/encoding cinfo))
+(defun mime-playback-entity (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-entity-info-encoding cinfo))
 	)
     ;; Check for VM
     (if (< beg (point-min))
@@ -72,10 +79,8 @@
 		       (cons 'encoding encoding)
 		       (cons 'major-mode major-mode)
 		       params))
-      (if mime-view-decoding-mode
-	  (setq cal (cons
-		     (cons 'mode mime-view-decoding-mode)
-		     cal))
+      (if mode
+	  (setq cal (cons (cons 'mode mode) cal))
 	)
       (setq ret (mime/get-content-decoding-alist cal))
       (setq method (cdr (assq 'method ret)))
@@ -84,10 +89,10 @@
 	     (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-article/show-output-buffer
+	     (mime-show-echo-buffer
 	      "No method are specified for %s\n" ctype)
 	     ))
       )
@@ -98,14 +103,14 @@
 ;;;
 
 (defun mime/get-content-decoding-alist (al)
-  (get-unified-alist mime/content-decoding-condition al)
+  (get-unified-alist mime-acting-condition al)
   )
 
 
 ;;; @ 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)
@@ -115,7 +120,7 @@
 	    )
 	(if method
 	    (let ((file (make-temp-name
-			 (expand-file-name "TM" mime/tmp-dir)))
+			 (expand-file-name "TM" mime-temp-directory)))
 		  b args)
 	      (if (nth 1 method)
 		  (setq b beg)
@@ -133,17 +138,17 @@
 	      (setq cal (put-alist 'file file cal))
 	      (setq args (nconc
 			  (list (car method)
-				mime/output-buffer-name (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-article/show-output-buffer)
+	      (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)
@@ -160,20 +165,40 @@
 	     ))
 	  format))
 
-(defun mime-article/show-output-buffer (&rest forms)
-  (get-buffer-create mime/output-buffer-name)
+(defvar mime-echo-window-is-shared-with-bbdb t
+  "*If non-nil, mime-echo window is shared with BBDB window.")
+
+(defvar mime-echo-window-height
+  (function
+   (lambda ()
+     (/ (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.
+Otherwise `mime-show-echo-buffer' uses it as height of mime-echo
+window.")
+
+(defun mime-show-echo-buffer (&rest forms)
+  "Show mime-echo buffer to display MIME-playing information."
+  (get-buffer-create mime-echo-buffer-name)
   (let ((the-win (selected-window))
-	(win (get-buffer-window mime/output-buffer-name))
+	(win (get-buffer-window mime-echo-buffer-name))
 	)
     (or win
-	(if (and mime/output-buffer-window-is-shared-with-bbdb
+	(if (and mime-echo-window-is-shared-with-bbdb
 		 (boundp 'bbdb-buffer-name)
 		 (setq win (get-buffer-window bbdb-buffer-name))
 		 )
-	    (set-window-buffer win mime/output-buffer-name)
-	  (select-window (get-buffer-window mime::article/preview-buffer))
-	  (setq win (split-window-vertically (/ (* (window-height) 3) 4)))
-	  (set-window-buffer win mime/output-buffer-name)
+	    (set-window-buffer win mime-echo-buffer-name)
+	  (select-window (get-buffer-window mime-view-buffer))
+	  (setq win (split-window-vertically
+		     (- (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)
 	  ))
     (select-window win)
     (goto-char (point-max))
@@ -223,30 +248,61 @@
   )
 
 
+;;; @ file extraction
+;;;
+
+(defun mime-method-to-save (beg end cal)
+  (goto-char beg)
+  (let* ((name
+	  (save-restriction
+	    (narrow-to-region beg end)
+	    (mime-article/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
 ;;;
 
-(defun mime-view-quitting-method-for-mime/show-message-mode ()
-  (let ((mother mime::preview/mother-buffer)
+(defun mime-view-quitting-method-for-mime-show-message-mode ()
+  "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)
 	)
-    (kill-buffer
-     (mime::preview-content-info/buffer (car mime::preview/content-list)))
+    (kill-buffer mime-raw-buffer)
     (mime-view-kill-buffer)
     (set-window-configuration win-conf)
     (pop-to-buffer mother)
-    ;;(goto-char (point-min))
-    ;;(mime-view-up-content)
     ))
 
-(defun mime-article/view-message/rfc822 (beg end cal)
+(defun mime-method-to-display-message/rfc822 (beg end cal)
   (let* ((cnum (mime-article/point-content-number beg))
-	 (cur-buf (current-buffer))
 	 (new-name (format "%s-%s" (buffer-name) cnum))
-	 (mother mime::article/preview-buffer)
-	 (code-converter
-	  (or (cdr (assq major-mode mime-text-decoder-alist))
-	      'mime-view-default-code-convert-region))
+	 (mother mime-view-buffer)
+	 (text-decoder
+	  (cdr (or (assq major-mode mime-text-decoder-alist)
+		   (assq t mime-text-decoder-alist))))
 	 str)
     (setq str (buffer-substring beg end))
     (switch-to-buffer new-name)
@@ -256,8 +312,8 @@
     (if (re-search-forward "^\n" nil t)
 	(delete-region (point-min) (match-end 0))
       )
-    (setq major-mode 'mime/show-message-mode)
-    (setq mime::article/code-converter code-converter)
+    (setq major-mode 'mime-show-message-mode)
+    (setq mime-text-decoder text-decoder)
     (mime-view-mode mother)
     ))
 
@@ -270,50 +326,25 @@
 	(cons t (mime-charset-to-coding-system default-mime-charset))
 	))
 
-(cond (running-mule-merged-emacs
-       (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)
-		     ))))
-	   (write-region start end file)
-	   ))
-       )
-      ((or (boundp 'MULE)
-	   running-xemacs-with-mule)
-       (defun mime-article::write-region (start end file)
-	 (let ((file-coding-system
-		(cdr
-		 (or (assq major-mode mime-article/coding-system-alist)
-		     (assq t mime-article/coding-system-alist)
-		     ))))
-	   (write-region start end file)
-	   ))
-       )
-      ((boundp 'NEMACS)
-       (defun mime-article::write-region (start end file)
-	 (let ((kanji-fileio-code
-		(cdr
-		 (or (assq major-mode mime-article/kanji-code-alist)
-		     (assq t mime-article/kanji-code-alist)
-		     ))))
-	   (write-region start end file)
-	   ))
-       )
-      (t
-       (defalias 'mime-article::write-region 'write-region)
-       ))
+(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)
+	      ))))
+    (write-region start end file)
+    ))
 
-(defun mime-article/decode-message/partial (beg end cal)
+(defun mime-method-to-store-message/partial (beg end cal)
   (goto-char beg)
-  (let* ((root-dir (expand-file-name
-		    (concat "m-prts-" (user-login-name)) mime/tmp-dir))
+  (let* ((root-dir
+	  (expand-file-name
+	   (concat "m-prts-" (user-login-name)) mime-temp-directory))
 	 (id (cdr (assoc "id" cal)))
 	 (number (cdr (assoc "number" cal)))
 	 (total (cdr (assoc "total" cal)))
 	 file
-	 (mother mime::article/preview-buffer)
+	 (mother mime-view-buffer)
          )
     (or (file-exists-p root-dir)
 	(make-directory root-dir)
@@ -333,19 +364,19 @@
 	    (set-buffer full-buf)
 	    (erase-buffer)
 	    (as-binary-input-file (insert-file-contents file))
-	    (setq major-mode 'mime/show-message-mode)
+	    (setq major-mode 'mime-show-message-mode)
 	    (mime-view-mode mother)
 	    )
 	  (set-window-buffer pwin
 			     (save-excursion
 			       (set-buffer full-buf)
-			       mime::article/preview-buffer))
+			       mime-view-buffer))
 	  (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
@@ -353,10 +384,10 @@
 		    (or (file-exists-p total-file)
 			(save-excursion
 			  (set-buffer
-			   (get-buffer-create mime/temp-buffer-name))
+			   (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)
@@ -376,7 +407,7 @@
       (if (and total (> total 0))
 	  (catch 'tag
 	    (save-excursion
-	      (set-buffer (get-buffer-create mime/temp-buffer-name))
+	      (set-buffer (get-buffer-create mime-temp-buffer-name))
 	      (let ((full-buf (current-buffer)))
 		(erase-buffer)
 		(let ((i 1))
@@ -389,7 +420,9 @@
 		    (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)))
@@ -403,7 +436,7 @@
 		       (delete-file file)
 		       ))
 		(save-window-excursion
-		  (setq major-mode 'mime/show-message-mode)
+		  (setq major-mode 'mime-show-message-mode)
 		  (mime-view-mode mother)
 		  )
 		(let ((pwin (or (get-buffer-window mother)
@@ -411,45 +444,56 @@
 				))
 		      (pbuf (save-excursion
 			      (set-buffer full-buf)
-			      mime::article/preview-buffer)))
+			      mime-view-buffer)))
 		  (set-window-buffer pwin pbuf)
 		  (select-window pwin)
 		  )))))
       )))
 
 
-;;; @ rot13-47
+;;; @ message/external-body
 ;;;
 
-(require 'view)
+(defvar mime-article/dired-function
+  (if mime/use-multi-frame
+      (function dired-other-frame)
+    (function mime-article/dired-function-for-one-frame)
+    ))
 
-(defconst mime-view-text/plain-mode-map (copy-keymap view-mode-map))
-(define-key mime-view-text/plain-mode-map
-  "q" (function mime-view-text/plain-exit))
+(defun mime-article/dired-function-for-one-frame (dir)
+  (let ((win (or (get-buffer-window mime-view-buffer)
+		 (get-largest-window))))
+    (select-window win)
+    (dired dir)
+    ))
 
-(defun mime-view-text/plain-mode ()
-  "\\{mime-view-text/plain-mode-map}"
-  (setq buffer-read-only t)
-  (setq major-mode 'mime-view-text/plain-mode)
-  (setq mode-name "MIME-View text/plain")
-  (use-local-map mime-view-text/plain-mode-map)
-  )
+(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)))
+	 ;;(mode (cdr (assoc "mode" cal)))
+	 (pathname (concat "/anonymous@" site ":" directory))
+	 )
+    (message (concat "Accessing " (expand-file-name name pathname) "..."))
+    (funcall mime-article/dired-function pathname)
+    (goto-char (point-min))
+    (search-forward name)
+    ))
 
-(defun mime-view-text/plain-exit ()
-  (interactive)
-  (kill-buffer (current-buffer))
-  )
 
-(defun mime-article/decode-caesar (beg end cal)
-  (let* ((cnum (mime-article/point-content-number beg))
-	 (cur-buf (current-buffer))
+;;; @ rot13-47
+;;;
+
+(defun mime-method-to-display-caesar (start end cal)
+  "Internal method for mime-view to display ROT13-47-48 message."
+  (let* ((cnum (mime-article/point-content-number start))
 	 (new-name (format "%s-%s" (buffer-name) cnum))
-	 (mother mime::article/preview-buffer)
+	 (the-buf (current-buffer))
+	 (mother mime-view-buffer)
 	 (charset (cdr (assoc "charset" cal)))
 	 (encoding (cdr (assq 'encoding cal)))
 	 (mode major-mode)
-	 str)
-    (setq str (buffer-substring beg end))
+	 )
     (let ((pwin (or (get-buffer-window mother)
 		    (get-largest-window)))
 	  (buf (get-buffer-create new-name))
@@ -460,7 +504,7 @@
       )
     (setq buffer-read-only nil)
     (erase-buffer)
-    (insert str)
+    (insert-buffer-substring the-buf start end)
     (goto-char (point-min))
     (if (re-search-forward "^\n" nil t)
 	(delete-region (point-min) (match-end 0))
@@ -470,13 +514,10 @@
       (and (functionp m)
 	   (funcall m charset encoding)
 	   ))
-    (save-excursion
-      (set-mark (point-min))
-      (goto-char (point-max))
-      (tm:caesar-region)
-      )
+    (mule-caesar-region (point-min) (point-max))
     (set-buffer-modified-p nil)
-    (mime-view-text/plain-mode)
+    (set-buffer mother)
+    (view-buffer new-name)
     ))