[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master b79d779: Improve upwards pixel scrolling for large images
From: |
Po Lu |
Subject: |
master b79d779: Improve upwards pixel scrolling for large images |
Date: |
Tue, 30 Nov 2021 07:36:57 -0500 (EST) |
branch: master
commit b79d779ae839d0484b24967b4753df9e9b85f614
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Improve upwards pixel scrolling for large images
This fixes most of the problem, but with a large image the
vscroll can sometimes jump about, which has to be fixed.
* lisp/pixel-scroll.el (pixel-scroll-precision-up): Handle
vscrolling large images in the first unseen line.
---
lisp/pixel-scroll.el | 85 +++++++++++++++++++++++++++-------------------------
1 file changed, 45 insertions(+), 40 deletions(-)
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 2fd7cac..097e4e5 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -423,50 +423,55 @@ the height of the current window."
(defun pixel-scroll-precision-scroll-up (delta)
"Scroll the current window up by DELTA pixels."
- (when-let* ((max-y (- (window-text-height nil t)
- (frame-char-height)
- (window-tab-line-height)
- (window-header-line-height)))
- (posn (posn-at-point))
- (current-y (+ (cdr (posn-x-y posn))
- (line-pixel-height))))
- (while (< (- max-y current-y) delta)
- (vertical-motion -1)
- (setq current-y (- current-y (line-pixel-height)))))
- (let ((current-vscroll (window-vscroll nil t)))
- (if (<= delta current-vscroll)
- (set-window-vscroll nil (- current-vscroll delta) t)
- (setq delta (- delta current-vscroll))
- (set-window-vscroll nil 0 t)
- (while (> delta 0)
- (let ((position (pixel-point-and-height-at-unseen-line)))
- (unless (cdr position)
- (signal 'beginning-of-buffer nil))
- (set-window-start nil (car position) t)
- ;; If the line above is taller than the window height (i.e. there's
- ;; a very tall image), keep point on it.
- (when (> (cdr position) (window-text-height nil t))
- (let ((vs (window-vscroll nil t)))
- (goto-char (car position))
- (set-window-vscroll nil vs t)))
- (setq delta (- delta (cdr position)))))
- (when (< delta 0)
- (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta)
+ (let* ((edges (window-edges nil t nil t))
+ (max-y (- (nth 3 edges)
+ (window-tab-line-height)
+ (window-header-line-height)))
+ (usable-height (- max-y (nth 1 edges))))
+ (when-let* ((posn (posn-at-point))
+ (current-y (+ (cdr (posn-x-y posn))
+ (line-pixel-height))))
+ (while (and (< (- max-y current-y) delta)
+ (< (cdr (posn-object-width-height posn))
+ usable-height))
+ (vertical-motion -1)
+ (setq current-y (- current-y (line-pixel-height))))
+ (when (and (>= (cdr (posn-object-width-height posn))
+ usable-height)
+ (let ((prev-line-height (save-excursion
+ (vertical-motion -1)
+ (line-pixel-height))))
+ (<= 0 (- (cdr (posn-x-y posn)) prev-line-height))))
+ (vertical-motion -1)))
+ (let ((current-vscroll (window-vscroll nil t)))
+ (if (<= delta current-vscroll)
+ (set-window-vscroll nil (- current-vscroll delta) t)
+ (setq delta (- delta current-vscroll))
+ (set-window-vscroll nil 0 t)
+ (while (> delta 0)
+ (let ((position (pixel-point-and-height-at-unseen-line)))
+ (unless (cdr position)
+ (signal 'beginning-of-buffer nil))
+ (set-window-start nil (car position) t)
+ ;; If the line above is taller than the window height (i.e. there's
+ ;; a very tall image), keep point on it.
+ (when (> (cdr position) usable-height)
+ (goto-char (car position)))
+ (setq delta (- delta (cdr position)))))
+ (when (< delta 0)
+ (if-let* ((desired-pos (posn-at-x-y 0 (+ (- delta)
(window-tab-line-height)
(window-header-line-height))))
(desired-start (posn-point desired-pos))
(desired-vscroll (cdr (posn-object-x-y desired-pos))))
- (let ((object (posn-object desired-pos)))
- (if (or (consp object) (stringp object))
- (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))))))))
-
-;; FIXME: This doesn't work when there's an image above the current
-;; line that is taller than the window.
+ (progn
+ (set-window-start nil desired-start t)
+ (set-window-vscroll nil desired-vscroll t))
+ (set-window-vscroll nil (abs delta) t)))))))
+
+;; FIXME: This doesn't _always_ work when there's an image above the
+;; current line that is taller than the window, and scrolling can
+;; sometimes be jumpy in that case.
(defun pixel-scroll-precision (event)
"Scroll the display vertically by pixels according to EVENT.
Move the display up or down by the pixel deltas in EVENT to
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master b79d779: Improve upwards pixel scrolling for large images,
Po Lu <=