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