mime-view.el

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