Merge semi-1_13_7.
[elisp/semi.git] / mime-view.el
index 763b20e..119d972 100644 (file)
 ;;;
 
 (defconst mime-view-version
-  (eval-when-compile
-    (concat (mime-product-name mime-user-interface-product) " MIME-View "
-           (mapconcat #'number-to-string
-                      (mime-product-version mime-user-interface-product) ".")
-           " (" (mime-product-code-name mime-user-interface-product) ")")))
+  (concat (mime-product-name mime-user-interface-product) " MIME-View "
+         (mapconcat #'number-to-string
+                    (mime-product-version mime-user-interface-product) ".")
+         " (" (mime-product-code-name mime-user-interface-product) ")"))
 
 
 ;;; @ variables
   :group 'mime-view
   :type 'file)
 
+(defcustom mime-preview-move-scroll nil
+  "*Decides whether to scroll when moving to next entity.
+When t, scroll the buffer. Non-nil but not t means scroll when
+the next entity is within next-screen-context-lines from top or
+buttom. Nil means don't scroll at all."
+  :group 'mime-view
+  :type '(choice (const :tag "Off" nil)
+                (const :tag "On" t)
+                (sexp :tag "Situation" 1)))
 
 ;;; @ in raw-buffer (representation space)
 ;;;
@@ -83,24 +91,25 @@ major-mode or t.  t means default.  REPRESENTATION-TYPE must be
 `binary' or `cooked'.")
 
 
-(defun mime-raw-find-entity-from-point (point &optional message-info)
-  "Return entity from POINT in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-message-structure' is used."
-  (or message-info
-      (setq message-info mime-message-structure))
-  (if (and (<= (mime-entity-point-min message-info) point)
-          (<= point (mime-entity-point-max message-info)))
-      (let ((children (mime-entity-children message-info)))
-       (catch 'tag
-         (while children
-           (let ((ret
-                  (mime-raw-find-entity-from-point point (car children))))
-             (if ret
-                 (throw 'tag ret)
-               ))
-           (setq children (cdr children)))
-         message-info))))
+;; (defun mime-raw-find-entity-from-point (point &optional message-info)
+;;   "Return entity from POINT in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (or message-info
+;;       (setq message-info mime-message-structure))
+;;   (if (and (<= (mime-entity-point-min message-info) point)
+;;            (<= point (mime-entity-point-max message-info)))
+;;       (let ((children (mime-entity-children message-info)))
+;;         (catch 'tag
+;;           (while children
+;;             (let ((ret
+;;                    (mime-raw-find-entity-from-point point (car children))))
+;;               (if ret
+;;                   (throw 'tag ret)
+;;                 ))
+;;             (setq children (cdr children)))
+;;           message-info))))
+;; (make-obsolete 'mime-raw-find-entity-from-point "don't use it.")
 
 
 ;;; @ in preview-buffer (presentation space)
@@ -112,15 +121,15 @@ If current MIME-preview buffer is generated by other buffer, such as
 message/partial, it is called `mother-buffer'.")
 (make-variable-buffer-local 'mime-mother-buffer)
 
-(defvar mime-raw-buffer nil
-  "Raw buffer corresponding with the (MIME-preview) buffer.")
-(make-variable-buffer-local 'mime-raw-buffer)
+;; (defvar mime-raw-buffer nil
+;;   "Raw buffer corresponding with the (MIME-preview) buffer.")
+;; (make-variable-buffer-local 'mime-raw-buffer)
 
 (defvar mime-preview-original-window-configuration nil
   "Window-configuration before mime-view-mode is called.")
 (make-variable-buffer-local 'mime-preview-original-window-configuration)
 
-(defun mime-preview-original-major-mode (&optional recursive)
+(defun mime-preview-original-major-mode (&optional recursive point)
   "Return major-mode of original buffer.
 If optional argument RECURSIVE is non-nil and current buffer has
 mime-mother-buffer, it returns original major-mode of the
@@ -130,79 +139,126 @@ mother-buffer."
        (set-buffer mime-mother-buffer)
        (mime-preview-original-major-mode recursive)
        )
-    (save-excursion
-      (set-buffer
-       (mime-entity-buffer
-       (get-text-property (point-min) 'mime-view-entity)))
-      major-mode)))
+    (cdr (assq 'major-mode
+              (get-text-property (or point
+                                     (if (> (point) (buffer-size))
+                                         (max (1- (point-max)) (point-min))
+                                       (point)))
+                                 'mime-view-situation)))))
 
 
 ;;; @ entity information
 ;;;
 
-(defun mime-entity-situation (entity)
+(defun mime-entity-situation (entity &optional situation)
   "Return situation of ENTITY."
-  (append (or (mime-entity-content-type entity)
-             (make-mime-content-type 'text 'plain))
-         (let ((d (mime-entity-content-disposition entity)))
-           (cons (cons 'disposition-type
-                       (mime-content-disposition-type d))
-                 (mapcar (function
-                          (lambda (param)
-                            (let ((name (car param)))
-                              (cons (cond ((string= name "filename")
-                                           'filename)
-                                          ((string= name "creation-date")
-                                           'creation-date)
-                                          ((string= name "modification-date")
-                                           'modification-date)
-                                          ((string= name "read-date")
-                                           'read-date)
-                                          ((string= name "size")
-                                           'size)
-                                          (t (cons 'disposition (car param))))
-                                    (cdr param)))))
-                         (mime-content-disposition-parameters d))
-                 ))
-         (list (cons 'encoding (mime-entity-encoding entity))
-               (cons 'major-mode
-                     (save-excursion
-                       (set-buffer (mime-entity-buffer entity))
-                       major-mode)))
-         ))
-
+  (let (rest param name)
+    ;; Content-Type
+    (unless (assq 'type situation)
+      (setq rest (or (mime-entity-content-type entity)
+                    (make-mime-content-type 'text 'plain))
+           situation (cons (car rest) situation)
+           rest (cdr rest))
+      )
+    (unless (assq 'subtype situation)
+      (or rest
+         (setq rest (or (cdr (mime-entity-content-type entity))
+                        '((subtype . plain)))))
+      (setq situation (cons (car rest) situation)
+           rest (cdr rest))
+      )
+    (while rest
+      (setq param (car rest))
+      (or (assoc (car param) situation)
+         (setq situation (cons param situation)))
+      (setq rest (cdr rest)))
+    
+    ;; Content-Disposition
+    (setq rest nil)
+    (unless (assq 'disposition-type situation)
+      (setq rest (mime-entity-content-disposition entity))
+      (if rest
+         (setq situation (cons (cons 'disposition-type
+                                     (mime-content-disposition-type rest))
+                               situation)
+               rest (mime-content-disposition-parameters rest))
+       ))
+    (while rest
+      (setq param (car rest)
+           name (car param))
+      (if (cond ((string= name "filename")
+                (if (assq 'filename situation)
+                    nil
+                  (setq name 'filename)))
+               ((string= name "creation-date")
+                (if (assq 'creation-date situation)
+                    nil
+                  (setq name 'creation-date)))
+               ((string= name "modification-date")
+                (if (assq 'modification-date situation)
+                    nil
+                  (setq name 'modification-date)))
+               ((string= name "read-date")
+                (if (assq 'read-date situation)
+                    nil
+                  (setq name 'read-date)))
+               ((string= name "size")
+                (if (assq 'size situation)
+                    nil
+                  (setq name 'size)))
+               (t (setq name (cons 'disposition name))
+                  (if (assoc name situation)
+                      nil
+                    name)))
+         (setq situation
+               (cons (cons name (cdr param))
+                     situation)))
+      (setq rest (cdr rest)))
+    
+    ;; Content-Transfer-Encoding
+    (or (assq 'encoding situation)
+       (setq situation
+             (cons (cons 'encoding (or (mime-entity-encoding entity)
+                                       "7bit"))
+                   situation)))
+    
+    situation))
 
 (defun mime-view-entity-title (entity)
-  (or (mime-read-field 'Content-Description entity)
-      (mime-read-field 'Subject entity)
+  (or (mime-entity-read-field entity 'Content-Description)
+      (mime-entity-read-field entity 'Subject)
       (mime-entity-filename entity)
       ""))
 
 
-(defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
-  "Return entity-node-id from POINT in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-message-structure' is used."
-  (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
-
-(defsubst mime-raw-point-to-entity-number (point &optional message-info)
-  "Return entity-number from POINT in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-message-structure' is used."
-  (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
-
-(defun mime-raw-flatten-message-info (&optional message-info)
-  "Return list of entity in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-message-structure' is used."
-  (or message-info
-      (setq message-info mime-message-structure))
-  (let ((dest (list message-info))
-       (rcl (mime-entity-children message-info)))
-    (while rcl
-      (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
-      (setq rcl (cdr rcl)))
-    dest))
+;; (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
+;;   "Return entity-node-id from POINT in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
+
+;; (make-obsolete 'mime-raw-point-to-entity-node-id "don't use it.")
+
+;; (defsubst mime-raw-point-to-entity-number (point &optional message-info)
+;;   "Return entity-number from POINT in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
+
+;; (make-obsolete 'mime-raw-point-to-entity-number "don't use it.")
+
+;; (defun mime-raw-flatten-message-info (&optional message-info)
+;;   "Return list of entity in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (or message-info
+;;       (setq message-info mime-message-structure))
+;;   (let ((dest (list message-info))
+;;         (rcl (mime-entity-children message-info)))
+;;     (while rcl
+;;       (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
+;;       (setq rcl (cdr rcl)))
+;;     dest))
 
 
 ;;; @ presentation of preview
@@ -319,6 +375,8 @@ Each elements are regexp of field-name.")
 ;;; @@@ predicate function
 ;;;
 
+(in-calist-package 'mime-view)
+
 (defun mime-calist::field-match-method-as-default-rule (calist
                                                        field-type field-value)
   (let ((s-field (assq field-type calist)))
@@ -485,8 +543,12 @@ Each elements are regexp of field-name.")
 
 (defun mime-display-multipart/mixed (entity situation)
   (let ((children (mime-entity-children entity))
+       (original-major-mode-cell (assq 'major-mode situation))
        (default-situation
          (cdr (assq 'childrens-situation situation))))
+    (if original-major-mode-cell
+       (setq default-situation
+             (cons original-major-mode-cell default-situation)))
     (while children
       (mime-display-entity (car children) nil default-situation)
       (setq children (cdr children))
@@ -510,12 +572,17 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 
 (defun mime-display-multipart/alternative (entity situation)
   (let* ((children (mime-entity-children entity))
+        (original-major-mode-cell (assq 'major-mode situation))
         (default-situation
           (cdr (assq 'childrens-situation situation)))
         (i 0)
         (p 0)
         (max-score 0)
-        (situations
+        situations)
+    (if original-major-mode-cell
+       (setq default-situation
+             (cons original-major-mode-cell default-situation)))
+    (setq situations
          (mapcar (function
                   (lambda (child)
                     (let ((situation
@@ -546,7 +613,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                       (setq i (1+ i))
                       situation)
                     ))
-                 children)))
+                 children))
     (setq i 0)
     (while children
       (let ((child (car children))
@@ -684,11 +751,9 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                                   default-situation preview-buffer)
   (or preview-buffer
       (setq preview-buffer (current-buffer)))
-  (let* ((raw-buffer (mime-entity-buffer entity))
-        (start (mime-entity-point-min entity))
-        e nb ne)
-    (set-buffer raw-buffer)
-    (goto-char start)
+  (let* (e nb ne nhb nbb)
+    (mime-goto-header-start-point entity)
+    (in-calist-package 'mime-view)
     (or situation
        (setq situation
              (or (ctree-match-calist mime-preview-condition
@@ -701,7 +766,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
           (eq (cdr (assq 'header situation)) 'visible))
          (header-presentation-method
           (or (cdr (assq 'header-presentation-method situation))
-              (cdr (assq major-mode mime-header-presentation-method-alist))))
+              (cdr (assq (cdr (assq 'major-mode situation))
+                         mime-header-presentation-method-alist))))
          (body-presentation-method
           (cdr (assq 'body-presentation-method situation)))
          (children (mime-entity-children entity)))
@@ -713,15 +779,18 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
              (mime-view-insert-entity-button entity)
            ))
       (when header-is-visible
+       (setq nhb (point))
        (if header-presentation-method
            (funcall header-presentation-method entity situation)
          (mime-insert-header entity
                              mime-view-ignored-field-list
                              mime-view-visible-field-list))
+       (run-hooks 'mime-display-header-hook)
+       (put-text-property nhb (point-max) 'mime-view-entity-header entity)
        (goto-char (point-max))
        (insert "\n")
-       (run-hooks 'mime-display-header-hook)
        )
+      (setq nbb (point))
       (cond (children)
             ((functionp body-presentation-method)
             (funcall body-presentation-method entity situation)
@@ -740,6 +809,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (setq ne (point-max))
       (widen)
       (put-text-property nb ne 'mime-view-entity entity)
+      (put-text-property nb ne 'mime-view-situation situation)
+      (put-text-property nbb ne 'mime-view-entity-body entity)
       (goto-char ne)
       (if children
          (if (functionp body-presentation-method)
@@ -884,21 +955,34 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 
 (defvar mime-view-redisplay nil)
 
+;;;###autoload
 (defun mime-display-message (message &optional preview-buffer
-                                    mother default-keymap-or-function)
+                                    mother default-keymap-or-function
+                                    original-major-mode)
+  "View MESSAGE in MIME-View mode.
+
+Optional argument PREVIEW-BUFFER specifies the buffer of the
+presentation.  It must be either nil or a name of preview buffer.
+
+Optional argument MOTHER specifies mother-buffer of the preview-buffer.
+
+Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or
+function.  If it is a keymap, keymap of MIME-View mode will be added
+to it.  If it is a function, it will be bound as default binding of
+keymap of MIME-View mode."
   (mime-maybe-hide-echo-buffer)
-  (let ((win-conf (current-window-configuration))
-       (raw-buffer (mime-entity-buffer message)))
+  (let ((win-conf (current-window-configuration)))
     (or preview-buffer
        (setq preview-buffer
-             (concat "*Preview-" (buffer-name raw-buffer) "*")))
-    (set-buffer raw-buffer)
-    (setq mime-preview-buffer preview-buffer)
+             (concat "*Preview-" (mime-entity-name message) "*")))
+    (or original-major-mode
+       (setq original-major-mode
+             (with-current-buffer (mime-entity-header-buffer message)
+               major-mode)))
     (let ((inhibit-read-only t))
       (set-buffer (get-buffer-create preview-buffer))
       (widen)
       (erase-buffer)
-      (setq mime-raw-buffer raw-buffer)
       (if mother
          (setq mime-mother-buffer mother)
        )
@@ -906,8 +990,9 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (setq major-mode 'mime-view-mode)
       (setq mode-name "MIME-View")
       (mime-display-entity message nil
-                          '((entity-button . invisible)
-                            (header . visible))
+                          `((entity-button . invisible)
+                            (header . visible)
+                            (major-mode . ,original-major-mode))
                           preview-buffer)
       (mime-view-define-keymap default-keymap-or-function)
       (let ((point
@@ -920,17 +1005,9 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (run-hooks 'mime-view-mode-hook)
       (set-buffer-modified-p nil)
       (setq buffer-read-only t)
-      (or (get-buffer-window preview-buffer)
-         (let ((r-win (get-buffer-window raw-buffer)))
-           (if r-win
-               (set-window-buffer r-win preview-buffer)
-             (let ((m-win (and mother (get-buffer-window mother))))
-               (if m-win
-                   (set-window-buffer m-win preview-buffer)
-                 (switch-to-buffer preview-buffer)
-                 )))))
-      )))
+      preview-buffer)))
 
+;;;###autoload
 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
                                   default-keymap-or-function
                                   representation-type)
@@ -957,9 +1034,18 @@ message.  It must be nil, `binary' or `cooked'.  If it is nil,
   (if (eq representation-type 'binary)
       (setq representation-type 'buffer)
     )
-  (mime-display-message
-   (mime-open-entity representation-type raw-buffer)
-   preview-buffer mother default-keymap-or-function))
+  (setq preview-buffer (mime-display-message
+                       (mime-open-entity representation-type raw-buffer)
+                       preview-buffer mother default-keymap-or-function))
+  (or (get-buffer-window preview-buffer)
+      (let ((r-win (get-buffer-window raw-buffer)))
+       (if r-win
+           (set-window-buffer r-win preview-buffer)
+         (let ((m-win (and mother (get-buffer-window mother))))
+           (if m-win
+               (set-window-buffer m-win preview-buffer)
+             (switch-to-buffer preview-buffer)
+             ))))))
 
 (defun mime-view-mode (&optional mother ctl encoding
                                 raw-buffer preview-buffer
@@ -1051,6 +1137,7 @@ It calls following-method selected from variable
     (let* ((p-beg
            (previous-single-property-change (point) 'mime-view-entity))
           p-end
+          ph-end
           (entity-node-id (mime-entity-node-id entity))
           (len (length entity-node-id))
           )
@@ -1094,63 +1181,79 @@ It calls following-method selected from variable
                 (setq p-end (point-max))
                 ))
             ))
+      (setq ph-end
+           (previous-single-property-change p-end 'mime-view-entity-header))
+      (if (or (null ph-end)
+             (< ph-end p-beg))
+         (setq ph-end p-beg)
+       )
       (let* ((mode (mime-preview-original-major-mode 'recursive))
             (new-name
              (format "%s-%s" (buffer-name) (reverse entity-node-id)))
             new-buf
             (the-buf (current-buffer))
-            (a-buf mime-raw-buffer)
             fields)
        (save-excursion
          (set-buffer (setq new-buf (get-buffer-create new-name)))
          (erase-buffer)
-         (insert-buffer-substring the-buf p-beg p-end)
+         (insert-buffer-substring the-buf ph-end p-end)
+         (when (= ph-end p-beg)
+           (goto-char (point-min))
+           (insert ?\n))
          (goto-char (point-min))
-          (let ((entity-node-id (mime-entity-node-id entity)) ci str)
-           (while (progn
-                    (setq
-                     str
-                     (save-excursion
-                       (set-buffer a-buf)
-                       (setq ci
-                             (mime-find-entity-from-node-id entity-node-id))
-                       (save-restriction
-                         (narrow-to-region
-                          (mime-entity-point-min ci)
-                          (mime-entity-point-max ci)
-                          )
-                         (std11-header-string-except
-                          (concat "^"
-                                  (apply (function regexp-or) fields)
-                                  ":") ""))))
-                    (if (and
-                         (eq (mime-entity-media-type ci) 'message)
-                         (eq (mime-entity-media-subtype ci) 'rfc822))
-                        nil
-                      (if str
-                          (insert str)
-                        )
-                      entity-node-id))
+          (let ((current-entity
+                (if (and (eq (mime-entity-media-type entity) 'message)
+                         (eq (mime-entity-media-subtype entity) 'rfc822))
+                    (mime-entity-children entity)
+                  entity))
+               str)
+           (while (and current-entity
+                       (progn
+                         (setq str
+                               (with-current-buffer
+                                   (mime-entity-header-buffer current-entity)
+                                 (save-restriction
+                                   (narrow-to-region
+                                    (mime-entity-header-start-point
+                                     current-entity)
+                                    (mime-entity-header-end-point
+                                     current-entity))
+                                   (std11-header-string-except
+                                    (concat
+                                     "^"
+                                     (apply (function regexp-or) fields)
+                                     ":") ""))))
+                         (if (and (eq (mime-entity-media-type
+                                       current-entity) 'message)
+                                  (eq (mime-entity-media-subtype
+                                       current-entity) 'rfc822))
+                             nil
+                           (if str
+                               (insert str)
+                             )
+                           t)))
              (setq fields (std11-collect-field-names)
-                   entity-node-id (cdr entity-node-id))
+                   current-entity (mime-entity-parent current-entity))
              )
            )
-         (let ((rest mime-view-following-required-fields-list))
+         (let ((rest mime-view-following-required-fields-list)
+               field-name ret)
            (while rest
-             (let ((field-name (car rest)))
-               (or (std11-field-body field-name)
-                   (insert
-                    (format
-                     (concat field-name
-                             ": "
-                             (save-excursion
-                               (set-buffer the-buf)
-                               (set-buffer mime-mother-buffer)
-                               (set-buffer mime-raw-buffer)
-                               (std11-field-body field-name)
-                               )
-                             "\n")))
-                   ))
+             (setq field-name (car rest))
+             (or (std11-field-body field-name)
+                 (progn
+                   (save-excursion
+                     (set-buffer the-buf)
+                     (setq ret
+                           (when mime-mother-buffer
+                             (set-buffer mime-mother-buffer)
+                             (mime-entity-fetch-field
+                              (get-text-property (point)
+                                                 'mime-view-entity)
+                              field-name))))
+                   (if ret
+                       (insert (concat field-name ": " ret "\n"))
+                     )))
              (setq rest (cdr rest))
              ))
          (mime-decode-header-in-buffer)
@@ -1184,8 +1287,17 @@ If there is no upper entity, call function `mime-preview-quit'."
        (while (setq point (previous-single-property-change
                            (point) 'mime-view-entity))
          (goto-char point)
-         (if (eq r (get-text-property (point) 'mime-view-entity))
-             (throw 'tag t)
+         (when (eq r (get-text-property (point) 'mime-view-entity))
+           (if (or (eq mime-preview-move-scroll t)
+                   (and mime-preview-move-scroll
+                        (>= point
+                            (save-excursion
+                              (move-to-window-line -1)
+                              (forward-line (* -1 next-screen-context-lines))
+                              (beginning-of-line)
+                              (point)))))
+               (recenter next-screen-context-lines))
+           (throw 'tag t)
            )
          )
        (mime-preview-quit)
@@ -1196,13 +1308,25 @@ If there is no upper entity, call function `mime-preview-quit'."
 If there is no previous entity, it calls function registered in
 variable `mime-preview-over-to-previous-method-alist'."
   (interactive)
-  (while (null (get-text-property (point) 'mime-view-entity))
+  (while (and (not (bobp))
+             (null (get-text-property (point) 'mime-view-entity)))
     (backward-char)
     )
   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
-    (if point
+    (if (and point
+            (>= point (point-min)))
        (if (get-text-property (1- point) 'mime-view-entity)
-           (goto-char point)
+           (progn (goto-char point)
+                  (if
+                   (or (eq mime-preview-move-scroll t)
+                       (and mime-preview-move-scroll
+                            (<= point
+                               (save-excursion
+                                 (move-to-window-line 0)
+                                 (forward-line next-screen-context-lines)
+                                 (end-of-line)
+                                 (point)))))
+                       (recenter (* -1 next-screen-context-lines))))
          (goto-char (1- point))
          (mime-preview-move-to-previous)
          )
@@ -1223,11 +1347,23 @@ variable `mime-preview-over-to-next-method-alist'."
     (forward-char)
     )
   (let ((point (next-single-property-change (point) 'mime-view-entity)))
-    (if point
+    (if (and point
+            (<= point (point-max)))
        (progn
          (goto-char point)
          (if (null (get-text-property point 'mime-view-entity))
              (mime-preview-move-to-next)
+           (and
+            (or (eq mime-preview-move-scroll t)
+                (and mime-preview-move-scroll
+                     (>= point
+                        (save-excursion
+                          (move-to-window-line -1)
+                          (forward-line
+                           (* -1 next-screen-context-lines))
+                          (beginning-of-line)
+                          (point)))))
+                (recenter next-screen-context-lines))
            ))
       (let ((f (assq (mime-preview-original-major-mode)
                     mime-preview-over-to-next-method-alist)))
@@ -1241,22 +1377,24 @@ variable `mime-preview-over-to-next-method-alist'."
 If reached to (point-max), it calls function registered in variable
 `mime-preview-over-to-next-method-alist'."
   (interactive)
-  (or h
-      (setq h (1- (window-height)))
-      )
-  (if (= (point) (point-max))
+  (if (eobp)
       (let ((f (assq (mime-preview-original-major-mode)
-                     mime-preview-over-to-next-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
+                    mime-preview-over-to-next-method-alist)))
+       (if f
+           (funcall (cdr f))
+         ))
     (let ((point
           (or (next-single-property-change (point) 'mime-view-entity)
-              (point-max))))
-      (forward-line h)
-      (if (> (point) point)
-          (goto-char point)
-        )
+              (point-max)))
+         (bottom (window-end (selected-window))))
+      (if (and (not h)
+              (> bottom point))
+         (progn (goto-char point)
+                (recenter next-screen-context-lines))
+       (condition-case nil
+           (scroll-up h)
+         (end-of-buffer
+          (goto-char (point-max)))))
       )))
 
 (defun mime-preview-scroll-down-entity (&optional h)
@@ -1264,34 +1402,40 @@ If reached to (point-max), it calls function registered in variable
 If reached to (point-min), it calls function registered in variable
 `mime-preview-over-to-previous-method-alist'."
   (interactive)
-  (or h
-      (setq h (1- (window-height)))
-      )
-  (if (= (point) (point-min))
+  (if (bobp)
       (let ((f (assq (mime-preview-original-major-mode)
                     mime-preview-over-to-previous-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
+       (if f
+           (funcall (cdr f))
+         ))
     (let ((point
           (or (previous-single-property-change (point) 'mime-view-entity)
-              (point-min))))
-      (forward-line (- h))
-      (if (< (point) point)
-          (goto-char point)
-        ))))
+              (point-min)))
+         (top (window-start (selected-window))))
+      (if (and (not h)
+              (< top point))
+         (progn (goto-char point)
+                (recenter (* -1 next-screen-context-lines)))
+       (condition-case nil
+           (scroll-down h)
+         (beginning-of-buffer
+          (goto-char (point-min)))))
+      )))
 
-(defun mime-preview-next-line-entity ()
-  (interactive)
-  (mime-preview-scroll-up-entity 1)
+(defun mime-preview-next-line-entity (&optional lines)
+  "Scroll up one line (or prefix LINES lines).
+If LINES is negative, scroll down LINES lines."
+  (interactive "p")
+  (mime-preview-scroll-up-entity (or lines 1))
   )
 
-(defun mime-preview-previous-line-entity ()
-  (interactive)
-  (mime-preview-scroll-down-entity 1)
+(defun mime-preview-previous-line-entity (&optional lines)
+  "Scrroll down one line (or prefix LINES lines).
+If LINES is negative, scroll up LINES lines."
+  (interactive "p")
+  (mime-preview-scroll-down-entity (or lines 1))
   )
 
-
 ;;; @@ quitting
 ;;;