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