mime-view.el

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