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 '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          ]]
 512 \[[ or click here by mouse button-2.             ]]"
 513     "\
 514 \[[ This is message/partial style split message. ]]
 515 \[[ Please press `v' key in this buffer.         ]]"
 516     ))
 517
 518 (defun mime-display-message/partial-button (&optional entity situation)
 519   (save-restriction
 520     (goto-char (point-max))
 521     (if (not (search-backward "\n\n" nil t))
 522         (insert "\n")
 523       )
 524     (goto-char (point-max))
 525     (narrow-to-region (point-max)(point-max))
 526     (insert mime-view-announcement-for-message/partial)
 527     (mime-add-button (point-min)(point-max)
 528                      #'mime-preview-play-current-entity)
 529     ))
 530
 531 (defun mime-display-multipart/mixed (entity situation)
 532   (let ((children (mime-entity-children entity))
 533         (default-situation
 534           (cdr (assq 'childrens-situation situation))))
 535     (while children
 536       (mime-display-entity (car children) nil default-situation)
 537       (setq children (cdr children))
 538       )))
 539
 540 (defcustom mime-view-type-subtype-score-alist
 541   '(((text . enriched) . 3)
 542     ((text . richtext) . 2)
 543     ((text . plain)    . 1)
 544     (t . 0))
 545   "Alist MEDIA-TYPE vs corresponding score.
 546 MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 547   :group 'mime-view
 548   :type '(repeat (cons (choice :tag "Media-Type"
 549                                (item :tag "Type/Subtype"
 550                                      (cons symbol symbol))
 551                                (item :tag "Type" symbol)
 552                                (item :tag "Default" t))
 553                        integer)))
 554
 555 (defun mime-display-multipart/alternative (entity situation)
 556   (let* ((children (mime-entity-children entity))
 557          (default-situation
 558            (cdr (assq 'childrens-situation situation)))
 559          (i 0)
 560          (p 0)
 561          (max-score 0)
 562          (situations
 563           (mapcar (function
 564                    (lambda (child)
 565                      (let ((situation
 566                             (or (ctree-match-calist
 567                                  mime-preview-condition
 568                                  (append (mime-entity-situation child)
 569                                          default-situation))
 570                                 default-situation)))
 571                        (if (cdr (assq 'body-presentation-method situation))
 572                            (let ((score
 573                                   (cdr
 574                                    (or (assoc
 575                                         (cons
 576                                          (cdr (assq 'type situation))
 577                                          (cdr (assq 'subtype situation)))
 578                                         mime-view-type-subtype-score-alist)
 579                                        (assq
 580                                         (cdr (assq 'type situation))
 581                                         mime-view-type-subtype-score-alist)
 582                                        (assq
 583                                         t
 584                                         mime-view-type-subtype-score-alist)
 585                                        ))))
 586                              (if (> score max-score)
 587                                  (setq p i
 588                                        max-score score)
 589                                )))
 590                        (setq i (1+ i))
 591                        situation)
 592                      ))
 593                   children)))
 594     (setq i 0)
 595     (while children
 596       (let ((child (car children))
 597             (situation (car situations)))
 598         (mime-display-entity child (if (= i p)
 599                                        situation
 600                                      (del-alist 'body-presentation-method
 601                                                 (copy-alist situation))))
 602         )
 603       (setq children (cdr children)
 604             situations (cdr situations)
 605             i (1+ i))
 606       )))
 607
 608
 609 ;;; @ acting-condition
 610 ;;;
 611
 612 (defvar mime-acting-condition nil
 613   "Condition-tree about how to process entity.")
 614
 615 (if (file-readable-p mailcap-file)
 616     (let ((entries (mailcap-parse-file)))
 617       (while entries
 618         (let ((entry (car entries))
 619               view print shared)
 620           (while entry
 621             (let* ((field (car entry))
 622                    (field-type (car field)))
 623               (cond ((eq field-type 'view)  (setq view field))
 624                     ((eq field-type 'print) (setq print field))
 625                     ((memq field-type '(compose composetyped edit)))
 626                     (t (setq shared (cons field shared))))
 627               )
 628             (setq entry (cdr entry))
 629             )
 630           (setq shared (nreverse shared))
 631           (ctree-set-calist-with-default
 632            'mime-acting-condition
 633            (append shared (list '(mode . "play")(cons 'method (cdr view)))))
 634           (if print
 635               (ctree-set-calist-with-default
 636                'mime-acting-condition
 637                (append shared
 638                        (list '(mode . "print")(cons 'method (cdr view))))
 639                ))
 640           )
 641         (setq entries (cdr entries))
 642         )))
 643
 644 (ctree-set-calist-strictly
 645  'mime-acting-condition
 646  '((type . application)(subtype . octet-stream)
 647    (mode . "play")
 648    (method . mime-detect-content)
 649    ))
 650
 651 (ctree-set-calist-with-default
 652  'mime-acting-condition
 653  '((mode . "extract")
 654    (method . mime-save-content)))
 655
 656 (ctree-set-calist-strictly
 657  'mime-acting-condition
 658  '((type . text)(subtype . x-rot13-47)(mode . "play")
 659    (method . mime-view-caesar)
 660    ))
 661 (ctree-set-calist-strictly
 662  'mime-acting-condition
 663  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
 664    (method . mime-view-caesar)
 665    ))
 666
 667 (ctree-set-calist-strictly
 668  'mime-acting-condition
 669  '((type . message)(subtype . rfc822)(mode . "play")
 670    (method . mime-view-message/rfc822)
 671    ))
 672 (ctree-set-calist-strictly
 673  'mime-acting-condition
 674  '((type . message)(subtype . partial)(mode . "play")
 675    (method . mime-store-message/partial-piece)
 676    ))
 677
 678 (ctree-set-calist-strictly
 679  'mime-acting-condition
 680  '((type . message)(subtype . external-body)
 681    ("access-type" . "anon-ftp")
 682    (method . mime-view-message/external-ftp)
 683    ))
 684
 685 (ctree-set-calist-strictly
 686  'mime-acting-condition
 687  '((type . application)(subtype . octet-stream)
 688    (method . mime-save-content)
 689    ))
 690
 691
 692 ;;; @ quitting method
 693 ;;;
 694
 695 (defvar mime-preview-quitting-method-alist
 696   '((mime-show-message-mode
 697      . mime-preview-quitting-method-for-mime-show-message-mode))
 698   "Alist of major-mode vs. quitting-method of mime-view.")
 699
 700 (defvar mime-preview-over-to-previous-method-alist nil
 701   "Alist of major-mode vs. over-to-previous-method of mime-view.")
 702
 703 (defvar mime-preview-over-to-next-method-alist nil
 704   "Alist of major-mode vs. over-to-next-method of mime-view.")
 705
 706
 707 ;;; @ following method
 708 ;;;
 709
 710 (defvar mime-preview-following-method-alist nil
 711   "Alist of major-mode vs. following-method of mime-view.")
 712
 713 (defvar mime-view-following-required-fields-list
 714   '("From"))
 715
 716
 717 ;;; @ X-Face
 718 ;;;
 719
 720 ;; hack from Gnus 5.0.4.
 721
 722 (defvar mime-view-x-face-to-pbm-command
 723   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 724
 725 (defvar mime-view-x-face-command
 726   (concat mime-view-x-face-to-pbm-command
 727           " | xv -quit -")
 728   "String to be executed to display an X-Face field.
 729 The command will be executed in a sub-shell asynchronously.
 730 The compressed face will be piped to this command.")
 731
 732 (defun mime-view-x-face-function ()
 733   "Function to display X-Face field. You can redefine to customize."
 734   ;; 1995/10/12 (c.f. tm-eng:130)
 735   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 736   (save-restriction
 737     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 738     ;; end
 739     (goto-char (point-min))
 740     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 741         (let ((beg (match-end 0))
 742               (end (std11-field-end))
 743               )
 744           (call-process-region beg end "sh" nil 0 nil
 745                                "-c" mime-view-x-face-command)
 746           ))))
 747
 748
 749 ;;; @ buffer setup
 750 ;;;
 751
 752 (defun mime-display-entity (entity &optional situation
 753                                    default-situation preview-buffer)
 754   (or preview-buffer
 755       (setq preview-buffer (current-buffer)))
 756   (let* ((raw-buffer (mime-entity-buffer entity))
 757          (start (mime-entity-point-min entity))
 758          e nb ne)
 759     (set-buffer raw-buffer)
 760     (goto-char start)
 761     (or situation
 762         (setq situation
 763               (or (ctree-match-calist mime-preview-condition
 764                                       (append (mime-entity-situation entity)
 765                                               default-situation))
 766                   default-situation)))
 767     (let ((button-is-invisible
 768            (eq (cdr (assq 'entity-button situation)) 'invisible))
 769           (header-is-visible
 770            (eq (cdr (assq 'header situation)) 'visible))
 771           (header-presentation-method
 772            (or (cdr (assq 'header-presentation-method situation))
 773                (cdr (assq major-mode mime-header-presentation-method-alist))))
 774           (body-presentation-method
 775            (cdr (assq 'body-presentation-method situation)))
 776           (children (mime-entity-children entity)))
 777       (set-buffer preview-buffer)
 778       (setq nb (point))
 779       (narrow-to-region nb nb)
 780       (or button-is-invisible
 781           (if (mime-view-entity-button-visible-p entity)
 782               (mime-view-insert-entity-button entity)
 783             ))
 784       (when header-is-visible
 785         (if header-presentation-method
 786             (funcall header-presentation-method entity situation)
 787           (mime-insert-decoded-header entity
 788                                       mime-view-ignored-field-list
 789                                       mime-view-visible-field-list
 790                                       (if (mime-entity-cooked-p entity)
 791                                           nil
 792                                         default-mime-charset))
 793           )
 794         (goto-char (point-max))
 795         (insert "\n")
 796         (run-hooks 'mime-display-header-hook)
 797         )
 798       (cond (children)
 799             ((functionp body-presentation-method)
 800              (funcall body-presentation-method entity situation)
 801              )
 802             (t
 803              (when button-is-invisible
 804                (goto-char (point-max))
 805                (mime-view-insert-entity-button entity)
 806                )
 807              (or header-is-visible
 808                  (progn
 809                    (goto-char (point-max))
 810                    (insert "\n")
 811                    ))
 812              ))
 813       (setq ne (point-max))
 814       (widen)
 815       (put-text-property nb ne 'mime-view-entity entity)
 816       (goto-char ne)
 817       (if children
 818           (if (functionp body-presentation-method)
 819               (funcall body-presentation-method entity situation)
 820             (mime-display-multipart/mixed entity situation)
 821             ))
 822       )))
 823
 824
 825 ;;; @ MIME viewer mode
 826 ;;;
 827
 828 (defconst mime-view-menu-title "MIME-View")
 829 (defconst mime-view-menu-list
 830   '((up          "Move to upper entity"    mime-preview-move-to-upper)
 831     (previous    "Move to previous entity" mime-preview-move-to-previous)
 832     (next        "Move to next entity"     mime-preview-move-to-next)
 833     (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
 834     (scroll-up   "Scroll-up"               mime-preview-scroll-up-entity)
 835     (play        "Play current entity"     mime-preview-play-current-entity)
 836     (extract     "Extract current entity"  mime-preview-extract-current-entity)
 837     (print       "Print current entity"    mime-preview-print-current-entity)
 838     (x-face      "Show X Face"             mime-preview-display-x-face)
 839     )
 840   "Menu for MIME Viewer")
 841
 842 (cond (running-xemacs
 843        (defvar mime-view-xemacs-popup-menu
 844          (cons mime-view-menu-title
 845                (mapcar (function
 846                         (lambda (item)
 847                           (vector (nth 1 item)(nth 2 item) t)
 848                           ))
 849                        mime-view-menu-list)))
 850        (defun mime-view-xemacs-popup-menu (event)
 851          "Popup the menu in the MIME Viewer buffer"
 852          (interactive "e")
 853          (select-window (event-window event))
 854          (set-buffer (event-buffer event))
 855          (popup-menu 'mime-view-xemacs-popup-menu))
 856        (defvar mouse-button-2 'button2)
 857        )
 858       (t
 859        (defvar mouse-button-2 [mouse-2])
 860        ))
 861
 862 (defun mime-view-define-keymap (&optional default)
 863   (let ((mime-view-mode-map (if (keymapp default)
 864                                 (copy-keymap default)
 865                               (make-sparse-keymap)
 866                               )))
 867     (define-key mime-view-mode-map
 868       "u"        (function mime-preview-move-to-upper))
 869     (define-key mime-view-mode-map
 870       "p"        (function mime-preview-move-to-previous))
 871     (define-key mime-view-mode-map
 872       "n"        (function mime-preview-move-to-next))
 873     (define-key mime-view-mode-map
 874       "\e\t"     (function mime-preview-move-to-previous))
 875     (define-key mime-view-mode-map
 876       "\t"       (function mime-preview-move-to-next))
 877     (define-key mime-view-mode-map
 878       " "        (function mime-preview-scroll-up-entity))
 879     (define-key mime-view-mode-map
 880       "\M- "     (function mime-preview-scroll-down-entity))
 881     (define-key mime-view-mode-map
 882       "\177"     (function mime-preview-scroll-down-entity))
 883     (define-key mime-view-mode-map
 884       "\C-m"     (function mime-preview-next-line-entity))
 885     (define-key mime-view-mode-map
 886       "\C-\M-m"  (function mime-preview-previous-line-entity))
 887     (define-key mime-view-mode-map
 888       "v"        (function mime-preview-play-current-entity))
 889     (define-key mime-view-mode-map
 890       "e"        (function mime-preview-extract-current-entity))
 891     (define-key mime-view-mode-map
 892       "\C-c\C-p" (function mime-preview-print-current-entity))
 893     (define-key mime-view-mode-map
 894       "a"        (function mime-preview-follow-current-entity))
 895     (define-key mime-view-mode-map
 896       "q"        (function mime-preview-quit))
 897     (define-key mime-view-mode-map
 898       "\C-c\C-x" (function mime-preview-kill-buffer))
 899     ;; (define-key mime-view-mode-map
 900     ;;   "<"        (function beginning-of-buffer))
 901     ;; (define-key mime-view-mode-map
 902     ;;   ">"        (function end-of-buffer))
 903     (define-key mime-view-mode-map
 904       "?"        (function describe-mode))
 905     (define-key mime-view-mode-map
 906       [tab] (function mime-preview-move-to-next))
 907     (define-key mime-view-mode-map
 908       [delete] (function mime-preview-scroll-down-entity))
 909     (define-key mime-view-mode-map
 910       [backspace] (function mime-preview-scroll-down-entity))
 911     (if (functionp default)
 912         (cond (running-xemacs
 913                (set-keymap-default-binding mime-view-mode-map default)
 914                )
 915               (t
 916                (setq mime-view-mode-map
 917                      (append mime-view-mode-map (list (cons t default))))
 918                )))
 919     (if mouse-button-2
 920         (define-key mime-view-mode-map
 921           mouse-button-2 (function mime-button-dispatcher))
 922       )
 923     (cond (running-xemacs
 924            (define-key mime-view-mode-map
 925              mouse-button-3 (function mime-view-xemacs-popup-menu))
 926            )
 927           ((>= emacs-major-version 19)
 928            (define-key mime-view-mode-map [menu-bar mime-view]
 929              (cons mime-view-menu-title
 930                    (make-sparse-keymap mime-view-menu-title)))
 931            (mapcar (function
 932                     (lambda (item)
 933                       (define-key mime-view-mode-map
 934                         (vector 'menu-bar 'mime-view (car item))
 935                         (cons (nth 1 item)(nth 2 item))
 936                         )
 937                       ))
 938                    (reverse mime-view-menu-list)
 939                    )
 940            ))
 941     (use-local-map mime-view-mode-map)
 942     (run-hooks 'mime-view-define-keymap-hook)
 943     ))
 944
 945 (defsubst mime-maybe-hide-echo-buffer ()
 946   "Clear mime-echo buffer and delete window for it."
 947   (let ((buf (get-buffer mime-echo-buffer-name)))
 948     (if buf
 949         (save-excursion
 950           (set-buffer buf)
 951           (erase-buffer)
 952           (let ((win (get-buffer-window buf)))
 953             (if win
 954                 (delete-window win)
 955               ))
 956           (bury-buffer buf)
 957           ))))
 958
 959 (defvar mime-view-redisplay nil)
 960
 961 (defun mime-display-message (message &optional preview-buffer
 962                                      mother default-keymap-or-function)
 963   (mime-maybe-hide-echo-buffer)
 964   (let ((win-conf (current-window-configuration))
 965         (raw-buffer (mime-entity-buffer message)))
 966     (or preview-buffer
 967         (setq preview-buffer
 968               (concat "*Preview-" (buffer-name raw-buffer) "*")))
 969     (set-buffer raw-buffer)
 970     (mime-parse-buffer)
 971     (setq mime-preview-buffer preview-buffer)
 972     (let ((inhibit-read-only t))
 973       (switch-to-buffer preview-buffer)
 974       (widen)
 975       (erase-buffer)
 976       (setq mime-raw-buffer raw-buffer)
 977       (if mother
 978           (setq mime-mother-buffer mother)
 979         )
 980       (setq mime-preview-original-window-configuration win-conf)
 981       (setq major-mode 'mime-view-mode)
 982       (setq mode-name "MIME-View")
 983       (mime-display-entity message nil
 984                            '((entity-button . invisible)
 985                              (header . visible))
 986                            preview-buffer)
 987       (mime-view-define-keymap default-keymap-or-function)
 988       (let ((point
 989              (next-single-property-change (point-min) 'mime-view-entity)))
 990         (if point
 991             (goto-char point)
 992           (goto-char (point-min))
 993           (search-forward "\n\n" nil t)
 994           ))
 995       (run-hooks 'mime-view-mode-hook)
 996       ))
 997   (set-buffer-modified-p nil)
 998   (setq buffer-read-only t)
 999   )
1000
1001 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
1002                                    default-keymap-or-function)
1003   (interactive)
1004   (mime-display-message
1005    (save-excursion
1006      (if raw-buffer (set-buffer raw-buffer))
1007      (mime-parse-message)
1008      )
1009    preview-buffer mother default-keymap-or-function))
1010
1011 (defun mime-view-mode (&optional mother ctl encoding
1012                                  raw-buffer preview-buffer
1013                                  default-keymap-or-function)
1014   "Major mode for viewing MIME message.
1015
1016 Here is a list of the standard keys for mime-view-mode.
1017
1018 key             feature
1019 ---             -------
1020
1021 u               Move to upper content
1022 p or M-TAB      Move to previous content
1023 n or TAB        Move to next content
1024 SPC             Scroll up or move to next content
1025 M-SPC or DEL    Scroll down or move to previous content
1026 RET             Move to next line
1027 M-RET           Move to previous line
1028 v               Decode current content as `play mode'
1029 e               Decode current content as `extract mode'
1030 C-c C-p         Decode current content as `print mode'
1031 a               Followup to current content.
1032 q               Quit
1033 button-2        Move to point under the mouse cursor
1034                 and decode current content as `play mode'
1035 "
1036   (interactive)
1037   (mime-display-message
1038    (save-excursion
1039      (if raw-buffer (set-buffer raw-buffer))
1040      (or mime-view-redisplay
1041          (mime-parse-message ctl encoding))
1042      )
1043    preview-buffer mother default-keymap-or-function))
1044
1045
1046 ;;; @@ playing
1047 ;;;
1048
1049 (autoload 'mime-preview-play-current-entity "mime-play"
1050   "Play current entity." t)
1051
1052 (defun mime-preview-extract-current-entity ()
1053   "Extract current entity into file (maybe).
1054 It decodes current entity to call internal or external method as
1055 \"extract\" mode.  The method is selected from variable
1056 `mime-acting-condition'."
1057   (interactive)
1058   (mime-preview-play-current-entity "extract")
1059   )
1060
1061 (defun mime-preview-print-current-entity ()
1062   "Print current entity (maybe).
1063 It decodes current entity to call internal or external method as
1064 \"print\" mode.  The method is selected from variable
1065 `mime-acting-condition'."
1066   (interactive)
1067   (mime-preview-play-current-entity "print")
1068   )
1069
1070
1071 ;;; @@ following
1072 ;;;
1073
1074 (defun mime-preview-follow-current-entity ()
1075   "Write follow message to current entity.
1076 It calls following-method selected from variable
1077 `mime-preview-following-method-alist'."
1078   (interactive)
1079   (let (entity)
1080     (while (null (setq entity
1081                        (get-text-property (point) 'mime-view-entity)))
1082       (backward-char)
1083       )
1084     (let* ((p-beg
1085             (previous-single-property-change (point) 'mime-view-entity))
1086            p-end
1087            (entity-node-id (mime-entity-node-id entity))
1088            (len (length entity-node-id))
1089            )
1090       (cond ((null p-beg)
1091              (setq p-beg
1092                    (if (eq (next-single-property-change (point-min)
1093                                                         'mime-view-entity)
1094                            (point))
1095                        (point)
1096                      (point-min)))
1097              )
1098             ((eq (next-single-property-change p-beg 'mime-view-entity)
1099                  (point))
1100              (setq p-beg (point))
1101              ))
1102       (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1103       (cond ((null p-end)
1104              (setq p-end (point-max))
1105              )
1106             ((null entity-node-id)
1107              (setq p-end (point-max))
1108              )
1109             (t
1110              (save-excursion
1111                (goto-char p-end)
1112                (catch 'tag
1113                  (let (e)
1114                    (while (setq e
1115                                 (next-single-property-change
1116                                  (point) 'mime-view-entity))
1117                      (goto-char e)
1118                      (let ((rc (mime-entity-node-id
1119                                 (get-text-property (point)
1120                                                    'mime-view-entity))))
1121                        (or (equal entity-node-id
1122                                   (nthcdr (- (length rc) len) rc))
1123                            (throw 'tag nil)
1124                            ))
1125                      (setq p-end e)
1126                      ))
1127                  (setq p-end (point-max))
1128                  ))
1129              ))
1130       (let* ((mode (mime-preview-original-major-mode 'recursive))
1131              (new-name
1132               (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1133              new-buf
1134              (the-buf (current-buffer))
1135              (a-buf mime-raw-buffer)
1136              fields)
1137         (save-excursion
1138           (set-buffer (setq new-buf (get-buffer-create new-name)))
1139           (erase-buffer)
1140           (insert-buffer-substring the-buf p-beg p-end)
1141           (goto-char (point-min))
1142           (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1143             (while (progn
1144                      (setq
1145                       str
1146                       (save-excursion
1147                         (set-buffer a-buf)
1148                         (setq
1149                          ci
1150                          (mime-raw-find-entity-from-node-id entity-node-id))
1151                         (save-restriction
1152                           (narrow-to-region
1153                            (mime-entity-point-min ci)
1154                            (mime-entity-point-max ci)
1155                            )
1156                           (std11-header-string-except
1157                            (concat "^"
1158                                    (apply (function regexp-or) fields)
1159                                    ":") ""))))
1160                      (if (and
1161                           (eq (mime-entity-media-type ci) 'message)
1162                           (eq (mime-entity-media-subtype ci) 'rfc822))
1163                          nil
1164                        (if str
1165                            (insert str)
1166                          )
1167                        entity-node-id))
1168               (setq fields (std11-collect-field-names)
1169                     entity-node-id (cdr entity-node-id))
1170               )
1171             )
1172           (let ((rest mime-view-following-required-fields-list))
1173             (while rest
1174               (let ((field-name (car rest)))
1175                 (or (std11-field-body field-name)
1176                     (insert
1177                      (format
1178                       (concat field-name
1179                               ": "
1180                               (save-excursion
1181                                 (set-buffer the-buf)
1182                                 (set-buffer mime-mother-buffer)
1183                                 (set-buffer mime-raw-buffer)
1184                                 (std11-field-body field-name)
1185                                 )
1186                               "\n")))
1187                     ))
1188               (setq rest (cdr rest))
1189               ))
1190           (eword-decode-header)
1191           )
1192         (let ((f (cdr (assq mode mime-preview-following-method-alist))))
1193           (if (functionp f)
1194               (funcall f new-buf)
1195             (message
1196              (format
1197               "Sorry, following method for %s is not implemented yet."
1198               mode))
1199             ))
1200         ))))
1201
1202
1203 ;;; @@ X-Face
1204 ;;;
1205
1206 (defun mime-preview-display-x-face ()
1207   (interactive)
1208   (save-window-excursion
1209     (set-buffer mime-raw-buffer)
1210     (mime-view-x-face-function)
1211     ))
1212
1213
1214 ;;; @@ moving
1215 ;;;
1216
1217 (defun mime-preview-move-to-upper ()
1218   "Move to upper entity.
1219 If there is no upper entity, call function `mime-preview-quit'."
1220   (interactive)
1221   (let (cinfo)
1222     (while (null (setq cinfo
1223                        (get-text-property (point) 'mime-view-entity)))
1224       (backward-char)
1225       )
1226     (let ((r (mime-raw-find-entity-from-node-id
1227               (cdr (mime-entity-node-id cinfo))
1228               (get-text-property 1 'mime-view-entity)))
1229           point)
1230       (catch 'tag
1231         (while (setq point (previous-single-property-change
1232                             (point) 'mime-view-entity))
1233           (goto-char point)
1234           (if (eq r (get-text-property (point) 'mime-view-entity))
1235               (throw 'tag t)
1236             )
1237           )
1238         (mime-preview-quit)
1239         ))))
1240
1241 (defun mime-preview-move-to-previous ()
1242   "Move to previous entity.
1243 If there is no previous entity, it calls function registered in
1244 variable `mime-preview-over-to-previous-method-alist'."
1245   (interactive)
1246   (while (null (get-text-property (point) 'mime-view-entity))
1247     (backward-char)
1248     )
1249   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
1250     (if point
1251         (if (get-text-property (1- point) 'mime-view-entity)
1252             (goto-char point)
1253           (goto-char (1- point))
1254           (mime-preview-move-to-previous)
1255           )
1256       (let ((f (assq (mime-preview-original-major-mode)
1257                      mime-preview-over-to-previous-method-alist)))
1258         (if f
1259             (funcall (cdr f))
1260           ))
1261       )))
1262
1263 (defun mime-preview-move-to-next ()
1264   "Move to next entity.
1265 If there is no previous entity, it calls function registered in
1266 variable `mime-preview-over-to-next-method-alist'."
1267   (interactive)
1268   (while (null (get-text-property (point) 'mime-view-entity))
1269     (forward-char)
1270     )
1271   (let ((point (next-single-property-change (point) 'mime-view-entity)))
1272     (if point
1273         (progn
1274           (goto-char point)
1275           (if (null (get-text-property point 'mime-view-entity))
1276               (mime-preview-move-to-next)
1277             ))
1278       (let ((f (assq (mime-preview-original-major-mode)
1279                      mime-preview-over-to-next-method-alist)))
1280         (if f
1281             (funcall (cdr f))
1282           ))
1283       )))
1284
1285 (defun mime-preview-scroll-up-entity (&optional h)
1286   "Scroll up current entity.
1287 If reached to (point-max), it calls function registered in variable
1288 `mime-preview-over-to-next-method-alist'."
1289   (interactive)
1290   (or h
1291       (setq h (1- (window-height)))
1292       )
1293   (if (= (point) (point-max))
1294       (let ((f (assq (mime-preview-original-major-mode)
1295                      mime-preview-over-to-next-method-alist)))
1296         (if f
1297             (funcall (cdr f))
1298           ))
1299     (let ((point
1300            (or (next-single-property-change (point) 'mime-view-entity)
1301                (point-max))))
1302       (forward-line h)
1303       (if (> (point) point)
1304           (goto-char point)
1305         )
1306       )))
1307
1308 (defun mime-preview-scroll-down-entity (&optional h)
1309   "Scroll down current entity.
1310 If reached to (point-min), it calls function registered in variable
1311 `mime-preview-over-to-previous-method-alist'."
1312   (interactive)
1313   (or h
1314       (setq h (1- (window-height)))
1315       )
1316   (if (= (point) (point-min))
1317       (let ((f (assq (mime-preview-original-major-mode)
1318                      mime-preview-over-to-previous-method-alist)))
1319         (if f
1320             (funcall (cdr f))
1321           ))
1322     (let ((point
1323            (or (previous-single-property-change (point) 'mime-view-entity)
1324                (point-min))))
1325       (forward-line (- h))
1326       (if (< (point) point)
1327           (goto-char point)
1328         ))))
1329
1330 (defun mime-preview-next-line-entity ()
1331   (interactive)
1332   (mime-preview-scroll-up-entity 1)
1333   )
1334
1335 (defun mime-preview-previous-line-entity ()
1336   (interactive)
1337   (mime-preview-scroll-down-entity 1)
1338   )
1339
1340
1341 ;;; @@ quitting
1342 ;;;
1343
1344 (defun mime-preview-quit ()
1345   "Quit from MIME-preview buffer.
1346 It calls function registered in variable
1347 `mime-preview-quitting-method-alist'."
1348   (interactive)
1349   (let ((r (assq (mime-preview-original-major-mode)
1350                  mime-preview-quitting-method-alist)))
1351     (if r
1352         (funcall (cdr r))
1353       )))
1354
1355 (defun mime-preview-kill-buffer ()
1356   (interactive)
1357   (kill-buffer (current-buffer))
1358   )
1359
1360
1361 ;;; @ end
1362 ;;;
1363
1364 (provide 'mime-view)
1365
1366 (run-hooks 'mime-view-load-hook)
1367
1368 ;;; mime-view.el ends here