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