mime-view.el

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