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