[elpa] externals/hyperbole a4c41006cf 066/143: *ert* buffer - make {.} jump to interactively defined test def

[ELPA Syncer]

branch: externals/hyperbole
commit a4c41006cf18515cc15b289a9057c6543bd65e80
Author: bw <rsw@gnu.org>
Commit: bw <rsw@gnu.org>

    *ert* buffer - make {.} jump to interactively defined test def
    
    Previously, had to have loaded the test def from a file; now can use
    TAGS files to find its location.  Use this incantation to set this up.
    
      (setq find-function-regexp-alist
            (assq-delete-all 'ert--test find-function-regexp-alist))
      ;; Could also set this to `smart-lisp-find-tag' instead of 
`xref-find-definitions'.
      (add-to-list 'find-function-regexp-alist '(ert--test . 
xref-find-definitions))
---
 ChangeLog     | 11 +++++++++++
 hmouse-tag.el | 23 +++++++++++++++++------
 hypb-ert.el   | 30 +++++++++++++++++-------------
 3 files changed, 45 insertions(+), 19 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 1a63095476..73b6e5f1d7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
 2024-01-05  Bob Weiner  <rsw@gnu.org>
 
+* hypb-ert.el (hypb-ert-run-test-at-definition): Accept a symbol as
+    a 'test-name' argument.
+
+* hmouse-tag.el (smart-emacs-lisp-mode-p): Include 'ert-results-mode'.
+                (smart-lisp-find-tag): Allow 'tag' arg to be a symbol,
+    not just a string.  This allows it to be used as a target function
+    in 'find-function-regexp-alist' which is used in the ert results buffer
+    with the {.} command to jump to the ert test definition at point.
+                (xref-definitions, xref-definition): Rewrite to handle
+    ert-deftests.
+
 * Makefile (test-all): Change 'ert-run-tests-interactively' to
     'ert-run-tests-batch' because this shows tracebacks of any tests that
     fail in the *Messages* buffer, speeding debugging.  Although it does
diff --git a/hmouse-tag.el b/hmouse-tag.el
index e67c427f40..00c54cc6bf 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    24-Aug-91
-;; Last-Mod:     29-Dec-23 at 00:52:05 by Bob Weiner
+;; Last-Mod:      5-Jan-24 at 14:02:46 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -36,12 +36,20 @@
      (max (point-min) (if (eolp) (1- (point)) (point)))
      'xref-item))
   (when (not (fboundp 'xref-definition))
-    (defun xref-definition (identifier)
-      "Return the first definition of string IDENTIFIER."
-      (car (xref-backend-definitions (xref-find-backend) identifier)))
     (defun xref-definitions (identifier)
       "Return a list of all definitions of string IDENTIFIER."
-      (xref-backend-definitions (xref-find-backend) identifier))
+      (let* ((elisp-flag (smart-emacs-lisp-mode-p))
+            (xref-backend (or (and elisp-flag
+                                   (fboundp 'ert-test-boundp)
+                                   (ert-test-boundp identifier)
+                                   (boundp 'xref-etags-mode)
+                                   'etags)
+                              (xref-find-backend)))
+            (xref-items (xref-backend-definitions xref-backend identifier)))
+       xref-items))
+    (defun xref-definition (identifier)
+      "Return the first definition of string IDENTIFIER."
+      (car (xref-definitions identifier)))
     (defun xref-item-buffer (item)
       "Return the buffer in which xref ITEM is defined."
       (marker-buffer (save-excursion (xref-location-marker (xref-item-location 
item)))))
@@ -422,7 +430,8 @@ If:
   ;; Beyond Lisp files, Emacs Lisp symbols appear frequently in Byte-Compiled
   ;; buffers, debugger buffers, program ChangeLog buffers, Help buffers,
   ;; *Warnings*, *Flymake log* and *Flymake diagnostics... buffers.
-  (or (memq major-mode #'(emacs-lisp-mode lisp-interaction-mode debugger-mode))
+  (or (memq major-mode #'(emacs-lisp-mode lisp-interaction-mode
+                                         debugger-mode ert-results-mode))
       (string-match-p (concat "\\`\\*\\(Warnings\\|Flymake 
log\\|Compile-Log\\(-Show\\)?\\)\\*"
                              "\\|\\`\\*Flymake diagnostics")
                      (buffer-name))
@@ -698,6 +707,8 @@ Use `hpath:display-buffer' to show definition or 
documentation."
                              (if current-prefix-arg
                                  "Show doc for" "Find")))
         current-prefix-arg))
+  (when (and tag (symbolp tag))
+    (setq tag (symbol-name tag)))
   (unless (stringp tag)
     (setq tag (if (stringp hkey-value) hkey-value (smart-lisp-at-tag-p t))))
   (let* ((elisp-flag (smart-emacs-lisp-mode-p))
diff --git a/hypb-ert.el b/hypb-ert.el
index 389461633c..ce5745718a 100644
--- a/hypb-ert.el
+++ b/hypb-ert.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell <matsl@gnu.org> and Bob Weiner <rsw@gnu.org>
 ;;
 ;; Orig-Date:    31-Mar-21 at 21:11:00
-;; Last-Mod:      4-Jan-24 at 14:10:39 by Mats Lidell
+;; Last-Mod:      5-Jan-24 at 15:11:42 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -32,17 +32,19 @@
 (eval-and-compile (mapc #'require '(lisp-mode hload-path ert hact hbut hargs)))
 
 (defun hypb-ert-message-function (_msg-pat &rest _args)
-  "Ignore messages ert outputs so can display messages from tests run."
+  "Ignore the messages ert outputs so can display its test messages."
   ;; (identity (apply #'format msg-pat args)))))))
   nil)
 
-(defun hypb-ert (selector)
+(defun hypb-ert (test-selector)
+  "Run all ert TEST-SELECTOR tests.
+See documentation for `ert-select-tests' for TEST-SELECTOR types."
   (if (memq 'message-fn (actype:params #'ert-run-tests-interactively))
       ;; Suppress ert messages so last test case message stays in the 
minibuffer;
       ;; 3rd arg message-fn available only in Emacs 27 and earlier
       (with-suppressed-warnings ((callargs ert))
-        (ert selector nil #'hypb-ert-message-function))
-    (ert selector))
+        (ert test-selector nil #'hypb-ert-message-function))
+    (ert test-selector))
   ;; ERT can display a long internal data structure as a result, so
   ;; replace it in the minibuffer with a blank message.
   (message ""))
@@ -68,6 +70,7 @@ See documentation for `ert-select-tests' for TEST-SELECTOR 
types."
          (directory-files (expand-file-name "test" hyperb:dir) nil 
"^[a-zA-Z].*\\.el$")))
 
 (defun hypb-ert-require-libraries ()
+  "Load all Hyperbole ert test symbols."
   (mapc #'require (hypb-ert-get-require-symbols)))
 
 (defal hyperbole-run-test  "hypb-ert-run-test"
@@ -78,7 +81,7 @@ See documentation for `ert-select-tests' for TEST-SELECTOR 
types."
 See documentation for `ert-select-tests' for TEST-SELECTOR types.")
 
 (defun hypb-ert-run-all-tests ()
-  "Run every ert test."
+  "Run every Hyperbole ert test."
   (interactive)
   (hypb-ert-require-libraries)
   (hypb-ert t))
@@ -102,19 +105,20 @@ With optional START-END-FLAG, return a list of (test-name 
start-pos end-pos)."
            (list (match-string-no-properties 2) (match-beginning 2) (match-end 
2))
          (match-string-no-properties 2))))))
 
-(defun hypb-ert-run-test-at-definition (test-name &optional debug-it)
-  "Assume on the name in the first line of an ert test def, eval and run the 
test.
-With optional DEBUG-IT non-nil (when the assist-key is pressed), edebug the
-test when it is run."
-  (let ((test-sym (intern-soft test-name)))
+(defun hypb-ert-run-test-at-definition (test-name &optional edebug-it)
+  "Eval and run the ert TEST-NAME defined at point.
+Assume point is on the text of the first line of an ert test def,
+With optional EDEBUG-IT non-nil (when the assist-key is pressed),
+edebug the test when it is run."
+  (let ((test-sym (if (symbolp test-name) test-name (intern-soft test-name))))
     ;; Ensure run the latest version of the test, either with the
     ;; edebugger if already instrumented for it; otherwise, with the
     ;; normal evaluator.
-    (if (and test-sym debug-it)
+    (if (and test-sym edebug-it)
        (edebug-defun)
       (eval-defun nil)
       (setq test-sym (intern-soft test-name))
-      (when (and test-sym debug-it)
+      (when (and test-sym edebug-it)
        (edebug-defun)))
     (setq test-sym (intern-soft test-name))
     (when (and test-sym (ert-test-boundp test-sym))