mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-18 20:10:31 -07:00
Code Issues Projects Releases Wiki Activity

Move the precision pixel scrolling feature to pixel-scroll.el

Browse source 
* etc/NEWS: Update NEWS entry for 'pixel-scroll-precision-mode'

* lisp/better-pixel-scroll.el: Remove file.

* src/pixel-scroll.el (x-coalesce-scroll-events): New variable
declaration.
(pixel-scroll-precision-mode-map): New variable.
(pixel-scroll-precision-scroll-down):
(pixel-scroll-precision-scroll-up):
(pixel-scroll-precision): New functions.
(pixel-scroll-precision-mode): New minor mode.
This commit is contained in:
Po Lu 2021-11-26 17:42:45 +08:00
parent 673eadaeb5
commit 5d6e1c749a
3 changed files with 127 additions and 151 deletions
Download patch file Download diff file Expand all files Collapse all files

10
etc/NEWS
View file

@ -94,10 +94,12 @@ This controls the thickness of the external borders of the menu bars
and pop-up menus.
---
** New minor mode 'better-pixel-scroll-mode'.
When enabled, using this mode with a capable scroll wheel will result
in the display being scrolled precisely according to the turning of
that wheel.
** New minor mode 'pixel-scroll-precision-mode'.
When enabled, you can scroll the display up or down by individual
pixels in a way that corresponds with the movement of your mouse
wheel, if supported by the mouse wheel. Unlike 'pixel-scroll-mode',
this mode scrolls the display pixel-by-pixel, as opposed to only
animating line-by-line scrolls.
** Terminal Emacs

147
lisp/better-pixel-scroll.el
View file

@ -1,147 +0,0 @@
;;; better-pixel-scroll.el --- Pixel scrolling support -*- lexical-binding:t -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This enables the use of smooth scroll events provided by XInput 2
;; or NS to scroll the display according to the user's precise turning
;; of the mouse wheel.
;;; Code:
(require 'mwheel)
(require 'subr-x)
(defvar x-coalesce-scroll-events)
(defvar better-pixel-scroll-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [wheel-down] #'better-pixel-scroll)
(define-key map [wheel-up] #'better-pixel-scroll)
map)
"The key map used by `better-pixel-scroll-mode'.")
(defun better-pixel-scroll-scroll-down (delta)
"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 (+ (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)
(error "End of buffer")))
(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)
(error "End of buffer")))))
(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))))
(unless (eq (window-start) desired-start)
(set-window-start nil desired-start t))
(set-window-vscroll nil desired-vscroll t))))
(defun better-pixel-scroll-scroll-up (delta)
"Scroll the current window up by DELTA pixels."
(when-let* ((max-y (- (window-text-height nil t)
(window-tab-line-height)
(window-header-line-height)))
(posn (posn-at-point))
(current-y (+ (cdr (posn-x-y posn))
(cdr (posn-object-width-height posn)))))
(while (< (- max-y current-y) delta)
(vertical-motion -1)
(setq current-y (- current-y (line-pixel-height)))))
(let ((current-vscroll (window-vscroll nil t)))
(setq delta (- delta current-vscroll))
(set-window-vscroll nil 0 t))
(while (> delta 0)
(set-window-start nil (save-excursion
(goto-char (window-start))
(when (zerop (vertical-motion -1))
(set-window-vscroll nil 0)
(signal 'beginning-of-buffer nil))
(setq delta (- delta (line-pixel-height)))
(point))
t))
(when (< delta 0)
(when-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))))
(unless (eq (window-start) desired-start)
(set-window-start nil desired-start t))
(set-window-vscroll nil desired-vscroll t))))
(defun better-pixel-scroll (event &optional arg)
"Scroll the display according to EVENT.
Take into account any pixel deltas in EVENT to scroll the display
according to the user's turning the mouse wheel. If EVENT does
not have precise scrolling deltas, call `mwheel-scroll' instead.
ARG is passed to `mwheel-scroll', should that be called."
(interactive (list last-input-event current-prefix-arg))
(let ((window (mwheel-event-window event)))
(if (and (nth 4 event)
(zerop (window-hscroll window)))
(let ((delta (round (cdr (nth 4 event)))))
(if (> (abs delta) (window-text-height window t))
(mwheel-scroll event arg)
(with-selected-window window
(if (< delta 0)
(better-pixel-scroll-scroll-down (- delta))
(better-pixel-scroll-scroll-up delta)))))
(mwheel-scroll event arg))))
;;;###autoload
(define-minor-mode better-pixel-scroll-mode
"Toggle pixel scrolling.
When enabled, this minor mode allows to scroll the display
precisely, according to the turning of the mouse wheel."
:global t
:group 'mouse
:keymap better-pixel-scroll-mode-map
(setq x-coalesce-scroll-events
(not better-pixel-scroll-mode)))
(provide 'better-pixel-scroll)
;;; better-pixel-scroll.el ends here.

121
lisp/pixel-scroll.el
View file

@ -67,6 +67,7 @@
;;; Code:
(require 'mwheel)
(require 'subr-x)
(defvar pixel-wait 0
"Idle time on each step of pixel scroll specified in second.
@ -90,6 +91,15 @@ is always with pixel resolution.")
(defvar pixel-last-scroll-time 0
"Time when the last scrolling was made, in second since the epoch.")
(defvar x-coalesce-scroll-events)
(defvar pixel-scroll-precision-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [wheel-down] #'pixel-scroll-precision)
(define-key map [wheel-up] #'pixel-scroll-precision)
map)
"The key map used by `pixel-scroll-precision-mode'.")
(defun pixel-scroll-in-rush-p ()
"Return non-nil if next scroll should be non-smooth.
When scrolling request is delivered soon after the previous one,
@ -354,5 +364,116 @@ Otherwise, redisplay will reset the window's vscroll."
(set-window-start nil (pixel-point-at-unseen-line) t)
(set-window-vscroll nil vscroll t))
;; FIXME: This doesn't work when DELTA is larger than the height
;; of the current window, and someone should probably fix that
;; at some point.
(defun pixel-scroll-precision-scroll-down (delta)
"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))))
(desired-start (posn-point desired-pos))
(desired-vscroll (cdr (posn-object-x-y desired-pos))))
(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."
(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)))
(setq delta (- delta current-vscroll))
(set-window-vscroll nil 0 t))
(while (> delta 0)
(set-window-start nil (save-excursion
(goto-char (window-start))
(when (zerop (vertical-motion -1))
(set-window-vscroll nil 0)
(signal 'beginning-of-buffer nil))
(setq delta (- delta (line-pixel-height)))
(point))
t))
(when (< delta 0)
(when-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))))
(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.
(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
scroll the display according to the user's turning the mouse
wheel."
(interactive "e")
(let ((window (mwheel-event-window event)))
(if (and (nth 4 event)
(zerop (window-hscroll window)))
(let ((delta (round (cdr (nth 4 event)))))
(if (> (abs delta) (window-text-height window t))
(mwheel-scroll event nil)
(with-selected-window window
(if (< delta 0)
(pixel-scroll-precision-scroll-down (- delta))
(pixel-scroll-precision-scroll-up delta)))))
(mwheel-scroll event nil))))
;;;###autoload
(define-minor-mode pixel-scroll-precision-mode
"Toggle pixel scrolling.
When enabled, this minor mode allows to scroll the display
precisely, according to the turning of the mouse wheel."
:global t
:group 'mouse
:keymap pixel-scroll-precision-mode-map
(setq x-coalesce-scroll-events
(not pixel-scroll-precision-mode)))
(provide 'pixel-scroll)
;;; pixel-scroll.el ends here