mime-view.el

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