Subject: 29.1; Pixel scroll doesn't work on platforms that do not expose device-class.
From: Jared Finder <[email-masked]>
To: [email-masked]
Date: Tue, 26 Dec 2023 13:01:30 -0800
List-Id: <debbugs-submit.debbugs.gnu.org>

Pixel scroll does not work on many platforms, such as Windows and Mac as
they only expose device classes core-keyboard and core-pointer.
Additionally, I have found that for Wayland under WSL on the emacs-29
branch, both the touchpad and the mouse are reported with device-class
'mouse on my Thinkpad laptop.

The attached patch enables a user to specify arbitrary device classes
that should cause interpolated scrolling so they can fix any issues.
This enables a user to customize this to the behavior of their local
machine.

I am undecided if this should involve renaming the existing
pixel-scroll-precision-interpolate-mice option or if it is important to
stay backward compatible with customizations that changed that option
from its default, t, to some other non-nil value.  Please give feedback
here.

Otherwise, this is a straightforward change that I think would be good
for the Emacs 29 branch so all platforms can get the smoothness of
interpolated pixel scrolling.

In GNU Emacs 29.1 (build 2, x86_64-pc-linux-gnu, GTK+ Version 3.24.37,
  cairo version 1.16.0) of 2023-09-11, modified by Debian built on melete
System Description: Debian GNU/Linux 12 (bookworm)

Configured using:
  'configure --build x86_64-linux-gnu --prefix=/usr
  --sharedstatedir=/var/lib --libexecdir=/usr/libexec
  --localstatedir=/var/lib --infodir=/usr/share/info
  --mandir=/usr/share/man --with-libsystemd --with-pop=yes
  
--enable-locallisppath=/etc/emacs:/usr/local/share/emacs/29.1/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/29.1/site-lisp:/usr/share/emacs/site-lisp
  --with-sound=alsa --without-gconf --with-mailutils
  --with-native-compilation --build x86_64-linux-gnu --prefix=/usr
  --sharedstatedir=/var/lib --libexecdir=/usr/libexec
  --localstatedir=/var/lib --infodir=/usr/share/info
  --mandir=/usr/share/man --with-libsystemd --with-pop=yes
  
--enable-locallisppath=/etc/emacs:/usr/local/share/emacs/29.1/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/29.1/site-lisp:/usr/share/emacs/site-lisp
  --with-sound=alsa --without-gconf --with-mailutils
  --with-native-compilation --with-pgtk 'CFLAGS=-g -O2
  -ffile-prefix-map=/build/emacs-N816CI/emacs-29.1+1=. 
-fstack-protector-strong
  -Wformat -Werror=format-security -Wall' 'CPPFLAGS=-Wdate-time
  -D_FORTIFY_SOURCE=2' LDFLAGS=-Wl,-z,relro'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 MODULES NATIVE_COMP
NOTIFY INOTIFY PDUMPER PGTK PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS TREE_SITTER WEBP XIM GTK3 ZLIB

Important settings:
   value of $LANG: en_US.UTF-8
   locale-coding-system: utf-8-unix

Major mode: Fundamental

Minor modes in effect:
   global-window-tool-bar-mode: t
   pixel-scroll-precision-mode: t
   recentf-mode: t
   global-subword-mode: t
   global-form-feed-st-mode: t
   icomplete-mode: t
   fido-mode: t
   electric-pair-mode: t
   delete-selection-mode: t
   cua-mode: t
   bar-cursor-mode: t
   url-handler-mode: t
   global-eldoc-mode: t
   show-paren-mode: t
   electric-indent-mode: t
   mouse-wheel-mode: t
   tool-bar-mode: t
   menu-bar-mode: t
   file-name-shadow-mode: t
   context-menu-mode: t
   global-font-lock-mode: t
   blink-cursor-mode: t
   window-divider-mode: t
   buffer-read-only: t
   column-number-mode: t
   line-number-mode: t
   transient-mark-mode: t
   auto-composition-mode: t
   auto-encryption-mode: t
   auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr cursor-sensor emacsbug finder-inf comp comp-cstr
cl-extra help-mode markdown-mode rx color thingatpt noutline outline
cus-edit pp cus-start cus-load window-tool-bar easy-mmode time-stamp
tab-line pixel-scroll recentf tree-widget wid-edit cap-words superword
subword form-feed-st icomplete elec-pair delsel cua-base bar-cursor
ls-lisp advice log-edit message sendmail yank-media puny dired
dired-loaddefs rfc822 mml mml-sec epa derived epg rfc6068 epg-config
gnus-util time-date mm-decode mm-bodies mm-encode mail-parse rfc2231
rfc2047 rfc2045 mm-util ietf-drums mail-prsvr mailabbrev mail-utils
gmm-utils mailheader pcvs-util add-log warnings icons compile
text-property-search comint ansi-osc ansi-color ring init-dir
bar-cursor-autoloads dired-icon-autoloads form-feed-st-autoloads
init-dir-autoloads markdown-mode-autoloads modus-themes-autoloads
package-lint-autoloads compat-autoloads info slime-autoloads
window-tool-bar-autoloads package browse-url url url-proxy url-privacy
url-expand url-methods url-history url-cookie generate-lisp-file
url-domsuf url-util mailcap url-handlers url-parse auth-source cl-seq
eieio eieio-core password-cache json map byte-opt bytecomp byte-compile
url-vars modus-vivendi-theme modus-themes cl-macs pcase subr-x
cl-loaddefs cl-lib gv rmc iso-transl tooltip cconv eldoc paren electric
uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/pgtk-win pgtk-win term/common-win pgtk-dnd tool-bar dnd fontset
image regexp-opt fringe tabulated-list replace newcomment text-mode
lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch
easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify
dynamic-setting system-font-setting font-render-setting cairo gtk pgtk
lcms2 multi-tty make-network-process native-compile emacs)

Memory information:
((conses 16 539696 29472)
  (symbols 48 22620 0)
  (strings 32 141326 2762)
  (string-bytes 1 3451370)
  (vectors 16 35478)
  (vector-slots 8 662830 21925)
  (floats 8 236 225)
  (intervals 56 505 10)
  (buffers 984 14))
From dfb4e33e9ed40c364a11f5faf23f3e7b87b88d54 Mon Sep 17 00:00:00 2001
From: Jared Finder <[email-masked]>
Date: Tue, 26 Dec 2023 12:44:40 -0800
Subject: [PATCH] Allow interpolation with arbitrary device classes

* lisp/pixel-scroll.el (pixel-scroll-precision-interpolate-mice)
(pixel-scroll-precision-interpolate-devices): Change boolean option to
list so it can support mulitple device class symbols and rename it for
clarity.
* (pixel-scroll--interpolate-based-on-device-class-p): New function for
backward compatibile check against above option.
* (pixel-scroll-precision): Call it.
---
 lisp/pixel-scroll.el | 46 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 36 insertions(+), 10 deletions(-)

diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 5f412bf418a..f82f95153b5 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -212,13 +212,31 @@ pixel-scroll-precision-interpolate-page
   :type 'boolean
   :version "29.1")
 
-(defcustom pixel-scroll-precision-interpolate-mice t
-  "Whether or not to interpolate scrolling from a mouse.
-If non-nil, scrolling from the mouse wheel of an actual mouse (as
-opposed to a touchpad) will cause Emacs to interpolate the scroll."
+(define-obsolete-variable-alias
+  'pixel-scroll-precision-interpolate-mice
+  'pixel-scroll-precision-interpolate-devices
+  "29.2")
+
+(defcustom pixel-scroll-precision-interpolate-devices (list 'mouse)
+  "List of device classes that will cause interpolated scrolling.
+Interpolated scrolling looks good for devices that generate
+significant scroll distance per event, such as mice, and looks
+poor for devices that have ery small distance events, such as
+high precision touchpads.
+
+See `device-class' for possible device classes.
+
+For backward compatibility, this also can be set to t, which is
+equivalent to '(mouse)."
   :group 'scrolling
-  :type 'boolean
-  :version "29.1")
+  :type '(list
+          (checklist :inline t
+                     (const :tag "Mouse" mouse)
+                     (const :tag "Generic pointing device" core-pointer))
+          (repeat :inline t
+                  :tag "Other devices"
+                  symbol))
+  :version "29.2")
 
 (defun pixel-scroll-in-rush-p ()
   "Return non-nil if next scroll should be non-smooth.
@@ -700,10 +718,8 @@ pixel-scroll-precision
             (if (> (abs delta) (window-text-height window t))
                 (mwheel-scroll event nil)
               (with-selected-window window
-                (if (or (and pixel-scroll-precision-interpolate-mice
-                             (eq (device-class last-event-frame
-                                               last-event-device)
-                                 'mouse))
+                (if (or (pixel-scroll--interpolate-based-on-device-class-p
+                         (device-class last-event-frame last-event-device))
                         (and pixel-scroll-precision-large-scroll-height
                              (> (abs delta)
                                 pixel-scroll-precision-large-scroll-height)
@@ -732,6 +748,16 @@ pixel-scroll-precision
                      (message (error-message-string '(end-of-buffer))))))))))
       (mwheel-scroll event nil))))
 
+(defun pixel-scroll--interpolate-based-on-device-class-p (class)
+  "Return whether this device class should always interpolate scrolling.
+CLASS is a value returned from `device-class'."
+  (and pixel-scroll-precision-interpolate-devices
+       (memq class
+             (if (eq pixel-scroll-precision-interpolate-devices t)
+                 ;; Emacs 29.1 had this as a boolean, defaulting to t.
+                 '(mouse)
+               pixel-scroll-precision-interpolate-devices))))
+
 ;; isearch-scroll support
 (put 'pixel-scroll-precision 'scroll-command t)
 
-- 
2.39.2