From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Po Lu Newsgroups: gmane.emacs.devel Subject: Pixel scrolling support Date: Fri, 26 Nov 2021 08:35:12 +0800 Message-ID: <87a6hrzrcv.fsf@yahoo.com> References: <87a6hrzrcv.fsf.ref@yahoo.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="37840"; mail-complaints-to="usenet@ciao.gmane.io" To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Fri Nov 26 01:36:10 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mqPDm-0009h4-Nn for ged-emacs-devel@m.gmane-mx.org; Fri, 26 Nov 2021 01:36:10 +0100 Original-Received: from localhost ([::1]:54166 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mqPDk-0001OR-NF for ged-emacs-devel@m.gmane-mx.org; Thu, 25 Nov 2021 19:36:08 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:48738) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mqPD2-0000dA-F1 for emacs-devel@gnu.org; Thu, 25 Nov 2021 19:35:24 -0500 Original-Received: from sonic310-25.consmr.mail.ne1.yahoo.com ([66.163.186.206]:41288) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mqPCz-0007KR-MY for emacs-devel@gnu.org; Thu, 25 Nov 2021 19:35:24 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=yahoo.com; s=s2048; t=1637886919; bh=z5QwQI2uEsHt/EqWADE9Q1YoNYyW0NZ+Oo89qrLlaOs=; h=From:To:Subject:Date:References:From:Subject:Reply-To; b=gCa5WyFqYR8UvVrjD6UOMfeZTEIgL5W/Gxtx6YWebHCk99I86aRllnnuRKZucWkSELrD9zd2zkp+t4DVIj0N3daoQaQCWodDosUgPRr/j1WJfYJrO8xAEpPzpEPf6XOLte1VrBo9XrNP3BQuhPFfywIMgBfltPAfS7uuiRuAwOf5ge19/mMU1JIyyVwCbJFHDcrH1fWvXzTyvTZ9LB1xWa6Q38D/mvmncuIdHVUaj4TojO7AW5e0cMve0R3mKGCMyhvJA57arhWwTcHAi0bpcT9c1HAlQuj8wRAKwt6RAEe22KUND9yk8Asme2RqZCaoOVrea55OQOVs99fYCyS5Bg== X-SONIC-DKIM-SIGN: v=1; a=rsa-sha256; c=relaxed/relaxed; d=yahoo.com; s=s2048; t=1637886919; bh=yligGGjSRJ4/O3nNqn2xmSllJKTTIDvPPXuGScUHM7c=; h=X-Sonic-MF:From:To:Subject:Date:From:Subject; b=Tc9+PZRWYlBAm1Sb1bnmULiKe33oJPTC4Ugb8L8fb42i2yPnb1qATeTKHDmOkKDAuVxwzzVvpwFxnIA6ciHjjFGjAN7ayAZNpZqpFnmOxdzy+c4m31X26OfzwfCAejegQ4EHDgzsLRocaOpTwzGUxUk/JqWjhl+LRrZJ7T+rK0exEXbH6Y0pks7X3iAavKy96ocABzoLPfKRiZsa46PL2oTxvBGktI35zhjApo3EGG0FAb6wK+wCWQfqMkyAhRDE+Gda9eXB9MqLZ2/rYD5jGMEq6SiX8uDgfKx1p/QsSUa9CWr4nThOh3QhL5N3z5QBt12rnnltqEIBv2/J1GbgdA== X-YMail-OSG: gQCy.d0VM1nnEELozgPls4GzlsKXLlqciajhuZe8kkC1nfxnBqww6kVMJ1qBlQn GI5ToJo35PS.v28txWXBfljarLokBJw2Tm3BSQbbz9JprBYXgb1a20jiDQvBFtoxKzteiqzzlIZb Sq8cvvzC7.jn7b5aSGbC4ujayXvNj7d85l8zZxCNklaLIYXHTEBecFaLEFQIg4VUgc__Ld.7CL12 W.vnGkTTraHbAuYrp6TGjE4Lbl0u4iL2EIa_BLNPQdZ2ryk2hbdH7KBf9lzbPoAXl6f_kWcB.hQA PGMKbadqnFUPn0Rl7CAITXi2OSTD3AE3Zjq1UsACWxz08Q3sy8hsvuHZMYpCe_9lTtQ.x.j7swWR kE6cF4KjubR7UfJxSgPmBQskMl8ZZn00uNWOuBZysTLxPAfhEVKScsVkmjXVSNc0yl4VucVLb9dg 9fSsq4ZUlNvc4Lirism5Udxj3Mi.PJ38PNZGhiNQs8Tg1NNNiRBc4C2nJ3_xlc1kOgJ5P66XnqtG 3b5Q_o1.doumgM8tuWuhTd90hJgrLuXU0WLlglTFzs6LexTqZEEPbjVwJ5GsujhpFbvLxKGtMAg2 3mrGSqQqMYyk6640TIcXWrQueL_HSfh7xietd6ADxi4kqfvLkQTxfo2BaxE.XXMMgouBTB_qc929 Ib2PSRoWfOekU575IEUK._Ku8k4yGM0WAXOmY25uOmMhgbCgbq2_5_POc0uzi5Pp0sP4t7C6aHyo 5ZzWKFQtRQ2xDQBKvvg9lCKql36yHaucvmSUpGD6lOD5yeEXqSxATbBZ.5kazdU3EYHPsx8l_dE1 gFglwMd.7ukHvLW0Em1tcGoenFJ.i9ywbQX6.0bRcu X-Sonic-MF: Original-Received: from sonic.gate.mail.ne1.yahoo.com by sonic310.consmr.mail.ne1.yahoo.com with HTTP; Fri, 26 Nov 2021 00:35:19 +0000 Original-Received: by kubenode513.mail-prod1.omega.sg3.yahoo.com (VZM Hermes SMTP Server) with ESMTPA ID 584fd75312864ab39335cc2381fdb6c1; Fri, 26 Nov 2021 00:35:17 +0000 (UTC) X-Mailer: WebService/1.1.19306 mail.backend.jedi.jws.acl:role.jedi.acl.token.atz.jws.hermes.yahoo Received-SPF: pass client-ip=66.163.186.206; envelope-from=luangruo@yahoo.com; helo=sonic310-25.consmr.mail.ne1.yahoo.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:280184 Archived-At: --=-=-= Content-Type: text/plain I would like to install the following file: --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=better-pixel-scroll.el ;;; 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 . ;;; 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) (defvar x-coalesce-scroll-events) (defvar better-pixel-scroll-mode-map (make-sparse-keymap) "The key map used by `better-pixel-scroll-mode'.") (define-key better-pixel-scroll-mode-map [wheel-down] #'better-pixel-scroll) (define-key better-pixel-scroll-mode-map [wheel-up] #'better-pixel-scroll) (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)))) (if (> delta 0) (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." (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) (setq current-y (- current-y (line-pixel-height))) (when (zerop (vertical-motion -1)) (set-window-vscroll nil 0) (signal 'beginning-of-buffer nil)))) (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) (better-pixel-scroll-scroll-down (- delta)))) (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)) (if (nth 4 event) (let ((delta (round (cdr (nth 4 event)))) (window (mwheel-event-window 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 herea --=-=-= Content-Type: text/plain on master, with an appropriate entry in NEWS. It defines a global minor mode that lets the user scroll the display according to the pixel information reported by his mouse wheel. Is that OK? Thanks. --=-=-=--