Eval top level defuns inside comment forms (#2323)

Since this is a sensitive codepath (cider-defun-at-point), it is risky
to change its behavior due to introducing bugs or introducing
unexpected behavior. This _should_ only affect evaluation inside a
comment form but we want to be careful. Therefore there is a defcustom
`cider-eval-toplevel-inside-comment-form` while others test this. If
there is a bug, it is easy for users to turn this feature off completely.

1 files changed, 74 insertions, 7 deletions

diff --git a/cider-util.el b/cider-util.el
index 6ad2acd3..95edc087 100644
--- a/cider-util.el
+++ b/cider-util.el
@@ -96,17 +96,84 @@ If BUFFER is provided act on that buffer instead."
 
 
 ;;; Thing at point
+
+(defun cider--text-or-limits (bounds start end)
+  "Returns the substring or the bounds of text.
+If BOUNDS is non-nil, returns the list (START END) of character
+positions.  Else returns the substring from START to END."
+  (funcall (if bounds #'list #'buffer-substring-no-properties)
+           start end))
+
+(defun cider-top-level-comment-p ()
+  "Return non-nil if point is in a comment form."
+  (save-excursion
+    (end-of-defun)
+    (clojure-backward-logical-sexp 1)
+    (forward-char 1)
+    (clojure-forward-logical-sexp 1)
+    (clojure-backward-logical-sexp 1)
+    (looking-at-p "comment")))
+
+(defcustom cider-eval-toplevel-inside-comment-form nil
+  "Eval top level forms inside comment forms instead of the comment form itself.
+Experimental.  Function `cider-defun-at-point' is used extensively so if we
+change this heuristic it needs to be bullet-proof and desired.  While
+testing, give an easy way to turn this new behavior off."
+  :group 'cider
+  :type 'boolean
+  :package-version '(cider . "0.18.0"))
+
+(defun cider-sexp-starts-until-position (position)
+  "Returns the starting points for forms before POSITION.
+Positions are in descending order to aide in finding the first starting
+position before the current position."
+  (save-excursion
+    (let (sexp-positions)
+      (condition-case nil
+          (while (< (point) position)
+            (clojure-forward-logical-sexp 1)
+            (clojure-backward-logical-sexp 1)
+            (push (point) sexp-positions)
+            (clojure-forward-logical-sexp 1))
+        (scan-error nil))
+      sexp-positions)))
+
+(defun cider-defun-inside-comment-form (&optional bounds)
+  "Return the toplevel form inside a comment containing point.
+Assumes point is inside a (comment ....) form and will return the text of
+that form or if BOUNDS, will return a list of the starting and ending
+position."
+  (save-excursion
+    (save-match-data
+      (let ((original-position (point))
+            cider-comment-start cider-comment-end)
+        (end-of-defun)
+        (setq cider-comment-end (point))
+        (clojure-backward-logical-sexp 1) ;; beginning of comment form
+        (setq cider-comment-start (point))
+        (forward-char 1)                  ;; skip paren so we start at comment
+        (clojure-forward-logical-sexp)    ;; skip past the comment form itself
+        (if-let* ((sexp-start (seq-find (lambda (beg-pos) (< beg-pos original-position))
+                                        (cider-sexp-starts-until-position cider-comment-end))))
+            (progn
+              (goto-char sexp-start)
+              (clojure-forward-logical-sexp 1)
+              (cider--text-or-limits bounds sexp-start (point)))
+          (cider--text-or-limits bounds cider-comment-start cider-comment-end))))))
+
 (defun cider-defun-at-point (&optional bounds)
   "Return the text of the top level sexp at point.
 If BOUNDS is non-nil, return a list of its starting and ending position
 instead."
-  (save-excursion
-    (save-match-data
-      (end-of-defun)
-      (let ((end (point)))
-        (clojure-backward-logical-sexp 1)
-        (funcall (if bounds #'list #'buffer-substring-no-properties)
-                 (point) end)))))
+  (if (and cider-eval-toplevel-inside-comment-form
+           (cider-top-level-comment-p))
+      (cider-defun-inside-comment-form bounds)
+    (save-excursion
+      (save-match-data
+        (end-of-defun)
+        (let ((end (point)))
+          (clojure-backward-logical-sexp 1)
+          (cider--text-or-limits bounds (point) end))))))
 
 (defun cider-ns-form ()
   "Retrieve the ns form."