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