: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)
;;;
`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)
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
(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
(cons (cons 'encoding (or (mime-entity-encoding entity)
"7bit"))
situation)))
-
- ;; major-mode
- (or (assq 'major-mode situation)
- (setq situation
- (cons (cons 'major-mode
- (with-current-buffer (mime-entity-buffer entity)
- major-mode))
- 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
;;; @@@ 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)))
(ctree-set-calist-strictly
'mime-preview-condition
+ '((type . application)(subtype . x-postpet)
+ (body . visible)
+ (body-presentation-method . mime-display-application/x-postpet)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
'((type . text)(subtype . t)
(body . visible)
(body-presentation-method . mime-display-text/plain)))
(enriched-decode beg (point-max))
)))
+(put 'unpack 'lisp-indent-function 1)
+(defmacro unpack (string &rest body)
+ `(let* ((*unpack*string* (string-as-unibyte ,string))
+ (*unpack*index* 0))
+ ,@body))
+
+(defun unpack-skip (len)
+ (setq *unpack*index* (+ len *unpack*index*)))
+
+(defun unpack-fixed (len)
+ (prog1
+ (substring *unpack*string* *unpack*index* (+ *unpack*index* len))
+ (unpack-skip len)))
+
+(defun unpack-byte ()
+ (char-int (aref (unpack-fixed 1) 0)))
+
+(defun unpack-short ()
+ (let* ((b0 (unpack-byte))
+ (b1 (unpack-byte)))
+ (+ (* 256 b0) b1)))
+
+(defun unpack-long ()
+ (let* ((s0 (unpack-short))
+ (s1 (unpack-short)))
+ (+ (* 65536 s0) s1)))
+
+(defun unpack-string ()
+ (let ((len (unpack-byte)))
+ (unpack-fixed len)))
+
+(defun unpack-string-sjis ()
+ (decode-mime-charset-string (unpack-string) 'shift_jis))
+
+(defun postpet-decode (string)
+ (condition-case nil
+ (unpack string
+ (let (res)
+ (unpack-skip 4)
+ (set-alist 'res 'carryingcount (unpack-long))
+ (unpack-skip 8)
+ (set-alist 'res 'sentyear (unpack-short))
+ (set-alist 'res 'sentmonth (unpack-short))
+ (set-alist 'res 'sentday (unpack-short))
+ (unpack-skip 8)
+ (set-alist 'res 'petname (unpack-string-sjis))
+ (set-alist 'res 'owner (unpack-string-sjis))
+ (set-alist 'res 'pettype (unpack-fixed 4))
+ (set-alist 'res 'health (unpack-short))
+ (unpack-skip 2)
+ (set-alist 'res 'sex (unpack-long))
+ (unpack-skip 1)
+ (set-alist 'res 'brain (unpack-byte))
+ (unpack-skip 39)
+ (set-alist 'res 'happiness (unpack-byte))
+ (unpack-skip 14)
+ (set-alist 'res 'petbirthyear (unpack-short))
+ (set-alist 'res 'petbirthmonth (unpack-short))
+ (set-alist 'res 'petbirthday (unpack-short))
+ (unpack-skip 8)
+ (set-alist 'res 'from (unpack-string))
+ (unpack-skip 5)
+ (unpack-skip 160)
+ (unpack-skip 4)
+ (unpack-skip 8)
+ (unpack-skip 8)
+ (unpack-skip 26)
+ (set-alist 'res 'treasure (unpack-short))
+ (set-alist 'res 'money (unpack-long))
+ res))
+ (error nil)))
+
+(defun mime-display-application/x-postpet (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (let ((pet (postpet-decode (mime-entity-content entity))))
+ (if pet
+ (insert "Petname: " (cdr (assq 'petname pet)) "\n"
+ "Owner: " (cdr (assq 'owner pet)) "\n"
+ "Pettype: " (cdr (assq 'pettype pet)) "\n"
+ "From: " (cdr (assq 'from pet)) "\n"
+ "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet))) "\n"
+ "SentYear: " (int-to-string (cdr (assq 'sentyear pet))) "\n"
+ "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet))) "\n"
+ "SentDay: " (int-to-string (cdr (assq 'sentday pet))) "\n"
+ "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet))) "\n"
+ "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet))) "\n"
+ "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet))) "\n"
+ "Health: " (int-to-string (cdr (assq 'health pet))) "\n"
+ "Sex: " (int-to-string (cdr (assq 'sex pet))) "\n"
+ "Brain: " (int-to-string (cdr (assq 'brain pet))) "\n"
+ "Happiness: " (int-to-string (cdr (assq 'happiness pet))) "\n"
+ "Treasure: " (int-to-string (cdr (assq 'treasure pet))) "\n"
+ "Money: " (int-to-string (cdr (assq 'money pet))) "\n"
+ )
+ (insert "Invalid format\n"))
+ (run-hooks 'mime-display-application/x-postpet-hook))))
+
+
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
"\
(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))
(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
(setq i (1+ i))
situation)
))
- children)))
+ children))
(setq i 0)
(while children
(let ((child (car children))
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
(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)))
(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)
(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)
(defvar mouse-button-2 'button2)
)
(t
+ (defvar mime-view-popup-menu
+ (let ((menu (make-sparse-keymap mime-view-menu-title)))
+ (nconc menu
+ (mapcar (function
+ (lambda (item)
+ (list (intern (nth 1 item)) 'menu-item
+ (nth 1 item)(nth 2 item))
+ ))
+ mime-view-menu-list))))
+ (defun mime-view-popup-menu (event)
+ "Popup the menu in the MIME Viewer buffer"
+ (interactive "@e")
+ (let ((menu mime-view-popup-menu) events func)
+ (setq events (x-popup-menu t menu))
+ (and events
+ (setq func (lookup-key menu (apply #'vector events)))
+ (commandp func)
+ (funcall func))))
(defvar mouse-button-2 [mouse-2])
))
mouse-button-3 (function mime-view-xemacs-popup-menu))
)
((>= emacs-major-version 19)
+ (define-key mime-view-mode-map
+ mouse-button-3 (function mime-view-popup-menu))
(define-key mime-view-mode-map [menu-bar mime-view]
(cons mime-view-menu-title
(make-sparse-keymap mime-view-menu-title)))
(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)
)
(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
(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)
(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
(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))
)
(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)
+ (let ((entity (when mime-mother-buffer
+ (set-buffer mime-mother-buffer)
+ (get-text-property (point)
+ 'mime-view-entity))))
+ (while (and entity
+ (null (setq ret (mime-entity-fetch-field
+ entity field-name))))
+ (setq entity (mime-entity-parent entity)))))
+ (if ret
+ (insert (concat field-name ": " ret "\n"))
+ )))
(setq rest (cdr rest))
))
(mime-decode-header-in-buffer)
(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)
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)
)
(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)))
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)
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
;;;