Modify header.

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

diff --git a/mime-play.el b/mime-play.el
index 9863aa2..e3774de 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,95,96,97,98,99,2000 Free Software Foundation, Inc.

 
 

-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>

 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el

-;; Version: $Id: mime-play.el,v 0.3 1997-02-27 08:34:21 tmorioka Exp $
-;; Keywords: mail, news, MIME, multimedia
+;; 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

@@ -28,368 +27,188 @@
 ;;; Code:
 
 (require 'mime-view)
 ;;; Code:
 
 (require 'mime-view)

+(require 'alist)
+(require 'filename)

 
 

-  
-;;; @ content decoder
-;;;
-
-(defvar mime-preview/after-decoded-position nil)
-
-(defun mime-preview/decode-content ()
-  (interactive)
-  (let ((pc (mime-preview/point-pcinfo (point))))
-    (if pc
-       (let ((the-buf (current-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))
-             (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))
-       )
-    ;; Check for VM
-    (if (< beg (point-min))
-       (setq beg (point-min))
-      )
-    (if (< (point-max) end)
-       (setq end (point-max))
-      )
-    (let (method cal ret)
-      (setq cal (list* (cons 'type ctype)
-                      (cons 'encoding encoding)
-                      (cons 'major-mode major-mode)
-                      params))
-      (if mime-view-decoding-mode
-         (setq cal (cons
-                    (cons 'mode mime-view-decoding-mode)
-                    cal))
-       )
-      (setq ret (mime/get-content-decoding-alist cal))
-      (setq method (cdr (assq 'method ret)))
-      (cond ((and (symbolp method)
-                 (fboundp method))
-            (funcall method beg end ret)
-            )
-           ((and (listp method)(stringp (car method)))
-            (mime-article/start-external-method-region beg end ret)
-            )
-           (t
-            (mime-article/show-output-buffer
-             "No method are specified for %s\n" ctype)
-            ))
-      )
-    ))
-
-
-;;; @ method selector
-;;;
+(eval-when-compile
+  (condition-case nil
+      (require 'bbdb)
+    (error (defvar bbdb-buffer-name nil)))
+  )

 
 

-;;; @@ alist
-;;;
+(defcustom mime-save-directory "~/"
+  "*Name of the directory where MIME entity will be saved in.
+If t, it means current directory."
+  :group 'mime-view
+  :type '(choice (const :tag "Current directory" t)
+                (directory)))

 
 

-(defun put-alist (item value alist)
-  "Modify ALIST to set VALUE to ITEM.
-If there is a pair whose car is ITEM, replace its cdr by VALUE.
-If there is not such pair, create new pair (ITEM . VALUE) and
-return new alist whose car is the new pair and cdr is ALIST.
-\[tomo's ELIS like function]"
-  (let ((pair (assoc item alist)))
-    (if pair
-       (progn
-         (setcdr pair value)
-         alist)
-      (cons (cons item value) alist)
-      )))
-
-(defun del-alist (item alist)
-  "If there is a pair whose key is ITEM, delete it from ALIST.
-\[tomo's ELIS emulating function]"
-  (if (equal item (car (car alist)))
-      (cdr alist)
-    (let ((pr alist)
-         (r (cdr alist))
-         )
-      (catch 'tag
-       (while (not (null r))
-         (if (equal item (car (car r)))
-             (progn
-               (rplacd pr (cdr r))
-               (throw 'tag alist)))
-         (setq pr r)
-         (setq r (cdr r))
-         )
-       alist))))
+(defvar mime-play-find-every-situations t
+  "*Find every available situations if non-nil.")

 
 
 
 

-;;; @@ field
+;;; @ content decoder

 ;;;
 
 ;;;
 

-(defun put-fields (tp c)
-  (catch 'tag
-    (let ((r tp) f ret)
-      (while r
-       (setq f (car r))
-       (if (not (if (setq ret (assoc (car f) c))
-                    (equal (cdr ret)(cdr f))
-                  (setq c (cons f c))
-                  ))
-           (throw 'tag 'error))
-       (setq r (cdr r))
-       ))
-    c))
-
-
-;;; @@ field unifier
-;;;
+;;;###autoload
+(defun mime-preview-play-current-entity (&optional ignore-examples mode)
+  "Play current entity.
+It decodes current entity to call internal or external method.  The
+method is selected from variable `mime-acting-condition'.
+If IGNORE-EXAMPLES (C-u prefix) is specified, this function ignores
+`mime-acting-situation-example-list'.
+If MODE is specified, play as it.  Default MODE is \"play\"."
+  (interactive "P")
+  (let ((entity (get-text-property (point) 'mime-view-entity)))
+    (if entity
+       (let ((situation
+              (get-text-property (point) 'mime-view-situation)))
+         (or mode
+             (setq mode "play"))
+         (setq situation 
+               (if (assq 'mode situation)
+                   (put-alist 'mode mode (copy-alist situation))
+                 (cons (cons 'mode mode)
+                       situation)))
+         (if ignore-examples
+             (setq situation
+                   (cons (cons 'ignore-examples ignore-examples)
+                         situation)))
+         (mime-play-entity entity situation)
+         ))))

 
 

-(defun field-unifier-for-default (a b)
+;;;###autoload
+(defun mime-play-entity (entity &optional situation ignored-method)
+  "Play entity specified by ENTITY.
+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 ((ret
   (let ((ret

-        (cond ((equal a b)    a)
-              ((null (cdr b)) a)
-              ((null (cdr a)) b)
-              )))
-    (if ret
-       (list nil ret nil)
-      )))
-
-(defun field-unifier-for-mode (a b)
-  (let ((va (cdr a)))
-    (if (if (consp va)
-           (member (cdr b) va)
-         (equal va (cdr b))
-         )
-       (list nil b nil)
-      )))
-
-(defun field-unify (a b)
-  (let ((sym (intern (concat "field-unifier-for-" (intern (car a))))))
-    (if (not (fboundp sym))
-       (setq sym (function field-unifier-for-default))
-      )
-    (funcall sym a b)
+        (mime-unify-situations (mime-entity-situation entity situation)
+                               mime-acting-condition
+                               mime-acting-situation-example-list
+                               'method ignored-method
+                               mime-play-find-every-situations))
+       method)
+    (setq mime-acting-situation-example-list (cdr ret)
+         ret (car ret))
+    (cond ((cdr ret)
+          (setq ret (select-menu-alist
+                     "Methods"
+                     (mapcar (function
+                              (lambda (situation)
+                                (cons
+                                 (format "%s"
+                                         (cdr (assq 'method situation)))
+                                 situation)))
+                             ret)))
+          (setq ret (mime-sort-situation ret))
+          (add-to-list 'mime-acting-situation-example-list (cons ret 0))
+          )
+         (t
+          (setq ret (car ret))
+          ))
+    (setq method (cdr (assq 'method ret)))
+    (cond ((and (symbolp method)
+               (fboundp method))
+          (funcall method entity ret)
+          )
+         ((stringp method)
+          (mime-activate-mailcap-method entity ret)
+          )
+          ;; ((and (listp method)(stringp (car method)))
+          ;;  (mime-activate-external-method entity ret)
+          ;;  )
+         (t
+          (mime-show-echo-buffer "No method are specified for %s\n"
+                                 (mime-type/subtype-string
+                                  (cdr (assq 'type situation))
+                                  (cdr (assq 'subtype situation))))
+          (if (y-or-n-p "Do you want to save current entity to disk?")
+              (mime-save-content entity situation))
+          ))

     ))
 
 
     ))
 
 

-;;; @@ type unifier
+;;; @ external decoder

 ;;;
 
 ;;;
 

-(defun assoc-unify (class instance)
-  (catch 'tag
-    (let ((cla (copy-alist class))
-         (ins (copy-alist instance))
-         (r class)
-         cell aret ret prev rest)
-      (while r
-       (setq cell (car r))
-       (setq aret (assoc (car cell) ins))
-       (if aret
-           (if (setq ret (field-unify cell aret))
-               (progn
-                 (if (car ret)
-                     (setq prev (put-alist (car (car ret))
-                                           (cdr (car ret))
-                                           prev))
-                   )
-                 (if (nth 2 ret)
-                     (setq rest (put-alist (car (nth 2 ret))
-                                           (cdr (nth 2 ret))
-                                           rest))
-                   )
-                 (setq cla (put-alist (car cell)(cdr (nth 1 ret)) cla))
-                 (setq ins (del-alist (car cell) ins))
-                 )
-             (throw 'tag nil)
-             ))
-       (setq r (cdr r))
-       )
-      (setq r (copy-alist ins))
-      (while r
-       (setq cell (car r))
-       (setq aret (assoc (car cell) cla))
-       (if aret
-           (if (setq ret (field-unify cell aret))
-               (progn
-                 (if (car ret)
-                     (setq prev (put-alist (car (car ret))
-                                           (cdr (car ret))
-                                           prev))
-                   )
-                 (if (nth 2 ret)
-                     (setq rest (put-alist (car (nth 2 ret))
-                                           (cdr (nth 2 ret))
-                                           rest))
-                   )
-                 (setq cla (del-alist (car cell) cla))
-                 (setq ins (put-alist (car cell)(cdr (nth 1 ret)) ins))
-                 )
-             (throw 'tag nil)
-             ))
-       (setq r (cdr r))
-       )
-      (list prev (append cla ins) rest)
-      )))
-
-(defun get-unified-alist (db al)
-  (let ((r db) ret)
-    (catch 'tag
-      (while r
-       (if (setq ret (nth 1 (assoc-unify (car r) al)))
-           (throw 'tag ret)
-         )
-       (setq r (cdr r))
-       ))))
+(defvar mime-mailcap-method-filename-alist nil)

 
 

-(defun delete-atype (atl al)
-  (let* ((r atl) ret oal)
-    (setq oal
-         (catch 'tag
-           (while r
-             (if (setq ret (nth 1 (assoc-unify (car r) al)))
-                 (throw 'tag (car r))
-               )
-             (setq r (cdr r))
-             )))
-    (delete oal atl)
-    ))
-
-(defun remove-atype (sym al)
-  (and (boundp sym)
-       (set sym (delete-atype (eval sym) al))
-       ))
-
-(defun replace-atype (atl old-al new-al)
-  (let* ((r atl) ret oal)
-    (if (catch 'tag
-         (while r
-           (if (setq ret (nth 1 (assoc-unify (car r) old-al)))
-               (throw 'tag (rplaca r new-al))
-             )
-           (setq r (cdr r))
+(defun mime-activate-mailcap-method (entity situation)
+  (let ((method (cdr (assoc 'method situation)))
+       (name (mime-entity-safe-filename entity)))
+    (setq name
+         (if (and name (not (string= name "")))
+             (expand-file-name name temporary-file-directory)
+           (make-temp-name
+            (expand-file-name "EMI" temporary-file-directory))

            ))
            ))

-       atl)))
-
-(defun set-atype (sym al &rest options)
-  (if (null (boundp sym))
-      (set sym al)
-    (let* ((replacement (memq 'replacement options))
-          (ignore-fields (car (cdr (memq 'ignore options))))
-          (remove (or (car (cdr (memq 'remove options)))
-                      (let ((ral (copy-alist al)))
-                        (mapcar (function
-                                 (lambda (type)
-                                   (setq ral (del-alist type ral))
-                                   ))
-                                ignore-fields)
-                        ral)))
-          )
-      (set sym
-          (or (if replacement
-                  (replace-atype (eval sym) remove al)
-                )
-              (cons al
-                    (delete-atype (eval sym) remove)
-                    )
-              )))))
-
-
-;;; @@ main selector
-;;;
-
-(defun mime/get-content-decoding-alist (al)
-  (get-unified-alist mime/content-decoding-condition al)
-  )
-
-
-;;; @ external decoder
-;;;
+    (mime-write-entity-content entity name)
+    (message "External method is starting...")
+    (let ((process
+          (let ((command
+                 (mailcap-format-command
+                  method
+                  (cons (cons 'filename name) situation))))
+            (start-process command mime-echo-buffer-name
+                           shell-file-name shell-command-switch command)
+            )))
+      (set-alist 'mime-mailcap-method-filename-alist process name)
+      (set-process-sentinel process 'mime-mailcap-method-sentinel)
+      )
+    ))

 
 

-(defun mime-article/start-external-method-region (beg end 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))
-           )
-       (if method
-           (let ((file (make-temp-name
-                        (expand-file-name "TM" mime/tmp-dir)))
-                 b args)
-             (if (nth 1 method)
-                 (setq b beg)
-               (setq b
-                     (if (re-search-forward "^$" nil t)
-                         (1+ (match-end 0))
-                       (point-min)
-                       ))
-               )
-             (goto-char b)
-             (write-region b end file)
-             (message "External method is starting...")
-             (setq cal (put-alist
-                        'name (replace-as-filename name) cal))
-             (setq cal (put-alist 'file file cal))
-             (setq args (nconc
-                         (list (car method)
-                               mime/output-buffer-name (car method)
-                               )
-                         (mime-article/make-method-args cal
-                                                        (cdr (cdr method)))
-                         ))
-             (apply (function start-process) args)
-             (mime-article/show-output-buffer)
-             ))
-       ))))
-
-(defun mime-article/make-method-args (cal format)
-  (mapcar (function
-          (lambda (arg)
-            (if (stringp arg)
-                arg
-              (let* ((item (eval arg))
-                     (ret (cdr (assoc item cal)))
-                     )
-                (if ret
-                    ret
-                  (if (eq item 'encoding)
-                      "7bit"
-                    ""))
-                ))
-            ))
-         format))
-
-(defun mime-article/show-output-buffer (&rest forms)
-  (get-buffer-create mime/output-buffer-name)
+(defun mime-mailcap-method-sentinel (process event)
+  (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
+    (if (file-exists-p file)
+       (delete-file file)
+      ))
+  (remove-alist 'mime-mailcap-method-filename-alist process)
+  (message (format "%s %s" process event)))
+
+(defvar mime-echo-window-is-shared-with-bbdb
+  (module-installed-p 'bbdb)
+  "*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)))
+    (unless win
+      (unless (and mime-echo-window-is-shared-with-bbdb
+                  (condition-case nil
+                      (setq win (get-buffer-window bbdb-buffer-name))
+                    (error nil)))
+       (select-window (get-buffer-window (or mime-preview-buffer
+                                             (current-buffer))))
+       (setq win (split-window-vertically
+                  (- (window-height)
+                     (if (functionp mime-echo-window-height)
+                         (funcall mime-echo-window-height)
+                       mime-echo-window-height)
+                     )))

        )
        )

-    (or win
-       (if (and mime/output-buffer-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 win)
     (goto-char (point-max))
     (if forms
     (select-window win)
     (goto-char (point-max))
     (if forms

-       (insert (apply (function format) forms))
-      )
+       (let ((buffer-read-only nil))
+         (insert (apply (function format) forms))
+         ))

     (select-window the-win)
     ))
 
     (select-window the-win)
     ))
 

@@ -407,155 +226,160 @@ return new alist whose car is the new pair and cdr is ALIST.
   (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)
-      (let (ret)
-       (or (if (or (and (setq ret (mime/Content-Disposition))
-                        (setq ret (assoc "filename" (cdr ret)))
-                        )
-                   (setq ret (assoc "name" param))
-                   (setq ret (assoc "x-name" param))
-                   )
-               (std11-strip-quoted-string (cdr ret))
-             )
-           (if (setq ret
-                     (std11-find-field-body '("Content-Description"
-                                              "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))
-                 ))
-           ))
-      ))
+(defun mime-entity-safe-filename (entity)
+  (let ((filename
+        (or (mime-entity-filename entity)
+            (let ((subj
+                   (or (mime-entity-read-field entity 'Content-Description)
+                       (mime-entity-read-field entity 'Subject))))
+              (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)
+      )))

 
 

-(defun mime-article/get-filename (param)
-  (replace-as-filename (mime-article/get-original-filename param))
-  )
+
+;;; @ file extraction
+;;;
+
+(defun mime-save-content (entity situation)
+  (let ((name (or (mime-entity-safe-filename entity)
+                 (format "%s" (mime-entity-media-type entity))))
+       (dir (if (eq t mime-save-directory)
+                default-directory
+              mime-save-directory))
+       filename)
+    (setq filename (read-file-name
+                   (concat "File name: (default "
+                           (file-name-nondirectory name) ") ")
+                   dir
+                   (concat (file-name-as-directory dir)
+                           (file-name-nondirectory name))))
+    (if (file-directory-p filename)
+       (setq filename (concat (file-name-as-directory filename)
+                              (file-name-nondirectory name))))
+    (if (file-exists-p filename)
+       (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
+           (error "")))
+    (mime-write-entity-content entity (expand-file-name filename))
+    ))
+
+
+;;; @ file detection
+;;;
+
+(defvar mime-magic-type-alist
+  '(("^\377\330\377[\340\356]..JFIF"   image jpeg)
+    ("^\211PNG"                                image png)
+    ("^GIF8[79]"                       image gif)
+    ("^II\\*\000"                      image tiff)
+    ("^MM\000\\*"                      image tiff)
+    ("^MThd"                           audio midi)
+    ("^\000\000\001\263"               video mpeg)
+    )
+  "*Alist of regexp about magic-number vs. corresponding media-types.
+Each element looks like (REGEXP TYPE SUBTYPE).
+REGEXP is a regular expression to match against the beginning of the
+content of entity.
+TYPE is symbol to indicate primary type of media-type.
+SUBTYPE is symbol to indicate subtype of media-type.")
+
+(defun mime-detect-content (entity situation)
+  (let (type subtype)
+    (let ((mdata (mime-entity-content entity))
+         (rest mime-magic-type-alist))
+      (while (not (let ((cell (car rest)))
+                   (if cell
+                       (if (string-match (car cell) mdata)
+                           (setq type (nth 1 cell)
+                                 subtype (nth 2 cell))
+                         )
+                     t)))
+       (setq rest (cdr rest))))
+    (setq situation (del-alist 'method (copy-alist situation)))
+    (mime-play-entity entity
+                     (if type
+                         (put-alist 'type type
+                                    (put-alist 'subtype subtype
+                                               situation))
+                       situation)
+                     'mime-detect-content)))

 
 
 ;;; @ mail/news message
 ;;;
 
 
 
 ;;; @ mail/news message
 ;;;
 

-(defun mime-view-quitting-method-for-mime/show-message-mode ()
-  (let ((mother mime::preview/mother-buffer)
-       (win-conf mime::preview/original-window-configuration)
-       )
-    (kill-buffer
-     (mime::preview-content-info/buffer (car mime::preview/content-list)))
-    (mime-view-kill-buffer)
+(defun mime-preview-quitting-method-for-mime-show-message-mode ()
+  "Quitting method for mime-view.
+It is registered to variable `mime-preview-quitting-method-alist'."
+  (let ((raw-buffer (mime-entity-buffer
+                    (get-text-property (point-min) 'mime-view-entity)))
+       (mother mime-mother-buffer)
+       (win-conf mime-preview-original-window-configuration))
+    (kill-buffer raw-buffer)
+    (mime-preview-kill-buffer)

     (set-window-configuration win-conf)
     (pop-to-buffer mother)
     (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)
-  (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))
-        str)
-    (setq str (buffer-substring beg end))
-    (switch-to-buffer new-name)
-    (erase-buffer)
-    (insert str)
-    (goto-char (point-min))
-    (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)
-    (mime/viewer-mode mother)
-    ))
+(defun mime-view-message/rfc822 (entity situation)
+  (let* ((new-name
+         (format "%s-%s" (buffer-name) (mime-entity-number entity)))
+        (mother (current-buffer))
+        (children (car (mime-entity-children entity)))
+        (preview-buffer
+         (mime-display-message
+          children new-name mother nil
+          (cdr (assq 'major-mode
+                     (get-text-property (point) 'mime-view-situation))))))
+    (or (get-buffer-window preview-buffer)
+       (let ((m-win (get-buffer-window mother)))
+         (if m-win
+             (set-window-buffer m-win preview-buffer)
+           (switch-to-buffer preview-buffer)
+           )))))

 
 
 ;;; @ message/partial
 ;;;
 
 
 
 ;;; @ message/partial
 ;;;
 

-(defvar mime-article/coding-system-alist
-  (list (cons 'mh-show-mode *noconv*)
-       (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/decode-message/partial (beg end cal)
-  (goto-char beg)
-  (let* ((root-dir (expand-file-name
-                   (concat "m-prts-" (user-login-name)) mime/tmp-dir))
+(defun mime-store-message/partial-piece (entity cal)
+  (let* ((root-dir
+         (expand-file-name
+          (concat "m-prts-" (user-login-name)) temporary-file-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 (current-buffer)))

     (or (file-exists-p root-dir)
     (or (file-exists-p root-dir)

-       (make-directory root-dir)
-       )
+       (make-directory root-dir))

     (setq id (replace-as-filename id))
     (setq root-dir (concat root-dir "/" id))
     (or (file-exists-p root-dir)
     (setq id (replace-as-filename id))
     (setq root-dir (concat root-dir "/" id))
     (or (file-exists-p root-dir)

-       (make-directory root-dir)
-       )
+       (make-directory root-dir))

     (setq file (concat root-dir "/FULL"))
     (if (file-exists-p file)
        (let ((full-buf (get-buffer-create "FULL"))
              (pwin (or (get-buffer-window mother)
                        (get-largest-window)))
     (setq file (concat root-dir "/FULL"))
     (if (file-exists-p file)
        (let ((full-buf (get-buffer-create "FULL"))
              (pwin (or (get-buffer-window mother)
                        (get-largest-window)))

-             )
+             pbuf)

          (save-window-excursion
            (set-buffer full-buf)
            (erase-buffer)
            (as-binary-input-file (insert-file-contents file))
          (save-window-excursion
            (set-buffer full-buf)
            (erase-buffer)
            (as-binary-input-file (insert-file-contents file))

-           (setq major-mode 'mime/show-message-mode)
-           (mime/viewer-mode mother)
+           (setq major-mode 'mime-show-message-mode)
+           (mime-view-buffer (current-buffer) nil mother)
+           (setq pbuf (current-buffer))

            )
            )

-         (set-window-buffer pwin
-                            (save-excursion
-                              (set-buffer full-buf)
-                              mime::article/preview-buffer))
+         (set-window-buffer pwin pbuf)

          (select-window pwin)
          )
          (select-window pwin)
          )

-      (re-search-forward "^$")
-      (goto-char (1+ (match-end 0)))

       (setq file (concat root-dir "/" number))
       (setq file (concat root-dir "/" number))

-      (mime-article::write-region (point) (point-max) file)
+      (mime-write-entity-body entity file)

       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total
       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total

@@ -563,10 +387,10 @@ return new alist whose car is the new pair and cdr is ALIST.
                    (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)

@@ -583,10 +407,12 @@ return new alist whose car is the new pair and cdr is ALIST.
                         (kill-buffer (current-buffer))
                         )))
                )))
                         (kill-buffer (current-buffer))
                         )))
                )))

-      (if (and total (> total 0))
+      (if (and total (> total 0)
+              (>= (length (directory-files root-dir nil "^[0-9]+$" t))
+                  total))

          (catch 'tag
            (save-excursion
          (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))

@@ -599,7 +425,9 @@ return new alist whose car is the new pair and cdr is 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)))

@@ -612,81 +440,72 @@ return new alist whose car is the new pair and cdr is ALIST.
                  (and (file-exists-p file)
                       (delete-file file)
                       ))
                  (and (file-exists-p file)
                       (delete-file file)
                       ))

-               (save-window-excursion
-                 (setq major-mode 'mime/show-message-mode)
-                 (mime/viewer-mode mother)
-                 )

                (let ((pwin (or (get-buffer-window mother)
                (let ((pwin (or (get-buffer-window mother)

-                               (get-largest-window)
-                               ))
-                     (pbuf (save-excursion
-                             (set-buffer full-buf)
-                             mime::article/preview-buffer)))
+                               (get-largest-window)))
+                     (pbuf (mime-display-message
+                            (mime-open-entity 'buffer (current-buffer))
+                            nil mother nil 'mime-show-message-mode)))

                  (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-raw-dired-function
+  (if (and (>= emacs-major-version 19) window-system)
+      (function dired-other-frame)
+    (function mime-raw-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-raw-dired-function-for-one-frame (dir)
+  (let ((win (or (get-buffer-window mime-preview-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-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) " ..."))
+    (funcall mime-raw-dired-function pathname)
+    (goto-char (point-min))
+    (search-forward name)
+    ))

 
 

-(defun mime-view-text/plain-exit ()
-  (interactive)
-  (kill-buffer (current-buffer))
-  )
+(defvar mime-raw-browse-url-function mime-browse-url-function)

 
 

-(defun mime-article/decode-caesar (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)
-        (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))
-         )
-      (set-window-buffer pwin buf)
-      (set-buffer buf)
-      (select-window pwin)
+(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
+;;;
+
+(defun mime-view-caesar (entity situation)
+  "Internal method for mime-view to display ROT13-47-48 message."
+  (let ((buf (get-buffer-create
+             (format "%s-%s" (buffer-name) (mime-entity-number entity)))))
+    (with-current-buffer buf
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (mime-insert-text-content entity)
+      (mule-caesar-region (point-min) (point-max))
+      (set-buffer-modified-p nil)

       )
       )

-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (insert str)
+    (let ((win (get-buffer-window (current-buffer))))
+      (or (eq (selected-window) win)
+         (select-window (or win (get-largest-window)))
+         ))
+    (view-buffer buf)

     (goto-char (point-min))
     (goto-char (point-min))

-    (if (re-search-forward "^\n" nil t)
-       (delete-region (point-min) (match-end 0))
-      )
-    (let ((m (cdr (or (assq mode mime-text-decoder-alist)
-                     (assq t mime-text-decoder-alist)))))
-      (and (functionp m)
-          (funcall m charset encoding)
-          ))
-    (save-excursion
-      (set-mark (point-min))
-      (goto-char (point-max))
-      (tm:caesar-region)
-      )
-    (set-buffer-modified-p nil)
-    (mime-view-text/plain-mode)

     ))
 
 
     ))