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