summaryrefslogtreecommitdiff
path: root/lisp/pixel-scroll.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/pixel-scroll.el')
-rw-r--r--lisp/pixel-scroll.el80
1 files changed, 32 insertions, 48 deletions
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 5ffa8caa71c..65671534865 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -375,59 +375,43 @@ Otherwise, redisplay will reset the window's vscroll."
"Scroll the current window down by DELTA pixels.
Note that this function doesn't work if DELTA is larger than
the height of the current window."
- (when-let* ((posn (posn-at-point))
- (current-y (cdr (posn-x-y posn)))
- (min-y (+ (frame-char-height)
- (window-tab-line-height)
- (window-header-line-height)))
- (cursor-height (line-pixel-height))
- (window-height (window-text-height nil t))
- (next-height (save-excursion
- (vertical-motion 1)
- (line-pixel-height))))
- (if (and (> delta 0)
- (<= cursor-height window-height))
- (while (< (- current-y min-y) delta)
- (vertical-motion 1)
- (setq current-y (+ current-y
- (line-pixel-height)))
- (when (eobp)
- (signal 'end-of-buffer nil)))
- (when (< (- (cdr (posn-object-width-height posn))
- (cdr (posn-object-x-y posn)))
- (- window-height next-height))
- (vertical-motion 1)
- (setq posn (posn-at-point)
- current-y (cdr (posn-x-y posn)))
- (while (< (- current-y min-y) delta)
- (vertical-motion 1)
- (setq current-y (+ current-y
- (line-pixel-height)))
- (when (eobp)
- (signal 'end-of-buffer nil)))))
- (let* ((desired-pos (posn-at-x-y 0 (+ delta
- (window-tab-line-height)
- (window-header-line-height))))
- (object (posn-object desired-pos))
- (desired-start (posn-point desired-pos))
- (desired-vscroll (cdr (posn-object-x-y desired-pos))))
- (if (or (consp object) (stringp object))
- ;; We are either on an overlay or a string, so set vscroll
- ;; directly.
- (set-window-vscroll nil (+ (window-vscroll nil t)
- delta)
- t)
- (unless (eq (window-start) desired-start)
- (set-window-start nil desired-start t))
- (set-window-vscroll nil desired-vscroll t)))))
+ (let* ((desired-pos (posn-at-x-y 0 (+ delta
+ (window-tab-line-height)
+ (window-header-line-height))))
+ (object (posn-object desired-pos))
+ (desired-start (posn-point desired-pos))
+ (desired-vscroll (cdr (posn-object-x-y desired-pos)))
+ (next-pos (save-excursion
+ (goto-char desired-start)
+ (when (zerop (vertical-motion 1))
+ (signal 'end-of-buffer nil))
+ (point))))
+ (if (and (< (point) next-pos)
+ (let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
+ (and pos-visibility
+ (or (eq (length pos-visibility) 2)
+ (when-let* ((posn (posn-at-point next-pos))
+ (edges (window-edges nil t))
+ (usable-height (- (nth 3 edges)
+ (nth 1 edges))))
+ (> (cdr (posn-object-width-height posn))
+ usable-height))))))
+ (goto-char next-pos))
+ (if (or (consp object) (stringp object))
+ ;; We are either on an overlay or a string, so set vscroll
+ ;; directly.
+ (set-window-vscroll nil (+ (window-vscroll nil t)
+ delta)
+ t)
+ (unless (eq (window-start) desired-start)
+ (set-window-start nil desired-start t))
+ (set-window-vscroll nil desired-vscroll t))))
(defun pixel-scroll-precision-scroll-up (delta)
"Scroll the current window up by DELTA pixels."
(let* ((edges (window-edges nil t nil t))
(max-y (- (nth 3 edges)
- (nth 1 edges)
- (window-tab-line-height)
- (window-header-line-height)))
+ (nth 1 edges)))
(usable-height max-y))
(when-let* ((posn (posn-at-point))
(current-y (+ (cdr (posn-x-y posn))