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 SEMI (Sophisticated 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 'std11)
  31 (require 'mime)
  32 (require 'semi-def)
  33 (require 'calist)
  34 (require 'alist)
  35 (require 'mailcap)
  36
  37
  38 ;;; @ version
  39 ;;;
  40
  41 (defconst mime-view-version-string
  42   `,(concat (car mime-user-interface-version) " MIME-View "
  43             (mapconcat #'number-to-string
  44                        (cddr mime-user-interface-version) ".")
  45             " (" (cadr mime-user-interface-version) ")"))
  46
  47
  48 ;;; @ variables
  49 ;;;
  50
  51 (defgroup mime-view nil
  52   "MIME view mode"
  53   :group 'mime)
  54
  55 (defcustom mime-view-find-every-acting-situation t
  56   "*Find every available acting-situation if non-nil."
  57   :group 'mime-view
  58   :type 'boolean)
  59
  60 (defcustom mime-acting-situation-examples-file "~/.mime-example"
  61   "*File name of example about acting-situation demonstrated by user."
  62   :group 'mime-view
  63   :type 'file)
  64
  65
  66 ;;; @ in raw-buffer (representation space)
  67 ;;;
  68
  69 (defvar mime-preview-buffer nil
  70   "MIME-preview buffer corresponding with the (raw) buffer.")
  71 (make-variable-buffer-local 'mime-preview-buffer)
  72
  73
  74 (defvar mime-raw-representation-type nil
  75   "Representation-type of mime-raw-buffer.
  76 It must be nil, `binary' or `cooked'.
  77 If it is nil, `mime-raw-representation-type-alist' is used as default
  78 value.
  79 Notice that this variable is usually used as buffer local variable in
  80 raw-buffer.")
  81
  82 (make-variable-buffer-local 'mime-raw-representation-type)
  83
  84 (defvar mime-raw-representation-type-alist
  85   '((mime-show-message-mode     . binary)
  86     (mime-temp-message-mode     . binary)
  87     (t                          . cooked)
  88     )
  89   "Alist of major-mode vs. representation-type of mime-raw-buffer.
  90 Each element looks like (SYMBOL . REPRESENTATION-TYPE).  SYMBOL is
  91 major-mode or t.  t means default.  REPRESENTATION-TYPE must be
  92 `binary' or `cooked'.
  93 This value is overridden by buffer local variable
  94 `mime-raw-representation-type' if it is not nil.")
  95
  96
  97 (defsubst mime-raw-find-entity-from-node-id (entity-node-id
  98                                              &optional message-info)
  99   "Return entity from ENTITY-NODE-ID in mime-raw-buffer.
 100 If optional argument MESSAGE-INFO is not specified,
 101 `mime-message-structure' is used."
 102   (mime-raw-find-entity-from-number (reverse entity-node-id) message-info))
 103
 104 (defun mime-raw-find-entity-from-number (entity-number &optional message-info)
 105   "Return entity from ENTITY-NUMBER in mime-raw-buffer.
 106 If optional argument MESSAGE-INFO is not specified,
 107 `mime-message-structure' is used."
 108   (or message-info
 109       (setq message-info mime-message-structure))
 110   (if (eq entity-number t)
 111       message-info
 112     (let ((sn (car entity-number)))
 113       (if (null sn)
 114           message-info
 115         (let ((rc (nth sn (mime-entity-children message-info))))
 116           (if rc
 117               (mime-raw-find-entity-from-number (cdr entity-number) rc)
 118             ))
 119         ))))
 120
 121 (defun mime-raw-find-entity-from-point (point &optional message-info)
 122   "Return entity from POINT in mime-raw-buffer.
 123 If optional argument MESSAGE-INFO is not specified,
 124 `mime-message-structure' is used."
 125   (or message-info
 126       (setq message-info mime-message-structure))
 127   (if (and (<= (mime-entity-point-min message-info) point)
 128            (<= point (mime-entity-point-max message-info)))
 129       (let ((children (mime-entity-children message-info)))
 130         (catch 'tag
 131           (while children
 132             (let ((ret
 133                    (mime-raw-find-entity-from-point point (car children))))
 134               (if ret
 135                   (throw 'tag ret)
 136                 ))
 137             (setq children (cdr children)))
 138           message-info))))
 139
 140
 141 ;;; @ in preview-buffer (presentation space)
 142 ;;;
 143
 144 (defvar mime-mother-buffer nil
 145   "Mother buffer corresponding with the (MIME-preview) buffer.
 146 If current MIME-preview buffer is generated by other buffer, such as
 147 message/partial, it is called `mother-buffer'.")
 148 (make-variable-buffer-local 'mime-mother-buffer)
 149
 150 (defvar mime-raw-buffer nil
 151   "Raw buffer corresponding with the (MIME-preview) buffer.")
 152 (make-variable-buffer-local 'mime-raw-buffer)
 153
 154 (defvar mime-preview-original-window-configuration nil
 155   "Window-configuration before mime-view-mode is called.")
 156 (make-variable-buffer-local 'mime-preview-original-window-configuration)
 157
 158 (defun mime-preview-original-major-mode (&optional recursive)
 159   "Return major-mode of original buffer.
 160 If optional argument RECURSIVE is non-nil and current buffer has
 161 mime-mother-buffer, it returns original major-mode of the
 162 mother-buffer."
 163   (if (and recursive mime-mother-buffer)
 164       (save-excursion
 165         (set-buffer mime-mother-buffer)
 166         (mime-preview-original-major-mode recursive)
 167         )
 168     (save-excursion
 169       (set-buffer
 170        (mime-entity-buffer
 171         (get-text-property (point-min) 'mime-view-entity)))
 172       major-mode)))
 173
 174
 175 ;;; @ entity information
 176 ;;;
 177
 178 (defsubst mime-entity-representation-type (entity)
 179   (with-current-buffer (mime-entity-buffer entity)
 180     (or mime-raw-representation-type
 181         (cdr (or (assq major-mode mime-raw-representation-type-alist)
 182                  (assq t mime-raw-representation-type-alist))))))
 183
 184 (defsubst mime-entity-cooked-p (entity)
 185   (eq (mime-entity-representation-type entity) 'cooked))
 186
 187 (defsubst mime-entity-parent (entity &optional message-info)
 188   "Return mother entity of ENTITY.
 189 If optional argument MESSAGE-INFO is not specified,
 190 `mime-message-structure' in buffer of ENTITY is used."
 191   (mime-raw-find-entity-from-node-id
 192    (cdr (mime-entity-node-id entity))
 193    (or message-info
 194        (save-excursion
 195          (set-buffer (mime-entity-buffer entity))
 196          mime-message-structure))))
 197
 198 (defun mime-entity-situation (entity)
 199   "Return situation of ENTITY."
 200   (append (or (mime-entity-content-type entity)
 201               (make-mime-content-type 'text 'plain))
 202           (let ((d (mime-entity-content-disposition entity)))
 203             (cons (cons 'disposition-type
 204                         (mime-content-disposition-type d))
 205                   (mapcar (function
 206                            (lambda (param)
 207                              (let ((name (car param)))
 208                                (cons (cond ((string= name "filename")
 209                                             'filename)
 210                                            ((string= name "creation-date")
 211                                             'creation-date)
 212                                            ((string= name "modification-date")
 213                                             'modification-date)
 214                                            ((string= name "read-date")
 215                                             'read-date)
 216                                            ((string= name "size")
 217                                             'size)
 218                                            (t (cons 'disposition (car param))))
 219                                      (cdr param)))))
 220                           (mime-content-disposition-parameters d))
 221                   ))
 222           (list (cons 'encoding (mime-entity-encoding entity))
 223                 (cons 'major-mode
 224                       (save-excursion
 225                         (set-buffer (mime-entity-buffer entity))
 226                         major-mode)))
 227           ))
 228
 229
 230 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 231
 232 (defun mime-entity-uu-filename (entity)
 233   (if (member (mime-entity-encoding entity)
 234               mime-view-uuencode-encoding-name-list)
 235       (save-excursion
 236         (set-buffer (mime-entity-buffer entity))
 237         (goto-char (mime-entity-body-start entity))
 238         (if (re-search-forward "^begin [0-9]+ "
 239                                (mime-entity-body-end entity) t)
 240             (if (looking-at ".+$")
 241                 (buffer-substring (match-beginning 0)(match-end 0))
 242               )))))
 243
 244 (defun mime-entity-filename (entity)
 245   (or (mime-entity-uu-filename entity)
 246       (mime-content-disposition-filename
 247        (mime-entity-content-disposition entity))
 248       (cdr (let ((param (mime-content-type-parameters
 249                          (mime-entity-content-type entity))))
 250              (or (assoc "name" param)
 251                  (assoc "x-name" param))
 252              ))))
 253
 254 (defun mime-view-entity-title (entity)
 255   (or (mime-entity-read-field entity 'Content-Description)
 256       (mime-entity-read-field entity 'Subject)
 257       (mime-entity-filename entity)
 258       ""))
 259
 260
 261 (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
 262   "Return entity-node-id from POINT in mime-raw-buffer.
 263 If optional argument MESSAGE-INFO is not specified,
 264 `mime-message-structure' is used."
 265   (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
 266
 267 (defsubst mime-raw-point-to-entity-number (point &optional message-info)
 268   "Return entity-number from POINT in mime-raw-buffer.
 269 If optional argument MESSAGE-INFO is not specified,
 270 `mime-message-structure' is used."
 271   (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
 272
 273 (defun mime-raw-flatten-message-info (&optional message-info)
 274   "Return list of entity in mime-raw-buffer.
 275 If optional argument MESSAGE-INFO is not specified,
 276 `mime-message-structure' is used."
 277   (or message-info
 278       (setq message-info mime-message-structure))
 279   (let ((dest (list message-info))
 280         (rcl (mime-entity-children message-info)))
 281     (while rcl
 282       (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
 283       (setq rcl (cdr rcl)))
 284     dest))
 285
 286
 287 ;;; @ presentation of preview
 288 ;;;
 289
 290 ;;; @@ entity-button
 291 ;;;
 292
 293 ;;; @@@ predicate function
 294 ;;;
 295
 296 (defun mime-view-entity-button-visible-p (entity)
 297   "Return non-nil if header of ENTITY is visible.
 298 Please redefine this function if you want to change default setting."
 299   (let ((media-type (mime-entity-media-type entity))
 300         (media-subtype (mime-entity-media-subtype entity)))
 301     (or (not (eq media-type 'application))
 302         (and (not (eq media-subtype 'x-selection))
 303              (or (not (eq media-subtype 'octet-stream))
 304                  (let ((mother-entity (mime-entity-parent entity)))
 305                    (or (not (eq (mime-entity-media-type mother-entity)
 306                                 'multipart))
 307                        (not (eq (mime-entity-media-subtype mother-entity)
 308                                 'encrypted)))
 309                    )
 310                  )))))
 311
 312 ;;; @@@ entity button generator
 313 ;;;
 314
 315 (defun mime-view-insert-entity-button (entity)
 316   "Insert entity-button of ENTITY."
 317   (let ((entity-node-id (mime-entity-node-id entity))
 318         (params (mime-entity-parameters entity))
 319         (subject (mime-view-entity-title entity)))
 320     (mime-insert-button
 321      (let ((access-type (assoc "access-type" params))
 322            (num (or (cdr (assoc "x-part-number" params))
 323                     (if (consp entity-node-id)
 324                         (mapconcat (function
 325                                     (lambda (num)
 326                                       (format "%s" (1+ num))
 327                                       ))
 328                                    (reverse entity-node-id) ".")
 329                       "0"))
 330                 ))
 331        (cond (access-type
 332               (let ((server (assoc "server" params)))
 333                 (setq access-type (cdr access-type))
 334                 (if server
 335                     (format "%s %s ([%s] %s)"
 336                             num subject access-type (cdr server))
 337                 (let ((site (cdr (assoc "site" params)))
 338                       (dir (cdr (assoc "directory" params)))
 339                       )
 340                   (format "%s %s ([%s] %s:%s)"
 341                           num subject access-type site dir)
 342                   )))
 343             )
 344            (t
 345             (let ((media-type (mime-entity-media-type entity))
 346                   (media-subtype (mime-entity-media-subtype entity))
 347                   (charset (cdr (assoc "charset" params)))
 348                   (encoding (mime-entity-encoding entity)))
 349               (concat
 350                num " " subject
 351                (let ((rest
 352                       (format " <%s/%s%s%s>"
 353                               media-type media-subtype
 354                               (if charset
 355                                   (concat "; " charset)
 356                                 "")
 357                               (if encoding
 358                                   (concat " (" encoding ")")
 359                                 ""))))
 360                  (if (>= (+ (current-column)(length rest))(window-width))
 361                      "\n\t")
 362                  rest)))
 363             )))
 364      (function mime-preview-play-current-entity))
 365     ))
 366
 367
 368 ;;; @@ entity-header
 369 ;;;
 370
 371 (defvar mime-header-presentation-method-alist nil
 372   "Alist of major mode vs. corresponding header-presentation-method functions.
 373 Each element looks like (SYMBOL . FUNCTION).
 374 SYMBOL must be major mode in raw-buffer or t.  t means default.
 375 Interface of FUNCTION must be (ENTITY SITUATION).")
 376
 377 (defvar mime-view-ignored-field-list
 378   '(".*Received" ".*Path" ".*Id" "References"
 379     "Replied" "Errors-To"
 380     "Lines" "Sender" ".*Host" "Xref"
 381     "Content-Type" "Precedence"
 382     "Status" "X-VM-.*")
 383   "All fields that match this list will be hidden in MIME preview buffer.
 384 Each elements are regexp of field-name.")
 385
 386 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
 387   "All fields that match this list will be displayed in MIME preview buffer.
 388 Each elements are regexp of field-name.")
 389
 390
 391 ;;; @@ entity-body
 392 ;;;
 393
 394 ;;; @@@ predicate function
 395 ;;;
 396
 397 (defun mime-calist::field-match-method-as-default-rule (calist
 398                                                         field-type field-value)
 399   (let ((s-field (assq field-type calist)))
 400     (cond ((null s-field)
 401            (cons (cons field-type field-value) calist)
 402            )
 403           (t calist))))
 404
 405 (define-calist-field-match-method
 406   'header #'mime-calist::field-match-method-as-default-rule)
 407
 408 (define-calist-field-match-method
 409   'body #'mime-calist::field-match-method-as-default-rule)
 410
 411
 412 (defvar mime-preview-condition nil
 413   "Condition-tree about how to display entity.")
 414
 415 (ctree-set-calist-strictly
 416  'mime-preview-condition '((type . application)(subtype . octet-stream)
 417                            (encoding . nil)
 418                            (body . visible)))
 419 (ctree-set-calist-strictly
 420  'mime-preview-condition '((type . application)(subtype . octet-stream)
 421                            (encoding . "7bit")
 422                            (body . visible)))
 423 (ctree-set-calist-strictly
 424  'mime-preview-condition '((type . application)(subtype . octet-stream)
 425                            (encoding . "8bit")
 426                            (body . visible)))
 427
 428 (ctree-set-calist-strictly
 429  'mime-preview-condition '((type . application)(subtype . pgp)
 430                            (body . visible)))
 431
 432 (ctree-set-calist-strictly
 433  'mime-preview-condition '((type . application)(subtype . x-latex)
 434                            (body . visible)))
 435
 436 (ctree-set-calist-strictly
 437  'mime-preview-condition '((type . application)(subtype . x-selection)
 438                            (body . visible)))
 439
 440 (ctree-set-calist-strictly
 441  'mime-preview-condition '((type . application)(subtype . x-comment)
 442                            (body . visible)))
 443
 444 (ctree-set-calist-strictly
 445  'mime-preview-condition '((type . message)(subtype . delivery-status)
 446                            (body . visible)))
 447
 448 (ctree-set-calist-strictly
 449  'mime-preview-condition
 450  '((body . visible)
 451    (body-presentation-method . mime-display-text/plain)))
 452
 453 (ctree-set-calist-strictly
 454  'mime-preview-condition
 455  '((type . nil)
 456    (body . visible)
 457    (body-presentation-method . mime-display-text/plain)))
 458
 459 (ctree-set-calist-strictly
 460  'mime-preview-condition
 461  '((type . text)(subtype . enriched)
 462    (body . visible)
 463    (body-presentation-method . mime-display-text/enriched)))
 464
 465 (ctree-set-calist-strictly
 466  'mime-preview-condition
 467  '((type . text)(subtype . richtext)
 468    (body . visible)
 469    (body-presentation-method . mime-display-text/richtext)))
 470
 471 (ctree-set-calist-strictly
 472  'mime-preview-condition
 473  '((type . text)(subtype . t)
 474    (body . visible)
 475    (body-presentation-method . mime-display-text/plain)))
 476
 477 (ctree-set-calist-strictly
 478  'mime-preview-condition
 479  '((type . multipart)(subtype . alternative)
 480    (body . visible)
 481    (body-presentation-method . mime-display-multipart/alternative)))
 482
 483 (ctree-set-calist-strictly
 484  'mime-preview-condition '((type . message)(subtype . partial)
 485                            (body-presentation-method
 486                             . mime-display-message/partial-button)))
 487
 488 (ctree-set-calist-strictly
 489  'mime-preview-condition '((type . message)(subtype . rfc822)
 490                            (body-presentation-method . nil)
 491                            (childrens-situation (header . visible)
 492                                                 (entity-button . invisible))))
 493
 494 (ctree-set-calist-strictly
 495  'mime-preview-condition '((type . message)(subtype . news)
 496                            (body-presentation-method . nil)
 497                            (childrens-situation (header . visible)
 498                                                 (entity-button . invisible))))
 499
 500
 501 ;;; @@@ entity presentation
 502 ;;;
 503
 504 (autoload 'mime-display-text/plain "mime-text")
 505 (autoload 'mime-display-text/enriched "mime-text")
 506 (autoload 'mime-display-text/richtext "mime-text")
 507
 508 (defvar mime-view-announcement-for-message/partial
 509   (if (and (>= emacs-major-version 19) window-system)
 510       "\
 511 \[[ This is message/partial style split message. ]]
 512 \[[ Please press `v' key in this buffer          ]]
 513 \[[ or click here by mouse button-2.             ]]"
 514     "\
 515 \[[ This is message/partial style split message. ]]
 516 \[[ Please press `v' key in this buffer.         ]]"
 517     ))
 518
 519 (defun mime-display-message/partial-button (&optional entity situation)
 520   (save-restriction
 521     (goto-char (point-max))
 522     (if (not (search-backward "\n\n" nil t))
 523         (insert "\n")
 524       )
 525     (goto-char (point-max))
 526     (narrow-to-region (point-max)(point-max))
 527     (insert mime-view-announcement-for-message/partial)
 528     (mime-add-button (point-min)(point-max)
 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