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