branch: elpa/cider
commit e9324acf81391f089932c657b70031ae3c3d0824
Author: Benson Chu <bensonchu...@gmail.com>
Commit: GitHub <nore...@github.com>
Consecutive result overlays can now be seen (#3259)
Previously, if multiple overlays were created one after another that
are meant to last for one command, every second overlay wouldn't show
up.
This is because there's some bad hook management causing the second
overlay in a sequence to be deleted. Whenever we're creating a second
overlay, the first one is automatically removed. But,
`cider--remove-result-overlay' is still in the `post-command-hook',
and thus, right after the second overlay is created, it's immediately
deleted.
Instead, when we're creating a new overlay, we should call remove any
instances of `cider--remove-result-overlay' in the
`post-command-hook', so that the newly created overlay doesn't get
hosed.
---
CHANGELOG.md | 1 +
cider-overlays.el | 7 ++
test/cider-overlay-tests.el | 193 +++++++++++++++++++++++++++++++++++++++-----
3 files changed, 180 insertions(+), 21 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index caac9cba15..260cb5b216 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -15,6 +15,7 @@
- Remove needless quotes from the choices of
`cider-jack-in-auto-inject-clojure`.
- [#2561](https://github.com/clojure-emacs/cider/issues/2561): Disable undo in
`*cider-test-report*` buffers.
- [#3251](https://github.com/clojure-emacs/cider/pull/3251): Disable undo in
`*cider-stacktrace*` buffers.
+- Consecutive overlays will not be spuriously deleted.
## 1.5.0 (2022-08-24)
diff --git a/cider-overlays.el b/cider-overlays.el
index 95788ad029..3c56e8060f 100644
--- a/cider-overlays.el
+++ b/cider-overlays.el
@@ -231,6 +231,8 @@ overlay."
;; inherit the face of the following text.
(display-string (format (propertize format 'face 'default)
value))
(o nil))
+ ;; Remove any overlay at the position we're creating a new one, if it
+ ;; exists.
(remove-overlays beg end 'category type)
(funcall (if cider-overlays-use-font-lock
#'font-lock-prepend-text-property
@@ -260,6 +262,11 @@ overlay."
(pcase duration
((pred numberp) (run-at-time duration nil #'cider--delete-overlay
o))
(`command
+ ;; Since the previous overlay was already removed above, we should
+ ;; remove the hook to remove all overlays after this function
+ ;; ends. Otherwise, we would inadvertently remove the newly
created
+ ;; overlay too.
+ (remove-hook 'post-command-hook 'cider--remove-result-overlay
'local)
;; If inside a command-loop, tell `cider--remove-result-overlay'
;; to only remove after the *next* command.
(if this-command
diff --git a/test/cider-overlay-tests.el b/test/cider-overlay-tests.el
index 50aa2f707f..fc59ea73a5 100644
--- a/test/cider-overlay-tests.el
+++ b/test/cider-overlay-tests.el
@@ -18,55 +18,206 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
-
(require 'buttercup)
+(require 'cl-lib)
+
(require 'cider-overlays)
+(defmacro cider--overlay-temp-buffer (&rest body)
+ "Run `body' in a temp buffer with some text. Also set `this-command' to
+true by default, as some parts of `cider--make-result-overlay rely on it
+being set that way"
+ (declare (indent 0)
+ (debug (&rest form)))
+ `(with-temp-buffer
+ ;; Will block some tests if this is not set
+ (setq comment-start ";;")
+ (insert "(+ 1 2)")
+ (save-excursion
+ (insert "\n(+ 3 4)")
+ (insert "\n(+ 5 6)")
+ (insert "\n(+ 7 8)")
+ (insert "\n(+ 9 0)"))
+ (let ((this-command t))
+ ,@body)))
+
(defmacro cider--with-overlay (overlay-args &rest body)
- "Run BODY in a temp buffer, with overlays created."
+ "Use temp buffer created by `cider--overlay-temp-buffer', and create an
overlay"
(declare (indent 1)
(debug (sexp sexp &rest form)))
- `(with-temp-buffer
- (insert "garbage")
- (save-excursion (insert "\nmore trash"))
- (cider--make-result-overlay ,@overlay-args)
- ,@body))
-
+ `(cider--overlay-temp-buffer
+ (let ((this-command t))
+ (cider--make-result-overlay ,@overlay-args)
+ ,@body)))
+
+(defconst cider-overlay--scale-time 0.01)
+
+(defun cider-overlay--scale-down-time (args)
+ (let ((plist (cdr args)))
+ (when-let* ((value (plist-get plist :duration))
+ ((numberp value)))
+ (setf (plist-get plist :duration)
+ (* value cider-overlay--scale-time))
+ (setf (cdr args) plist)))
+ args)
+
+(defun sleep--scale-down-time (args)
+ (list (* cider-overlay--scale-time (car args))))
+
+(defun cider-overlay--safe-to-speed-up-tests ()
+ (and (<= 28 emacs-major-version)
+ (not (member system-type
+ '(ms-dos windows-nt cygwin)))))
(describe "cider--make-result-overlay"
- :var (overlay-position this-command)
+ :var (overlay-count this-command)
(before-all
- (fset 'overlay-position (lambda ()
- ;; FIXME: Why map `overlay-start' (or anything
- ;; else) since the result is only ever compared
- ;; to nil?
- (mapcar #'overlay-start
- (overlays-at (point-min))))))
+ (fset 'overlay-count (lambda ()
+ (save-excursion
+ (goto-char (point-min))
+ (let ((the-count 0))
+ (while (not (eobp))
+ (setq the-count (+ the-count
+ (length (overlays-at
(point)))))
+ (forward-line 1))
+ the-count))))
+ (fset 'end-of-next-line (lambda ()
+ (forward-line)
+ (end-of-line)))
+ (when (cider-overlay--safe-to-speed-up-tests)
+ (advice-add #'cider--make-result-overlay
+ :filter-args
+ #'cider-overlay--scale-down-time)
+ (advice-add #'sleep-for
+ :filter-args
+ #'sleep--scale-down-time)))
+
+ (after-all
+ (when (cider-overlay--safe-to-speed-up-tests)
+ (advice-remove #'cider--make-result-overlay
+ #'cider-overlay--scale-down-time)
+ (advice-remove #'sleep-for
+ #'sleep--scale-down-time)))
(it "can create overlays"
+ (cider--overlay-temp-buffer
+ ;; When there are no overlays, there are no overlays
+ (expect (not (overlays-at (point-min))) :to-be-truthy))
+
(cider--with-overlay ("ok")
+ ;; When there are overlays, there are overlays.
(expect (overlays-at (point-min)) :to-be-truthy)))
+ (describe "for all types of overlays"
+ (it "creating multiple in the same spot will result in the old one being
deleted"
+ (cider--overlay-temp-buffer
+ (dotimes (i 2)
+ (dolist (type '(4 command change))
+ (dotimes (i 3)
+ (cider--make-result-overlay "ok" :duration type)
+ (expect (overlay-count) :to-equal 1)))))))
+
(describe "when overlay duration is `command`"
- (it "erases overlays after the next command is executed"
+ (it "will stay stay for one command"
(cider--with-overlay ("ok" :duration 'command)
+ ;; post-command-hook runs right after overlay is created, so this isn't
+ ;; simulating the next command
(run-hooks 'post-command-hook)
- (run-hooks 'post-command-hook)
- (expect (overlay-position) :to-equal nil))
+ (expect (overlay-count) :to-equal 1)))
+ (it "erases overlays after the next command is executed"
(cider--with-overlay ("ok" :duration 'command)
+ ;; Running post-command-hook twice indicates that not only was the
+ ;; overlay created, but that another command was run after that.
+ (dotimes (i 2)
+ (expect (overlay-count) :to-equal 1)
+ (run-hooks 'post-command-hook))
+ (expect (overlay-count) :to-equal 0))
+
+ (cider--overlay-temp-buffer
+ ;; Instead of the previous test, we can also set this-command to nil,
+ ;; indicating to cider--make-result-overlay that the overlay was
created
+ ;; non-interactively, and thus should be deleted after one
+ ;; post-command-hook.
(setq this-command nil)
+ (cider--make-result-overlay "ok" :duration 'command)
(run-hooks 'post-command-hook)
- (expect (overlay-position) :to-equal nil))))
+ (expect (overlay-count) :to-equal 0)))
+
+ (it "will not erase overlays if they're created consecutively"
+ (cider--overlay-temp-buffer
+ (dotimes (i 2)
+ (cider--make-result-overlay "ok" :duration 'command)
+ (run-hooks 'post-command-hook)
+ (expect (overlay-count) :to-equal 1)))))
(describe "when overlay duration is given in secs"
(it "erases overlays after that duration"
(cider--with-overlay ("ok" :duration 1.5)
(sleep-for 1)
- (expect (overlay-position) :not :to-equal nil)
+ (expect (overlay-count) :to-equal 1)
+ (sleep-for 1)
+ (expect (overlay-count) :to-equal 0)))
+
+ (it "overlays will be erased independently of each other"
+ (cider--overlay-temp-buffer
+ (cider--make-result-overlay "ok" :duration 1.5)
+ (end-of-next-line)
+ (cider--make-result-overlay "ok" :duration 0.5)
+ (expect (overlay-count) :to-equal 2)
+ (sleep-for 1)
+ (expect (overlay-count) :to-equal 1)
(sleep-for 1)
- (expect (overlay-position) :to-equal nil)))))
+ (expect (overlay-count) :to-equal 0)))
+
+ (it "overlays don't respond to commands being run or insertions"
+ (cider--overlay-temp-buffer
+ (cider--make-result-overlay "ok" :duration 1)
+ (run-hooks 'post-command-hook)
+ (run-hooks 'post-command-hook)
+ (insert "Hello")
+ (expect (overlay-count) :to-equal 1)))
+
+ (it "duration overlays are currently the only overlays that can be deleted
independently from the other types"
+ (cider--overlay-temp-buffer
+ ;; Create overlays
+ (dolist (type '(0.5 1.5 command change))
+ (cider--make-result-overlay "ok" :duration type)
+ (end-of-next-line))
+ (expect (overlay-count) :to-equal 4)
+ ;; Doing nothing but sit there, one overlay should be removed just
+ ;; because of that.
+ (sleep-for 1)
+ (expect (overlay-count) :to-equal 3)
+ (sleep-for 1)
+ (expect (overlay-count) :to-equal 2))))
+
+ (describe "when overlay duration is `change'"
+ (it "will not erase from running commands"
+ (cider--with-overlay ("ok" :duration 'change)
+ (dotimes (i 3)
+ (run-hooks 'post-command-hook)
+ (expect (overlay-count) :to-equal 1))))
+
+ (it "will change after making modifications to the buffer"
+ (cider--with-overlay ("ok" :duration 'change)
+ (insert "Hello")
+ (expect (overlay-count) :to-equal 0)))
+
+ (it "multiple overlays can be created before they are all destroyed"
+ (cider--overlay-temp-buffer
+ (cider--make-result-overlay "ok" :duration 'change)
+ (expect (overlay-count) :to-be 1)
+
+ (end-of-next-line)
+ (run-hooks 'post-command-hook)
+ (run-hooks 'post-command-hook)
+ (cider--make-result-overlay "ok" :duration 'change)
+ (expect (overlay-count) :to-be 2)
+
+ (insert "Hello")
+ (expect (overlay-count) :to-be 0)))))
(describe "cider--delete-overlay"
:var (overlay-position)
