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