From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: E Sabof Newsgroups: gmane.emacs.bugs Subject: bug#18923: Alternative scrolling model Date: Sun, 02 Nov 2014 01:15:52 +0000 Message-ID: <87wq7e9zcn.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1414891058 15305 80.91.229.3 (2 Nov 2014 01:17:38 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 2 Nov 2014 01:17:38 +0000 (UTC) To: 18923@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Nov 02 02:17:29 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XkjnJ-0001d0-Vb for geb-bug-gnu-emacs@m.gmane.org; Sun, 02 Nov 2014 02:17:26 +0100 Original-Received: from localhost ([::1]:54259 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XkjnJ-00005p-Ba for geb-bug-gnu-emacs@m.gmane.org; Sat, 01 Nov 2014 21:17:25 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39251) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xkjn7-00005S-1V for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:17:22 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Xkjmx-00049g-UX for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:17:12 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:47699) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xkjmx-00049b-QK for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:17:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Xkjmx-0006Ew-HW for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:17:03 -0400 X-Loop: help-debbugs@gnu.org Resent-From: E Sabof Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 02 Nov 2014 01:17:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 18923 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.141489099723918 (code B ref -1); Sun, 02 Nov 2014 01:17:03 +0000 Original-Received: (at submit) by debbugs.gnu.org; 2 Nov 2014 01:16:37 +0000 Original-Received: from localhost ([127.0.0.1]:44912 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XkjmV-0006Df-Se for submit@debbugs.gnu.org; Sat, 01 Nov 2014 21:16:36 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:37432) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XkjmO-0006D9-S4 for submit@debbugs.gnu.org; Sat, 01 Nov 2014 21:16:30 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XkjmA-0003jf-Hn for submit@debbugs.gnu.org; Sat, 01 Nov 2014 21:16:23 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:48218) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XkjmA-0003jb-EV for submit@debbugs.gnu.org; Sat, 01 Nov 2014 21:16:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39130) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xkjm1-0008U1-8t for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:16:14 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Xkjls-0003hm-49 for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:16:05 -0400 Original-Received: from mail-wi0-x22c.google.com ([2a00:1450:400c:c05::22c]:54907) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xkjlr-0003he-Pb for bug-gnu-emacs@gnu.org; Sat, 01 Nov 2014 21:15:56 -0400 Original-Received: by mail-wi0-f172.google.com with SMTP id bs8so3915382wib.11 for ; Sat, 01 Nov 2014 18:15:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:date:message-id:mime-version:content-type; bh=BZZkluwX4sD68jHjX/oaNjcMxxS/E78GIqnXfxhZ0Z0=; b=UeOIKc+a7rPBMBUYDUExyzgwgSusylW9y0ufJDvhEJhzidf1c65gcNVQ1w2AqL1RVY c4rOKsY7JOQL0PwkdPt1nu+bNgwNd5sJN6tOdgMboS0bqWU17orIHF4/8wNXMkosUJGR 4SveathCeET/X7ZWpl9bs934u1KLmEq7Uo9zcn1BfSgtHIx278iykFb8xBQhbixpPObK nLB4FZ8Eh4HhVIvagiNHJAZUdby1v467v5Dib6tcD0P+M7EurKWB36PSUT82MWPB6Y7n PaZlyErHR8dhHBP2wHztERT5WmL9Vkj2rB3eVE0g+Z9u/QHgEbiSYkPD8D0lBl/LexAa Zrww== X-Received: by 10.180.182.195 with SMTP id eg3mr6813800wic.31.1414890954548; Sat, 01 Nov 2014 18:15:54 -0700 (PDT) Original-Received: from ubuntu ([31.185.153.108]) by mx.google.com with ESMTPSA id bc1sm2812065wib.16.2014.11.01.18.15.53 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sat, 01 Nov 2014 18:15:53 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:95363 I've made a prototype for an alternative way to scroll. Essentially scrolling is done pixelwise irrespective of content. Whole lines are scrolled "normally", and the remainder is vscrolled. If the end result is close to a line boundary it gets "snapped" to it. This prevents unpleasant jumping when encountering an image. It doesn't handle the "image taller than window" case, but it would if `st-height' could measure more accurately. Evgeni ;; Any vscroll adjustements will be reset by line-move (require 'cl-lib) (defun st-message (&rest args) ;; (apply 'message args) ) (defvar st-ov nil) (defun st-height (&optional pos) "Won't report accurately, if the line is higher than window." (cl-flet (( posn-y () (cdr (posn-x-y (or (posn-at-point) (progn (vertical-motion 0) (set-window-start nil (point)) (posn-at-point))))))) (save-excursion (save-window-excursion (let* ((ws (window-vscroll nil t)) a b) (when (cl-plusp ws) (set-window-vscroll nil 0 t)) (setq a (posn-y)) (vertical-motion 1) (setq b (posn-y)) (when (cl-plusp ws) (set-window-vscroll nil ws t)) (- b a) ))))) (cl-defun st-get-lines (ammount) "Provide the information required to scroll by AMMOUNT. AMMOUNT can be positive, if scrolling towards the end of the buffer, or negative otherwise. Returns \(list vscroll \(list lines\)\), where \"vscroll\" is the current \(window-vscroll\) and \"lines\" are the lines are enogh or more lines required for to scroll." (let* (( direction (if (cl-plusp ammount) 1 -1)) ( vscroll (window-vscroll nil t)) rows) (save-excursion (goto-char (window-start)) (cl-incf ammount vscroll) (when (cl-minusp direction) (unless (cl-minusp ammount) (cl-return-from st-get-lines (list vscroll nil))) (vertical-motion -1)) (cl-loop do (push (st-height) rows) until (or (zerop (vertical-motion direction)) ;; >= ? (>= (cl-reduce '+ rows) (abs ammount)))) (list vscroll (nreverse rows))))) (cl-defun st-move (lines vscroll) ;; vscroll changes aren't always displayed. Haven't found a work-around for this. (let (( ori-point (point)) ( new-ws (save-excursion (goto-char (window-start)) (vertical-motion lines) (point)))) (progn (set-window-start nil new-ws) ;; If I don't do this, vscroll might get reset to 0 ;; (point) might change after this ;; (window-start) might change after this, if the cursor is positioned on ;; that image, and scrolling down. This always happends if image would be ;; split at the bottom, but sometimes it happens earlier. What follows is ;; a work-around. (redisplay t) (when (/= (window-start) new-ws) ;; (message "HIT") (vertical-motion -1) (set-window-start nil new-ws) (redisplay t) ) ) (set-window-vscroll nil vscroll t) ;; Prevents flashes of incorrectly positioned images ;; (window-start) might change after this, if the cursor is on an image and ;; it might get divided on the upper edge (redisplay t) (when (/= (window-start) new-ws) ;; (message "HIT2") (vertical-motion 1) (set-window-start nil new-ws) (redisplay t) ) )) (cl-defun scroll--backtick (&optional (arg 1) pixelwise snap) (interactive) (let* (( default-height (default-line-height)) ( pixels-to-move (if pixelwise arg (* arg default-height))) ( snap (or snap (/ default-height 2))) ( line-info (st-get-lines (- pixels-to-move))) ( heights (cadr line-info)) ( initial-vscroll (car line-info)) ( excess 0) enough-or-too-many-heights too-few-heights) (if (<= pixels-to-move initial-vscroll) (progn (setq heights nil excess (- initial-vscroll pixels-to-move))) (cl-decf pixels-to-move initial-vscroll) (setq enough-or-too-many-heights (cl-reduce '+ heights) too-few-heights (cl-reduce '+ (butlast heights) :initial-value 0)) (cond ( (= enough-or-too-many-heights pixels-to-move) (st-message "Exact %s" heights) ) ( (> pixels-to-move enough-or-too-many-heights) (st-message "Near edge %s > %s" pixels-to-move enough-or-too-many-heights) (setq excess 0)) ( (<= (- enough-or-too-many-heights snap) pixels-to-move) (st-message "Snap out") (setq excess 0)) ( (and (cl-plusp too-few-heights) (>= (+ too-few-heights snap) pixels-to-move)) (st-message "Snap in %s" heights) (setq excess 0) (setq heights (butlast heights)) ) ( t (st-message "Default") (setq excess (- enough-or-too-many-heights pixels-to-move)) ))) (st-move (- (length heights)) excess) )) (cl-defun scroll-tick (&optional (arg 1) pixelwise snap) (interactive) (cond ( (zerop arg) (cl-return-from scroll-tick)) ( (< arg 0) (cl-return-from scroll-tick (scroll--backtick (- arg) pixelwise snap)))) (when st-ov (delete-overlay st-ov)) (let* (( default-height (default-line-height)) ( pixels-to-move (if pixelwise arg (* arg default-height))) ( snap (or snap (/ default-height 2))) ( line-info (st-get-lines pixels-to-move)) ( heights (cadr line-info)) ( initial-vscroll (car line-info)) excess enough-or-too-many-heights too-few-heights) (cl-incf pixels-to-move initial-vscroll) (setq enough-or-too-many-heights (cl-reduce '+ heights) too-few-heights (cl-reduce '+ (butlast heights) :initial-value 0) excess (if (= enough-or-too-many-heights pixels-to-move) 0 (- pixels-to-move too-few-heights))) (cond ( (= enough-or-too-many-heights pixels-to-move) (st-message "Exact %s" heights) ) ( (> pixels-to-move enough-or-too-many-heights) (st-message "Near edge") (setq excess 0)) ( (<= (- enough-or-too-many-heights snap) pixels-to-move) (st-message "Snap out") (setq excess 0)) ( (and (cl-plusp too-few-heights) (>= (+ too-few-heights snap) pixels-to-move)) (st-message "Snap in %s" heights) (setq excess 0) (setq heights (butlast heights)) ) ( t (st-message "Default") (setq heights (butlast heights)) )) (st-move (length heights) excess) )) ;; (global-set-key (kbd "") (lambda () (interactive) (scroll-tick 10))) ;; (global-set-key (kbd "") (lambda () (interactive) (scroll-tick -10))) ;; TESTS ;; (require 'noflet) ;; (ert-deftest scroll-tick () ;; (noflet (( st-move (&rest args) args)) ;; (noflet (( st-get-lines (arg) ;; '(0 (30)))) ;; ;; Simple V-scroll ;; (should (equal (scroll-tick 5 t 0) ;; '(0 5))) ;; ;; Simple exact ;; (should (equal (scroll-tick 30 t 0) ;; '(1 0))) ;; ) ;; (noflet (( st-get-lines (arg) ;; '(0 (5 30)))) ;; ;; Complete line + vscroll ;; (should (equal (scroll-tick 15 t 0) ;; '(1 10))) ;; ;; Complete 2 lines ;; (should (equal (scroll-tick 35 t 0) ;; '(2 0))) ;; ) ;; (noflet (( st-get-lines (arg) ;; '(5 (10 20)))) ;; ;; ;; (should (equal (scroll-tick 20 t 0) ;; '(1 15))) ;; ;; Complete 2 lines ;; (should (equal (scroll-tick 25 t 0) ;; '(2 0))) ;; )) ;; ) ;; (ert-deftest scroll-backtick () ;; (noflet (( st-move (&rest args) args)) ;; (noflet (( st-get-lines (arg) ;; '(0 (30)))) ;; ;; Simple V-scroll ;; (should (equal (scroll-tick -5 t 0) ;; '(-1 25))) ;; ;; Simple exact ;; (should (equal (scroll-tick -30 t 0) ;; '(-1 0)))) ;; (noflet (( st-get-lines (arg) ;; '(0 (5 30)))) ;; ;; Complete line + vscroll ;; (should (equal (scroll-tick -15 t 0) ;; '(-2 20))) ;; ;; Complete 2 lines ;; (should (equal (scroll-tick -35 t 0) ;; '(-2 0))) ;; ) ;; (noflet (( st-get-lines (arg) ;; '(5 (10)))) ;; ;; Scroll across existing vscroll + a bit ;; (should (equal (scroll-tick -10 t 0) ;; '(-1 5))) ;; ) ;; (noflet (( st-get-lines (arg) ;; '(5 (10 20)))) ;; ;; Scroll up a bit ;; (should (equal (scroll-tick -1 t 0) ;; '(0 4))) ;; ;; Remove vscroll ;; (should (equal (scroll-tick -5 t 0) ;; '(0 0))) ;; ;; ;; (should (equal (scroll-tick -20 t 0) ;; '(-2 15))) ;; ) ;; ) ;; )