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