1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
| | ;;; window-tests.el -- tests for window.c -*- lexical-binding: t -*-
;; Copyright (C) 2016 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; This program 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.
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(defun window-test-scrolling (margin &optional effective-margin)
(unless effective-margin
(setq effective-margin margin))
(erase-buffer)
(insert (mapconcat #'number-to-string
(number-sequence 1 200) "\n"))
(goto-char 1)
(sit-for 0)
(let ((scroll-margin margin)
(mode-lines (/ (window-mode-line-height) (line-pixel-height)))
(wstart (window-start)))
;; Stopping before `scroll-margin' so we shouldn't have
;; scrolled.
(let ((current-prefix-arg (- (window-height)
mode-lines (window-start) effective-margin)))
(call-interactively 'next-line))
(sit-for 0)
(should (= wstart (window-start)))
;; Passing `scroll-margin' should trigger scrolling.
(call-interactively 'next-line)
(sit-for 0)
(should (/= wstart (window-start)))
;; Scroll back to top.
(let ((current-prefix-arg (window-start)))
(call-interactively 'scroll-down-command))
(sit-for 0)
(should (= 1 (window-start)))))
(defmacro window-with-test-buffer-window (&rest body)
(declare (debug t))
(let ((bufvar (make-symbol "buf")))
`(let ((,bufvar (get-buffer-create "*test*")))
(with-selected-window (display-buffer ,bufvar)
(with-current-buffer ,bufvar
,@body)))))
(ert-deftest window-test-scroll-margin-0 ()
(skip-unless (not noninteractive))
(window-with-test-buffer-window
(window-test-scrolling 0)))
(ert-deftest window-test-scroll-margin-negative ()
"A negative `scroll-margin' should be the same as 0."
(skip-unless (not noninteractive))
(window-with-test-buffer-window
(window-test-scrolling -10 0)))
(ert-deftest window-test-scroll-margin-max ()
(skip-unless (not noninteractive))
(window-with-test-buffer-window
(let* ((mode-lines (/ (window-mode-line-height) (line-pixel-height)))
(max-margin (/ (- (window-height) mode-lines) 4)))
(window-test-scrolling max-margin))))
(ert-deftest window-test-scroll-margin-over-max ()
"A `scroll-margin' more than max should be the same as max."
(skip-unless (not noninteractive))
(window-with-test-buffer-window
;; Check that mode line is not counted for determining max margin.
(set-window-text-height nil 7)
(let* ((mode-lines (/ (window-mode-line-height) (line-pixel-height)))
(max-margin (/ (- (window-height) mode-lines) 4)))
(window-test-scrolling (+ max-margin 1) max-margin)
(window-test-scrolling (+ max-margin 2) max-margin))))
(defun window-test--point-in-middle-of-window-p ()
(= (count-lines (window-start) (window-point))
(- (count-lines (window-point) (window-end)) 1
(if (pos-visible-in-window-p (window-end)) 0 1))))
(ert-deftest window-test-scroll-margin-whole-window ()
"Test `maximum-scroll-margin' at 0.5.
With a high `scroll-margin', this should keep cursor in the
middle of the window."
(skip-unless (not noninteractive))
(let ((maximum-scroll-margin 0.5)
(scroll-margin 100))
(window-with-test-buffer-window
(set-window-text-height nil 7)
(erase-buffer)
(insert (mapconcat #'number-to-string
(number-sequence 1 200) "\n"))
(goto-char 1)
(sit-for 0)
(call-interactively 'scroll-up-command)
(sit-for 0)
(should (window-test--point-in-middle-of-window-p))
(call-interactively 'scroll-up-command)
(sit-for 0)
(should (window-test--point-in-middle-of-window-p))
(call-interactively 'scroll-down-command)
(sit-for 0)
(should (window-test--point-in-middle-of-window-p)))))
|