mime-view.el

   1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1994/07/13
   7 ;;      Renamed: 1994/08/31 from tm-body.el
   8 ;;      Renamed: 1997/02/19 from tm-view.el
   9 ;; Keywords: MIME, multimedia, mail, news
  10
  11 ;; This file is part of SEMI (Sophisticated Emacs MIME Interfaces).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'std11)
  31 (require 'mel)
  32 (require 'eword-decode)
  33 (require 'mime-parse)
  34 (require 'semi-def)
  35 (require 'calist)
  36
  37
  38 ;;; @ version
  39 ;;;
  40
  41 (defconst mime-view-version-string
  42   `,(concat (car mime-module-version) " MIME-View "
  43             (mapconcat #'number-to-string (cddr mime-module-version) ".")
  44             " (" (cadr mime-module-version) ")"))
  45
  46
  47 ;;; @ variables
  48 ;;;
  49
  50 (defgroup mime-view nil
  51   "MIME view mode"
  52   :group 'mime)
  53
  54 (defcustom mime-view-find-every-acting-situation nil
  55   "*Find every available acting-situation if non-nil."
  56   :group 'mime-view
  57   :type 'boolean)
  58
  59 (defcustom mime-view-acting-example-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     ))
 502
 503
 504 ;;; @ acting-condition
 505 ;;;
 506
 507 (defvar mime-acting-condition nil
 508   "Condition-tree about how to process entity.")
 509
 510 (ctree-set-calist-strictly
 511  'mime-acting-condition
 512  '((type . t)(subtype . t)(mode . "play")
 513    (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
 514    ))
 515 (ctree-set-calist-strictly
 516  'mime-acting-condition
 517  '((type . t)(subtype . t)(mode . "extract")
 518    (method . mime-method-to-save)))
 519
 520 (ctree-set-calist-strictly
 521  'mime-acting-condition
 522  '((type . text)(subtype . plain)(mode . "play")
 523    (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
 524    ))
 525 (ctree-set-calist-strictly
 526  'mime-acting-condition
 527  '((type . text)(subtype . plain)(mode . "print")
 528    (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
 529    ))
 530 (ctree-set-calist-strictly
 531  'mime-acting-condition
 532  '((type . text)(subtype . html)(mode . "play")
 533    (method "tm-html" nil 'file "" 'encoding 'mode 'name)
 534    ))
 535 (ctree-set-calist-strictly
 536  'mime-acting-condition
 537  '((type . text)(subtype . x-rot13-47)(mode . "play")
 538    (method . mime-method-to-display-caesar)
 539    ))
 540 (ctree-set-calist-strictly
 541  'mime-acting-condition
 542  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
 543    (method . mime-method-to-display-caesar)
 544    ))
 545
 546 (ctree-set-calist-strictly
 547  'mime-acting-condition
 548  '((type . audio)(subtype . basic)(mode . "play")
 549    (method "tm-au" nil 'file "" 'encoding 'mode 'name)
 550    ))
 551
 552 (ctree-set-calist-strictly
 553  'mime-acting-condition
 554  '((type . image)(mode . "play")
 555    (method "tm-image" nil 'file "" 'encoding 'mode 'name)
 556    ))
 557 (ctree-set-calist-strictly
 558  'mime-acting-condition
 559  '((type . image)(mode . "print")
 560    (method "tm-image" nil 'file "" 'encoding 'mode 'name)
 561    ))
 562
 563 (ctree-set-calist-strictly
 564  'mime-acting-condition
 565  '((type . video)(subtype . mpeg)(mode . "play")
 566    (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
 567    ))
 568
 569 (ctree-set-calist-strictly
 570  'mime-acting-condition
 571  '((type . application)(subtype . postscript)(mode . "play")
 572    (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
 573    ))
 574 (ctree-set-calist-strictly
 575  'mime-acting-condition
 576  '((type . application)(subtype . postscript)(mode . "print")
 577    (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
 578    ))
 579
 580 (ctree-set-calist-strictly
 581  'mime-acting-condition
 582  '((type . message)(subtype . rfc822)(mode . "play")
 583    (method . mime-method-to-display-message/rfc822)
 584    ))
 585 (ctree-set-calist-strictly
 586  'mime-acting-condition
 587  '((type . message)(subtype . partial)(mode . "play")
 588    (method . mime-method-to-store-message/partial)
 589    ))
 590
 591 (ctree-set-calist-strictly
 592  'mime-acting-condition
 593  '((type . message)(subtype . external-body)
 594    ("access-type" . "anon-ftp")
 595    (method . mime-method-to-display-message/external-ftp)
 596    ))
 597
 598 (ctree-set-calist-strictly
 599  'mime-acting-condition
 600  '((type . application)(subtype . octet-stream)
 601    (method . mime-method-to-save)
 602    ))
 603
 604
 605 ;;; @ quitting method
 606 ;;;
 607
 608 (defvar mime-preview-quitting-method-alist
 609   '((mime-show-message-mode
 610      . mime-preview-quitting-method-for-mime-show-message-mode))
 611   "Alist of major-mode vs. quitting-method of mime-view.")
 612
 613 (defvar mime-view-over-to-previous-method-alist nil)
 614 (defvar mime-view-over-to-next-method-alist nil)
 615
 616 (defvar mime-view-show-summary-method nil
 617   "Alist of major-mode vs. show-summary-method.")
 618
 619
 620 ;;; @ following method
 621 ;;;
 622
 623 (defvar mime-view-following-method-alist nil
 624   "Alist of major-mode vs. following-method of mime-view.")
 625
 626 (defvar mime-view-following-required-fields-list
 627   '("From"))
 628
 629
 630 ;;; @ X-Face
 631 ;;;
 632
 633 ;; hack from Gnus 5.0.4.
 634
 635 (defvar mime-view-x-face-to-pbm-command
 636   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 637
 638 (defvar mime-view-x-face-command
 639   (concat mime-view-x-face-to-pbm-command
 640           " | xv -quit -")
 641   "String to be executed to display an X-Face field.
 642 The command will be executed in a sub-shell asynchronously.
 643 The compressed face will be piped to this command.")
 644
 645 (defun mime-view-x-face-function ()
 646   "Function to display X-Face field. You can redefine to customize."
 647   ;; 1995/10/12 (c.f. tm-eng:130)
 648   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 649   (save-restriction
 650     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 651     ;; end
 652     (goto-char (point-min))
 653     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 654         (let ((beg (match-end 0))
 655               (end (std11-field-end))
 656               )
 657           (call-process-region beg end "sh" nil 0 nil
 658                                "-c" mime-view-x-face-command)
 659           ))))
 660
 661
 662 ;;; @ miscellaneous
 663 ;;;
 664
 665 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 666
 667 (defvar mime-raw-buffer-coding-system-alist
 668   `((t . ,(mime-charset-to-coding-system default-mime-charset)))
 669   "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.")
 670
 671
 672 ;;; @ buffer setup
 673 ;;;
 674
 675 (defvar mime-view-redisplay nil)
 676
 677 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
 678   (if ibuf
 679       (progn
 680         (get-buffer ibuf)
 681         (set-buffer ibuf)
 682         ))
 683   (or mime-view-redisplay
 684       (setq mime-raw-message-info (mime-parse-message ctl encoding))
 685       )
 686   (let ((message-info mime-raw-message-info)
 687         (the-buf (current-buffer))
 688         (mode major-mode))
 689     (or obuf
 690         (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
 691     (set-buffer (get-buffer-create obuf))
 692     (let ((inhibit-read-only t))
 693       ;;(setq buffer-read-only nil)
 694       (widen)
 695       (erase-buffer)
 696       (setq mime-raw-buffer the-buf)
 697       (setq mime-preview-original-major-mode mode)
 698       (setq major-mode 'mime-view-mode)
 699       (setq mode-name "MIME-View")
 700       (mime-view-display-message message-info the-buf obuf)
 701       (set-buffer-modified-p nil)
 702       )
 703     (setq buffer-read-only t)
 704     (set-buffer the-buf)
 705     )
 706   (setq mime-preview-buffer obuf)
 707   )
 708
 709 (defun mime-view-display-message (message-info ibuf obuf)
 710   (let* ((start (mime-entity-point-min message-info))
 711          (end (mime-entity-point-max message-info))
 712          (media-type (mime-entity-media-type message-info))
 713          (media-subtype (mime-entity-media-subtype message-info))
 714          (params (mime-entity-parameters message-info))
 715          (encoding (mime-entity-encoding message-info))
 716          end-of-header e nb ne subj)
 717     (set-buffer ibuf)
 718     (goto-char start)
 719     (setq end-of-header (if (re-search-forward "^$" nil t)
 720                             (1+ (match-end 0))
 721                           end))
 722     (if (> end-of-header end)
 723         (setq end-of-header end)
 724       )
 725     (save-restriction
 726       (narrow-to-region start end)
 727       (setq subj
 728             (eword-decode-string
 729              (mime-raw-get-subject params encoding)))
 730       )
 731     (set-buffer obuf)
 732     (setq nb (point))
 733     (narrow-to-region nb nb)
 734     ;; Insert message-header
 735     (save-restriction
 736       (narrow-to-region (point)(point))
 737       (insert-buffer-substring mime-raw-buffer start end-of-header)
 738       (let ((f (cdr (assq mime-preview-original-major-mode
 739                           mime-view-content-header-filter-alist))))
 740         (if (functionp f)
 741             (funcall f)
 742           (mime-view-default-content-header-filter)
 743           ))
 744       (run-hooks 'mime-view-content-header-filter-hook)
 745       )
 746     (let* ((situation
 747             (ctree-match-calist mime-preview-condition
 748                                 (list* (cons 'type       media-type)
 749                                        (cons 'subtype    media-subtype)
 750                                        (cons 'encoding   encoding)
 751                                        (cons 'major-mode major-mode)
 752                                        params)))
 753            (message-button
 754             (cdr (assq 'message-button situation)))
 755            (body-presentation-method
 756             (cdr (assq 'body-presentation-method situation))))
 757       (when (eq message-button 'visible)
 758         (goto-char (point-max))
 759         (mime-view-insert-entity-button message-info message-info subj)
 760         )
 761       (cond ((eq body-presentation-method 'with-filter)
 762              (let ((body-filter (cdr (assq 'body-filter situation))))
 763                (save-restriction
 764                  (narrow-to-region (point-max)(point-max))
 765                  (insert-buffer-substring mime-raw-buffer end-of-header end)
 766                  (funcall body-filter situation)
 767                  )))
 768             ((functionp body-presentation-method)
 769              (funcall body-presentation-method situation)
 770              )
 771             ((null (mime-entity-children message-info))
 772              (goto-char (point-max))
 773              (mime-view-insert-entity-button message-info message-info subj)
 774              ))
 775       (setq ne (point-max))
 776       (widen)
 777       (put-text-property nb ne 'mime-view-raw-buffer ibuf)
 778       (put-text-property nb ne 'mime-view-entity message-info)
 779       (goto-char ne)
 780       (let ((children (mime-entity-children message-info))
 781             (default-situation
 782              (cdr (assq 'childrens-situation situation))))
 783         (while children
 784           (mime-view-display-entity (car children) message-info ibuf obuf
 785                                     default-situation)
 786           (setq children (cdr children))
 787           )))))
 788
 789 (defun mime-view-display-entity (entity message-info ibuf obuf
 790                                         default-situation)
 791   (let* ((start (mime-entity-point-min entity))
 792          (end (mime-entity-point-max entity))
 793          (media-type (mime-entity-media-type entity))
 794          (media-subtype (mime-entity-media-subtype entity))
 795          (params (mime-entity-parameters entity))
 796          (encoding (mime-entity-encoding entity))
 797          end-of-header e nb ne subj)
 798     (set-buffer ibuf)
 799     (goto-char start)
 800     (setq end-of-header (if (re-search-forward "^$" nil t)
 801                             (1+ (match-end 0))
 802                           end))
 803     (if (> end-of-header end)
 804         (setq end-of-header end)
 805       )
 806     (save-restriction
 807       (narrow-to-region start end)
 808       (setq subj
 809             (eword-decode-string
 810              (mime-raw-get-subject params encoding)))
 811       )
 812     (let* ((situation
 813             (ctree-match-calist mime-preview-condition
 814                                 (list* (cons 'type       media-type)
 815                                        (cons 'subtype    media-subtype)
 816                                        (cons 'encoding   encoding)
 817                                        (cons 'major-mode major-mode)
 818                                        (append params
 819                                                default-situation))))
 820            (button-is-invisible
 821             (eq (cdr (assq 'entity-button situation)) 'invisible))
 822            (header-is-visible
 823             (eq (cdr (assq 'header situation)) 'visible))
 824            (body-presentation-method
 825             (cdr (assq 'body-presentation-method situation))))
 826       (set-buffer obuf)
 827       (setq nb (point))
 828       (narrow-to-region nb nb)
 829       (or button-is-invisible
 830           (if (mime-view-entity-button-visible-p entity message-info)
 831               (mime-view-insert-entity-button entity message-info subj)
 832             ))
 833       (if header-is-visible
 834           (save-restriction
 835             (narrow-to-region (point)(point))
 836             (insert-buffer-substring mime-raw-buffer start end-of-header)
 837             (let ((f (cdr (assq mime-preview-original-major-mode
 838                                 mime-view-content-header-filter-alist))))
 839               (if (functionp f)
 840                   (funcall f)
 841                 (mime-view-default-content-header-filter)
 842                 ))
 843             (run-hooks 'mime-view-content-header-filter-hook)
 844             ))
 845       (cond ((eq body-presentation-method 'with-filter)
 846              (let ((body-filter (cdr (assq 'body-filter situation))))
 847                (save-restriction
 848                  (narrow-to-region (point-max)(point-max))
 849                  (insert-buffer-substring mime-raw-buffer end-of-header end)
 850                  (funcall body-filter situation)
 851                  )))
 852             ((functionp body-presentation-method)
 853              (funcall body-presentation-method situation)
 854              ))
 855       (or header-is-visible
 856           body-presentation-method
 857           (progn
 858             (goto-char (point-max))
 859             (insert "\n")
 860             ))
 861       (setq ne (point-max))
 862       (widen)
 863       (put-text-property nb ne 'mime-view-raw-buffer ibuf)
 864       (put-text-property nb ne 'mime-view-entity entity)
 865       (goto-char ne)
 866       (let ((children (mime-entity-children entity))
 867             (default-situation
 868               (cdr (assq 'childrens-situation situation))))
 869         (while children
 870           (mime-view-display-entity (car children) message-info ibuf obuf
 871                                     default-situation)
 872           (setq children (cdr children))
 873           )))))
 874
 875 (defun mime-raw-get-uu-filename (param &optional encoding)
 876   (if (member (or encoding
 877                   (cdr (assq 'encoding param))
 878                   )
 879               mime-view-uuencode-encoding-name-list)
 880       (save-excursion
 881         (or (if (re-search-forward "^begin [0-9]+ " nil t)
 882                 (if (looking-at ".+$")
 883                     (buffer-substring (match-beginning 0)(match-end 0))
 884                   ))
 885             ""))
 886     ))
 887
 888 (defun mime-raw-get-subject (param &optional encoding)
 889   (or (std11-find-field-body '("Content-Description" "Subject"))
 890       (let (ret)
 891         (if (or (and (setq ret (mime/Content-Disposition))
 892                      (setq ret (assoc "filename" (cdr ret)))
 893                      )
 894                 (setq ret (assoc "name" param))
 895                 (setq ret (assoc "x-name" param))
 896                 )
 897             (std11-strip-quoted-string (cdr ret))
 898           ))
 899       (mime-raw-get-uu-filename param encoding)
 900       ""))
 901
 902
 903 ;;; @ MIME viewer mode
 904 ;;;
 905
 906 (defconst mime-view-menu-title "MIME-View")
 907 (defconst mime-view-menu-list
 908   '((up          "Move to upper entity"    mime-preview-move-to-upper)
 909     (previous    "Move to previous entity" mime-preview-move-to-previous)
 910     (next        "Move to next entity"     mime-preview-move-to-next)
 911     (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
 912     (scroll-up   "Scroll-up"               mime-preview-scroll-up-entity)
 913     (play        "Play current entity"     mime-preview-play-current-entity)
 914     (extract     "Extract current entity"  mime-preview-extract-current-entity)
 915     (print       "Print current entity"    mime-preview-print-current-entity)
 916     (x-face      "Show X Face"             mime-preview-display-x-face)
 917     )
 918   "Menu for MIME Viewer")
 919
 920 (cond (running-xemacs
 921        (defvar mime-view-xemacs-popup-menu
 922          (cons mime-view-menu-title
 923                (mapcar (function
 924                         (lambda (item)
 925                           (vector (nth 1 item)(nth 2 item) t)
 926                           ))
 927                        mime-view-menu-list)))
 928        (defun mime-view-xemacs-popup-menu (event)
 929          "Popup the menu in the MIME Viewer buffer"
 930          (interactive "e")
 931          (select-window (event-window event))
 932          (set-buffer (event-buffer event))
 933          (popup-menu 'mime-view-xemacs-popup-menu))
 934        (defvar mouse-button-2 'button2)
 935        )
 936       (t
 937        (defvar mouse-button-2 [mouse-2])
 938        ))
 939
 940 (defun mime-view-define-keymap (&optional default)
 941   (let ((mime-view-mode-map (if (keymapp default)
 942                                 (copy-keymap default)
 943                               (make-sparse-keymap)
 944                               )))
 945     (define-key mime-view-mode-map
 946       "u"        (function mime-preview-move-to-upper))
 947     (define-key mime-view-mode-map
 948       "p"        (function mime-preview-move-to-previous))
 949     (define-key mime-view-mode-map
 950       "n"        (function mime-preview-move-to-next))
 951     (define-key mime-view-mode-map
 952       "\e\t"     (function mime-preview-move-to-previous))
 953     (define-key mime-view-mode-map
 954       "\t"       (function mime-preview-move-to-next))
 955     (define-key mime-view-mode-map
 956       " "        (function mime-preview-scroll-up-entity))
 957     (define-key mime-view-mode-map
 958       "\M- "     (function mime-preview-scroll-down-entity))
 959     (define-key mime-view-mode-map
 960       "\177"     (function mime-preview-scroll-down-entity))
 961     (define-key mime-view-mode-map
 962       "\C-m"     (function mime-preview-next-line-entity))
 963     (define-key mime-view-mode-map
 964       "\C-\M-m"  (function mime-preview-previous-line-entity))
 965     (define-key mime-view-mode-map
 966       "v"        (function mime-preview-play-current-entity))
 967     (define-key mime-view-mode-map
 968       "e"        (function mime-preview-extract-current-entity))
 969     (define-key mime-view-mode-map
 970       "\C-c\C-p" (function mime-preview-print-current-entity))
 971     (define-key mime-view-mode-map
 972       "a"        (function mime-preview-follow-current-entity))
 973     (define-key mime-view-mode-map
 974       "q"        (function mime-preview-quit))
 975     (define-key mime-view-mode-map
 976       "h"        (function mime-preview-show-summary))
 977     (define-key mime-view-mode-map
 978       "\C-c\C-x" (function mime-preview-kill-buffer))
 979     ;; (define-key mime-view-mode-map
 980     ;;   "<"        (function beginning-of-buffer))
 981     ;; (define-key mime-view-mode-map
 982     ;;   ">"        (function end-of-buffer))
 983     (define-key mime-view-mode-map
 984       "?"        (function describe-mode))
 985     (define-key mime-view-mode-map
 986       [tab] (function mime-preview-move-to-next))
 987     (define-key mime-view-mode-map
 988       [delete] (function mime-preview-scroll-down-entity))
 989     (define-key mime-view-mode-map
 990       [backspace] (function mime-preview-scroll-down-entity))
 991     (if (functionp default)
 992         (cond (running-xemacs
 993                (set-keymap-default-binding mime-view-mode-map default)
 994                )
 995               (t
 996                (setq mime-view-mode-map
 997                      (append mime-view-mode-map (list (cons t default))))
 998                )))
 999     (if mouse-button-2
1000         (define-key mime-view-mode-map
1001           mouse-button-2 (function mime-button-dispatcher))
1002       )
1003     (cond (running-xemacs
1004            (define-key mime-view-mode-map
1005              mouse-button-3 (function mime-view-xemacs-popup-menu))
1006            )
1007           ((>= emacs-major-version 19)
1008            (define-key mime-view-mode-map [menu-bar mime-view]
1009              (cons mime-view-menu-title
1010                    (make-sparse-keymap mime-view-menu-title)))
1011            (mapcar (function
1012                     (lambda (item)
1013                       (define-key mime-view-mode-map
1014                         (vector 'menu-bar 'mime-view (car item))
1015                         (cons (nth 1 item)(nth 2 item))
1016                         )
1017                       ))
1018                    (reverse mime-view-menu-list)
1019                    )
1020            ))
1021     (use-local-map mime-view-mode-map)
1022     (run-hooks 'mime-view-define-keymap-hook)
1023     ))
1024
1025 (defsubst mime-maybe-hide-echo-buffer ()
1026   "Clear mime-echo buffer and delete window for it."
1027   (let ((buf (get-buffer mime-echo-buffer-name)))
1028     (if buf
1029         (save-excursion
1030           (set-buffer buf)
1031           (erase-buffer)
1032           (let ((win (get-buffer-window buf)))
1033             (if win
1034                 (delete-window win)
1035               ))
1036           (bury-buffer buf)
1037           ))))
1038
1039 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
1040                                  default-keymap-or-function)
1041   "Major mode for viewing MIME message.
1042
1043 Here is a list of the standard keys for mime-view-mode.
1044
1045 key             feature
1046 ---             -------
1047
1048 u               Move to upper content
1049 p or M-TAB      Move to previous content
1050 n or TAB        Move to next content
1051 SPC             Scroll up or move to next content
1052 M-SPC or DEL    Scroll down or move to previous content
1053 RET             Move to next line
1054 M-RET           Move to previous line
1055 v               Decode current content as `play mode'
1056 e               Decode current content as `extract mode'
1057 C-c C-p         Decode current content as `print mode'
1058 a               Followup to current content.
1059 x               Display X-Face
1060 q               Quit
1061 button-2        Move to point under the mouse cursor
1062                 and decode current content as `play mode'
1063 "
1064   (interactive)
1065   (mime-maybe-hide-echo-buffer)
1066   (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
1067         (win-conf (current-window-configuration))
1068         )
1069     (prog1
1070         (switch-to-buffer ret)
1071       (setq mime-preview-original-window-configuration win-conf)
1072       (if mother
1073           (progn
1074             (setq mime-mother-buffer mother)
1075             ))
1076       (mime-view-define-keymap default-keymap-or-function)
1077       (let ((point
1078              (next-single-property-change (point-min) 'mime-view-entity)))
1079         (if point
1080             (goto-char point)
1081           (goto-char (point-min))
1082           (search-forward "\n\n" nil t)
1083           ))
1084       (run-hooks 'mime-view-mode-hook)
1085       )))
1086
1087
1088 ;;; @@ playing
1089 ;;;
1090
1091 (autoload 'mime-preview-play-current-entity "mime-play"
1092   "Play current entity." t)
1093
1094 (defun mime-preview-extract-current-entity ()
1095   "Extract current entity into file (maybe).
1096 It decodes current entity to call internal or external method as
1097 \"extract\" mode.  The method is selected from variable
1098 `mime-acting-condition'."
1099   (interactive)
1100   (mime-preview-play-current-entity "extract")
1101   )
1102
1103 (defun mime-preview-print-current-entity ()
1104   "Print current entity (maybe).
1105 It decodes current entity to call internal or external method as
1106 \"print\" mode.  The method is selected from variable
1107 `mime-acting-condition'."
1108   (interactive)
1109   (mime-preview-play-current-entity "print")
1110   )
1111
1112
1113 ;;; @@ following
1114 ;;;
1115
1116 (defun mime-preview-original-major-mode ()
1117   "Return major-mode of original buffer.
1118 If a current buffer has mime-mother-buffer, return original major-mode
1119 of the mother-buffer."
1120   (if mime-mother-buffer
1121       (save-excursion
1122         (set-buffer mime-mother-buffer)
1123         (mime-preview-original-major-mode)
1124         )
1125     mime-preview-original-major-mode))
1126
1127 (defun mime-preview-follow-current-entity ()
1128   "Write follow message to current entity.
1129 It calls following-method selected from variable
1130 `mime-view-following-method-alist'."
1131   (interactive)
1132   (let (entity)
1133     (while (null (setq entity
1134                        (get-text-property (point) 'mime-view-entity)))
1135       (backward-char)
1136       )
1137     (let* ((p-beg
1138             (previous-single-property-change (point) 'mime-view-entity))
1139            p-end
1140            (entity-node-id (mime-entity-node-id entity))
1141            (len (length entity-node-id))
1142            )
1143       (cond ((null p-beg)
1144              (setq p-beg
1145                    (if (eq (next-single-property-change (point-min)
1146                                                         'mime-view-entity)
1147                            (point))
1148                        (point)
1149                      (point-min)))
1150              )
1151             ((eq (next-single-property-change p-beg 'mime-view-entity)
1152                  (point))
1153              (setq p-beg (point))
1154              ))
1155       (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1156       (cond ((null p-end)
1157              (setq p-end (point-max))
1158              )
1159             ((null entity-node-id)
1160              (setq p-end (point-max))
1161              )
1162             (t
1163              (save-excursion
1164                (goto-char p-end)
1165                (catch 'tag
1166                  (let (e)
1167                    (while (setq e
1168                                 (next-single-property-change
1169                                  (point) 'mime-view-entity))
1170                      (goto-char e)
1171                      (let ((rc (mime-entity-node-id
1172                                 (get-text-property (point)
1173                                                    'mime-view-entity))))
1174                        (or (equal entity-node-id
1175                                   (nthcdr (- (length rc) len) rc))
1176                            (throw 'tag nil)
1177                            ))
1178                      (setq p-end e)
1179                      ))
1180                  (setq p-end (point-max))
1181                  ))
1182              ))
1183       (let* ((mode (mime-preview-original-major-mode))
1184              (new-name
1185               (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1186              new-buf
1187              (the-buf (current-buffer))
1188              (a-buf mime-raw-buffer)
1189              fields)
1190         (save-excursion
1191           (set-buffer (setq new-buf (get-buffer-create new-name)))
1192           (erase-buffer)
1193           (insert-buffer-substring the-buf p-beg p-end)
1194           (goto-char (point-min))
1195           (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1196             (while (progn
1197                      (setq
1198                       str
1199                       (save-excursion
1200                         (set-buffer a-buf)
1201                         (setq
1202                          ci
1203                          (mime-raw-find-entity-from-node-id entity-node-id))
1204                         (save-restriction
1205                           (narrow-to-region
1206                            (mime-entity-point-min ci)
1207                            (mime-entity-point-max ci)
1208                            )
1209                           (std11-header-string-except
1210                            (concat "^"
1211                                    (apply (function regexp-or) fields)
1212                                    ":") ""))))
1213                      (if (and
1214                           (eq (mime-entity-media-type ci) 'message)
1215                           (eq (mime-entity-media-subtype ci) 'rfc822))
1216                          nil
1217                        (if str
1218                            (insert str)
1219                          )
1220                        entity-node-id))
1221               (setq fields (std11-collect-field-names)
1222                     entity-node-id (cdr entity-node-id))
1223               )
1224             )
1225           (let ((rest mime-view-following-required-fields-list))
1226             (while rest
1227               (let ((field-name (car rest)))
1228                 (or (std11-field-body field-name)
1229                     (insert
1230                      (format
1231                       (concat field-name
1232                               ": "
1233                               (save-excursion
1234                                 (set-buffer the-buf)
1235                                 (set-buffer mime-mother-buffer)
1236                                 (set-buffer mime-raw-buffer)
1237                                 (std11-field-body field-name)
1238                                 )
1239                               "\n")))
1240                     ))
1241               (setq rest (cdr rest))
1242               ))
1243           (eword-decode-header)
1244           )
1245         (let ((f (cdr (assq mode mime-view-following-method-alist))))
1246           (if (functionp f)
1247               (funcall f new-buf)
1248             (message
1249              (format
1250               "Sorry, following method for %s is not implemented yet."
1251               mode))
1252             ))
1253         ))))
1254
1255
1256 ;;; @@ X-Face
1257 ;;;
1258
1259 (defun mime-preview-display-x-face ()
1260   (interactive)
1261   (save-window-excursion
1262     (set-buffer mime-raw-buffer)
1263     (mime-view-x-face-function)
1264     ))
1265
1266
1267 ;;; @@ moving
1268 ;;;
1269
1270 (defun mime-preview-move-to-upper ()
1271   "Move to upper entity.
1272 If there is no upper entity, call function `mime-preview-quit'."
1273   (interactive)
1274   (let (cinfo)
1275     (while (null (setq cinfo
1276                        (get-text-property (point) 'mime-view-entity)))
1277       (backward-char)
1278       )
1279     (let ((r (mime-raw-find-entity-from-node-id
1280               (cdr (mime-entity-node-id cinfo))
1281               (get-text-property 1 'mime-view-entity)))
1282           point)
1283       (catch 'tag
1284         (while (setq point (previous-single-property-change
1285                             (point) 'mime-view-entity))
1286           (goto-char point)
1287           (if (eq r (get-text-property (point) 'mime-view-entity))
1288               (throw 'tag t)
1289             )
1290           )
1291         (mime-preview-quit)
1292         ))))
1293
1294 (defun mime-preview-move-to-previous ()
1295   "Move to previous entity.
1296 If there is no previous entity, it calls function registered in
1297 variable `mime-view-over-to-previous-method-alist'."
1298   (interactive)
1299   (while (null (get-text-property (point) 'mime-view-entity))
1300     (backward-char)
1301     )
1302   (let ((point
1303          (previous-single-property-change (point) 'mime-view-entity)))
1304     (if point
1305         (goto-char point)
1306       (let ((f (assq mime-preview-original-major-mode
1307                      mime-view-over-to-previous-method-alist)))
1308         (if f
1309             (funcall (cdr f))
1310           ))
1311       )))
1312
1313 (defun mime-preview-move-to-next ()
1314   "Move to next entity.
1315 If there is no previous entity, it calls function registered in
1316 variable `mime-view-over-to-next-method-alist'."
1317   (interactive)
1318   (let ((point (next-single-property-change (point) 'mime-view-entity)))
1319     (if point
1320         (goto-char point)
1321       (let ((f (assq mime-preview-original-major-mode
1322                      mime-view-over-to-next-method-alist)))
1323         (if f
1324             (funcall (cdr f))
1325           ))
1326       )))
1327
1328 (defun mime-preview-scroll-up-entity (&optional h)
1329   "Scroll up current entity.
1330 If reached to (point-max), it calls function registered in variable
1331 `mime-view-over-to-next-method-alist'."
1332   (interactive)
1333   (or h
1334       (setq h (1- (window-height)))
1335       )
1336   (if (= (point) (point-max))
1337       (let ((f (assq mime-preview-original-major-mode
1338                      mime-view-over-to-next-method-alist)))
1339         (if f
1340             (funcall (cdr f))
1341           ))
1342     (let ((point
1343            (or (next-single-property-change (point) 'mime-view-entity)
1344                (point-max))))
1345       (forward-line h)
1346       (if (> (point) point)
1347           (goto-char point)
1348         )
1349       )))
1350
1351 (defun mime-preview-scroll-down-entity (&optional h)
1352   "Scroll down current entity.
1353 If reached to (point-min), it calls function registered in variable
1354 `mime-view-over-to-previous-method-alist'."
1355   (interactive)
1356   (or h
1357       (setq h (1- (window-height)))
1358       )
1359   (if (= (point) (point-min))
1360       (let ((f (assq mime-preview-original-major-mode
1361                      mime-view-over-to-previous-method-alist)))
1362         (if f
1363             (funcall (cdr f))
1364           ))
1365     (let (point)
1366       (save-excursion
1367         (catch 'tag
1368           (while (> (point) 1)
1369             (if (setq point
1370                       (previous-single-property-change (point)
1371                                                        'mime-view-entity))
1372                 (throw 'tag t)
1373               )
1374             (backward-char)
1375             )
1376           (setq point (point-min))
1377           ))
1378       (forward-line (- h))
1379       (if (< (point) point)
1380           (goto-char point)
1381         ))))
1382
1383 (defun mime-preview-next-line-entity ()
1384   (interactive)
1385   (mime-preview-scroll-up-entity 1)
1386   )
1387
1388 (defun mime-preview-previous-line-entity ()
1389   (interactive)
1390   (mime-preview-scroll-down-entity 1)
1391   )
1392
1393
1394 ;;; @@ quitting
1395 ;;;
1396
1397 (defun mime-preview-quit ()
1398   "Quit from MIME-preview buffer.
1399 It calls function registered in variable
1400 `mime-preview-quitting-method-alist'."
1401   (interactive)
1402   (let ((r (assq mime-preview-original-major-mode
1403                  mime-preview-quitting-method-alist)))
1404     (if r
1405         (funcall (cdr r))
1406       )))
1407
1408 (defun mime-preview-show-summary ()
1409   "Show summary.
1410 It calls function registered in variable
1411 `mime-view-show-summary-method'."
1412   (interactive)
1413   (let ((r (assq mime-preview-original-major-mode
1414                  mime-view-show-summary-method)))
1415     (if r
1416         (funcall (cdr r))
1417       )))
1418
1419 (defun mime-preview-kill-buffer ()
1420   (interactive)
1421   (kill-buffer (current-buffer))
1422   )
1423
1424
1425 ;;; @ end
1426 ;;;
1427
1428 (provide 'mime-view)
1429
1430 (run-hooks 'mime-view-load-hook)
1431
1432 ;;; mime-view.el ends here