mime-view.el

   1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1994/07/13
   7 ;;      Renamed: 1994/08/31 from tm-body.el
   8 ;;      Renamed: 1997/02/19 from tm-view.el
   9 ;; Keywords: MIME, multimedia, mail, news
  10
  11 ;; This file is part of WEMI (Widget based Emacs MIME Interfaces).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'mime)
  31 (require 'semi-def)
  32 (require 'calist)
  33 (require 'alist)
  34 (require 'mailcap)
  35
  36
  37 ;;; @ version
  38 ;;;
  39
  40 (defconst mime-view-version-string
  41   `,(concat (car mime-user-interface-version) " MIME-View "
  42             (mapconcat #'number-to-string
  43                        (cddr mime-user-interface-version) ".")
  44             " (" (cadr mime-user-interface-version) ")"))
  45
  46
  47 ;;; @ variables
  48 ;;;
  49
  50 (defgroup mime-view nil
  51   "MIME view mode"
  52   :group 'mime)
  53
  54 (defcustom mime-view-find-every-acting-situation t
  55   "*Find every available acting-situation if non-nil."
  56   :group 'mime-view
  57   :type 'boolean)
  58
  59 (defcustom mime-acting-situation-examples-file "~/.mime-example"
  60   "*File name of example about acting-situation demonstrated by user."
  61   :group 'mime-view
  62   :type 'file)
  63
  64
  65 ;;; @ in raw-buffer (representation space)
  66 ;;;
  67
  68 (defvar mime-preview-buffer nil
  69   "MIME-preview buffer corresponding with the (raw) buffer.")
  70 (make-variable-buffer-local 'mime-preview-buffer)
  71
  72
  73 (defvar mime-raw-representation-type nil
  74   "Representation-type of mime-raw-buffer.
  75 It must be nil, `binary' or `cooked'.
  76 If it is nil, `mime-raw-representation-type-alist' is used as default
  77 value.
  78 Notice that this variable is usually used as buffer local variable in
  79 raw-buffer.")
  80
  81 (make-variable-buffer-local 'mime-raw-representation-type)
  82
  83 (defvar mime-raw-representation-type-alist
  84   '((mime-show-message-mode     . binary)
  85     (mime-temp-message-mode     . binary)
  86     (t                          . cooked)
  87     )
  88   "Alist of major-mode vs. representation-type of mime-raw-buffer.
  89 Each element looks like (SYMBOL . REPRESENTATION-TYPE).  SYMBOL is
  90 major-mode or t.  t means default.  REPRESENTATION-TYPE must be
  91 `binary' or `cooked'.
  92 This value is overridden by buffer local variable
  93 `mime-raw-representation-type' if it is not nil.")
  94
  95
  96 (defsubst mime-raw-find-entity-from-node-id (entity-node-id
  97                                              &optional message-info)
  98   "Return entity from ENTITY-NODE-ID in mime-raw-buffer.
  99 If optional argument MESSAGE-INFO is not specified,
 100 `mime-message-structure' is used."
 101   (mime-raw-find-entity-from-number (reverse entity-node-id) message-info))
 102
 103 (defun mime-raw-find-entity-from-number (entity-number &optional message-info)
 104   "Return entity from ENTITY-NUMBER in mime-raw-buffer.
 105 If optional argument MESSAGE-INFO is not specified,
 106 `mime-message-structure' is used."
 107   (or message-info
 108       (setq message-info mime-message-structure))
 109   (if (eq entity-number t)
 110       message-info
 111     (let ((sn (car entity-number)))
 112       (if (null sn)
 113           message-info
 114         (let ((rc (nth sn (mime-entity-children message-info))))
 115           (if rc
 116               (mime-raw-find-entity-from-number (cdr entity-number) rc)
 117             ))
 118         ))))
 119
 120 (defun mime-raw-find-entity-from-point (point &optional message-info)
 121   "Return entity from POINT in mime-raw-buffer.
 122 If optional argument MESSAGE-INFO is not specified,
 123 `mime-message-structure' is used."
 124   (or message-info
 125       (setq message-info mime-message-structure))
 126   (if (and (<= (mime-entity-point-min message-info) point)
 127            (<= point (mime-entity-point-max message-info)))
 128       (let ((children (mime-entity-children message-info)))
 129         (catch 'tag
 130           (while children
 131             (let ((ret
 132                    (mime-raw-find-entity-from-point point (car children))))
 133               (if ret
 134                   (throw 'tag ret)
 135                 ))
 136             (setq children (cdr children)))
 137           message-info))))
 138
 139
 140 ;;; @ in preview-buffer (presentation space)
 141 ;;;
 142
 143 (defvar mime-mother-buffer nil
 144   "Mother buffer corresponding with the (MIME-preview) buffer.
 145 If current MIME-preview buffer is generated by other buffer, such as
 146 message/partial, it is called `mother-buffer'.")
 147 (make-variable-buffer-local 'mime-mother-buffer)
 148
 149 (defvar mime-raw-buffer nil
 150   "Raw buffer corresponding with the (MIME-preview) buffer.")
 151 (make-variable-buffer-local 'mime-raw-buffer)
 152
 153 (defvar mime-preview-original-window-configuration nil
 154   "Window-configuration before mime-view-mode is called.")
 155 (make-variable-buffer-local 'mime-preview-original-window-configuration)
 156
 157 (defun mime-preview-original-major-mode (&optional recursive)
 158   "Return major-mode of original buffer.
 159 If optional argument RECURSIVE is non-nil and current buffer has
 160 mime-mother-buffer, it returns original major-mode of the
 161 mother-buffer."
 162   (if (and recursive mime-mother-buffer)
 163       (save-excursion
 164         (set-buffer mime-mother-buffer)
 165         (mime-preview-original-major-mode recursive)
 166         )
 167     (save-excursion
 168       (set-buffer
 169        (mime-entity-buffer
 170         (get-text-property (point-min) 'mime-view-entity)))
 171       major-mode)))
 172
 173
 174 ;;; @ entity information
 175 ;;;
 176
 177 (defsubst mime-entity-representation-type (entity)
 178   (with-current-buffer (mime-entity-buffer entity)
 179     (or mime-raw-representation-type
 180         (cdr (or (assq major-mode mime-raw-representation-type-alist)
 181                  (assq t mime-raw-representation-type-alist))))))
 182
 183 (defsubst mime-entity-cooked-p (entity)
 184   (eq (mime-entity-representation-type entity) 'cooked))
 185
 186 (defsubst mime-entity-parent (entity &optional message-info)
 187   "Return mother entity of ENTITY.
 188 If optional argument MESSAGE-INFO is not specified,
 189 `mime-message-structure' in buffer of ENTITY is used."
 190   (mime-raw-find-entity-from-node-id
 191    (cdr (mime-entity-node-id entity))
 192    (or message-info
 193        (save-excursion
 194          (set-buffer (mime-entity-buffer entity))
 195          mime-message-structure))))
 196
 197 (defun mime-entity-situation (entity)
 198   "Return situation of ENTITY."
 199   (append (or (mime-entity-content-type entity)
 200               (make-mime-content-type 'text 'plain))
 201           (let ((d (mime-entity-content-disposition entity)))
 202             (cons (cons 'disposition-type
 203                         (mime-content-disposition-type d))
 204                   (mapcar (function
 205                            (lambda (param)
 206                              (let ((name (car param)))
 207                                (cons (cond ((string= name "filename")
 208                                             'filename)
 209                                            ((string= name "creation-date")
 210                                             'creation-date)
 211                                            ((string= name "modification-date")
 212                                             'modification-date)
 213                                            ((string= name "read-date")
 214                                             'read-date)
 215                                            ((string= name "size")
 216                                             'size)
 217                                            (t (cons 'disposition (car param))))
 218                                      (cdr param)))))
 219                           (mime-content-disposition-parameters d))
 220                   ))
 221           (list (cons 'encoding (mime-entity-encoding entity))
 222                 (cons 'major-mode
 223                       (save-excursion
 224                         (set-buffer (mime-entity-buffer entity))
 225                         major-mode)))
 226           ))
 227
 228
 229 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 230
 231 (defun mime-entity-uu-filename (entity)
 232   (if (member (mime-entity-encoding entity)
 233               mime-view-uuencode-encoding-name-list)
 234       (save-excursion
 235         (set-buffer (mime-entity-buffer entity))
 236         (goto-char (mime-entity-body-start entity))
 237         (if (re-search-forward "^begin [0-9]+ "
 238                                (mime-entity-body-end entity) t)
 239             (if (looking-at ".+$")
 240                 (buffer-substring (match-beginning 0)(match-end 0))
 241               )))))
 242
 243 (defun mime-entity-filename (entity)
 244   (or (mime-entity-uu-filename entity)
 245       (mime-content-disposition-filename
 246        (mime-entity-content-disposition entity))
 247       (cdr (let ((param (mime-content-type-parameters
 248                          (mime-entity-content-type entity))))
 249              (or (assoc "name" param)
 250                  (assoc "x-name" param))
 251              ))))
 252
 253 (defun mime-view-entity-title (entity)
 254   (or (mime-entity-read-field entity 'Content-Description)
 255       (mime-entity-read-field entity 'Subject)
 256       (mime-entity-filename entity)
 257       ""))
 258
 259
 260 (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
 261   "Return entity-node-id from POINT in mime-raw-buffer.
 262 If optional argument MESSAGE-INFO is not specified,
 263 `mime-message-structure' is used."
 264   (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
 265
 266 (defsubst mime-raw-point-to-entity-number (point &optional message-info)
 267   "Return entity-number from POINT in mime-raw-buffer.
 268 If optional argument MESSAGE-INFO is not specified,
 269 `mime-message-structure' is used."
 270   (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
 271
 272 (defun mime-raw-flatten-message-info (&optional message-info)
 273   "Return list of entity in mime-raw-buffer.
 274 If optional argument MESSAGE-INFO is not specified,
 275 `mime-message-structure' is used."
 276   (or message-info
 277       (setq message-info mime-message-structure))
 278   (let ((dest (list message-info))
 279         (rcl (mime-entity-children message-info)))
 280     (while rcl
 281       (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
 282       (setq rcl (cdr rcl)))
 283     dest))
 284
 285
 286 ;;; @ presentation of preview
 287 ;;;
 288
 289 ;;; @@ entity-button
 290 ;;;
 291
 292 ;;; @@@ predicate function
 293 ;;;
 294
 295 (defun mime-view-entity-button-visible-p (entity)
 296   "Return non-nil if header of ENTITY is visible.
 297 Please redefine this function if you want to change default setting."
 298   (let ((media-type (mime-entity-media-type entity))
 299         (media-subtype (mime-entity-media-subtype entity)))
 300     (or (not (eq media-type 'application))
 301         (and (not (eq media-subtype 'x-selection))
 302              (or (not (eq media-subtype 'octet-stream))
 303                  (let ((mother-entity (mime-entity-parent entity)))
 304                    (or (not (eq (mime-entity-media-type mother-entity)
 305                                 'multipart))
 306                        (not (eq (mime-entity-media-subtype mother-entity)
 307                                 'encrypted)))
 308                    )
 309                  )))))
 310
 311 ;;; @@@ entity button generator
 312 ;;;
 313
 314 (defun mime-view-insert-entity-button (entity)
 315   "Insert entity-button of ENTITY."
 316   (let ((entity-node-id (mime-entity-node-id entity))
 317         (params (mime-entity-parameters entity))
 318         (subject (mime-view-entity-title entity)))
 319     (mime-insert-button
 320      (let ((access-type (assoc "access-type" params))
 321            (num (or (cdr (assoc "x-part-number" params))
 322                     (if (consp entity-node-id)
 323                         (mapconcat (function
 324                                     (lambda (num)
 325                                       (format "%s" (1+ num))
 326                                       ))
 327                                    (reverse entity-node-id) ".")
 328                       "0"))
 329                 ))
 330        (cond (access-type
 331               (let ((server (assoc "server" params)))
 332                 (setq access-type (cdr access-type))
 333                 (if server
 334                     (format "%s %s ([%s] %s)"
 335                             num subject access-type (cdr server))
 336                 (let ((site (cdr (assoc "site" params)))
 337                       (dir (cdr (assoc "directory" params)))
 338                       )
 339                   (format "%s %s ([%s] %s:%s)"
 340                           num subject access-type site dir)
 341                   )))
 342             )
 343            (t
 344             (let ((media-type (mime-entity-media-type entity))
 345                   (media-subtype (mime-entity-media-subtype entity))
 346                   (charset (cdr (assoc "charset" params)))
 347                   (encoding (mime-entity-encoding entity)))
 348               (concat
 349                num " " subject
 350                (let ((rest
 351                       (format " <%s/%s%s%s>"
 352                               media-type media-subtype
 353                               (if charset
 354                                   (concat "; " charset)
 355                                 "")
 356                               (if encoding
 357                                   (concat " (" encoding ")")
 358                                 ""))))
 359                  (if (>= (+ (current-column)(length rest))(window-width))
 360                      "\n\t")
 361                  rest)))
 362             )))
 363      (function mime-preview-play-current-entity))
 364     ))
 365
 366
 367 ;;; @@ entity-header
 368 ;;;
 369
 370 (defvar mime-header-presentation-method-alist nil
 371   "Alist of major mode vs. corresponding header-presentation-method functions.
 372 Each element looks like (SYMBOL . FUNCTION).
 373 SYMBOL must be major mode in raw-buffer or t.  t means default.
 374 Interface of FUNCTION must be (ENTITY SITUATION).")
 375
 376 (defvar mime-view-ignored-field-list
 377   '(".*Received" ".*Path" ".*Id" "References"
 378     "Replied" "Errors-To"
 379     "Lines" "Sender" ".*Host" "Xref"
 380     "Content-Type" "Precedence"
 381     "Status" "X-VM-.*")
 382   "All fields that match this list will be hidden in MIME preview buffer.
 383 Each elements are regexp of field-name.")
 384
 385 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
 386   "All fields that match this list will be displayed in MIME preview buffer.
 387 Each elements are regexp of field-name.")
 388
 389
 390 ;;; @@ entity-body
 391 ;;;
 392
 393 ;;; @@@ predicate function
 394 ;;;
 395
 396 (defun mime-calist::field-match-method-as-default-rule (calist
 397                                                         field-type field-value)
 398   (let ((s-field (assq field-type calist)))
 399     (cond ((null s-field)
 400            (cons (cons field-type field-value) calist)
 401            )
 402           (t calist))))
 403
 404 (define-calist-field-match-method
 405   'header #'mime-calist::field-match-method-as-default-rule)
 406
 407 (define-calist-field-match-method
 408   'body #'mime-calist::field-match-method-as-default-rule)
 409
 410
 411 (defvar mime-preview-condition nil
 412   "Condition-tree about how to display entity.")
 413
 414 (ctree-set-calist-strictly
 415  'mime-preview-condition '((type . application)(subtype . octet-stream)
 416                            (encoding . nil)
 417                            (body . visible)))
 418 (ctree-set-calist-strictly
 419  'mime-preview-condition '((type . application)(subtype . octet-stream)
 420                            (encoding . "7bit")
 421                            (body . visible)))
 422 (ctree-set-calist-strictly
 423  'mime-preview-condition '((type . application)(subtype . octet-stream)
 424                            (encoding . "8bit")
 425                            (body . visible)))
 426
 427 (ctree-set-calist-strictly
 428  'mime-preview-condition '((type . application)(subtype . pgp)
 429                            (body . visible)))
 430
 431 (ctree-set-calist-strictly
 432  'mime-preview-condition '((type . application)(subtype . x-latex)
 433                            (body . visible)))
 434
 435 (ctree-set-calist-strictly
 436  'mime-preview-condition '((type . application)(subtype . x-selection)
 437                            (body . visible)))
 438
 439 (ctree-set-calist-strictly
 440  'mime-preview-condition '((type . application)(subtype . x-comment)
 441                            (body . visible)))
 442
 443 (ctree-set-calist-strictly
 444  'mime-preview-condition '((type . message)(subtype . delivery-status)
 445                            (body . visible)))
 446
 447 (ctree-set-calist-strictly
 448  'mime-preview-condition
 449  '((body . visible)
 450    (body-presentation-method . mime-display-text/plain)))
 451
 452 (ctree-set-calist-strictly
 453  'mime-preview-condition
 454  '((type . nil)
 455    (body . visible)
 456    (body-presentation-method . mime-display-text/plain)))
 457
 458 (ctree-set-calist-strictly
 459  'mime-preview-condition
 460  '((type . text)(subtype . enriched)
 461    (body . visible)
 462    (body-presentation-method . mime-display-text/enriched)))
 463
 464 (ctree-set-calist-strictly
 465  'mime-preview-condition
 466  '((type . text)(subtype . richtext)
 467    (body . visible)
 468    (body-presentation-method . mime-display-text/richtext)))
 469
 470 (ctree-set-calist-strictly
 471  'mime-preview-condition
 472  '((type . text)(subtype . t)
 473    (body . visible)
 474    (body-presentation-method . mime-display-text/plain)))
 475
 476 (ctree-set-calist-strictly
 477  'mime-preview-condition
 478  '((type . multipart)(subtype . alternative)
 479    (body . visible)
 480    (body-presentation-method . mime-display-multipart/alternative)))
 481
 482 (ctree-set-calist-strictly
 483  'mime-preview-condition '((type . message)(subtype . partial)
 484                            (body-presentation-method
 485                             . mime-display-message/partial-button)))
 486
 487 (ctree-set-calist-strictly
 488  'mime-preview-condition '((type . message)(subtype . rfc822)
 489                            (body-presentation-method . nil)
 490                            (childrens-situation (header . visible)
 491                                                 (entity-button . invisible))))
 492
 493 (ctree-set-calist-strictly
 494  'mime-preview-condition '((type . message)(subtype . news)
 495                            (body-presentation-method . nil)
 496                            (childrens-situation (header . visible)
 497                                                 (entity-button . invisible))))
 498
 499
 500 ;;; @@@ entity presentation
 501 ;;;
 502
 503 (autoload 'mime-display-text/plain "mime-text")
 504 (autoload 'mime-display-text/enriched "mime-text")
 505 (autoload 'mime-display-text/richtext "mime-text")
 506
 507 (defvar mime-view-announcement-for-message/partial
 508   (if (and (>= emacs-major-version 19) window-system)
 509       "\
 510 This is message/partial style split message.
 511 Please press `v' key in this buffer or click here by mouse button-2."
 512     "\
 513 This is message/partial style split message.
 514 Please press `v' key in this buffer."
 515     ))
 516
 517 (defun mime-display-message/partial-button (&optional entity situation)
 518   (save-restriction
 519     (goto-char (point-max))
 520     (if (not (search-backward "\n\n" nil t))
 521         (insert "\n")
 522       )
 523     (goto-char (point-max))
 524     ;;(narrow-to-region (point-max)(point-max))
 525     ;;(insert mime-view-announcement-for-message/partial)
 526     ;; (mime-add-button (point-min)(point-max)
 527     ;;                  #'mime-preview-play-current-entity)
 528     (mime-insert-button mime-view-announcement-for-message/partial
 529                         #'mime-preview-play-current-entity)
 530     ))
 531
 532 (defun mime-display-multipart/mixed (entity situation)
 533   (let ((children (mime-entity-children entity))
 534         (default-situation
 535           (cdr (assq 'childrens-situation situation))))
 536     (while children
 537       (mime-display-entity (car children) nil default-situation)
 538       (setq children (cdr children))
 539       )))
 540
 541 (defcustom mime-view-type-subtype-score-alist
 542   '(((text . enriched) . 3)
 543     ((text . richtext) . 2)
 544     ((text . plain)    . 1)
 545     (t . 0))
 546   "Alist MEDIA-TYPE vs corresponding score.
 547 MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 548   :group 'mime-view
 549   :type '(repeat (cons (choice :tag "Media-Type"
 550                                (item :tag "Type/Subtype"
 551                                      (cons symbol symbol))
 552                                (item :tag "Type" symbol)
 553                                (item :tag "Default" t))
 554                        integer)))
 555
 556 (defun mime-display-multipart/alternative (entity situation)
 557   (let* ((children (mime-entity-children entity))
 558          (default-situation
 559            (cdr (assq 'childrens-situation situation)))
 560          (i 0)
 561          (p 0)
 562          (max-score 0)
 563          (situations
 564           (mapcar (function
 565                    (lambda (child)
 566                      (let ((situation
 567                             (or (ctree-match-calist
 568                                  mime-preview-condition
 569                                  (append (mime-entity-situation child)
 570                                          default-situation))
 571                                 default-situation)))
 572                        (if (cdr (assq 'body-presentation-method situation))
 573                            (let ((score
 574                                   (cdr
 575                                    (or (assoc
 576                                         (cons
 577                                          (cdr (assq 'type situation))
 578                                          (cdr (assq 'subtype situation)))
 579                                         mime-view-type-subtype-score-alist)
 580                                        (assq
 581                                         (cdr (assq 'type situation))
 582                                         mime-view-type-subtype-score-alist)
 583                                        (assq
 584                                         t
 585                                         mime-view-type-subtype-score-alist)
 586                                        ))))
 587                              (if (> score max-score)
 588                                  (setq p i
 589                                        max-score score)
 590                                )))
 591                        (setq i (1+ i))
 592                        situation)
 593                      ))
 594                   children)))
 595     (setq i 0)
 596     (while children
 597       (let ((child (car children))
 598             (situation (car situations)))
 599         (mime-display-entity child (if (= i p)
 600                                        situation
 601                                      (del-alist 'body-presentation-method
 602                                                 (copy-alist situation))))
 603         )
 604       (setq children (cdr children)
 605             situations (cdr situations)
 606             i (1+ i))
 607       )))
 608
 609
 610 ;;; @ acting-condition
 611 ;;;
 612
 613 (defvar mime-acting-condition nil
 614   "Condition-tree about how to process entity.")
 615
 616 (if (file-readable-p mailcap-file)
 617     (let ((entries (mailcap-parse-file)))
 618       (while entries
 619         (let ((entry (car entries))
 620               view print shared)
 621           (while entry
 622             (let* ((field (car entry))
 623                    (field-type (car field)))
 624               (cond ((eq field-type 'view)  (setq view field))
 625                     ((eq field-type 'print) (setq print field))
 626                     ((memq field-type '(compose composetyped edit)))
 627                     (t (setq shared (cons field shared))))
 628               )
 629             (setq entry (cdr entry))
 630             )
 631           (setq shared (nreverse shared))
 632           (ctree-set-calist-with-default
 633            'mime-acting-condition
 634            (append shared (list '(mode . "play")(cons 'method (cdr view)))))
 635           (if print
 636               (ctree-set-calist-with-default
 637                'mime-acting-condition
 638                (append shared
 639                        (list '(mode . "print")(cons 'method (cdr view))))
 640                ))
 641           )
 642         (setq entries (cdr entries))
 643         )))
 644
 645 (ctree-set-calist-strictly
 646  'mime-acting-condition
 647  '((type . application)(subtype . octet-stream)
 648    (mode . "play")
 649    (method . mime-detect-content)
 650    ))
 651
 652 (ctree-set-calist-with-default
 653  'mime-acting-condition
 654  '((mode . "extract")
 655    (method . mime-save-content)))
 656
 657 (ctree-set-calist-strictly
 658  'mime-acting-condition
 659  '((type . text)(subtype . x-rot13-47)(mode . "play")
 660    (method . mime-view-caesar)
 661    ))
 662 (ctree-set-calist-strictly
 663  'mime-acting-condition
 664  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
 665    (method . mime-view-caesar)
 666    ))
 667
 668 (ctree-set-calist-strictly
 669  'mime-acting-condition
 670  '((type . message)(subtype . rfc822)(mode . "play")
 671    (method . mime-view-message/rfc822)
 672    ))
 673 (ctree-set-calist-strictly
 674  'mime-acting-condition
 675  '((type . message)(subtype . partial)(mode . "play")
 676    (method . mime-store-message/partial-piece)
 677    ))
 678
 679 (ctree-set-calist-strictly
 680  'mime-acting-condition
 681  '((type . message)(subtype . external-body)
 682    ("access-type" . "anon-ftp")
 683    (method . mime-view-message/external-ftp)
 684    ))
 685
 686 (ctree-set-calist-strictly
 687  'mime-acting-condition
 688  '((type . application)(subtype . octet-stream)
 689    (method . mime-save-content)
 690    ))
 691
 692
 693 ;;; @ quitting method
 694 ;;;
 695
 696 (defvar mime-preview-quitting-method-alist
 697   '((mime-show-message-mode
 698      . mime-preview-quitting-method-for-mime-show-message-mode))
 699   "Alist of major-mode vs. quitting-method of mime-view.")
 700
 701 (defvar mime-preview-over-to-previous-method-alist nil
 702   "Alist of major-mode vs. over-to-previous-method of mime-view.")
 703
 704 (defvar mime-preview-over-to-next-method-alist nil
 705   "Alist of major-mode vs. over-to-next-method of mime-view.")
 706
 707
 708 ;;; @ following method
 709 ;;;
 710
 711 (defvar mime-preview-following-method-alist nil
 712   "Alist of major-mode vs. following-method of mime-view.")
 713
 714 (defvar mime-view-following-required-fields-list
 715   '("From"))
 716
 717
 718 ;;; @ X-Face
 719 ;;;
 720
 721 ;; hack from Gnus 5.0.4.
 722
 723 (defvar mime-view-x-face-to-pbm-command
 724   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 725
 726 (defvar mime-view-x-face-command
 727   (concat mime-view-x-face-to-pbm-command
 728           " | xv -quit -")
 729   "String to be executed to display an X-Face field.
 730 The command will be executed in a sub-shell asynchronously.
 731 The compressed face will be piped to this command.")
 732
 733 (defun mime-view-x-face-function ()
 734   "Function to display X-Face field. You can redefine to customize."
 735   ;; 1995/10/12 (c.f. tm-eng:130)
 736   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 737   (save-restriction
 738     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 739     ;; end
 740     (goto-char (point-min))
 741     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 742         (let ((beg (match-end 0))
 743               (end (std11-field-end))
 744               )
 745           (call-process-region beg end "sh" nil 0 nil
 746                                "-c" mime-view-x-face-command)
 747           ))))
 748
 749
 750 ;;; @ buffer setup
 751 ;;;
 752
 753 (defun mime-display-entity (entity &optional situation
 754                                    default-situation preview-buffer)
 755   (or preview-buffer
 756       (setq preview-buffer (current-buffer)))
 757   (let* ((raw-buffer (mime-entity-buffer entity))
 758          (start (mime-entity-point-min entity))
 759          e nb ne)
 760     (set-buffer raw-buffer)
 761     (goto-char start)
 762     (or situation
 763         (setq situation
 764               (or (ctree-match-calist mime-preview-condition
 765                                       (append (mime-entity-situation entity)
 766                                               default-situation))
 767                   default-situation)))
 768     (let ((button-is-invisible
 769            (eq (cdr (assq 'entity-button situation)) 'invisible))
 770           (header-is-visible
 771            (eq (cdr (assq 'header situation)) 'visible))
 772           (header-presentation-method
 773            (or (cdr (assq 'header-presentation-method situation))
 774                (cdr (assq major-mode mime-header-presentation-method-alist))))
 775           (body-presentation-method
 776            (cdr (assq 'body-presentation-method situation)))
 777           (children (mime-entity-children entity)))
 778       (set-buffer preview-buffer)
 779       (setq nb (point))
 780       (narrow-to-region nb nb)
 781       (or button-is-invisible
 782           (if (mime-view-entity-button-visible-p entity)
 783               (mime-view-insert-entity-button entity)
 784             ))
 785       (when header-is-visible
 786         (if header-presentation-method
 787             (funcall header-presentation-method entity situation)
 788           (mime-insert-decoded-header entity
 789                                       mime-view-ignored-field-list
 790                                       mime-view-visible-field-list
 791                                       (if (mime-entity-cooked-p entity)
 792                                           nil
 793                                         default-mime-charset))
 794           )
 795         (goto-char (point-max))
 796         (insert "\n")
 797         (run-hooks 'mime-display-header-hook)
 798         )
 799       (cond (children)
 800             ((functionp body-presentation-method)
 801              (funcall body-presentation-method entity situation)
 802              )
 803             (t
 804              (when button-is-invisible
 805                (goto-char (point-max))
 806                (mime-view-insert-entity-button entity)
 807                )
 808              (or header-is-visible
 809                  (progn
 810                    (goto-char (point-max))
 811                    (insert "\n")
 812                    ))
 813              ))
 814       (setq ne (point-max))
 815       (widen)
 816       (put-text-property nb ne 'mime-view-entity entity)
 817       (goto-char ne)
 818       (if children
 819           (if (functionp body-presentation-method)
 820               (funcall body-presentation-method entity situation)
 821             (mime-display-multipart/mixed entity situation)
 822             ))
 823       )))
 824
 825
 826 ;;; @ MIME viewer mode
 827 ;;;
 828
 829 (defconst mime-view-menu-title "MIME-View")
 830 (defconst mime-view-menu-list
 831   '((up          "Move to upper entity"    mime-preview-move-to-upper)
 832     (previous    "Move to previous entity" mime-preview-move-to-previous)
 833     (next        "Move to next entity"     mime-preview-move-to-next)
 834     (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
 835     (scroll-up   "Scroll-up"               mime-preview-scroll-up-entity)
 836     (play        "Play current entity"     mime-preview-play-current-entity)
 837     (extract     "Extract current entity"  mime-preview-extract-current-entity)
 838     (print       "Print current entity"    mime-preview-print-current-entity)
 839     (x-face      "Show X Face"             mime-preview-display-x-face)
 840     )
 841   "Menu for MIME Viewer")
 842
 843 (cond (running-xemacs
 844        (defvar mime-view-xemacs-popup-menu
 845          (cons mime-view-menu-title
 846                (mapcar (function
 847                         (lambda (item)
 848                           (vector (nth 1 item)(nth 2 item) t)
 849                           ))
 850                        mime-view-menu-list)))
 851        (defun mime-view-xemacs-popup-menu (event)
 852          "Popup the menu in the MIME Viewer buffer"
 853          (interactive "e")
 854          (select-window (event-window event))
 855          (set-buffer (event-buffer event))
 856          (popup-menu 'mime-view-xemacs-popup-menu))
 857        (defvar mouse-button-2 'button2)
 858        )
 859       (t
 860        (defvar mouse-button-2 [mouse-2])
 861        ))
 862
 863 (defun mime-view-define-keymap (&optional default)
 864   (let ((mime-view-mode-map (if (keymapp default)
 865                                 (copy-keymap default)
 866                               (make-sparse-keymap)
 867                               )))
 868     (define-key mime-view-mode-map
 869       "u"        (function mime-preview-move-to-upper))
 870     (define-key mime-view-mode-map
 871       "p"        (function mime-preview-move-to-previous))
 872     (define-key mime-view-mode-map
 873       "n"        (function mime-preview-move-to-next))
 874     (define-key mime-view-mode-map
 875       "\e\t"     (function mime-preview-move-to-previous))
 876     (define-key mime-view-mode-map
 877       "\t"       (function mime-preview-move-to-next))
 878     (define-key mime-view-mode-map
 879       " "        (function mime-preview-scroll-up-entity))
 880     (define-key mime-view-mode-map
 881       "\M- "     (function mime-preview-scroll-down-entity))
 882     (define-key mime-view-mode-map
 883       "\177"     (function mime-preview-scroll-down-entity))
 884     (define-key mime-view-mode-map
 885       "\C-m"     (function mime-preview-next-line-entity))
 886     (define-key mime-view-mode-map
 887       "\C-\M-m"  (function mime-preview-previous-line-entity))
 888     (define-key mime-view-mode-map
 889       "v"        (function mime-preview-play-current-entity))
 890     (define-key mime-view-mode-map
 891       "e"        (function mime-preview-extract-current-entity))
 892     (define-key mime-view-mode-map
 893       "\C-c\C-p" (function mime-preview-print-current-entity))
 894     (define-key mime-view-mode-map
 895       "a"        (function mime-preview-follow-current-entity))
 896     (define-key mime-view-mode-map
 897       "q"        (function mime-preview-quit))
 898     (define-key mime-view-mode-map
 899       "\C-c\C-x" (function mime-preview-kill-buffer))
 900     ;; (define-key mime-view-mode-map
 901     ;;   "<"        (function beginning-of-buffer))
 902     ;; (define-key mime-view-mode-map
 903     ;;   ">"        (function end-of-buffer))
 904     (define-key mime-view-mode-map
 905       "?"        (function describe-mode))
 906     (define-key mime-view-mode-map
 907       [tab] (function mime-preview-move-to-next))
 908     (define-key mime-view-mode-map
 909       [delete] (function mime-preview-scroll-down-entity))
 910     (define-key mime-view-mode-map
 911       [backspace] (function mime-preview-scroll-down-entity))
 912     (if (functionp default)
 913         (cond (running-xemacs
 914                (set-keymap-default-binding mime-view-mode-map default)
 915                )
 916               (t
 917                (setq mime-view-mode-map
 918                      (append mime-view-mode-map (list (cons t default))))
 919                )))
 920     (if mouse-button-2
 921         (define-key mime-view-mode-map
 922           mouse-button-2 (function mime-button-dispatcher))
 923       )
 924     (cond (running-xemacs
 925            (define-key mime-view-mode-map
 926              mouse-button-3 (function mime-view-xemacs-popup-menu))
 927            )
 928           ((>= emacs-major-version 19)
 929            (define-key mime-view-mode-map [menu-bar mime-view]
 930              (cons mime-view-menu-title
 931                    (make-sparse-keymap mime-view-menu-title)))
 932            (mapcar (function
 933                     (lambda (item)
 934                       (define-key mime-view-mode-map
 935                         (vector 'menu-bar 'mime-view (car item))
 936                         (cons (nth 1 item)(nth 2 item))
 937                         )
 938                       ))
 939                    (reverse mime-view-menu-list)
 940                    )
 941            ))
 942     (use-local-map mime-view-mode-map)
 943     (run-hooks 'mime-view-define-keymap-hook)
 944     ))
 945
 946 (defsubst mime-maybe-hide-echo-buffer ()
 947   "Clear mime-echo buffer and delete window for it."
 948   (let ((buf (get-buffer mime-echo-buffer-name)))
 949     (if buf
 950         (save-excursion
 951           (set-buffer buf)
 952           (erase-buffer)
 953           (let ((win (get-buffer-window buf)))
 954             (if win
 955                 (delete-window win)
 956               ))
 957           (bury-buffer buf)
 958           ))))
 959
 960 (defvar mime-view-redisplay nil)
 961
 962 (defun mime-display-message (message &optional preview-buffer
 963                                      mother default-keymap-or-function)
 964   (mime-maybe-hide-echo-buffer)
 965   (let ((win-conf (current-window-configuration))
 966         (raw-buffer (mime-entity-buffer message)))
 967     (or preview-buffer
 968         (setq preview-buffer
 969               (concat "*Preview-" (buffer-name raw-buffer) "*")))
 970     (set-buffer raw-buffer)
 971     (mime-parse-buffer)
 972     (setq mime-preview-buffer preview-buffer)
 973     (let ((inhibit-read-only t))
 974       (switch-to-buffer preview-buffer)
 975       (widen)
 976       (erase-buffer)
 977       (setq mime-raw-buffer raw-buffer)
 978       (if mother
 979           (setq mime-mother-buffer mother)
 980         )
 981       (setq mime-preview-original-window-configuration win-conf)
 982       (setq major-mode 'mime-view-mode)
 983       (setq mode-name "MIME-View")
 984       (mime-display-entity message nil
 985                            '((entity-button . invisible)
 986                              (header . visible))
 987                            preview-buffer)
 988       (mime-view-define-keymap default-keymap-or-function)
 989       (let ((point
 990              (next-single-property-change (point-min) 'mime-view-entity)))
 991         (if point
 992             (goto-char point)
 993           (goto-char (point-min))
 994           (search-forward "\n\n" nil t)
 995           ))
 996       (run-hooks 'mime-view-mode-hook)
 997       ))
 998   (set-buffer-modified-p nil)
 999   (setq buffer-read-only t)
1000   )
1001
1002 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
1003                                    default-keymap-or-function)
1004   (interactive)
1005   (mime-display-message
1006    (save-excursion
1007      (if raw-buffer (set-buffer raw-buffer))
1008      (mime-parse-message)
1009      )
1010    preview-buffer mother default-keymap-or-function))
1011
1012 (defun mime-view-mode (&optional mother ctl encoding
1013                                  raw-buffer preview-buffer
1014                                  default-keymap-or-function)
1015   "Major mode for viewing MIME message.
1016
1017 Here is a list of the standard keys for mime-view-mode.
1018
1019 key             feature
1020 ---             -------
1021
1022 u               Move to upper content
1023 p or M-TAB      Move to previous content
1024 n or TAB        Move to next content
1025 SPC             Scroll up or move to next content
1026 M-SPC or DEL    Scroll down or move to previous content
1027 RET             Move to next line
1028 M-RET           Move to previous line
1029 v               Decode current content as `play mode'
1030 e               Decode current content as `extract mode'
1031 C-c C-p         Decode current content as `print mode'
1032 a               Followup to current content.
1033 q               Quit
1034 button-2        Move to point under the mouse cursor
1035                 and decode current content as `play mode'
1036 "
1037   (interactive)
1038   (mime-display-message
1039    (save-excursion
1040      (if raw-buffer (set-buffer raw-buffer))
1041      (or mime-view-redisplay
1042          (mime-parse-message ctl encoding))
1043      )
1044    preview-buffer mother default-keymap-or-function))
1045
1046
1047 ;;; @@ playing
1048 ;;;
1049
1050 (autoload 'mime-preview-play-current-entity "mime-play"
1051   "Play current entity." t)
1052
1053 (defun mime-preview-extract-current-entity ()
1054   "Extract current entity into file (maybe).
1055 It decodes current entity to call internal or external method as
1056 \"extract\" mode.  The method is selected from variable
1057 `mime-acting-condition'."
1058   (interactive)
1059   (mime-preview-play-current-entity "extract")
1060   )
1061
1062 (defun mime-preview-print-current-entity ()
1063   "Print current entity (maybe).
1064 It decodes current entity to call internal or external method as
1065 \"print\" mode.  The method is selected from variable
1066 `mime-acting-condition'."
1067   (interactive)
1068   (mime-preview-play-current-entity "print")
1069   )
1070
1071
1072 ;;; @@ following
1073 ;;;
1074
1075 (defun mime-preview-follow-current-entity ()
1076   "Write follow message to current entity.
1077 It calls following-method selected from variable
1078 `mime-preview-following-method-alist'."
1079   (interactive)
1080   (let (entity)
1081     (while (null (setq entity
1082                        (get-text-property (point) 'mime-view-entity)))
1083       (backward-char)
1084       )
1085     (let* ((p-beg
1086             (previous-single-property-change (point) 'mime-view-entity))
1087            p-end
1088            (entity-node-id (mime-entity-node-id entity))
1089            (len (length entity-node-id))
1090            )
1091       (cond ((null p-beg)
1092              (setq p-beg
1093                    (if (eq (next-single-property-change (point-min)
1094                                                         'mime-view-entity)
1095                            (point))
1096                        (point)
1097                      (point-min)))
1098              )
1099             ((eq (next-single-property-change p-beg 'mime-view-entity)
1100                  (point))
1101              (setq p-beg (point))
1102              ))
1103       (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1104       (cond ((null p-end)
1105              (setq p-end (point-max))
1106              )
1107             ((null entity-node-id)
1108              (setq p-end (point-max))
1109              )
1110             (t
1111              (save-excursion
1112                (goto-char p-end)
1113                (catch 'tag
1114                  (let (e)
1115                    (while (setq e
1116                                 (next-single-property-change
1117                                  (point) 'mime-view-entity))
1118                      (goto-char e)
1119                      (let ((rc (mime-entity-node-id
1120                                 (get-text-property (point)
1121                                                    'mime-view-entity))))
1122                        (or (equal entity-node-id
1123                                   (nthcdr (- (length rc) len) rc))
1124                            (throw 'tag nil)
1125                            ))
1126                      (setq p-end e)
1127                      ))
1128                  (setq p-end (point-max))
1129                  ))
1130              ))
1131       (let* ((mode (mime-preview-original-major-mode 'recursive))
1132              (new-name
1133               (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1134              new-buf
1135              (the-buf (current-buffer))
1136              (a-buf mime-raw-buffer)
1137              fields)
1138         (save-excursion
1139           (set-buffer (setq new-buf (get-buffer-create new-name)))
1140           (erase-buffer)
1141           (insert-buffer-substring the-buf p-beg p-end)
1142           (goto-char (point-min))
1143           (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1144             (while (progn
1145                      (setq
1146                       str
1147                       (save-excursion
1148                         (set-buffer a-buf)
1149                         (setq
1150                          ci
1151                          (mime-raw-find-entity-from-node-id entity-node-id))
1152                         (save-restriction
1153                           (narrow-to-region
1154                            (mime-entity-point-min ci)
1155                            (mime-entity-point-max ci)
1156                            )
1157                           (std11-header-string-except
1158                            (concat "^"
1159                                    (apply (function regexp-or) fields)
1160                                    ":") ""))))
1161                      (if (and
1162                           (eq (mime-entity-media-type ci) 'message)
1163                           (eq (mime-entity-media-subtype ci) 'rfc822))
1164                          nil
1165                        (if str
1166                            (insert str)
1167                          )
1168                        entity-node-id))
1169               (setq fields (std11-collect-field-names)
1170                     entity-node-id (cdr entity-node-id))
1171               )
1172             )
1173           (let ((rest mime-view-following-required-fields-list))
1174             (while rest
1175               (let ((field-name (car rest)))
1176                 (or (std11-field-body field-name)
1177                     (insert
1178                      (format
1179                       (concat field-name
1180                               ": "
1181                               (save-excursion
1182                                 (set-buffer the-buf)
1183                                 (set-buffer mime-mother-buffer)
1184                                 (set-buffer mime-raw-buffer)
1185                                 (std11-field-body field-name)
1186                                 )
1187                               "\n")))
1188                     ))
1189               (setq rest (cdr rest))
1190               ))
1191           (eword-decode-header)
1192           )
1193         (let ((f (cdr (assq mode mime-preview-following-method-alist))))
1194           (if (functionp f)
1195               (funcall f new-buf)
1196             (message
1197              (format
1198               "Sorry, following method for %s is not implemented yet."
1199               mode))
1200             ))
1201         ))))
1202
1203
1204 ;;; @@ X-Face
1205 ;;;
1206
1207 (defun mime-preview-display-x-face ()
1208   (interactive)
1209   (save-window-excursion
1210     (set-buffer mime-raw-buffer)
1211     (mime-view-x-face-function)
1212     ))
1213
1214
1215 ;;; @@ moving
1216 ;;;
1217
1218 (defun mime-preview-move-to-upper ()
1219   "Move to upper entity.
1220 If there is no upper entity, call function `mime-preview-quit'."
1221   (interactive)
1222   (let (cinfo)
1223     (while (null (setq cinfo
1224                        (get-text-property (point) 'mime-view-entity)))
1225       (backward-char)
1226       )
1227     (let ((r (mime-raw-find-entity-from-node-id
1228               (cdr (mime-entity-node-id cinfo))
1229               (get-text-property 1 'mime-view-entity)))
1230           point)
1231       (catch 'tag
1232         (while (setq point (previous-single-property-change
1233                             (point) 'mime-view-entity))
1234           (goto-char point)
1235           (if (eq r (get-text-property (point) 'mime-view-entity))
1236               (throw 'tag t)
1237             )
1238           )
1239         (mime-preview-quit)
1240         ))))
1241
1242 (defun mime-preview-move-to-previous ()
1243   "Move to previous entity.
1244 If there is no previous entity, it calls function registered in
1245 variable `mime-preview-over-to-previous-method-alist'."
1246   (interactive)
1247   (while (null (get-text-property (point) 'mime-view-entity))
1248     (backward-char)
1249     )
1250   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
1251     (if point
1252         (if (get-text-property (1- point) 'mime-view-entity)
1253             (goto-char point)
1254           (goto-char (1- point))
1255           (mime-preview-move-to-previous)
1256           )
1257       (let ((f (assq (mime-preview-original-major-mode)
1258                      mime-preview-over-to-previous-method-alist)))
1259         (if f
1260             (funcall (cdr f))
1261           ))
1262       )))
1263
1264 (defun mime-preview-move-to-next ()
1265   "Move to next entity.
1266 If there is no previous entity, it calls function registered in
1267 variable `mime-preview-over-to-next-method-alist'."
1268   (interactive)
1269   (while (null (get-text-property (point) 'mime-view-entity))
1270     (forward-char)
1271     )
1272   (let ((point (next-single-property-change (point) 'mime-view-entity)))
1273     (if point
1274         (progn
1275           (goto-char point)
1276           (if (null (get-text-property point 'mime-view-entity))
1277               (mime-preview-move-to-next)
1278             ))
1279       (let ((f (assq (mime-preview-original-major-mode)
1280                      mime-preview-over-to-next-method-alist)))
1281         (if f
1282             (funcall (cdr f))
1283           ))
1284       )))
1285
1286 (defun mime-preview-scroll-up-entity (&optional h)
1287   "Scroll up current entity.
1288 If reached to (point-max), it calls function registered in variable
1289 `mime-preview-over-to-next-method-alist'."
1290   (interactive)
1291   (or h
1292       (setq h (1- (window-height)))
1293       )
1294   (if (= (point) (point-max))
1295       (let ((f (assq (mime-preview-original-major-mode)
1296                      mime-preview-over-to-next-method-alist)))
1297         (if f
1298             (funcall (cdr f))
1299           ))
1300     (let ((point
1301            (or (next-single-property-change (point) 'mime-view-entity)
1302                (point-max))))
1303       (forward-line h)
1304       (if (> (point) point)
1305           (goto-char point)
1306         )
1307       )))
1308
1309 (defun mime-preview-scroll-down-entity (&optional h)
1310   "Scroll down current entity.
1311 If reached to (point-min), it calls function registered in variable
1312 `mime-preview-over-to-previous-method-alist'."
1313   (interactive)
1314   (or h
1315       (setq h (1- (window-height)))
1316       )
1317   (if (= (point) (point-min))
1318       (let ((f (assq (mime-preview-original-major-mode)
1319                      mime-preview-over-to-previous-method-alist)))
1320         (if f
1321             (funcall (cdr f))
1322           ))
1323     (let ((point
1324            (or (previous-single-property-change (point) 'mime-view-entity)
1325                (point-min))))
1326       (forward-line (- h))
1327       (if (< (point) point)
1328           (goto-char point)
1329         ))))
1330
1331 (defun mime-preview-next-line-entity ()
1332   (interactive)
1333   (mime-preview-scroll-up-entity 1)
1334   )
1335
1336 (defun mime-preview-previous-line-entity ()
1337   (interactive)
1338   (mime-preview-scroll-down-entity 1)
1339   )
1340
1341
1342 ;;; @@ quitting
1343 ;;;
1344
1345 (defun mime-preview-quit ()
1346   "Quit from MIME-preview buffer.
1347 It calls function registered in variable
1348 `mime-preview-quitting-method-alist'."
1349   (interactive)
1350   (let ((r (assq (mime-preview-original-major-mode)
1351                  mime-preview-quitting-method-alist)))
1352     (if r
1353         (funcall (cdr r))
1354       )))
1355
1356 (defun mime-preview-kill-buffer ()
1357   (interactive)
1358   (kill-buffer (current-buffer))
1359   )
1360
1361
1362 ;;; @ end
1363 ;;;
1364
1365 (provide 'mime-view)
1366
1367 (run-hooks 'mime-view-load-hook)
1368
1369 ;;; mime-view.el ends here