mime-play.el

   1 ;;; mime-play.el --- Playback processing module for mime-view.el
   2
   3 ;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1995/9/26 (separated from tm-view.el)
   7 ;;      Renamed: 1997/2/21 from tm-play.el
   8 ;; Keywords: MIME, multimedia, mail, news
   9
  10 ;; This file is part of SEMI (Secretariat of Emacs MIME Interfaces).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'mime-view)
  30 (require 'alist)
  31 (require 'filename)
  32 (require 'eword-decode)
  33
  34 (eval-when-compile
  35   (condition-case nil
  36       (require 'bbdb)
  37     (error (defvar bbdb-buffer-name nil))))
  38
  39 (defcustom mime-save-directory "~/"
  40   "*Name of the directory where MIME entity will be saved in.
  41 If t, it means current directory."
  42   :group 'mime-view
  43   :type '(choice (const :tag "Current directory" t)
  44                  (directory)))
  45
  46 (defvar mime-acting-situation-example-list nil)
  47
  48 (defvar mime-acting-situation-example-list-max-size 16)
  49
  50 (defun mime-save-acting-situation-examples ()
  51   (let* ((file mime-acting-situation-examples-file)
  52          (buffer (get-buffer-create " *mime-example*")))
  53     (unwind-protect
  54         (save-excursion
  55           (set-buffer buffer)
  56           (setq buffer-file-name file)
  57           (erase-buffer)
  58           (insert ";;; " (file-name-nondirectory file) "\n")
  59           (insert "\n;; This file is generated automatically by "
  60                   mime-view-version "\n\n")
  61           (insert ";;; Code:\n\n")
  62           (pp `(setq mime-acting-situation-example-list
  63                      ',mime-acting-situation-example-list)
  64               (current-buffer))
  65           (insert "\n;;; "
  66                   (file-name-nondirectory file)
  67                   " ends here.\n")
  68           (save-buffer))
  69       (kill-buffer buffer))))
  70
  71 (add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
  72
  73 (defun mime-reduce-acting-situation-examples ()
  74   (let ((len (length mime-acting-situation-example-list))
  75         i ir ic j jr jc ret
  76         dest d-i d-j
  77         (max-sim 0) sim
  78         min-det-ret det-ret
  79         min-det-org det-org
  80         min-freq freq)
  81     (setq i 0
  82           ir mime-acting-situation-example-list)
  83     (while (< i len)
  84       (setq ic (car ir)
  85             j 0
  86             jr mime-acting-situation-example-list)
  87       (while (< j len)
  88         (unless (= i j)
  89           (setq jc (car jr))
  90           (setq ret (mime-compare-situation-with-example (car ic)(car jc))
  91                 sim (car ret)
  92                 det-ret (+ (length (car ic))(length (car jc)))
  93                 det-org (length (cdr ret))
  94                 freq (+ (cdr ic)(cdr jc)))
  95           (cond ((< max-sim sim)
  96                  (setq max-sim sim
  97                        min-det-ret det-ret
  98                        min-det-org det-org
  99                        min-freq freq
 100                        d-i i
 101                        d-j j
 102                        dest (cons (cdr ret) freq)))
 103                 ((= max-sim sim)
 104                  (cond ((> min-det-ret det-ret)
 105                         (setq min-det-ret det-ret
 106                               min-det-org det-org
 107                               min-freq freq
 108                               d-i i
 109                               d-j j
 110                               dest (cons (cdr ret) freq)))
 111                        ((= min-det-ret det-ret)
 112                         (cond ((> min-det-org det-org)
 113                                (setq min-det-org det-org
 114                                      min-freq freq
 115                                      d-i i
 116                                      d-j j
 117                                      dest (cons (cdr ret) freq)))
 118                               ((= min-det-org det-org)
 119                                (cond ((> min-freq freq)
 120                                       (setq min-freq freq
 121                                             d-i i
 122                                             d-j j
 123                                             dest (cons (cdr ret) freq)))))))))))
 124         (setq jr (cdr jr)
 125               j (1+ j)))
 126       (setq ir (cdr ir)
 127             i (1+ i)))
 128     (if (> d-i d-j)
 129         (setq i d-i
 130               d-i d-j
 131               d-j i))
 132     (setq jr (nthcdr (1- d-j) mime-acting-situation-example-list))
 133     (setcdr jr (cddr jr))
 134     (if (= d-i 0)
 135         (setq mime-acting-situation-example-list
 136               (cdr mime-acting-situation-example-list))
 137       (setq ir (nthcdr (1- d-i) mime-acting-situation-example-list))
 138       (setcdr ir (cddr ir)))
 139     (if (setq ir (assoc (car dest) mime-acting-situation-example-list))
 140         (setcdr ir (+ (cdr ir)(cdr dest)))
 141       (setq mime-acting-situation-example-list
 142             (cons dest mime-acting-situation-example-list)))))
 143
 144
 145 ;;; @ content decoder
 146 ;;;
 147
 148 ;;;###autoload
 149 (defun mime-preview-play-current-entity (&optional ignore-examples mode)
 150   "Play current entity.
 151 It decodes current entity to call internal or external method.  The
 152 method is selected from variable `mime-acting-condition'.
 153 If IGNORE-EXAMPLES (C-u prefix) is specified, this function ignores
 154 `mime-acting-situation-example-list'.
 155 If MODE is specified, play as it.  Default MODE is \"play\"."
 156   (interactive "P")
 157   (let ((entity (get-text-property (point) 'mime-view-entity)))
 158     (if entity
 159         (let ((situation
 160                (get-text-property (point) 'mime-view-situation)))
 161           (or mode
 162               (setq mode "play"))
 163           (setq situation
 164                 (if (assq 'mode situation)
 165                     (put-alist 'mode mode (copy-alist situation))
 166                   (cons (cons 'mode mode)
 167                         situation)))
 168           (if ignore-examples
 169               (setq situation
 170                     (cons (cons 'ignore-examples ignore-examples)
 171                           situation)))
 172           (mime-play-entity entity situation)))))
 173
 174 (defun mime-sort-situation (situation)
 175   (sort situation
 176         #'(lambda (a b)
 177             (let ((a-t (car a))
 178                   (b-t (car b))
 179                   (order '((type . 1)
 180                            (subtype . 2)
 181                            (mode . 3)
 182                            (method . 4)
 183                            (major-mode . 5)
 184                            (disposition-type . 6)))
 185                   a-order b-order)
 186               (if (symbolp a-t)
 187                   (let ((ret (assq a-t order)))
 188                     (if ret
 189                         (setq a-order (cdr ret))
 190                       (setq a-order 7)))
 191                 (setq a-order 8))
 192               (if (symbolp b-t)
 193                   (let ((ret (assq b-t order)))
 194                     (if ret
 195                         (setq b-order (cdr ret))
 196                       (setq b-order 7)))
 197                 (setq b-order 8))
 198               (if (= a-order b-order)
 199                   (string< (format "%s" a-t)(format "%s" b-t))
 200                 (< a-order b-order))))))
 201
 202 (defsubst mime-delq-null-situation (situations field
 203                                                &optional ignored-value)
 204   (let (dest)
 205     (while situations
 206       (let* ((situation (car situations))
 207              (cell (assq field situation)))
 208         (if cell
 209             (or (eq (cdr cell) ignored-value)
 210                 (setq dest (cons situation dest)))))
 211       (setq situations (cdr situations)))
 212     dest))
 213
 214 (defun mime-compare-situation-with-example (situation example)
 215   (let ((example (copy-alist example))
 216         (match 0))
 217     (while situation
 218       (let* ((cell (car situation))
 219              (key (car cell))
 220              (ecell (assoc key example)))
 221         (when ecell
 222           (if (equal cell ecell)
 223               (setq match (1+ match))
 224             (setq example (delq ecell example)))))
 225       (setq situation (cdr situation)))
 226     (cons match example)))
 227
 228 ;;;###autoload
 229 (defun mime-play-entity (entity &optional situation ignored-method)
 230   "Play entity specified by ENTITY.
 231 It decodes the entity to call internal or external method.  The method
 232 is selected from variable `mime-acting-condition'.  If MODE is
 233 specified, play as it.  Default MODE is \"play\"."
 234   (let (method ret)
 235     (in-calist-package 'mime-view)
 236     (setq ret
 237           (mime-delq-null-situation
 238            (ctree-find-calist mime-acting-condition
 239                               (mime-entity-situation entity situation)
 240                               mime-view-find-every-acting-situation)
 241            'method ignored-method))
 242     (or (assq 'ignore-examples situation)
 243         (if (cdr ret)
 244             (let ((rest ret)
 245                   (max-score 0)
 246                   (max-escore 0)
 247                   max-examples
 248                   max-situations)
 249               (while rest
 250                 (let ((situation (car rest))
 251                       (examples mime-acting-situation-example-list))
 252                   (while examples
 253                     (let* ((ret
 254                             (mime-compare-situation-with-example
 255                              situation (caar examples)))
 256                            (ret-score (car ret)))
 257                       (cond ((> ret-score max-score)
 258                              (setq max-score ret-score
 259                                    max-escore (cdar examples)
 260                                    max-examples (list (cdr ret))
 261                                    max-situations (list situation)))
 262                             ((= ret-score max-score)
 263                              (cond ((> (cdar examples) max-escore)
 264                                     (setq max-escore (cdar examples)
 265                                           max-examples (list (cdr ret))
 266                                           max-situations (list situation)))
 267                                    ((= (cdar examples) max-escore)
 268                                     (setq max-examples
 269                                           (cons (cdr ret) max-examples))
 270                                     (or (member situation max-situations)
 271                                         (setq max-situations
 272                                               (cons situation max-situations))))))))
 273                     (setq examples (cdr examples))))
 274                 (setq rest (cdr rest)))
 275               (when max-situations
 276                 (setq ret max-situations)
 277                 (while max-examples
 278                   (let* ((example (car max-examples))
 279                          (cell
 280                           (assoc example mime-acting-situation-example-list)))
 281                     (if cell
 282                         (setcdr cell (1+ (cdr cell)))
 283                       (setq mime-acting-situation-example-list
 284                             (cons (cons example 0)
 285                                   mime-acting-situation-example-list))))
 286                   (setq max-examples (cdr max-examples)))))))
 287     (cond ((cdr ret)
 288            (setq ret (select-menu-alist
 289                       "Methods"
 290                       (mapcar (function
 291                                (lambda (situation)
 292                                  (cons
 293                                   (format "%s"
 294                                           (cdr (assq 'method situation)))
 295                                   situation)))
 296                               ret)))
 297            (setq ret (mime-sort-situation ret))
 298            (add-to-list 'mime-acting-situation-example-list (cons ret 0)))
 299           (t
 300            (setq ret (car ret))))
 301     (setq method (cdr (assq 'method ret)))
 302     (cond ((and (symbolp method)
 303                 (fboundp method))
 304            (funcall method entity ret))
 305           ((stringp method)
 306            (mime-activate-mailcap-method entity ret))
 307           ;; ((and (listp method)(stringp (car method)))
 308           ;;  (mime-activate-external-method entity ret)
 309           ;;  )
 310           (t
 311            (mime-show-echo-buffer "No method are specified for %s\n"
 312                                   (mime-type/subtype-string
 313                                    (cdr (assq 'type situation))
 314                                    (cdr (assq 'subtype situation))))
 315            (if (y-or-n-p "Do you want to save current entity to disk?")
 316                (mime-save-content entity situation))))))
 317
 318
 319 ;;; @ external decoder
 320 ;;;
 321
 322 (defvar mime-mailcap-method-filename-alist nil)
 323
 324 (defun mime-activate-mailcap-method (entity situation)
 325   (let ((method (cdr (assoc 'method situation)))
 326         (name (mime-entity-safe-filename entity)))
 327     (setq name
 328           (if (and name (not (string= name "")))
 329               (expand-file-name name temporary-file-directory)
 330             (make-temp-name
 331              (expand-file-name "EMI" temporary-file-directory))))
 332     (mime-write-entity-content entity name)
 333     (message "External method is starting...")
 334     (let ((process
 335            (let ((command
 336                   (mailcap-format-command
 337                    method
 338                    (cons (cons 'filename name) situation))))
 339              (start-process command mime-echo-buffer-name
 340                             shell-file-name shell-command-switch command))))
 341       (set-alist 'mime-mailcap-method-filename-alist process name)
 342       (set-process-sentinel process 'mime-mailcap-method-sentinel))))
 343
 344 (defun mime-mailcap-method-sentinel (process event)
 345   (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
 346     (if (file-exists-p file)
 347         (delete-file file)))
 348   (remove-alist 'mime-mailcap-method-filename-alist process)
 349   (message (format "%s %s" process event)))
 350
 351 (defvar mime-echo-window-is-shared-with-bbdb
 352   (module-installed-p 'bbdb)
 353   "*If non-nil, mime-echo window is shared with BBDB window.")
 354
 355 (defvar mime-echo-window-height
 356   (function
 357    (lambda ()
 358      (/ (window-height) 5)))
 359   "*Size of mime-echo window.
 360 It allows function or integer.  If it is function,
 361 `mime-show-echo-buffer' calls it to get height of mime-echo window.
 362 Otherwise `mime-show-echo-buffer' uses it as height of mime-echo
 363 window.")
 364
 365 (defun mime-show-echo-buffer (&rest forms)
 366   "Show mime-echo buffer to display MIME-playing information."
 367   (get-buffer-create mime-echo-buffer-name)
 368   (let ((the-win (selected-window))
 369         (win (get-buffer-window mime-echo-buffer-name)))
 370     (unless win
 371       (unless (and mime-echo-window-is-shared-with-bbdb
 372                    (condition-case nil
 373                        (setq win (get-buffer-window bbdb-buffer-name))
 374                      (error nil)))
 375         (select-window (get-buffer-window (or mime-preview-buffer
 376                                               (current-buffer))))
 377         (setq win (split-window-vertically
 378                    (- (window-height)
 379                       (if (functionp mime-echo-window-height)
 380                           (funcall mime-echo-window-height)
 381                         mime-echo-window-height)))))
 382       (set-window-buffer win mime-echo-buffer-name))
 383     (select-window win)
 384     (goto-char (point-max))
 385     (if forms
 386         (let ((buffer-read-only nil))
 387           (insert (apply (function format) forms))))
 388     (select-window the-win)))
 389
 390
 391 ;;; @ file name
 392 ;;;
 393
 394 (defvar mime-view-file-name-char-regexp "[A-Za-z0-9+_-]")
 395
 396 (defvar mime-view-file-name-regexp-1
 397   (concat mime-view-file-name-char-regexp "+\\."
 398           mime-view-file-name-char-regexp "+"))
 399
 400 (defvar mime-view-file-name-regexp-2
 401   (concat (regexp-* mime-view-file-name-char-regexp)
 402           "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
 403
 404 (defun mime-entity-safe-filename (entity)
 405   (let ((filename
 406          (or (mime-entity-filename entity)
 407              (let ((subj
 408                     (or (mime-entity-read-field entity 'Content-Description)
 409                         (mime-entity-read-field entity 'Subject))))
 410                (if (and subj
 411                         (or (string-match mime-view-file-name-regexp-1 subj)
 412                             (string-match mime-view-file-name-regexp-2 subj)))
 413                    (substring subj (match-beginning 0)(match-end 0)))))))
 414     (if filename
 415         (replace-as-filename filename))))
 416
 417
 418 ;;; @ file extraction
 419 ;;;
 420
 421 (defun mime-save-content (entity situation)
 422   (let ((name (or (mime-entity-safe-filename entity)
 423                   (format "%s" (mime-entity-media-type entity))))
 424         (dir (if (eq t mime-save-directory)
 425                  default-directory
 426                mime-save-directory))
 427         filename)
 428     (setq filename (read-file-name
 429                     (concat "File name: (default "
 430                             (file-name-nondirectory name) ") ")
 431                     dir
 432                     (concat (file-name-as-directory dir)
 433                             (file-name-nondirectory name))))
 434     (if (file-directory-p filename)
 435         (setq filename (concat (file-name-as-directory filename)
 436                                (file-name-nondirectory name))))
 437     (if (file-exists-p filename)
 438         (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
 439             (error "")))
 440     (mime-write-entity-content entity (expand-file-name filename))))
 441
 442 (defun mime-save-content-for-broken-message (entity situation)
 443   (let ((name (or (and (mime-entity-filename entity)
 444                        (eword-decode-string
 445                         (mime-entity-filename entity)))
 446                   (format "%s" (mime-entity-media-type entity))))
 447         (dir (if (eq t mime-save-directory)
 448                  default-directory
 449                mime-save-directory))
 450         filename)
 451     (setq filename (read-file-name
 452                     (concat "File name: (default "
 453                             (file-name-nondirectory name) ") ")
 454                     dir
 455                     (concat (file-name-as-directory dir)
 456                             (file-name-nondirectory name))))
 457     (if (file-directory-p filename)
 458         (setq filename (concat (file-name-as-directory filename)
 459                                (file-name-nondirectory name))))
 460     (if (file-exists-p filename)
 461         (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
 462             (error "")))
 463     (mime-write-entity-content entity (expand-file-name filename))))
 464
 465 ;;; @ file detection
 466 ;;;
 467
 468 (defvar mime-magic-type-alist
 469   '(("^\377\330\377[\340\356]..JFIF"    image jpeg)
 470     ("^\211PNG"                         image png)
 471     ("^GIF8[79]"                        image gif)
 472     ("^II\\*\000"                       image tiff)
 473     ("^MM\000\\*"                       image tiff)
 474     ("^MThd"                            audio midi)
 475     ("^\000\000\001\263"                video mpeg))
 476   "*Alist of regexp about magic-number vs. corresponding media-types.
 477 Each element looks like (REGEXP TYPE SUBTYPE).
 478 REGEXP is a regular expression to match against the beginning of the
 479 content of entity.
 480 TYPE is symbol to indicate primary type of media-type.
 481 SUBTYPE is symbol to indicate subtype of media-type.")
 482
 483 (defun mime-detect-content (entity situation)
 484   (let (type subtype)
 485     (let ((mdata (mime-entity-content entity))
 486           (rest mime-magic-type-alist))
 487       (while (not (let ((cell (car rest)))
 488                     (if cell
 489                         (if (string-match (car cell) mdata)
 490                             (setq type (nth 1 cell)
 491                                   subtype (nth 2 cell)))
 492                       t)))
 493         (setq rest (cdr rest))))
 494     (setq situation (del-alist 'method (copy-alist situation)))
 495     (mime-play-entity entity
 496                       (if type
 497                           (put-alist 'type type
 498                                      (put-alist 'subtype subtype
 499                                                 situation))
 500                         situation)
 501                       'mime-detect-content)))
 502
 503
 504 ;;; @ mail/news message
 505 ;;;
 506
 507 (defun mime-preview-quitting-method-for-mime-show-message-mode ()
 508   "Quitting method for mime-view.
 509 It is registered to variable `mime-preview-quitting-method-alist'."
 510   (let ((mother mime-mother-buffer)
 511         (win-conf mime-preview-original-window-configuration))
 512     (if (and (boundp 'mime-view-temp-message-buffer)
 513              (buffer-live-p mime-view-temp-message-buffer))
 514         (kill-buffer mime-view-temp-message-buffer))
 515     (mime-preview-kill-buffer)
 516     (set-window-configuration win-conf)
 517     (pop-to-buffer mother)))
 518
 519 (defun mime-view-message/rfc822 (entity situation)
 520   (let* ((new-name
 521           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 522          (mother (current-buffer))
 523          (children (car (mime-entity-children entity)))
 524          (preview-buffer
 525           (mime-display-message
 526            children new-name mother nil
 527            (cdr (assq 'major-mode
 528                       (get-text-property (point) 'mime-view-situation))))))
 529     (or (get-buffer-window preview-buffer)
 530         (let ((m-win (get-buffer-window mother)))
 531           (if m-win
 532               (set-window-buffer m-win preview-buffer)
 533             (switch-to-buffer preview-buffer))))))
 534
 535
 536 ;;; @ message/partial
 537 ;;;
 538
 539 (defun mime-store-message/partial-piece (entity cal)
 540   (let* ((root-dir
 541           (expand-file-name
 542            (concat "m-prts-" (user-login-name)) temporary-file-directory))
 543          (id (cdr (assoc "id" cal)))
 544          (number (cdr (assoc "number" cal)))
 545          (total (cdr (assoc "total" cal)))
 546          file
 547          (mother (current-buffer)))
 548     (or (file-exists-p root-dir)
 549         (make-directory root-dir))
 550     (setq id (replace-as-filename id))
 551     (setq root-dir (concat root-dir "/" id))
 552     (or (file-exists-p root-dir)
 553         (make-directory root-dir))
 554     (setq file (concat root-dir "/FULL"))
 555     (if (file-exists-p file)
 556         (let ((full-buf (get-buffer-create "FULL"))
 557               (pwin (or (get-buffer-window mother)
 558                         (get-largest-window)))
 559               pbuf)
 560           (save-window-excursion
 561             (set-buffer full-buf)
 562             (erase-buffer)
 563             (insert-file-contents-as-binary file)
 564             (setq major-mode 'mime-show-message-mode)
 565             (mime-view-buffer (current-buffer) nil mother)
 566             (setq pbuf (current-buffer))
 567             (make-local-variable 'mime-view-temp-message-buffer)
 568             (setq mime-view-temp-message-buffer full-buf))
 569           (set-window-buffer pwin pbuf)
 570           (select-window pwin))
 571       (setq file (concat root-dir "/" number))
 572       (mime-write-entity-body entity file)
 573       (let ((total-file (concat root-dir "/CT")))
 574         (setq total
 575               (if total
 576                   (progn
 577                     (or (file-exists-p total-file)
 578                         (save-excursion
 579                           (set-buffer
 580                            (get-buffer-create mime-temp-buffer-name))
 581                           (erase-buffer)
 582                           (insert total)
 583                           (write-region (point-min)(point-max) total-file)
 584                           (kill-buffer (current-buffer))))
 585                     (string-to-number total))
 586                 (and (file-exists-p total-file)
 587                      (save-excursion
 588                        (set-buffer (find-file-noselect total-file))
 589                        (prog1
 590                            (and (re-search-forward "[0-9]+" nil t)
 591                                 (string-to-number
 592                                  (buffer-substring (match-beginning 0)
 593                                                    (match-end 0))))
 594                          (kill-buffer (current-buffer))))))))
 595       (if (and total (> total 0)
 596                (>= (length (directory-files root-dir nil "^[0-9]+$" t))
 597                    total))
 598           (catch 'tag
 599             (save-excursion
 600               (set-buffer (get-buffer-create mime-temp-buffer-name))
 601               (let ((full-buf (current-buffer)))
 602                 (erase-buffer)
 603                 (let ((i 1))
 604                   (while (<= i total)
 605                     (setq file (concat root-dir "/" (int-to-string i)))
 606                     (or (file-exists-p file)
 607                         (throw 'tag nil))
 608                     (as-binary-input-file (insert-file-contents file))
 609                     (goto-char (point-max))
 610                     (setq i (1+ i))))
 611                 (write-region-as-binary (point-min)(point-max)
 612                                         (expand-file-name "FULL" root-dir))
 613                 (let ((i 1))
 614                   (while (<= i total)
 615                     (let ((file (format "%s/%d" root-dir i)))
 616                       (and (file-exists-p file)
 617                            (delete-file file)))
 618                     (setq i (1+ i))))
 619                 (let ((file (expand-file-name "CT" root-dir)))
 620                   (and (file-exists-p file)
 621                        (delete-file file)))
 622                 (let ((buf (current-buffer))
 623                       (pwin (or (get-buffer-window mother)
 624                                 (get-largest-window)))
 625                       (pbuf (mime-display-message
 626                              (mime-open-entity 'buffer (current-buffer))
 627                              nil mother nil 'mime-show-message-mode)))
 628                   (with-current-buffer pbuf
 629                     (make-local-variable 'mime-view-temp-message-buffer)
 630                     (setq mime-view-temp-message-buffer buf))
 631                   (set-window-buffer pwin pbuf)
 632                   (select-window pwin)))))))))
 633
 634
 635 ;;; @ message/external-body
 636 ;;;
 637
 638 (defvar mime-raw-dired-function
 639   (if (and (>= emacs-major-version 19) window-system)
 640       (function dired-other-frame)
 641     (function mime-raw-dired-function-for-one-frame)))
 642
 643 (defun mime-raw-dired-function-for-one-frame (dir)
 644   (let ((win (or (get-buffer-window mime-preview-buffer)
 645                  (get-largest-window))))
 646     (select-window win)
 647     (dired dir)))
 648
 649 (defun mime-view-message/external-anon-ftp (entity cal)
 650   (let* ((site (cdr (assoc "site" cal)))
 651          (directory (cdr (assoc "directory" cal)))
 652          (name (cdr (assoc "name" cal)))
 653          (pathname (concat "/anonymous@" site ":" directory)))
 654     (message (concat "Accessing " (expand-file-name name pathname) "..."))
 655     (funcall mime-raw-dired-function pathname)
 656     (goto-char (point-min))
 657     (search-forward name)))
 658
 659 (defvar mime-raw-browse-url-function mime-browse-url-function)
 660
 661 (defun mime-view-message/external-url (entity cal)
 662   (let ((url (cdr (assoc "url" cal))))
 663     (message (concat "Accessing " url "..."))
 664     (funcall mime-raw-browse-url-function url)))
 665
 666
 667 ;;; @ rot13-47
 668 ;;;
 669
 670 (defun mime-view-caesar (entity situation)
 671   "Internal method for mime-view to display ROT13-47-48 message."
 672   (let ((buf (get-buffer-create
 673               (format "%s-%s" (buffer-name) (mime-entity-number entity)))))
 674     (with-current-buffer buf
 675       (setq buffer-read-only nil)
 676       (erase-buffer)
 677       (mime-insert-text-content entity)
 678       (mule-caesar-region (point-min) (point-max))
 679       (set-buffer-modified-p nil))
 680     (let ((win (get-buffer-window (current-buffer))))
 681       (or (eq (selected-window) win)
 682           (select-window (or win (get-largest-window)))))
 683     (view-buffer buf)
 684     (goto-char (point-min))))
 685
 686
 687 ;;; @ end
 688 ;;;
 689
 690 (provide 'mime-play)
 691
 692 (let* ((file mime-acting-situation-examples-file)
 693        (buffer (get-buffer-create " *mime-example*")))
 694   (if (file-readable-p file)
 695       (unwind-protect
 696           (save-excursion
 697             (set-buffer buffer)
 698             (erase-buffer)
 699             (insert-file-contents file)
 700             (eval-buffer)
 701             ;; format check
 702             (condition-case nil
 703                 (let ((i 0))
 704                   (while (and (> (length mime-acting-situation-example-list)
 705                                  mime-acting-situation-example-list-max-size)
 706                               (< i 16))
 707                     (mime-reduce-acting-situation-examples)
 708                     (setq i (1+ i))))
 709               (error (setq mime-acting-situation-example-list nil))))
 710         (kill-buffer buffer))))
 711
 712 ;;; mime-play.el ends here