branch: externals/topspace
commit 7741d88dcae11a83af707f749c30d498318ded9a
Author: Trevor Pogue <pogu...@mcmaster.ca>
Commit: Trevor Pogue <pogu...@mcmaster.ca>
Increase test coverage
---
.github/workflows/test.yml | 2 +-
.gitignore | 3 +
test/test-helper.el | 1 +
test/topspace-test.el | 245 ++++++++++++++++++++++++++++++---------------
topspace.el | 29 +++---
5 files changed, 187 insertions(+), 93 deletions(-)
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index e7988ab1c9..3dd84b5ae3 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -6,7 +6,7 @@ jobs:
strategy:
matrix:
emacs_version:
-# - 25.1 remove untill coveralls reporting error is debugged
+ - 25.1
- 26.1
- 27.1
- 28.1
diff --git a/.gitignore b/.gitignore
index c5c0ca413c..3c603c71e4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,6 +2,9 @@
.projectile
*.elc
.cask
+Eldev
+.eldev
+topspace.log
coverage/
cask-run
test/director/
\ No newline at end of file
diff --git a/test/test-helper.el b/test/test-helper.el
index c7169f8ab9..e59761bf66 100644
--- a/test/test-helper.el
+++ b/test/test-helper.el
@@ -11,6 +11,7 @@
(undercover "*.el"
;; (:report-file "coverage/.resultset.json")
;; (:report-format 'simplecov)
+ ;; (:report-format 'text)
))
(require 'smooth-scrolling)
diff --git a/test/topspace-test.el b/test/topspace-test.el
index 5c4eb852c3..486a0fd4e6 100644
--- a/test/topspace-test.el
+++ b/test/topspace-test.el
@@ -1,4 +1,4 @@
-;;; test-topspace.el --- Main test file -*- lexical-binding: t; -*-
+;;; test-topspace.el --- Main test file -*- lexical-binding: t -*-
;; Copyright (C) 2022 Trevor Edwin Pogue
@@ -6,6 +6,29 @@
;;; Code:
+(setq topspace--log-target '(file . "~/topspace/topspace.log"))
+(setq topspace--start-time (float-time))
+
+(defun topspace--log (message)
+ "Log MESSAGE."
+ (when topspace--log-target
+ (let ((log-line (format "%06d %s\n"
+ (round (- (* 1000 (float-time))
+ (* 1000 topspace--start-time)))
+ message))
+ (target-type (car topspace--log-target))
+ (target-name (cdr topspace--log-target)))
+ (pcase target-type
+ ('buffer
+ (with-current-buffer (get-buffer-create target-name)
+ (goto-char (point-max))
+ (insert log-line)))
+ ('file
+ (let ((save-silently t))
+ (append-to-file log-line nil target-name)))
+ (_
+ (error "Unrecognized log target type: %S" target-type))))))
+
(defmacro topspace--cmds (&rest cmds)
"Run CMDS with command hooks."
(let ((result '(progn)))
@@ -18,63 +41,74 @@
))))
result))
-(describe "topspace"
- :var (prev-height)
-
- (before-all
- (topspace--cmds (set-frame-size (selected-frame) 101 24))
- (switch-to-buffer (find-file-noselect "./topspace.el" t))
- (global-topspace-mode 1))
-
- (before-each (switch-to-buffer "topspace.el")
- (setq smooth-scrolling-mode nil))
-
- (it "reduces top space height before cursor can move below window-end"
- (goto-char 1)
- (topspace--draw 0)
- (topspace--cmds
- (scroll-down)
- (scroll-up)
- (scroll-down)
- )
- (setq prev-height (topspace-height))
- (topspace--cmds
- (next-line))
- (expect (topspace-height) :to-equal (1- prev-height))
- (topspace--cmds (next-line) (next-line))
- (expect (topspace-height) :to-equal (- prev-height 3)))
-
- (it "moves cursor up before cursor is scrolled below window-end"
- (topspace--cmds (scroll-down-line))
- (expect (topspace-height) :to-equal (- prev-height 2))
- (topspace--cmds
- (scroll-down-line)
- (scroll-down-line))
- (expect (topspace-height) :to-equal prev-height)
- (topspace--cmds (scroll-up-line))
- (expect (topspace-height) :to-equal (1- prev-height)))
-
- (describe "topspace--after-scroll"
- (it "is needed when first scrolling above the top line"
- (progn (topspace--cmds (goto-char 1)
- (topspace--draw 0))
- (topspace--cmds (scroll-up-line))
- (condition-case nil (scroll-down 2)
- (error (print 'wtf))))
- (expect (topspace-height) :to-equal 0)))
-
- (describe "topspace--window-configuration-change"
- (it "autocenters buffer when window size changes"
+(describe
+ "topspace"
+ :var (prev-height)
+
+ (before-all
+ (topspace--cmds (set-frame-size (selected-frame) 90 24))
+ (switch-to-buffer (find-file-noselect "./topspace.el" t))
+ (global-topspace-mode)
+ )
+
+ (before-each (switch-to-buffer "topspace.el"))
+
+ (it "reduces top space height before cursor can move below window-end"
+ (goto-char 1)
+ (topspace--draw 0)
+ (topspace--cmds
+ (scroll-down)
+ (scroll-up)
+ (scroll-down)
+ )
+ (setq prev-height (topspace-height))
+ (topspace--cmds
+ (next-line))
+ (expect (topspace-height) :to-equal (1- prev-height))
+ (topspace--cmds (next-line 4))
+ (expect (topspace-height) :to-equal (- prev-height 5))
+ (topspace--cmds (scroll-down 2)))
+
+ (it "moves cursor up before cursor is scrolled below window-end"
+ (topspace--cmds (scroll-down-line))
+ (expect (topspace-height) :to-equal (- prev-height 2))
+ (topspace--cmds
+ (scroll-down-line)
+ (scroll-down-line))
+ (expect (topspace-height) :to-equal prev-height)
+ (topspace--cmds (scroll-up-line))
+ (expect (topspace-height) :to-equal (1- prev-height)))
+
+ (describe
+ "topspace--after-scroll"
+ (it "is needed when first scrolling above the top line"
+ (goto-char 1)
+ (topspace--draw 0)
+ (scroll-up-line)
+ (scroll-down 2)
+ (expect (round (topspace-height)) :to-equal 1)))
+
+ (describe
+ "topspace--window-configuration-change"
+
+ (it "autocenters buffer when window size changes"
(switch-to-buffer "*scratch*")
- (topspace--cmds (set-frame-size (selected-frame) 101 24))
(run-hooks 'window-configuration-change-hook)
(expect (round (* (topspace-height) 10)) :to-equal 86)
- (topspace--cmds (set-frame-size (selected-frame) 101 22))
+ (topspace--cmds (set-frame-size (selected-frame) 90 22))
(run-hooks 'window-configuration-change-hook)
- (expect (round (* (topspace-height) 10)) :to-equal 78)))
-
- (describe "topspace-mode"
- (it "can be enabled and disabled locally"
+ (expect (round (* (topspace-height) 10)) :to-equal 78)
+ (topspace--cmds (set-frame-size (selected-frame) 90 24)))
+
+ (it "will redraw topspace even if window height didn't change
+in case topspace-autocenter-buffers changed return value"
+ (spy-on 'topspace--draw)
+ (topspace--window-configuration-change)
+ (expect 'topspace--draw :to-have-been-called)))
+
+ (describe
+ "topspace-mode"
+ (it "can be enabled and disabled locally"
(topspace-mode -1)
(expect topspace-mode :to-equal nil)
(scroll-up-line)
@@ -82,53 +116,106 @@
(expect (topspace-height) :to-equal 0)
(ignore-errors (scroll-down-line))
(topspace-mode 1)
- (expect topspace-mode :to-equal t)
- ))
+ (expect topspace-mode :to-equal t)))
- (describe "topspace--draw-increase-height"
- (it "increases top space height"
+ (describe
+ "topspace--draw-increase-height"
+ (it "increases top space height"
(goto-char 1)
(recenter)
(setq prev-height (topspace-height))
(topspace--draw-increase-height 1)
(expect (topspace-height) :to-equal (1+ prev-height))))
- (describe "topspace--draw-increase-height"
- (it "increases top space height"
- (goto-char 1)
- (recenter)
- (setq prev-height (topspace-height))
- (topspace--draw-increase-height 1)
- (expect (topspace-height) :to-equal (1+ prev-height))))
-
- (describe "topspace--after-recenter"
- (it "adds top space if recentering near top of buffer"
+ (describe
+ "topspace--after-recenter"
+ (it "adds top space if recentering near top of buffer"
(goto-char 1)
(recenter)
(expect (round (topspace-height)) :to-equal (/ (window-height) 2))
(recenter -1)
(expect (round (topspace-height)) :to-equal (- (window-height) 2))))
- (describe "topspace--previous-line"
- (it "is to be used like previous-line but non-interactively"
+ (describe
+ "topspace--previous-line"
+ (it "is to be used like previous-line but non-interactively"
(goto-char 1)
(next-line)
(topspace--previous-line)
- (expect (line-number-at-pos) :to-equal 1)))
-
- (describe "topspace--smooth-scroll-lines-above-point"
- (it "allows smooth-scrolling package to work with topspace"
- (expect (topspace--smooth-scroll-lines-above-point)
- :to-equal (smooth-scroll-lines-above-point))))
+ (expect (line-number-at-pos) :to-equal 1)
+ (should-error (topspace--previous-line))))
+
+ (describe
+ "topspace--smooth-scroll-lines-above-point"
+ (it "allows smooth-scrolling package to work with topspace"
+ :to-equal (smooth-scroll-lines-above-point)
+ (progn (goto-char 1)
+ (topspace--draw 0)
+ (goto-line smooth-scroll-margin)
+ (set-window-start (selected-window) (point))
+ (scroll-down smooth-scroll-margin)
+ (setq smooth-scrolling-mode nil)
+ (call-interactively 'smooth-scrolling-mode))
+ (previous-line)
+ (previous-line)
+ (expect (round (topspace-height)) :to-equal 2)
+ (setq smooth-scrolling-mode nil)
+ ))
- (describe "topspace-default-empty-line-indicator"
- (it "can return a string with an indicator in left-fringe"
+ (describe
+ "topspace-default-empty-line-indicator"
+ (it "can return a string with an indicator in left-fringe"
(setq indicate-empty-lines t)
(let ((bitmap (catch 'tag (dolist (x fringe-indicator-alist)
(when (eq (car x) 'empty-line)
(throw 'tag (cdr x)))))))
(expect (topspace-default-empty-line-indicator) :to-equal
(propertize " " 'display (list `left-fringe bitmap
- `fringe)))))))
+ `fringe))))))
+ (describe
+ "topspace--count-lines"
+ ;; TODO: figure out how to test cask on a graphical emacs frame with display
+ ;; (it "can count lines if window-absolute-pixel-position returns non-nil"
+ ;; (expect (display-graphic-p) :to-equal nil)
+ ;; (make-frame-on-display ":0")
+ ;; (topspace--log (frame-list))
+ ;; (sit-for 1)
+ ;; (with-selected-window
+ ;; ;; (switch-to-buffer "topspace.el")
+ ;; (frame-selected-window (car (frames-on-display-list)))
+ ;; (expect (round (topspace--count-lines (point-min) (point-max)))
+ ;; :to-equal
+ ;; (line-number-at-pos (point-max)))))
+
+ (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))
+ )))
+
+ (describe
+ "topspace--correct-height"
+ (it "fixes topspace height when larger than max valid value"
+ (let ((max-height
+ (- (topspace--window-height) (topspace--context-lines))))
+ (expect (topspace--correct-height (1+ max-height))
+ :to-equal max-height))))
+
+ (describe
+ "topspace-height"
+ (it "by default returns 0 for new buffer when topspace-autocenter-buffers
+returns nil"
+ (let ((prev-autocenter-val topspace-autocenter-buffers))
+ (setq topspace--heights '())
+ (setq topspace-autocenter-buffers nil)
+ (expect (topspace-height) :to-equal 0)
+ (setq topspace-autocenter-buffers prev-autocenter-val))))
+
+ (describe
+ "topspace--current-line-plus-topspace"
+ (it "can accept an arg or no args"
+ (expect (topspace--current-line-plus-topspace)
+ :to-equal (topspace--current-line-plus-topspace
+ (topspace-height))))))
;;; test-topspace.el ends here
diff --git a/topspace.el b/topspace.el
index f55a0f6d02..34f9e75933 100644
--- a/topspace.el
+++ b/topspace.el
@@ -59,6 +59,9 @@
;;; Code:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Debugging
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Private variables
@@ -220,7 +223,14 @@ 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)
- (list (topspace--scroll total-lines)))))
+ (setq total-lines (topspace--scroll total-lines))
+ (let ((window-start-visual-line))
+ (when (< (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))))))
(defun topspace--filter-args-scroll-up (&optional total-lines)
"Run before `scroll-up' for scrolling above the top line.
@@ -400,12 +410,10 @@ If that doesn't work it uses
`topspace--count-lines-slower'."
((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-lines-slower end old-end) 0)
- (if (< old-start start)
- (topspace--count-lines-slower old-start start) 0)))
+ (+ (/ (- (cdr end-y) (cdr start-y)) (float (default-line-height)))
+ (if (> old-end end) (topspace--count-lines-slower end old-end) 0)
+ (if (< old-start start)
+ (topspace--count-lines-slower 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-lines-slower start old-end))))))
@@ -479,12 +487,7 @@ lines: if either `auto-window-vscroll' or TRY-VSCROLL is
nil, this
function will not vscroll.
ARG defaults to 1."
(or arg (setq arg 1))
- (if (called-interactively-p 'interactive)
- (condition-case err
- (line-move (- arg) nil nil try-vscroll)
- ((beginning-of-buffer end-of-buffer)
- (signal (car err) (cdr err))))
- (line-move (- arg) nil nil try-vscroll))
+ (line-move (- arg) nil nil try-vscroll)
nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
