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 WEMI (Widget based 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 or click here by mouse button-2."
 537     "\
 538 This is message/partial style split message.
 539 Please press `v' key in this buffer."
 540     ))
 541
 542 (defun mime-display-message/partial-button (&optional entity situation)
 543   (save-restriction
 544     (goto-char (point-max))
 545     (if (not (search-backward "\n\n" nil t))
 546         (insert "\n")
 547       )
 548     (goto-char (point-max))
 549     ;;(narrow-to-region (point-max)(point-max))
 550     ;;(insert mime-view-announcement-for-message/partial)
 551     ;; (mime-add-button (point-min)(point-max)
 552     ;;                  #'mime-preview-play-current-entity)
 553     (mime-insert-button mime-view-announcement-for-message/partial
 554                         #'mime-preview-play-current-entity)
 555     ))
 556
 557 (defun mime-display-multipart/mixed (entity situation)
 558   (let ((children (mime-entity-children entity))
 559         (default-situation
 560           (cdr (assq 'childrens-situation situation))))
 561     (while children
 562       (mime-display-entity (car children) nil default-situation)
 563       (setq children (cdr children))
 564       )))
 565
 566 (defcustom mime-view-type-subtype-score-alist
 567   '(((text . enriched) . 3)
 568     ((text . richtext) . 2)
 569     ((text . plain)    . 1)
 570     (t . 0))
 571   "Alist MEDIA-TYPE vs corresponding score.
 572 MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 573   :group 'mime-view
 574   :type '(repeat (cons (choice :tag "Media-Type"
 575                                (item :tag "Type/Subtype"
 576                                      (cons symbol symbol))
 577                                (item :tag "Type" symbol)
 578                                (item :tag "Default" t))
 579                        integer)))
 580
 581 (defun mime-display-multipart/alternative (entity situation)
 582   (let* ((children (mime-entity-children entity))
 583          (default-situation
 584            (cdr (assq 'childrens-situation situation)))
 585          (i 0)
 586          (p 0)
 587          (max-score 0)
 588          (situations
 589           (mapcar (function
 590                    (lambda (child)
 591                      (let ((situation
 592                             (or (ctree-match-calist
 593                                  mime-preview-condition
 594                                  (append (mime-entity-situation child)
 595                                          default-situation))
 596                                 default-situation)))
 597                        (if (cdr (assq 'body-presentation-method situation))
 598                            (let ((score
 599                                   (cdr
 600                                    (or (assoc
 601                                         (cons
 602                                          (cdr (assq 'type situation))
 603                                          (cdr (assq 'subtype situation)))
 604                                         mime-view-type-subtype-score-alist)
 605                                        (assq
 606                                         (cdr (assq 'type situation))
 607                                         mime-view-type-subtype-score-alist)
 608                                        (assq
 609                                         t
 610                                         mime-view-type-subtype-score-alist)
 611                                        ))))
 612                              (if (> score max-score)
 613                                  (setq p i
 614                                        max-score score)
 615                                )))
 616                        (setq i (1+ i))
 617                        situation)
 618                      ))
 619                   children)))
 620     (setq i 0)
 621     (while children
 622       (let ((child (car children))
 623             (situation (car situations)))
 624         (mime-display-entity child (if (= i p)
 625                                        situation
 626                                      (del-alist 'body-presentation-method
 627                                                 (copy-alist situation))))
 628         )
 629       (setq children (cdr children)
 630             situations (cdr situations)
 631             i (1+ i))
 632       )))
 633
 634
 635 ;;; @ acting-condition
 636 ;;;
 637
 638 (defvar mime-acting-condition nil
 639   "Condition-tree about how to process entity.")
 640
 641 (if (file-readable-p mailcap-file)
 642     (let ((entries (mailcap-parse-file)))
 643       (while entries
 644         (let ((entry (car entries))
 645               view print shared)
 646           (while entry
 647             (let* ((field (car entry))
 648                    (field-type (car field)))
 649               (cond ((eq field-type 'view)  (setq view field))
 650                     ((eq field-type 'print) (setq print field))
 651                     ((memq field-type '(compose composetyped edit)))
 652                     (t (setq shared (cons field shared))))
 653               )
 654             (setq entry (cdr entry))
 655             )
 656           (setq shared (nreverse shared))
 657           (ctree-set-calist-with-default
 658            'mime-acting-condition
 659            (append shared (list '(mode . "play")(cons 'method (cdr view)))))
 660           (if print
 661               (ctree-set-calist-with-default
 662                'mime-acting-condition
 663                (append shared
 664                        (list '(mode . "print")(cons 'method (cdr view))))
 665                ))
 666           )
 667         (setq entries (cdr entries))
 668         )))
 669
 670 (ctree-set-calist-strictly
 671  'mime-acting-condition
 672  '((type . application)(subtype . octet-stream)
 673    (mode . "play")
 674    (method . mime-detect-content)
 675    ))
 676
 677 (ctree-set-calist-with-default
 678  'mime-acting-condition
 679  '((mode . "extract")
 680    (method . mime-save-content)))
 681
 682 (ctree-set-calist-strictly
 683  'mime-acting-condition
 684  '((type . text)(subtype . x-rot13-47)(mode . "play")
 685    (method . mime-view-caesar)
 686    ))
 687 (ctree-set-calist-strictly
 688  'mime-acting-condition
 689  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
 690    (method . mime-view-caesar)
 691    ))
 692
 693 (ctree-set-calist-strictly
 694  'mime-acting-condition
 695  '((type . message)(subtype . rfc822)(mode . "play")
 696    (method . mime-view-message/rfc822)
 697    ))
 698 (ctree-set-calist-strictly
 699  'mime-acting-condition
 700  '((type . message)(subtype . partial)(mode . "play")
 701    (method . mime-store-message/partial-piece)
 702    ))
 703
 704 (ctree-set-calist-strictly
 705  'mime-acting-condition
 706  '((type . message)(subtype . external-body)
 707    ("access-type" . "anon-ftp")
 708    (method . mime-view-message/external-ftp)
 709    ))
 710
 711 (ctree-set-calist-strictly
 712  'mime-acting-condition
 713  '((type . application)(subtype . octet-stream)
 714    (method . mime-save-content)
 715    ))
 716
 717
 718 ;;; @ quitting method
 719 ;;;
 720
 721 (defvar mime-preview-quitting-method-alist
 722   '((mime-show-message-mode
 723      . mime-preview-quitting-method-for-mime-show-message-mode))
 724   "Alist of major-mode vs. quitting-method of mime-view.")
 725
 726 (defvar mime-preview-over-to-previous-method-alist nil
 727   "Alist of major-mode vs. over-to-previous-method of mime-view.")
 728
 729 (defvar mime-preview-over-to-next-method-alist nil
 730   "Alist of major-mode vs. over-to-next-method of mime-view.")
 731
 732
 733 ;;; @ following method
 734 ;;;
 735
 736 (defvar mime-preview-following-method-alist nil
 737   "Alist of major-mode vs. following-method of mime-view.")
 738
 739 (defvar mime-view-following-required-fields-list
 740   '("From"))
 741
 742
 743 ;;; @ X-Face
 744 ;;;
 745
 746 ;; hack from Gnus 5.0.4.
 747
 748 (defvar mime-view-x-face-to-pbm-command
 749   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 750
 751 (defvar mime-view-x-face-command
 752   (concat mime-view-x-face-to-pbm-command
 753           " | xv -quit -")
 754   "String to be executed to display an X-Face field.
 755 The command will be executed in a sub-shell asynchronously.
 756 The compressed face will be piped to this command.")
 757
 758 (defun mime-view-x-face-function ()
 759   "Function to display X-Face field. You can redefine to customize."
 760   ;; 1995/10/12 (c.f. tm-eng:130)
 761   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 762   (save-restriction
 763     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 764     ;; end
 765     (goto-char (point-min))
 766     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 767         (let ((beg (match-end 0))
 768               (end (std11-field-end))
 769               )
 770           (call-process-region beg end "sh" nil 0 nil
 771                                "-c" mime-view-x-face-command)
 772           ))))
 773
 774
 775 ;;; @ buffer setup
 776 ;;;
 777
 778 (defun mime-display-entity (entity &optional situation
 779                                    default-situation preview-buffer)
 780   (or preview-buffer
 781       (setq preview-buffer (current-buffer)))
 782   (let* ((raw-buffer (mime-entity-buffer entity))
 783          (start (mime-entity-point-min entity))
 784          e nb ne)
 785     (set-buffer raw-buffer)
 786     (goto-char start)
 787     (or situation
 788         (setq situation
 789               (or (ctree-match-calist mime-preview-condition
 790                                       (append (mime-entity-situation entity)
 791                                               default-situation))
 792                   default-situation)))
 793     (let ((button-is-invisible
 794            (eq (cdr (assq 'entity-button situation)) 'invisible))
 795           (header-is-visible
 796            (eq (cdr (assq 'header situation)) 'visible))
 797           (header-presentation-method
 798            (or (cdr (assq 'header-presentation-method situation))
 799                (cdr (assq major-mode mime-header-presentation-method-alist))))
 800           (body-presentation-method
 801            (cdr (assq 'body-presentation-method situation)))
 802           (children (mime-entity-children entity)))
 803       (set-buffer preview-buffer)
 804       (setq nb (point))
 805       (narrow-to-region nb nb)
 806       (or button-is-invisible
 807           (if (mime-view-entity-button-visible-p entity)
 808               (mime-view-insert-entity-button entity)
 809             ))
 810       (when header-is-visible
 811         (if header-presentation-method
 812             (funcall header-presentation-method entity situation)
 813           (mime-insert-decoded-header
 814            entity
 815            mime-view-ignored-field-list mime-view-visible-field-list
 816            (save-excursion
 817              (set-buffer raw-buffer)
 818              (if (eq (cdr (assq major-mode mime-raw-representation-type-alist))
 819                      'binary)
 820                  default-mime-charset)
 821              )))
 822         (goto-char (point-max))
 823         (insert "\n")
 824         (run-hooks 'mime-display-header-hook)
 825         )
 826       (cond (children)
 827             ((functionp body-presentation-method)
 828              (funcall body-presentation-method entity situation)
 829              )
 830             (t
 831              (when button-is-invisible
 832                (goto-char (point-max))
 833                (mime-view-insert-entity-button entity)
 834                )
 835              (or header-is-visible
 836                  (progn
 837                    (goto-char (point-max))
 838                    (insert "\n")
 839                    ))
 840              ))
 841       (setq ne (point-max))
 842       (widen)
 843       (put-text-property nb ne 'mime-view-entity entity)
 844       (goto-char ne)
 845       (if children
 846           (if (functionp body-presentation-method)
 847               (funcall body-presentation-method entity situation)
 848             (mime-display-multipart/mixed entity situation)
 849             ))
 850       )))
 851
 852
 853 ;;; @ MIME viewer mode
 854 ;;;
 855
 856 (defconst mime-view-menu-title "MIME-View")
 857 (defconst mime-view-menu-list
 858   '((up          "Move to upper entity"    mime-preview-move-to-upper)
 859     (previous    "Move to previous entity" mime-preview-move-to-previous)
 860     (next        "Move to next entity"     mime-preview-move-to-next)
 861     (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
 862     (scroll-up   "Scroll-up"               mime-preview-scroll-up-entity)
 863     (play        "Play current entity"     mime-preview-play-current-entity)
 864     (extract     "Extract current entity"  mime-preview-extract-current-entity)
 865     (print       "Print current entity"    mime-preview-print-current-entity)
 866     (x-face      "Show X Face"             mime-preview-display-x-face)
 867     )
 868   "Menu for MIME Viewer")
 869
 870 (cond (running-xemacs
 871        (defvar mime-view-xemacs-popup-menu
 872          (cons mime-view-menu-title
 873                (mapcar (function
 874                         (lambda (item)
 875                           (vector (nth 1 item)(nth 2 item) t)
 876                           ))
 877                        mime-view-menu-list)))
 878        (defun mime-view-xemacs-popup-menu (event)
 879          "Popup the menu in the MIME Viewer buffer"
 880          (interactive "e")
 881          (select-window (event-window event))
 882          (set-buffer (event-buffer event))
 883          (popup-menu 'mime-view-xemacs-popup-menu))
 884        (defvar mouse-button-2 'button2)
 885        )
 886       (t
 887        (defvar mouse-button-2 [mouse-2])
 888        ))
 889
 890 (defun mime-view-define-keymap (&optional default)
 891   (let ((mime-view-mode-map (if (keymapp default)
 892                                 (copy-keymap default)
 893                               (make-sparse-keymap)
 894                               )))
 895     (define-key mime-view-mode-map
 896       "u"        (function mime-preview-move-to-upper))
 897     (define-key mime-view-mode-map
 898       "p"        (function mime-preview-move-to-previous))
 899     (define-key mime-view-mode-map
 900       "n"        (function mime-preview-move-to-next))
 901     (define-key mime-view-mode-map
 902       "\e\t"     (function mime-preview-move-to-previous))
 903     (define-key mime-view-mode-map
 904       "\t"       (function mime-preview-move-to-next))
 905     (define-key mime-view-mode-map
 906       " "        (function mime-preview-scroll-up-entity))
 907     (define-key mime-view-mode-map
 908       "\M- "     (function mime-preview-scroll-down-entity))
 909     (define-key mime-view-mode-map
 910       "\177"     (function mime-preview-scroll-down-entity))
 911     (define-key mime-view-mode-map
 912       "\C-m"     (function mime-preview-next-line-entity))
 913     (define-key mime-view-mode-map
 914       "\C-\M-m"  (function mime-preview-previous-line-entity))
 915     (define-key mime-view-mode-map
 916       "v"        (function mime-preview-play-current-entity))
 917     (define-key mime-view-mode-map
 918       "e"        (function mime-preview-extract-current-entity))
 919     (define-key mime-view-mode-map
 920       "\C-c\C-p" (function mime-preview-print-current-entity))
 921     (define-key mime-view-mode-map
 922       "a"        (function mime-preview-follow-current-entity))
 923     (define-key mime-view-mode-map
 924       "q"        (function mime-preview-quit))
 925     (define-key mime-view-mode-map
 926       "\C-c\C-x" (function mime-preview-kill-buffer))
 927     ;; (define-key mime-view-mode-map
 928     ;;   "<"        (function beginning-of-buffer))
 929     ;; (define-key mime-view-mode-map
 930     ;;   ">"        (function end-of-buffer))
 931     (define-key mime-view-mode-map
 932       "?"        (function describe-mode))
 933     (define-key mime-view-mode-map
 934       [tab] (function mime-preview-move-to-next))
 935     (define-key mime-view-mode-map
 936       [delete] (function mime-preview-scroll-down-entity))
 937     (define-key mime-view-mode-map
 938       [backspace] (function mime-preview-scroll-down-entity))
 939     (if (functionp default)
 940         (cond (running-xemacs
 941                (set-keymap-default-binding mime-view-mode-map default)
 942                )
 943               (t
 944                (setq mime-view-mode-map
 945                      (append mime-view-mode-map (list (cons t default))))
 946                )))
 947     (if mouse-button-2
 948         (define-key mime-view-mode-map
 949           mouse-button-2 (function mime-button-dispatcher))
 950       )
 951     (cond (running-xemacs
 952            (define-key mime-view-mode-map
 953              mouse-button-3 (function mime-view-xemacs-popup-menu))
 954            )
 955           ((>= emacs-major-version 19)
 956            (define-key mime-view-mode-map [menu-bar mime-view]
 957              (cons mime-view-menu-title
 958                    (make-sparse-keymap mime-view-menu-title)))
 959            (mapcar (function
 960                     (lambda (item)
 961                       (define-key mime-view-mode-map
 962                         (vector 'menu-bar 'mime-view (car item))
 963                         (cons (nth 1 item)(nth 2 item))
 964                         )
 965                       ))
 966                    (reverse mime-view-menu-list)
 967                    )
 968            ))
 969     (use-local-map mime-view-mode-map)
 970     (run-hooks 'mime-view-define-keymap-hook)
 971     ))
 972
 973 (defsubst mime-maybe-hide-echo-buffer ()
 974   "Clear mime-echo buffer and delete window for it."
 975   (let ((buf (get-buffer mime-echo-buffer-name)))
 976     (if buf
 977         (save-excursion
 978           (set-buffer buf)
 979           (erase-buffer)
 980           (let ((win (get-buffer-window buf)))
 981             (if win
 982                 (delete-window win)
 983               ))
 984           (bury-buffer buf)
 985           ))))
 986
 987 (defvar mime-view-redisplay nil)
 988
 989 (defun mime-display-message (message &optional preview-buffer
 990                                      mother default-keymap-or-function)
 991   (mime-maybe-hide-echo-buffer)
 992   (let ((win-conf (current-window-configuration))
 993         (raw-buffer (mime-entity-buffer message)))
 994     (or preview-buffer
 995         (setq preview-buffer
 996               (concat "*Preview-" (buffer-name raw-buffer) "*")))
 997     (set-buffer raw-buffer)
 998     (setq mime-raw-message-info (mime-parse-message))
 999     (setq mime-preview-buffer preview-buffer)
1000     (let ((inhibit-read-only t))
1001       (switch-to-buffer preview-buffer)
1002       (widen)
1003       (erase-buffer)
1004       (setq mime-raw-buffer raw-buffer)
1005       (if mother
1006           (setq mime-mother-buffer mother)
1007         )
1008       (setq mime-preview-original-window-configuration win-conf)
1009       (setq major-mode 'mime-view-mode)
1010       (setq mode-name "MIME-View")
1011       (mime-display-entity message nil
1012                            '((entity-button . invisible)
1013                              (header . visible))
1014                            preview-buffer)
1015       (mime-view-define-keymap default-keymap-or-function)
1016       (let ((point
1017              (next-single-property-change (point-min) 'mime-view-entity)))
1018         (if point
1019             (goto-char point)
1020           (goto-char (point-min))
1021           (search-forward "\n\n" nil t)
1022           ))
1023       (run-hooks 'mime-view-mode-hook)
1024       ))
1025   (set-buffer-modified-p nil)
1026   (setq buffer-read-only t)
1027   )
1028
1029 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
1030                                    default-keymap-or-function)
1031   (interactive)
1032   (mime-display-message
1033    (save-excursion
1034      (if raw-buffer (set-buffer raw-buffer))
1035      (mime-parse-message)
1036      )
1037    preview-buffer mother default-keymap-or-function))
1038
1039 (defun mime-view-mode (&optional mother ctl encoding
1040                                  raw-buffer preview-buffer
1041                                  default-keymap-or-function)
1042   "Major mode for viewing MIME message.
1043
1044 Here is a list of the standard keys for mime-view-mode.
1045
1046 key             feature
1047 ---             -------
1048
1049 u               Move to upper content
1050 p or M-TAB      Move to previous content
1051 n or TAB        Move to next content
1052 SPC             Scroll up or move to next content
1053 M-SPC or DEL    Scroll down or move to previous content
1054 RET             Move to next line
1055 M-RET           Move to previous line
1056 v               Decode current content as `play mode'
1057 e               Decode current content as `extract mode'
1058 C-c C-p         Decode current content as `print mode'
1059 a               Followup to current content.
1060 q               Quit
1061 button-2        Move to point under the mouse cursor
1062                 and decode current content as `play mode'
1063 "
1064   (interactive)
1065   (mime-display-message
1066    (save-excursion
1067      (if raw-buffer (set-buffer raw-buffer))
1068      (or mime-view-redisplay
1069          (mime-parse-message ctl encoding))
1070      )
1071    preview-buffer mother default-keymap-or-function))
1072
1073
1074 ;;; @@ playing
1075 ;;;
1076
1077 (autoload 'mime-preview-play-current-entity "mime-play"
1078   "Play current entity." t)
1079
1080 (defun mime-preview-extract-current-entity ()
1081   "Extract current entity into file (maybe).
1082 It decodes current entity to call internal or external method as
1083 \"extract\" mode.  The method is selected from variable
1084 `mime-acting-condition'."
1085   (interactive)
1086   (mime-preview-play-current-entity "extract")
1087   )
1088
1089 (defun mime-preview-print-current-entity ()
1090   "Print current entity (maybe).
1091 It decodes current entity to call internal or external method as
1092 \"print\" mode.  The method is selected from variable
1093 `mime-acting-condition'."
1094   (interactive)
1095   (mime-preview-play-current-entity "print")
1096   )
1097
1098
1099 ;;; @@ following
1100 ;;;
1101
1102 (defun mime-preview-follow-current-entity ()
1103   "Write follow message to current entity.
1104 It calls following-method selected from variable
1105 `mime-preview-following-method-alist'."
1106   (interactive)
1107   (let (entity)
1108     (while (null (setq entity
1109                        (get-text-property (point) 'mime-view-entity)))
1110       (backward-char)
1111       )
1112     (let* ((p-beg
1113             (previous-single-property-change (point) 'mime-view-entity))
1114            p-end
1115            (entity-node-id (mime-entity-node-id entity))
1116            (len (length entity-node-id))
1117            )
1118       (cond ((null p-beg)
1119              (setq p-beg
1120                    (if (eq (next-single-property-change (point-min)
1121                                                         'mime-view-entity)
1122                            (point))
1123                        (point)
1124                      (point-min)))
1125              )
1126             ((eq (next-single-property-change p-beg 'mime-view-entity)
1127                  (point))
1128              (setq p-beg (point))
1129              ))
1130       (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1131       (cond ((null p-end)
1132              (setq p-end (point-max))
1133              )
1134             ((null entity-node-id)
1135              (setq p-end (point-max))
1136              )
1137             (t
1138              (save-excursion
1139                (goto-char p-end)
1140                (catch 'tag
1141                  (let (e)
1142                    (while (setq e
1143                                 (next-single-property-change
1144                                  (point) 'mime-view-entity))
1145                      (goto-char e)
1146                      (let ((rc (mime-entity-node-id
1147                                 (get-text-property (point)
1148                                                    'mime-view-entity))))
1149                        (or (equal entity-node-id
1150                                   (nthcdr (- (length rc) len) rc))
1151                            (throw 'tag nil)
1152                            ))
1153                      (setq p-end e)
1154                      ))
1155                  (setq p-end (point-max))
1156                  ))
1157              ))
1158       (let* ((mode (mime-preview-original-major-mode 'recursive))
1159              (new-name
1160               (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1161              new-buf
1162              (the-buf (current-buffer))
1163              (a-buf mime-raw-buffer)
1164              fields)
1165         (save-excursion
1166           (set-buffer (setq new-buf (get-buffer-create new-name)))
1167           (erase-buffer)
1168           (insert-buffer-substring the-buf p-beg p-end)
1169           (goto-char (point-min))
1170           (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1171             (while (progn
1172                      (setq
1173                       str
1174                       (save-excursion
1175                         (set-buffer a-buf)
1176                         (setq
1177                          ci
1178                          (mime-raw-find-entity-from-node-id entity-node-id))
1179                         (save-restriction
1180                           (narrow-to-region
1181                            (mime-entity-point-min ci)
1182                            (mime-entity-point-max ci)
1183                            )
1184                           (std11-header-string-except
1185                            (concat "^"
1186                                    (apply (function regexp-or) fields)
1187                                    ":") ""))))
1188                      (if (and
1189                           (eq (mime-entity-media-type ci) 'message)
1190                           (eq (mime-entity-media-subtype ci) 'rfc822))
1191                          nil
1192                        (if str
1193                            (insert str)
1194                          )
1195                        entity-node-id))
1196               (setq fields (std11-collect-field-names)
1197                     entity-node-id (cdr entity-node-id))
1198               )
1199             )
1200           (let ((rest mime-view-following-required-fields-list))
1201             (while rest
1202               (let ((field-name (car rest)))
1203                 (or (std11-field-body field-name)
1204                     (insert
1205                      (format
1206                       (concat field-name
1207                               ": "
1208                               (save-excursion
1209                                 (set-buffer the-buf)
1210                                 (set-buffer mime-mother-buffer)
1211                                 (set-buffer mime-raw-buffer)
1212                                 (std11-field-body field-name)
1213                                 )
1214                               "\n")))
1215                     ))
1216               (setq rest (cdr rest))
1217               ))
1218           (eword-decode-header)
1219           )
1220         (let ((f (cdr (assq mode mime-preview-following-method-alist))))
1221           (if (functionp f)
1222               (funcall f new-buf)
1223             (message
1224              (format
1225               "Sorry, following method for %s is not implemented yet."
1226               mode))
1227             ))
1228         ))))
1229
1230
1231 ;;; @@ X-Face
1232 ;;;
1233
1234 (defun mime-preview-display-x-face ()
1235   (interactive)
1236   (save-window-excursion
1237     (set-buffer mime-raw-buffer)
1238     (mime-view-x-face-function)
1239     ))
1240
1241
1242 ;;; @@ moving
1243 ;;;
1244
1245 (defun mime-preview-move-to-upper ()
1246   "Move to upper entity.
1247 If there is no upper entity, call function `mime-preview-quit'."
1248   (interactive)
1249   (let (cinfo)
1250     (while (null (setq cinfo
1251                        (get-text-property (point) 'mime-view-entity)))
1252       (backward-char)
1253       )
1254     (let ((r (mime-raw-find-entity-from-node-id
1255               (cdr (mime-entity-node-id cinfo))
1256               (get-text-property 1 'mime-view-entity)))
1257           point)
1258       (catch 'tag
1259         (while (setq point (previous-single-property-change
1260                             (point) 'mime-view-entity))
1261           (goto-char point)
1262           (if (eq r (get-text-property (point) 'mime-view-entity))
1263               (throw 'tag t)
1264             )
1265           )
1266         (mime-preview-quit)
1267         ))))
1268
1269 (defun mime-preview-move-to-previous ()
1270   "Move to previous entity.
1271 If there is no previous entity, it calls function registered in
1272 variable `mime-preview-over-to-previous-method-alist'."
1273   (interactive)
1274   (while (null (get-text-property (point) 'mime-view-entity))
1275     (backward-char)
1276     )
1277   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
1278     (if point
1279         (if (get-text-property (1- point) 'mime-view-entity)
1280             (goto-char point)
1281           (goto-char (1- point))
1282           (mime-preview-move-to-previous)
1283           )
1284       (let ((f (assq (mime-preview-original-major-mode)
1285                      mime-preview-over-to-previous-method-alist)))
1286         (if f
1287             (funcall (cdr f))
1288           ))
1289       )))
1290
1291 (defun mime-preview-move-to-next ()
1292   "Move to next entity.
1293 If there is no previous entity, it calls function registered in
1294 variable `mime-preview-over-to-next-method-alist'."
1295   (interactive)
1296   (while (null (get-text-property (point) 'mime-view-entity))
1297     (forward-char)
1298     )
1299   (let ((point (next-single-property-change (point) 'mime-view-entity)))
1300     (if point
1301         (progn
1302           (goto-char point)
1303           (if (null (get-text-property point 'mime-view-entity))
1304               (mime-preview-move-to-next)
1305             ))
1306       (let ((f (assq (mime-preview-original-major-mode)
1307                      mime-preview-over-to-next-method-alist)))
1308         (if f
1309             (funcall (cdr f))
1310           ))
1311       )))
1312
1313 (defun mime-preview-scroll-up-entity (&optional h)
1314   "Scroll up current entity.
1315 If reached to (point-max), it calls function registered in variable
1316 `mime-preview-over-to-next-method-alist'."
1317   (interactive)
1318   (or h
1319       (setq h (1- (window-height)))
1320       )
1321   (if (= (point) (point-max))
1322       (let ((f (assq (mime-preview-original-major-mode)
1323                      mime-preview-over-to-next-method-alist)))
1324         (if f
1325             (funcall (cdr f))
1326           ))
1327     (let ((point
1328            (or (next-single-property-change (point) 'mime-view-entity)
1329                (point-max))))
1330       (forward-line h)
1331       (if (> (point) point)
1332           (goto-char point)
1333         )
1334       )))
1335
1336 (defun mime-preview-scroll-down-entity (&optional h)
1337   "Scroll down current entity.
1338 If reached to (point-min), it calls function registered in variable
1339 `mime-preview-over-to-previous-method-alist'."
1340   (interactive)
1341   (or h
1342       (setq h (1- (window-height)))
1343       )
1344   (if (= (point) (point-min))
1345       (let ((f (assq (mime-preview-original-major-mode)
1346                      mime-preview-over-to-previous-method-alist)))
1347         (if f
1348             (funcall (cdr f))
1349           ))
1350     (let ((point
1351            (or (previous-single-property-change (point) 'mime-view-entity)
1352                (point-min))))
1353       (forward-line (- h))
1354       (if (< (point) point)
1355           (goto-char point)
1356         ))))
1357
1358 (defun mime-preview-next-line-entity ()
1359   (interactive)
1360   (mime-preview-scroll-up-entity 1)
1361   )
1362
1363 (defun mime-preview-previous-line-entity ()
1364   (interactive)
1365   (mime-preview-scroll-down-entity 1)
1366   )
1367
1368
1369 ;;; @@ quitting
1370 ;;;
1371
1372 (defun mime-preview-quit ()
1373   "Quit from MIME-preview buffer.
1374 It calls function registered in variable
1375 `mime-preview-quitting-method-alist'."
1376   (interactive)
1377   (let ((r (assq (mime-preview-original-major-mode)
1378                  mime-preview-quitting-method-alist)))
1379     (if r
1380         (funcall (cdr r))
1381       )))
1382
1383 (defun mime-preview-kill-buffer ()
1384   (interactive)
1385   (kill-buffer (current-buffer))
1386   )
1387
1388
1389 ;;; @ end
1390 ;;;
1391
1392 (provide 'mime-view)
1393
1394 (run-hooks 'mime-view-load-hook)
1395
1396 ;;; mime-view.el ends here