Consecutive result overlays can now be seen (#3259)

pestctrl · web-flow · commit e9324acf8139 · 2022-10-28T13:25:03.000+03:00
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.
diff --git 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
@@ -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
@@ -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)
