Rename `mime-pgp-add-keys' ->

[elisp/semi.git] / mime-play.el

diff --git a/mime-play.el b/mime-play.el
index 6d06072..65b9fcf 100644 (file)
--- 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
 
 ;; 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
 
 ;; 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

@@ -29,6 +28,7 @@
 
 (require 'mime-view)
 (require 'alist)
 
 (require 'mime-view)
 (require 'alist)

+(require 'filename)

 
   
 ;;; @ content decoder
 
   
 ;;; @ content decoder

@@ -36,29 +36,36 @@
 
 (defvar mime-preview/after-decoded-position nil)
 
 
 (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)
   (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))
          (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)
                ))
          ))))
 
              (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))
        )
     ;; Check for VM
     (if (< beg (point-min))

@@ -72,10 +79,8 @@
                       (cons 'encoding encoding)
                       (cons 'major-mode major-mode)
                       params))
                       (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)))
        )
       (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)))
             (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
             )
            (t

-            (mime-article/show-output-buffer
+            (mime-show-echo-buffer

              "No method are specified for %s\n" ctype)
             ))
       )
              "No method are specified for %s\n" ctype)
             ))
       )

@@ -98,14 +103,14 @@
 ;;;
 
 (defun mime/get-content-decoding-alist (al)
 ;;;
 
 (defun mime/get-content-decoding-alist (al)

-  (get-unified-alist mime/content-decoding-condition al)
+  (get-unified-alist mime-acting-condition al)

   )
 
 
 ;;; @ 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)
   (save-excursion
     (save-restriction
       (narrow-to-region beg end)

@@ -115,7 +120,7 @@
            )
        (if method
            (let ((file (make-temp-name
            )
        (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)
                  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)
              (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)
                          ))
              (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)
   (mapcar (function
           (lambda (arg)
             (if (stringp arg)

@@ -160,20 +165,40 @@
             ))
          format))
 
             ))
          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))
   (let ((the-win (selected-window))

-       (win (get-buffer-window mime/output-buffer-name))
+       (win (get-buffer-window mime-echo-buffer-name))

        )
     (or win
        )
     (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))
                 )
                 (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))
          ))
     (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
 ;;;
 
 ;;; @ 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)
        )
        (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)
     (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))
   (let* ((cnum (mime-article/point-content-number beg))

-        (cur-buf (current-buffer))

         (new-name (format "%s-%s" (buffer-name) cnum))
         (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)
         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))
       )
     (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)
     ))
 
     (mime-view-mode mother)
     ))
 

@@ -270,50 +326,25 @@
        (cons t (mime-charset-to-coding-system default-mime-charset))
        ))
 
        (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)
   (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
         (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)
          )
     (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))
            (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-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))
          (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

@@ -353,10 +384,10 @@
                    (or (file-exists-p total-file)
                        (save-excursion
                          (set-buffer
                    (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)
                          (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)

@@ -376,7 +407,7 @@
       (if (and total (> total 0))
          (catch 'tag
            (save-excursion
       (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))
              (let ((full-buf (current-buffer)))
                (erase-buffer)
                (let ((i 1))

@@ -389,7 +420,9 @@
                    (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)))

@@ -403,7 +436,7 @@
                       (delete-file file)
                       ))
                (save-window-excursion
                       (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)
                  (mime-view-mode mother)
                  )
                (let ((pwin (or (get-buffer-window mother)

@@ -411,45 +444,56 @@
                                ))
                      (pbuf (save-excursion
                              (set-buffer full-buf)
                                ))
                      (pbuf (save-excursion
                              (set-buffer full-buf)

-                             mime::article/preview-buffer)))
+                             mime-view-buffer)))

                  (set-window-buffer pwin pbuf)
                  (select-window pwin)
                  )))))
       )))
 
 
                  (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))
         (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)
         (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))
     (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)
       )
     (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))
     (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)
           ))
       (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)
     (set-buffer-modified-p nil)

-    (mime-view-text/plain-mode)
+    (set-buffer mother)
+    (view-buffer new-name)

     ))
 
 
     ))