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