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