aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/pixel-scroll.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/pixel-scroll.el')
-rw-r--r--lisp/pixel-scroll.el85
1 files changed, 38 insertions, 47 deletions
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index ead841c9823..336b555e77c 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -397,7 +397,11 @@ returns nil."
397The returned value is a cons of the position of the first 397The returned value is a cons of the position of the first
398character on the unseen line just above the scope of current 398character on the unseen line just above the scope of current
399window, and the pixel height of that line." 399window, and the pixel height of that line."
400 (let* ((pos0 (window-start)) 400 (let* ((pos0 (save-excursion
401 (goto-char (window-start))
402 (unless (bobp)
403 (beginning-of-visual-line))
404 (point)))
401 (vscroll0 (window-vscroll nil t)) 405 (vscroll0 (window-vscroll nil t))
402 (line-height nil) 406 (line-height nil)
403 (pos 407 (pos
@@ -407,8 +411,7 @@ window, and the pixel height of that line."
407 (point-min) 411 (point-min)
408 (vertical-motion -1) 412 (vertical-motion -1)
409 (setq line-height 413 (setq line-height
410 (cdr (window-text-pixel-size nil (point) 414 (cdr (window-text-pixel-size nil (point) pos0)))
411 pos0)))
412 (point))))) 415 (point)))))
413 ;; restore initial position 416 ;; restore initial position
414 (set-window-start nil pos0 t) 417 (set-window-start nil pos0 t)
@@ -436,12 +439,13 @@ the height of the current window."
436 (let* ((desired-pos (posn-at-x-y 0 (+ delta 439 (let* ((desired-pos (posn-at-x-y 0 (+ delta
437 (window-tab-line-height) 440 (window-tab-line-height)
438 (window-header-line-height)))) 441 (window-header-line-height))))
439 (object (posn-object desired-pos))
440 (desired-start (posn-point desired-pos)) 442 (desired-start (posn-point desired-pos))
441 (scroll-area-total-height (cdr (window-text-pixel-size nil 443 (current-vs (window-vscroll nil t))
442 (window-start) 444 (start-posn (unless (eq desired-start (window-start))
443 (1- desired-start)))) 445 (posn-at-point desired-start)))
444 (desired-vscroll (- delta scroll-area-total-height)) 446 (desired-vscroll (if start-posn
447 (- delta (cdr (posn-x-y start-posn)))
448 (+ current-vs delta)))
445 (edges (window-edges nil t)) 449 (edges (window-edges nil t))
446 (usable-height (- (nth 3 edges) 450 (usable-height (- (nth 3 edges)
447 (nth 1 edges))) 451 (nth 1 edges)))
@@ -450,36 +454,24 @@ the height of the current window."
450 (when (zerop (vertical-motion (1+ scroll-margin))) 454 (when (zerop (vertical-motion (1+ scroll-margin)))
451 (signal 'end-of-buffer nil)) 455 (signal 'end-of-buffer nil))
452 (point))) 456 (point)))
453 (end-pos (posn-at-x-y 0 (+ usable-height 457 (scroll-preserve-screen-position nil)
454 (window-tab-line-height) 458 (auto-window-vscroll nil))
455 (window-header-line-height))))) 459 (when (and (or (< (point) next-pos))
456 (if (or (overlayp object) 460 (let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
457 (stringp object) 461 (and pos-visibility
458 (and (consp object) 462 (or (eq (length pos-visibility) 2)
459 (stringp (car object))) 463 (when-let* ((posn (posn-at-point next-pos)))
460 (and (consp (posn-object end-pos)) 464 (> (cdr (posn-object-width-height posn))
461 (> (cdr (posn-object-x-y end-pos)) 0))) 465 usable-height))))))
462 ;; We are either on an overlay or a string, so set vscroll 466 (goto-char next-pos))
463 ;; directly. 467 (set-window-start nil (if (zerop (window-hscroll))
464 (set-window-vscroll nil (+ (window-vscroll nil t) 468 desired-start
465 delta) 469 (save-excursion
466 t) 470 (goto-char desired-start)
467 (when (and (or (< (point) next-pos)) 471 (beginning-of-visual-line)
468 (let ((pos-visibility (pos-visible-in-window-p next-pos nil t))) 472 (point)))
469 (and pos-visibility 473 t)
470 (or (eq (length pos-visibility) 2) 474 (set-window-vscroll nil desired-vscroll t)))
471 (when-let* ((posn (posn-at-point next-pos)))
472 (> (cdr (posn-object-width-height posn))
473 usable-height))))))
474 (goto-char next-pos))
475 (set-window-start nil (if (zerop (window-hscroll))
476 desired-start
477 (save-excursion
478 (goto-char desired-start)
479 (beginning-of-visual-line)
480 (point)))
481 t)
482 (set-window-vscroll nil desired-vscroll t))))
483 475
484(defun pixel-scroll-precision-scroll-down (delta) 476(defun pixel-scroll-precision-scroll-down (delta)
485 "Scroll the current window down by DELTA pixels." 477 "Scroll the current window down by DELTA pixels."
@@ -558,13 +550,14 @@ animation."
558 (setq time-elapsed (+ time-elapsed 550 (setq time-elapsed (+ time-elapsed
559 (- (float-time) last-time)) 551 (- (float-time) last-time))
560 percentage (/ time-elapsed total-time)) 552 percentage (/ time-elapsed total-time))
561 (if (< delta 0) 553 (let ((throw-on-input nil))
562 (pixel-scroll-precision-scroll-down 554 (if (< delta 0)
563 (ceiling (abs (* (* delta factor) 555 (pixel-scroll-precision-scroll-down
564 (/ between-scroll total-time))))) 556 (ceiling (abs (* (* delta factor)
565 (pixel-scroll-precision-scroll-up 557 (/ between-scroll total-time)))))
566 (ceiling (* (* delta factor) 558 (pixel-scroll-precision-scroll-up
567 (/ between-scroll total-time))))) 559 (ceiling (* (* delta factor)
560 (/ between-scroll total-time))))))
568 (setq last-time (float-time))) 561 (setq last-time (float-time)))
569 (if (< percentage 1) 562 (if (< percentage 1)
570 (progn 563 (progn
@@ -723,8 +716,6 @@ precisely, according to the turning of the mouse wheel."
723 :group 'mouse 716 :group 'mouse
724 :keymap pixel-scroll-precision-mode-map 717 :keymap pixel-scroll-precision-mode-map
725 (setq mwheel-coalesce-scroll-events 718 (setq mwheel-coalesce-scroll-events
726 (not pixel-scroll-precision-mode)
727 make-cursor-line-fully-visible
728 (not pixel-scroll-precision-mode))) 719 (not pixel-scroll-precision-mode)))
729 720
730(provide 'pixel-scroll) 721(provide 'pixel-scroll)