mime-view.el

   1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1994/07/13
   7 ;;      Renamed: 1994/08/31 from tm-body.el
   8 ;;      Renamed: 1997/02/19 from tm-view.el
   9 ;; Keywords: MIME, multimedia, mail, news
  10
  11 ;; This file is part of WEMI (Widget based Emacs MIME Interfaces).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'std11)
  31 (require 'mel)
  32 (require 'eword-decode)
  33 (require 'mime-parse)
  34 (require 'semi-def)
  35 (require 'calist)
  36
  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 '((body . visible)
 391                            (body-presentation-method . with-filter)
 392                            (body-filter . mime-preview-filter-for-text/plain)))
 393
 394 (ctree-set-calist-strictly
 395  'mime-preview-condition '((type . nil)
 396                            (body . visible)
 397                            (body-presentation-method . with-filter)
 398                            (body-filter . mime-preview-filter-for-text/plain)))
 399
 400 (ctree-set-calist-strictly
 401  'mime-preview-condition '((type . text)(subtype . enriched)
 402                            (body . visible)
 403                            (body-presentation-method . with-filter)
 404                            (body-filter
 405                             . mime-preview-filter-for-text/enriched)))
 406
 407 (ctree-set-calist-strictly
 408  'mime-preview-condition '((type . text)(subtype . richtext)
 409                            (body . visible)
 410                            (body-presentation-method . with-filter)
 411                            (body-filter
 412                             . mime-preview-filter-for-text/richtext)))
 413
 414 (ctree-set-calist-strictly
 415  'mime-preview-condition '((type . text)(subtype . t)
 416                            (body . visible)
 417                            (body-presentation-method . with-filter)
 418                            (body-filter . mime-preview-filter-for-text/plain)))
 419
 420 (ctree-set-calist-strictly
 421  'mime-preview-condition '((type . message)(subtype . partial)
 422                            (body-presentation-method
 423                             . mime-view-insert-message/partial-button)))
 424
 425 (ctree-set-calist-strictly
 426  'mime-preview-condition '((type . message)(subtype . rfc822)
 427                            (body-presentation-method . nil)
 428                            (childrens-situation (header . visible)
 429                                                 (entity-button . invisible))))
 430
 431 (ctree-set-calist-strictly
 432  'mime-preview-condition '((type . message)(subtype . news)
 433                            (body-presentation-method . nil)
 434                            (childrens-situation (header . visible)
 435                                                 (entity-button . invisible))))
 436
 437
 438 ;;; @@@ entity filter
 439 ;;;
 440
 441 (autoload 'mime-preview-filter-for-text/plain "mime-text")
 442 (autoload 'mime-preview-filter-for-text/enriched "mime-text")
 443 (autoload 'mime-preview-filter-for-text/richtext "mime-text")
 444
 445 (defvar mime-text-decoder-alist
 446   '((mime-show-message-mode     . mime-text-decode-buffer)
 447     (mime-temp-message-mode     . mime-text-decode-buffer)
 448     (t                          . mime-text-decode-buffer-maybe)
 449     )
 450   "Alist of major-mode vs. mime-text-decoder.
 451 Each element looks like (SYMBOL . FUNCTION).  SYMBOL is major-mode or
 452 t.  t means default.
 453
 454 Specification of FUNCTION is described in DOC-string of variable
 455 `mime-text-decoder'.
 456
 457 This value is overridden by buffer local variable `mime-text-decoder'
 458 if it is not nil.")
 459
 460
 461 (defvar mime-view-announcement-for-message/partial
 462   (if (and (>= emacs-major-version 19) window-system)
 463       "\
 464 This is message/partial style split message.
 465 Please press `v' key in this buffer
 466 or click here by mouse button-2.            "
 467     "\
 468 This is message/partial style split message.
 469 Please press `v' key in this buffer.        "
 470     ))
 471
 472 (defun mime-view-insert-message/partial-button (&optional situation)
 473   (save-restriction
 474     (goto-char (point-max))
 475     (if (not (search-backward "\n\n" nil t))
 476         (insert "\n")
 477       )
 478     (goto-char (point-max))
 479     ;;(narrow-to-region (point-max)(point-max))
 480     ;;(insert mime-view-announcement-for-message/partial)
 481     ;; (mime-add-button (point-min)(point-max)
 482     ;;                  #'mime-preview-play-current-entity)
 483     (mime-insert-button mime-view-announcement-for-message/partial
 484                         #'mime-preview-play-current-entity)
 485     ))
 486
 487
 488 ;;; @ acting-condition
 489 ;;;
 490
 491 (defvar mime-acting-condition
 492   '(((type . text)(subtype . plain)
 493      (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
 494      (mode "play" "print")
 495      )
 496     ((type . text)(subtype . html)
 497      (method "tm-html" nil 'file "" 'encoding 'mode 'name)
 498      (mode . "play")
 499      )
 500     ((type . text)(subtype . x-rot13-47)
 501      (method . mime-method-to-display-caesar)
 502      (mode . "play")
 503      )
 504     ((type . text)(subtype . x-rot13-47-48)
 505      (method . mime-method-to-display-caesar)
 506      (mode . "play")
 507      )
 508
 509     ((type . audio)(subtype . basic)
 510      (method "tm-au"    nil 'file "" 'encoding 'mode 'name)
 511      (mode . "play")
 512      )
 513
 514     ((type . image)
 515      (method "tm-image" nil 'file "" 'encoding 'mode 'name)
 516      (mode "play" "print")
 517      )
 518
 519     ((type . video)(subtype . mpeg)
 520      (method "tm-mpeg"  nil 'file "" 'encoding 'mode 'name)
 521      (mode . "play")
 522      )
 523
 524     ((type . application)(subtype . postscript)
 525      (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
 526      (mode "play" "print")
 527      )
 528     ((type . application)(subtype . octet-stream)
 529      (method . mime-method-to-save)(mode "play" "print")
 530      )
 531
 532     ((type . message)(subtype . external-body)
 533      ("access-type" . "anon-ftp")
 534      (method . mime-method-to-display-message/external-ftp)
 535      )
 536     ((type . message)(subtype . rfc822)
 537      (method . mime-method-to-display-message/rfc822)
 538      (mode . "play")
 539      )
 540     ((type . message)(subtype . partial)
 541      (method . mime-method-to-store-message/partial)
 542      (mode . "play")
 543      )
 544
 545     ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
 546      (mode . "play")
 547      )
 548     ((method . mime-method-to-save)(mode . "extract"))
 549     ))
 550
 551
 552 ;;; @ quitting method
 553 ;;;
 554
 555 (defvar mime-preview-quitting-method-alist
 556   '((mime-show-message-mode
 557      . mime-preview-quitting-method-for-mime-show-message-mode))
 558   "Alist of major-mode vs. quitting-method of mime-view.")
 559
 560 (defvar mime-view-over-to-previous-method-alist nil)
 561 (defvar mime-view-over-to-next-method-alist nil)
 562
 563 (defvar mime-view-show-summary-method nil
 564   "Alist of major-mode vs. show-summary-method.")
 565
 566
 567 ;;; @ following method
 568 ;;;
 569
 570 (defvar mime-view-following-method-alist nil
 571   "Alist of major-mode vs. following-method of mime-view.")
 572
 573 (defvar mime-view-following-required-fields-list
 574   '("From"))
 575
 576
 577 ;;; @ X-Face
 578 ;;;
 579
 580 ;; hack from Gnus 5.0.4.
 581
 582 (defvar mime-view-x-face-to-pbm-command
 583   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 584
 585 (defvar mime-view-x-face-command
 586   (concat mime-view-x-face-to-pbm-command
 587           " | xv -quit -")
 588   "String to be executed to display an X-Face field.
 589 The command will be executed in a sub-shell asynchronously.
 590 The compressed face will be piped to this command.")
 591
 592 (defun mime-view-x-face-function ()
 593   "Function to display X-Face field. You can redefine to customize."
 594   ;; 1995/10/12 (c.f. tm-eng:130)
 595   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 596   (save-restriction
 597     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 598     ;; end
 599     (goto-char (point-min))
 600     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 601         (let ((beg (match-end 0))
 602               (end (std11-field-end))
 603               )
 604           (call-process-region beg end "sh" nil 0 nil
 605                                "-c" mime-view-x-face-command)
 606           ))))
 607
 608
 609 ;;; @ miscellaneous
 610 ;;;
 611
 612 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 613
 614 (defvar mime-raw-buffer-coding-system-alist
 615   `((t . ,(mime-charset-to-coding-system default-mime-charset)))
 616   "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.")
 617
 618
 619 ;;; @ buffer setup
 620 ;;;
 621
 622 (defvar mime-view-redisplay nil)
 623
 624 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
 625   (if ibuf
 626       (progn
 627         (get-buffer ibuf)
 628         (set-buffer ibuf)
 629         ))
 630   (or mime-view-redisplay
 631       (setq mime-raw-message-info (mime-parse-message ctl encoding))
 632       )
 633   (let ((message-info mime-raw-message-info)
 634         (the-buf (current-buffer))
 635         (mode major-mode))
 636     (or obuf
 637         (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
 638     (set-buffer (get-buffer-create obuf))
 639     (let ((inhibit-read-only t))
 640       ;;(setq buffer-read-only nil)
 641       (widen)
 642       (erase-buffer)
 643       (setq mime-raw-buffer the-buf)
 644       (setq mime-preview-original-major-mode mode)
 645       (setq major-mode 'mime-view-mode)
 646       (setq mode-name "MIME-View")
 647       (mime-view-display-message message-info the-buf obuf)
 648       (set-buffer-modified-p nil)
 649       )
 650     (setq buffer-read-only t)
 651     (set-buffer the-buf)
 652     )
 653   (setq mime-preview-buffer obuf)
 654   )
 655
 656 (defun mime-view-display-message (message-info ibuf obuf)
 657   (let* ((start (mime-entity-point-min message-info))
 658          (end (mime-entity-point-max message-info))
 659          (media-type (mime-entity-media-type message-info))
 660          (media-subtype (mime-entity-media-subtype message-info))
 661          (params (mime-entity-parameters message-info))
 662          (encoding (mime-entity-encoding message-info))
 663          end-of-header e nb ne subj)
 664     (set-buffer ibuf)
 665     (goto-char start)
 666     (setq end-of-header (if (re-search-forward "^$" nil t)
 667                             (1+ (match-end 0))
 668                           end))
 669     (if (> end-of-header end)
 670         (setq end-of-header end)
 671       )
 672     (save-restriction
 673       (narrow-to-region start end)
 674       (setq subj
 675             (eword-decode-string
 676              (mime-raw-get-subject params encoding)))
 677       )
 678     (set-buffer obuf)
 679     (setq nb (point))
 680     (narrow-to-region nb nb)
 681     ;; Insert message-header
 682     (save-restriction
 683       (narrow-to-region (point)(point))
 684       (insert-buffer-substring mime-raw-buffer start end-of-header)
 685       (let ((f (cdr (assq mime-preview-original-major-mode
 686                           mime-view-content-header-filter-alist))))
 687         (if (functionp f)
 688             (funcall f)
 689           (mime-view-default-content-header-filter)
 690           ))
 691       (run-hooks 'mime-view-content-header-filter-hook)
 692       )
 693     (let* ((situation
 694             (ctree-match-calist mime-preview-condition
 695                                 (list* (cons 'type       media-type)
 696                                        (cons 'subtype    media-subtype)
 697                                        (cons 'encoding   encoding)
 698                                        (cons 'major-mode major-mode)
 699                                        params)))
 700            (message-button
 701             (cdr (assq 'message-button situation)))
 702            (body-presentation-method
 703             (cdr (assq 'body-presentation-method situation))))
 704       (when (eq message-button 'visible)
 705         (goto-char (point-max))
 706         (mime-view-insert-entity-button message-info message-info subj)
 707         )
 708       (cond ((eq body-presentation-method 'with-filter)
 709              (let ((body-filter (cdr (assq 'body-filter situation))))
 710                (save-restriction
 711                  (narrow-to-region (point-max)(point-max))
 712                  (insert-buffer-substring mime-raw-buffer end-of-header end)
 713                  (funcall body-filter situation)
 714                  )))
 715             ((functionp body-presentation-method)
 716              (funcall body-presentation-method situation)
 717              )
 718             ((null (mime-entity-children message-info))
 719              (goto-char (point-max))
 720              (mime-view-insert-entity-button message-info message-info subj)
 721              ))
 722       (setq ne (point-max))
 723       (widen)
 724       (put-text-property nb ne 'mime-view-raw-buffer ibuf)
 725       (put-text-property nb ne 'mime-view-entity message-info)
 726       (goto-char ne)
 727       (let ((children (mime-entity-children message-info))
 728             (default-situation
 729              (cdr (assq 'childrens-situation situation))))
 730         (while children
 731           (mime-view-display-entity (car children) message-info ibuf obuf
 732                                     default-situation)
 733           (setq children (cdr children))
 734           )))))
 735
 736 (defun mime-view-display-entity (entity message-info ibuf obuf
 737                                         default-situation)
 738   (let* ((start (mime-entity-point-min entity))
 739          (end (mime-entity-point-max entity))
 740          (media-type (mime-entity-media-type entity))
 741          (media-subtype (mime-entity-media-subtype entity))
 742          (params (mime-entity-parameters entity))
 743          (encoding (mime-entity-encoding entity))
 744          end-of-header e nb ne subj)
 745     (set-buffer ibuf)
 746     (goto-char start)
 747     (setq end-of-header (if (re-search-forward "^$" nil t)
 748                             (1+ (match-end 0))
 749                           end))
 750     (if (> end-of-header end)
 751         (setq end-of-header end)
 752       )
 753     (save-restriction
 754       (narrow-to-region start end)
 755       (setq subj
 756             (eword-decode-string
 757              (mime-raw-get-subject params encoding)))
 758       )
 759     (let* ((situation
 760             (ctree-match-calist mime-preview-condition
 761                                 (list* (cons 'type       media-type)
 762                                        (cons 'subtype    media-subtype)
 763                                        (cons 'encoding   encoding)
 764                                        (cons 'major-mode major-mode)
 765                                        (append params
 766                                                default-situation))))
 767            (button-is-invisible
 768             (eq (cdr (assq 'entity-button situation)) 'invisible))
 769            (header-is-visible
 770             (eq (cdr (assq 'header situation)) 'visible))
 771            (body-presentation-method
 772             (cdr (assq 'body-presentation-method situation))))
 773       (set-buffer obuf)
 774       (setq nb (point))
 775       (narrow-to-region nb nb)
 776       (or button-is-invisible
 777           (if (mime-view-entity-button-visible-p entity message-info)
 778               (mime-view-insert-entity-button entity message-info subj)
 779             ))
 780       (if header-is-visible
 781           (save-restriction
 782             (narrow-to-region (point)(point))
 783             (insert-buffer-substring mime-raw-buffer start end-of-header)
 784             (let ((f (cdr (assq mime-preview-original-major-mode
 785                                 mime-view-content-header-filter-alist))))
 786               (if (functionp f)
 787                   (funcall f)
 788                 (mime-view-default-content-header-filter)
 789                 ))
 790             (run-hooks 'mime-view-content-header-filter-hook)
 791             ))
 792       (cond ((eq body-presentation-method 'with-filter)
 793              (let ((body-filter (cdr (assq 'body-filter situation))))
 794                (save-restriction
 795                  (narrow-to-region (point-max)(point-max))
 796                  (insert-buffer-substring mime-raw-buffer end-of-header end)
 797                  (funcall body-filter situation)
 798                  )))
 799             ((functionp body-presentation-method)
 800              (funcall body-presentation-method situation)
 801              ))
 802       (or header-is-visible
 803           body-presentation-method
 804           (progn
 805             (goto-char (point-max))
 806             (insert "\n")
 807             ))
 808       (setq ne (point-max))
 809       (widen)
 810       (put-text-property nb ne 'mime-view-raw-buffer ibuf)
 811       (put-text-property nb ne 'mime-view-entity entity)
 812       (goto-char ne)
 813       (let ((children (mime-entity-children entity))
 814             (default-situation
 815               (cdr (assq 'childrens-situation situation))))
 816         (while children
 817           (mime-view-display-entity (car children) message-info ibuf obuf
 818                                     default-situation)
 819           (setq children (cdr children))
 820           )))))
 821
 822 (defun mime-raw-get-uu-filename (param &optional encoding)
 823   (if (member (or encoding
 824                   (cdr (assq 'encoding param))
 825                   )
 826               mime-view-uuencode-encoding-name-list)
 827       (save-excursion
 828         (or (if (re-search-forward "^begin [0-9]+ " nil t)
 829                 (if (looking-at ".+$")
 830                     (buffer-substring (match-beginning 0)(match-end 0))
 831                   ))
 832             ""))
 833     ))
 834
 835 (defun mime-raw-get-subject (param &optional encoding)
 836   (or (std11-find-field-body '("Content-Description" "Subject"))
 837       (let (ret)
 838         (if (or (and (setq ret (mime/Content-Disposition))
 839                      (setq ret (assoc "filename" (cdr ret)))
 840                      )
 841                 (setq ret (assoc "name" param))
 842                 (setq ret (assoc "x-name" param))
 843                 )
 844             (std11-strip-quoted-string (cdr ret))
 845           ))
 846       (mime-raw-get-uu-filename param encoding)
 847       ""))
 848
 849
 850 ;;; @ MIME viewer mode
 851 ;;;
 852
 853 (defconst mime-view-menu-title "MIME-View")
 854 (defconst mime-view-menu-list
 855   '((up          "Move to upper entity"    mime-preview-move-to-upper)
 856     (previous    "Move to previous entity" mime-preview-move-to-previous)
 857     (next        "Move to next entity"     mime-preview-move-to-next)
 858     (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
 859     (scroll-up   "Scroll-up"               mime-preview-scroll-up-entity)
 860     (play        "Play current entity"     mime-preview-play-current-entity)
 861     (extract     "Extract current entity"  mime-preview-extract-current-entity)
 862     (print       "Print current entity"    mime-preview-print-current-entity)
 863     (x-face      "Show X Face"             mime-preview-display-x-face)
 864     )
 865   "Menu for MIME Viewer")
 866
 867 (cond (running-xemacs
 868        (defvar mime-view-xemacs-popup-menu
 869          (cons mime-view-menu-title
 870                (mapcar (function
 871                         (lambda (item)
 872                           (vector (nth 1 item)(nth 2 item) t)
 873                           ))
 874                        mime-view-menu-list)))
 875        (defun mime-view-xemacs-popup-menu (event)
 876          "Popup the menu in the MIME Viewer buffer"
 877          (interactive "e")
 878          (select-window (event-window event))
 879          (set-buffer (event-buffer event))
 880          (popup-menu 'mime-view-xemacs-popup-menu))
 881        (defvar mouse-button-2 'button2)
 882        )
 883       (t
 884        (defvar mouse-button-2 [mouse-2])
 885        ))
 886
 887 (defun mime-view-define-keymap (&optional default)
 888   (let ((mime-view-mode-map (if (keymapp default)
 889                                 (copy-keymap default)
 890                               (make-sparse-keymap)
 891                               )))
 892     (define-key mime-view-mode-map
 893       "u"        (function mime-preview-move-to-upper))
 894     (define-key mime-view-mode-map
 895       "p"        (function mime-preview-move-to-previous))
 896     (define-key mime-view-mode-map
 897       "n"        (function mime-preview-move-to-next))
 898     (define-key mime-view-mode-map
 899       "\e\t"     (function mime-preview-move-to-previous))
 900     (define-key mime-view-mode-map
 901       "\t"       (function mime-preview-move-to-next))
 902     (define-key mime-view-mode-map
 903       " "        (function mime-preview-scroll-up-entity))
 904     (define-key mime-view-mode-map
 905       "\M- "     (function mime-preview-scroll-down-entity))
 906     (define-key mime-view-mode-map
 907       "\177"     (function mime-preview-scroll-down-entity))
 908     (define-key mime-view-mode-map
 909       "\C-m"     (function mime-preview-next-line-entity))
 910     (define-key mime-view-mode-map
 911       "\C-\M-m"  (function mime-preview-previous-line-entity))
 912     (define-key mime-view-mode-map
 913       "v"        (function mime-preview-play-current-entity))
 914     (define-key mime-view-mode-map
 915       "e"        (function mime-preview-extract-current-entity))
 916     (define-key mime-view-mode-map
 917       "\C-c\C-p" (function mime-preview-print-current-entity))
 918     (define-key mime-view-mode-map
 919       "a"        (function mime-preview-follow-current-entity))
 920     (define-key mime-view-mode-map
 921       "q"        (function mime-preview-quit))
 922     (define-key mime-view-mode-map
 923       "h"        (function mime-preview-show-summary))
 924     (define-key mime-view-mode-map
 925       "\C-c\C-x" (function mime-preview-kill-buffer))
 926     ;; (define-key mime-view-mode-map
 927     ;;   "<"        (function beginning-of-buffer))
 928     ;; (define-key mime-view-mode-map
 929     ;;   ">"        (function end-of-buffer))
 930     (define-key mime-view-mode-map
 931       "?"        (function describe-mode))
 932     (define-key mime-view-mode-map
 933       [tab] (function mime-preview-move-to-next))
 934     (define-key mime-view-mode-map
 935       [delete] (function mime-preview-scroll-down-entity))
 936     (define-key mime-view-mode-map
 937       [backspace] (function mime-preview-scroll-down-entity))
 938     (if (functionp default)
 939         (cond (running-xemacs
 940                (set-keymap-default-binding mime-view-mode-map default)
 941                )
 942               (t
 943                (setq mime-view-mode-map
 944                      (append mime-view-mode-map (list (cons t default))))
 945                )))
 946     (if mouse-button-2
 947         (define-key mime-view-mode-map
 948           mouse-button-2 (function mime-button-dispatcher))
 949       )
 950     (cond (running-xemacs
 951            (define-key mime-view-mode-map
 952              mouse-button-3 (function mime-view-xemacs-popup-menu))
 953            )
 954           ((>= emacs-major-version 19)
 955            (define-key mime-view-mode-map [menu-bar mime-view]
 956              (cons mime-view-menu-title
 957                    (make-sparse-keymap mime-view-menu-title)))
 958            (mapcar (function
 959                     (lambda (item)
 960                       (define-key mime-view-mode-map
 961                         (vector 'menu-bar 'mime-view (car item))
 962                         (cons (nth 1 item)(nth 2 item))
 963                         )
 964                       ))
 965                    (reverse mime-view-menu-list)
 966                    )
 967            ))
 968     (use-local-map mime-view-mode-map)
 969     (run-hooks 'mime-view-define-keymap-hook)
 970     ))
 971
 972 (defsubst mime-maybe-hide-echo-buffer ()
 973   "Clear mime-echo buffer and delete window for it."
 974   (let ((buf (get-buffer mime-echo-buffer-name)))
 975     (if buf
 976         (save-excursion
 977           (set-buffer buf)
 978           (erase-buffer)
 979           (let ((win (get-buffer-window buf)))
 980             (if win
 981                 (delete-window win)
 982               ))
 983           (bury-buffer buf)
 984           ))))
 985
 986 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
 987                                  default-keymap-or-function)
 988   "Major mode for viewing MIME message.
 989
 990 Here is a list of the standard keys for mime-view-mode.
 991
 992 key             feature
 993 ---             -------
 994
 995 u               Move to upper content
 996 p or M-TAB      Move to previous content
 997 n or TAB        Move to next content
 998 SPC             Scroll up or move to next content
 999 M-SPC or DEL    Scroll down or move to previous content
1000 RET             Move to next line
1001 M-RET           Move to previous line
1002 v               Decode current content as `play mode'
1003 e               Decode current content as `extract mode'
1004 C-c C-p         Decode current content as `print mode'
1005 a               Followup to current content.
1006 x               Display X-Face
1007 q               Quit
1008 button-2        Move to point under the mouse cursor
1009                 and decode current content as `play mode'
1010 "
1011   (interactive)
1012   (mime-maybe-hide-echo-buffer)
1013   (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
1014         (win-conf (current-window-configuration))
1015         )
1016     (prog1
1017         (switch-to-buffer ret)
1018       (setq mime-preview-original-window-configuration win-conf)
1019       (if mother
1020           (progn
1021             (setq mime-mother-buffer mother)
1022             ))
1023       (mime-view-define-keymap default-keymap-or-function)
1024       (let ((point
1025              (next-single-property-change (point-min) 'mime-view-entity)))
1026         (if point
1027             (goto-char point)
1028           (goto-char (point-min))
1029           (search-forward "\n\n" nil t)
1030           ))
1031       (run-hooks 'mime-view-mode-hook)
1032       )))
1033
1034
1035 ;;; @@ playing
1036 ;;;
1037
1038 (autoload 'mime-preview-play-current-entity "mime-play"
1039   "Play current entity." t)
1040
1041 (defun mime-preview-extract-current-entity ()
1042   "Extract current entity into file (maybe).
1043 It decodes current entity to call internal or external method as
1044 \"extract\" mode.  The method is selected from variable
1045 `mime-acting-condition'."
1046   (interactive)
1047   (mime-preview-play-current-entity "extract")
1048   )
1049
1050 (defun mime-preview-print-current-entity ()
1051   "Print current entity (maybe).
1052 It decodes current entity to call internal or external method as
1053 \"print\" mode.  The method is selected from variable
1054 `mime-acting-condition'."
1055   (interactive)
1056   (mime-preview-play-current-entity "print")
1057   )
1058
1059
1060 ;;; @@ following
1061 ;;;
1062
1063 (defun mime-preview-original-major-mode ()
1064   "Return major-mode of original buffer.
1065 If a current buffer has mime-mother-buffer, return original major-mode
1066 of the mother-buffer."
1067   (if mime-mother-buffer
1068       (save-excursion
1069         (set-buffer mime-mother-buffer)
1070         (mime-preview-original-major-mode)
1071         )
1072     mime-preview-original-major-mode))
1073
1074 (defun mime-preview-follow-current-entity ()
1075   "Write follow message to current entity.
1076 It calls following-method selected from variable
1077 `mime-view-following-method-alist'."
1078   (interactive)
1079   (let ((message-info (get-text-property (point-min) 'mime-view-entity))
1080         entity)
1081     (while (null (setq entity
1082                        (get-text-property (point) 'mime-view-entity)))
1083       (backward-char)
1084       )
1085     (let* ((p-beg
1086             (previous-single-property-change (point) 'mime-view-entity))
1087            p-end
1088            (entity-node-id (mime-entity-node-id entity))
1089            (len (length entity-node-id))
1090            )
1091       (cond ((null p-beg)
1092              (setq p-beg
1093                    (if (eq (next-single-property-change (point-min)
1094                                                         'mime-view-entity)
1095                            (point))
1096                        (point)
1097                      (point-min)))
1098              )
1099             ((eq (next-single-property-change p-beg 'mime-view-entity)
1100                  (point))
1101              (setq p-beg (point))
1102              ))
1103       (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1104       (cond ((null p-end)
1105              (setq p-end (point-max))
1106              )
1107             ((null entity-node-id)
1108              (setq p-end (point-max))
1109              )
1110             (t
1111              (save-excursion
1112                (goto-char p-end)
1113                (catch 'tag
1114                  (let (e)
1115                    (while (setq e
1116                                 (next-single-property-change
1117                                  (point) 'mime-view-entity))
1118                      (goto-char e)
1119                      (let ((rc (mime-entity-node-id
1120                                 (get-text-property (point)
1121                                                    'mime-view-entity))))
1122                        (or (equal entity-node-id
1123                                   (nthcdr (- (length rc) len) rc))
1124                            (throw 'tag nil)
1125                            ))
1126                      (setq p-end e)
1127                      ))
1128                  (setq p-end (point-max))
1129                  ))
1130              ))
1131       (let* ((mode (mime-preview-original-major-mode))
1132              (new-name
1133               (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1134              new-buf
1135              (the-buf (current-buffer))
1136              (a-buf mime-raw-buffer)
1137              fields)
1138         (save-excursion
1139           (set-buffer (setq new-buf (get-buffer-create new-name)))
1140           (erase-buffer)
1141           (insert-buffer-substring the-buf p-beg p-end)
1142           (goto-char (point-min))
1143           ;; (if (mime-view-header-visible-p entity message-info)
1144           ;;     (delete-region (goto-char (point-min))
1145           ;;                    (if (re-search-forward "^$" nil t)
1146           ;;                        (match-end 0)
1147           ;;                      (point-min)))
1148           ;;   )
1149           ;;(goto-char (point-min))
1150           ;;(insert "\n")
1151           (goto-char (point-min))
1152           (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1153             (while (progn
1154                      (setq
1155                       str
1156                       (save-excursion
1157                         (set-buffer a-buf)
1158                         (setq
1159                          ci
1160                          (mime-raw-find-entity-from-node-id entity-node-id))
1161                         (save-restriction
1162                           (narrow-to-region
1163                            (mime-entity-point-min ci)
1164                            (mime-entity-point-max ci)
1165                            )
1166                           (std11-header-string-except
1167                            (concat "^"
1168                                    (apply (function regexp-or) fields)
1169                                    ":") ""))))
1170                      (if (and
1171                           (eq (mime-entity-media-type ci) 'message)
1172                           (eq (mime-entity-media-subtype ci) 'rfc822))
1173                          nil
1174                        (if str
1175                            (insert str)
1176                          )
1177                        entity-node-id))
1178               (setq fields (std11-collect-field-names)
1179                     entity-node-id (cdr entity-node-id))
1180               )
1181             )
1182           (let ((rest mime-view-following-required-fields-list))
1183             (while rest
1184               (let ((field-name (car rest)))
1185                 (or (std11-field-body field-name)
1186                     (insert
1187                      (format
1188                       (concat field-name
1189                               ": "
1190                               (save-excursion
1191                                 (set-buffer the-buf)
1192                                 (set-buffer mime-mother-buffer)
1193                                 (set-buffer mime-raw-buffer)
1194                                 (std11-field-body field-name)
1195                                 )
1196                               "\n")))
1197                     ))
1198               (setq rest (cdr rest))
1199               ))
1200           (eword-decode-header)
1201           )
1202         (let ((f (cdr (assq mode mime-view-following-method-alist))))
1203           (if (functionp f)
1204               (funcall f new-buf)
1205             (message
1206              (format
1207               "Sorry, following method for %s is not implemented yet."
1208               mode))
1209             ))
1210         ))))
1211
1212
1213 ;;; @@ X-Face
1214 ;;;
1215
1216 (defun mime-preview-display-x-face ()
1217   (interactive)
1218   (save-window-excursion
1219     (set-buffer mime-raw-buffer)
1220     (mime-view-x-face-function)
1221     ))
1222
1223
1224 ;;; @@ moving
1225 ;;;
1226
1227 (defun mime-preview-move-to-upper ()
1228   "Move to upper entity.
1229 If there is no upper entity, call function `mime-preview-quit'."
1230   (interactive)
1231   (let (cinfo)
1232     (while (null (setq cinfo
1233                        (get-text-property (point) 'mime-view-entity)))
1234       (backward-char)
1235       )
1236     (let ((r (mime-raw-find-entity-from-node-id
1237               (cdr (mime-entity-node-id cinfo))
1238               (get-text-property 1 'mime-view-entity)))
1239           point)
1240       (catch 'tag
1241         (while (setq point (previous-single-property-change
1242                             (point) 'mime-view-entity))
1243           (goto-char point)
1244           (if (eq r (get-text-property (point) 'mime-view-entity))
1245               (throw 'tag t)
1246             )
1247           )
1248         (mime-preview-quit)
1249         ))))
1250
1251 (defun mime-preview-move-to-previous ()
1252   "Move to previous entity.
1253 If there is no previous entity, it calls function registered in
1254 variable `mime-view-over-to-previous-method-alist'."
1255   (interactive)
1256   (while (null (get-text-property (point) 'mime-view-entity))
1257     (backward-char)
1258     )
1259   (let ((point
1260          (previous-single-property-change (point) 'mime-view-entity)))
1261     (if point
1262         (goto-char point)
1263       (let ((f (assq mime-preview-original-major-mode
1264                      mime-view-over-to-previous-method-alist)))
1265         (if f
1266             (funcall (cdr f))
1267           ))
1268       )))
1269
1270 (defun mime-preview-move-to-next ()
1271   "Move to next entity.
1272 If there is no previous entity, it calls function registered in
1273 variable `mime-view-over-to-next-method-alist'."
1274   (interactive)
1275   (let ((point (next-single-property-change (point) 'mime-view-entity)))
1276     (if point
1277         (goto-char point)
1278       (let ((f (assq mime-preview-original-major-mode
1279                      mime-view-over-to-next-method-alist)))
1280         (if f
1281             (funcall (cdr f))
1282           ))
1283       )))
1284
1285 (defun mime-preview-scroll-up-entity (&optional h)
1286   "Scroll up current entity.
1287 If reached to (point-max), it calls function registered in variable
1288 `mime-view-over-to-next-method-alist'."
1289   (interactive)
1290   (or h
1291       (setq h (1- (window-height)))
1292       )
1293   (if (= (point) (point-max))
1294       (let ((f (assq mime-preview-original-major-mode
1295                      mime-view-over-to-next-method-alist)))
1296         (if f
1297             (funcall (cdr f))
1298           ))
1299     (let ((point
1300            (or (next-single-property-change (point) 'mime-view-entity)
1301                (point-max))))
1302       (forward-line h)
1303       (if (> (point) point)
1304           (goto-char point)
1305         )
1306       )))
1307
1308 (defun mime-preview-scroll-down-entity (&optional h)
1309   "Scroll down current entity.
1310 If reached to (point-min), it calls function registered in variable
1311 `mime-view-over-to-previous-method-alist'."
1312   (interactive)
1313   (or h
1314       (setq h (1- (window-height)))
1315       )
1316   (if (= (point) (point-min))
1317       (let ((f (assq mime-preview-original-major-mode
1318                      mime-view-over-to-previous-method-alist)))
1319         (if f
1320             (funcall (cdr f))
1321           ))
1322     (let (point)
1323       (save-excursion
1324         (catch 'tag
1325           (while (> (point) 1)
1326             (if (setq point
1327                       (previous-single-property-change (point)
1328                                                        'mime-view-entity))
1329                 (throw 'tag t)
1330               )
1331             (backward-char)
1332             )
1333           (setq point (point-min))
1334           ))
1335       (forward-line (- h))
1336       (if (< (point) point)
1337           (goto-char point)
1338         ))))
1339
1340 (defun mime-preview-next-line-entity ()
1341   (interactive)
1342   (mime-preview-scroll-up-entity 1)
1343   )
1344
1345 (defun mime-preview-previous-line-entity ()
1346   (interactive)
1347   (mime-preview-scroll-down-entity 1)
1348   )
1349
1350
1351 ;;; @@ quitting
1352 ;;;
1353
1354 (defun mime-preview-quit ()
1355   "Quit from MIME-preview buffer.
1356 It calls function registered in variable
1357 `mime-preview-quitting-method-alist'."
1358   (interactive)
1359   (let ((r (assq mime-preview-original-major-mode
1360                  mime-preview-quitting-method-alist)))
1361     (if r
1362         (funcall (cdr r))
1363       )))
1364
1365 (defun mime-preview-show-summary ()
1366   "Show summary.
1367 It calls function registered in variable
1368 `mime-view-show-summary-method'."
1369   (interactive)
1370   (let ((r (assq mime-preview-original-major-mode
1371                  mime-view-show-summary-method)))
1372     (if r
1373         (funcall (cdr r))
1374       )))
1375
1376 (defun mime-preview-kill-buffer ()
1377   (interactive)
1378   (kill-buffer (current-buffer))
1379   )
1380
1381
1382 ;;; @ end
1383 ;;;
1384
1385 (provide 'mime-view)
1386
1387 (run-hooks 'mime-view-load-hook)
1388
1389 ;;; mime-view.el ends here