branch: externals/topspace
commit 186ea6091a8696adc24b2afa314d919fcf225ca5
Author: Trevor Pogue <pogu...@mcmaster.ca>
Commit: Trevor Pogue <pogu...@mcmaster.ca>
Internal optimizations and refactoring
- Remove uneeded `topspace--count-lines` call in
`topspace--filter-args-scroll-down`
- Make `topspace--count-lines` more accurate by not adding extra 1 to value
- Increase test coverage
- Make tests run in workflow only when a src file is changed
- Add supported Emacs versions badge to readme
---
.github/workflows/test.yml | 2 ++
.gitignore | 1 +
README.md | 6 +++--
test/topspace-test.el | 18 ++++++++++-----
topspace.el | 57 +++++++++++++++++++++++++---------------------
5 files changed, 50 insertions(+), 34 deletions(-)
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index c26fa0c799..8549e60eb4 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -1,6 +1,8 @@
name: Test
on: [ push, pull_request ]
+ paths:
+ - '*.el'
jobs:
test:
runs-on: ubuntu-latest
diff --git a/.gitignore b/.gitignore
index 3c603c71e4..668e2ffa75 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,6 +5,7 @@
Eldev
.eldev
topspace.log
+\#*\#
coverage/
cask-run
test/director/
\ No newline at end of file
diff --git a/README.md b/README.md
index 8d340bfe6c..ddddfb7044 100644
--- a/README.md
+++ b/README.md
@@ -5,9 +5,11 @@
<p align="center">
<a
href="https://github.com/trevorpogue/topspace/actions/workflows/test.yml/";><img
src="https://github.com/trevorpogue/topspace/actions/workflows/test.yml/badge.svg";
height="20"/></a>
- <a href='https://coveralls.io/github/trevorpogue/topspace?branch=main'><img
src='https://coveralls.io/repos/github/trevorpogue/topspace/badge.svg?branch=main&&;'
alt='Coverage Status' /></a>
+ <a href='https://coveralls.io/github/trevorpogue/topspace?branch=main'><img
src='https://coveralls.io/repos/github/trevorpogue/topspace/badge.svg?branch=main&0'
alt='Coverage Status' /></a>
+ <a
href="https://github.com/trevorpogue/topspace/blob/main/.github/workflows/test.yml";><img
src="https://img.shields.io/badge/Supports-Emacs_25.1--28.1-blueviolet.svg?style=flat-square&logo=GNU%20Emacs&logoColor=whit";
height="20"/></a>
<a href="http://melpa.org/#/topspace";><img
src="http://melpa.org/packages/topspace-badge.svg"; height="20"/></a>
<a href="http://stable.melpa.org/#/topspace";><img
src="http://stable.melpa.org/packages/topspace-badge.svg"; height="20"/></a>
+
</p>
<p align="center"><img
src="https://user-images.githubusercontent.com/12535207/164986647-cdb35afa-de45-4e6f-ac16-fad765f9969e.gif"/></p>
@@ -22,7 +24,7 @@
TopSpace is an Emacs minor mode that allows you to scroll down and recenter
top lines by automatically drawing an upper margin/padding above the top line
as you scroll down or recenter top text.
-TopSpace is:
+### Features
* **Easier on the eyes**: Recenter or scroll down top text to a more
comfortable eye level for reading, especially when in full-screen or on a large
monitor.
* **Easy to use**: No new keybindings are required, keep using all your
previous scrolling & recentering commands, except now you can also scroll above
the top lines. It also integrates seamlessly with [centered-cursor-mode][1] to
keep the cursor centered all the way to the top line.
diff --git a/test/topspace-test.el b/test/topspace-test.el
index 486a0fd4e6..22d3a98dea 100644
--- a/test/topspace-test.el
+++ b/test/topspace-test.el
@@ -8,6 +8,7 @@
(setq topspace--log-target '(file . "~/topspace/topspace.log"))
(setq topspace--start-time (float-time))
+(setq topspace--scroll-down-scale-factor 0)
(defun topspace--log (message)
"Log MESSAGE."
@@ -48,8 +49,7 @@
(before-all
(topspace--cmds (set-frame-size (selected-frame) 90 24))
(switch-to-buffer (find-file-noselect "./topspace.el" t))
- (global-topspace-mode)
- )
+ (global-topspace-mode))
(before-each (switch-to-buffer "topspace.el"))
@@ -159,13 +159,13 @@ in case topspace-autocenter-buffers changed return value"
(previous-line)
(previous-line)
(expect (round (topspace-height)) :to-equal 2)
- (setq smooth-scrolling-mode nil)
- ))
+ (setq smooth-scrolling-mode nil)))
(describe
"topspace-default-empty-line-indicator"
(it "can return a string with an indicator in left-fringe"
(setq indicate-empty-lines t)
+ (add-to-list 'fringe-indicator-alist '(up . up-arrow))
(let ((bitmap (catch 'tag (dolist (x fringe-indicator-alist)
(when (eq (car x) 'empty-line)
(throw 'tag (cdr x)))))))
@@ -187,11 +187,17 @@ in case topspace-autocenter-buffers changed return value"
;; :to-equal
;; (line-number-at-pos (point-max)))))
+ (it "can count lines if start is larger than end"
+ (set-window-start (selected-window) 100)
+ (expect (round (topspace--count-lines (point-max) (point-min)))
+ :to-equal
+ (line-number-at-pos (point-max)))
+ (set-window-start (selected-window) 1))
+
(it "can count lines if window-absolute-pixel-position returns nil"
(expect (round (topspace--count-lines (point-min) (point-max)))
:to-equal
- (line-number-at-pos (point-max))
- )))
+ (line-number-at-pos (point-max)))))
(describe
"topspace--correct-height"
diff --git a/topspace.el b/topspace.el
index 8039fb700c..47f1531cb5 100644
--- a/topspace.el
+++ b/topspace.el
@@ -27,7 +27,7 @@
;; by automatically drawing an upper margin/padding above the top line
;; as you scroll down or recenter top text.
-;; TopSpace is:
+;; Features:
;; - Easier on the eyes: Recenter or scroll down top text to a more
;; comfortable eye level for reading, especially when in full-screen
@@ -103,6 +103,12 @@ This flag signals to wait until then to display top
space.")
(defvar topspace--advice-added nil "Keep track if `advice-add` done already.")
+(defvar topspace--scroll-down-scale-factor 1
+ "For eliminating an error when testing in non-interactive batch mode.
+An error occurs in this mode any time `scroll-down' is passed a
+non-zero value, which halts tests and makes testing many topspace features
+impossible. So this variable is set to zero when testing in this mode.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Customization
@@ -223,16 +229,8 @@ TOTAL-LINES is used in the same way as in `scroll-down'."
(setq total-lines (or total-lines (- (topspace--window-height)
next-screen-context-lines)))
(setq topspace--total-lines-scrolling total-lines)
- (setq total-lines (topspace--scroll total-lines))
- (let ((window-start-visual-line))
- (when (and
- (> total-lines 1)
- (< (line-number-at-pos (window-start)) (topspace--window-height)))
- ;; only count lines here otherwise it will take too much compute time
- (setq window-start-visual-line (topspace--count-lines 1
(window-start)))
- (when (> total-lines window-start-visual-line)
- (setq total-lines window-start-visual-line)))
- (list (round total-lines))))))
+ (list (* topspace--scroll-down-scale-factor
+ (topspace--scroll total-lines))))))
(defun topspace--filter-args-scroll-up (&optional total-lines)
"Run before `scroll-up' for scrolling above the top line.
@@ -364,16 +362,18 @@ which must be accounted for in the calling functions."
(defun topspace--count-pixel-height (start end)
"Return total pixels between points START and END as if they're both
visible."
- (setq end (min end (point-max)))
- (setq start (max start (point-min)))
(let ((result 0))
(save-excursion
+ (goto-char end)
+ (beginning-of-visual-line)
+ (setq end (point))
(goto-char start)
+ (beginning-of-visual-line)
(while (< (point) end)
(setq result (+ result (* (vertical-motion 1) (line-pixel-height))))))
result))
-(defun topspace--count-slow (start end)
+(defun topspace--count-lines-slow (start end)
"Return screen lines between points START and END.
Like `topspace--count-lines' but is a slower backup alternative."
(/ (topspace--count-pixel-height start end) (float (default-line-height))))
@@ -384,22 +384,27 @@ Like `count-screen-lines' except `count-screen-lines' will
return unexpected value when END is in column 0. This fixes that issue.
This function also tries to first count the lines using a potentially faster
technique involving `window-absolute-pixel-position'.
-If that doesn't work it uses `topspace--count-slow'."
- (let ((old-end end) (old-start start))
+If that doesn't work it uses `topspace--count-lines-slow'."
+ (setq end (min end (point-max)))
+ (setq start (max start (point-min)))
+ (let ((old-end) (old-start) (swap)
+ (line-height (float (default-line-height))))
+ (when (> start end) (setq swap end) (setq end start) (setq start swap))
+ (setq old-end end) (setq old-start start)
(setq end (min end (- (window-end) 1)))
(setq start (max start (window-start)))
(let ((end-y (window-absolute-pixel-position end))
(start-y (window-absolute-pixel-position start)))
- (cond
- ((and end-y start-y)
- ;; first try counting lines by getting the pixel difference
- ;; between end and start and dividing by `default-line-height'
- (+ (/ (- (cdr end-y) (cdr start-y)) (float (default-line-height)))
- (if (> old-end end) (topspace--count-slow end old-end) 0)
- (if (< old-start start) (topspace--count-slow old-start start) 0)))
- (t ;; if the pixel method above doesn't work do this slower method
- ;; (it won't work if either START or END are not visible in window)
- (topspace--count-slow start old-end))))))
+ (+
+ (if (> old-end end) (topspace--count-lines-slow end old-end) 0)
+ (if (< old-start start) (topspace--count-lines-slow old-start start) 0)
+ (condition-case nil
+ ;; first try counting lines by getting the pixel difference
+ ;; between end and start and dividing by `default-line-height'
+ (/ (- (cdr end-y) (cdr start-y)) line-height)
+ ;; if the pixel method above doesn't work do this slower method
+ ;; (it won't work if either START or END are not visible in window)
+ (error (topspace--count-lines-slow start end)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Overlay drawing
![https://github.com/trevorpogue/topspace/actions/workflows/test.yml/badge.svg"](https://github.com/trevorpogue/topspace/actions/workflows/test.yml/badge.svg"){kind=link}
![https://img.shields.io/badge/Supports-Emacs_25.1--28.1-blueviolet.svg?style=flat-square&logo=GNU%20Emacs&logoColor=whit"](https://img.shields.io/badge/Supports-Emacs_25.1--28.1-blueviolet.svg?style=flat-square&logo=GNU%20Emacs&logoColor=whit"){kind=link}
![http://melpa.org/packages/topspace-badge.svg"](http://melpa.org/packages/topspace-badge.svg"){kind=link}
![http://stable.melpa.org/packages/topspace-badge.svg"](http://stable.melpa.org/packages/topspace-badge.svg"){kind=link}
![https://user-images.githubusercontent.com/12535207/164986647-cdb35afa-de45-4e6f-ac16-fad765f9969e.gif"/](https://user-images.githubusercontent.com/12535207/164986647-cdb35afa-de45-4e6f-ac16-fad765f9969e.gif"/){kind=link}