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