mime-view.el

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