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