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