mime-view.el

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