master 55cc8b040b: Make which-func-mode output less junk

[Lars Ingebrigtsen]

branch: master
commit 55cc8b040b0e3c5f97fd1386d1e9c5a120be6340
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make which-func-mode output less junk
    
    * lisp/emacs-lisp/lisp-mode.el (lisp-current-defun-name): Use
    edebug specs to find the name (if they exist), and default to
    returning the top-level symbol if there isn't a define-like form
    (bug#49592).
---
 lisp/emacs-lisp/lisp-mode.el            | 64 +++++++++++++++++++++++----------
 lisp/progmodes/which-func.el            |  3 ++
 test/lisp/emacs-lisp/lisp-mode-tests.el | 23 ++++++++++++
 3 files changed, 72 insertions(+), 18 deletions(-)

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index c906ee6e31..2e7f019aa9 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -728,30 +728,58 @@ font-lock keywords will not be case sensitive."
            len))))
 
 (defun lisp-current-defun-name ()
-  "Return the name of the defun at point, or nil."
+  "Return the name of the defun at point.
+If there is no defun at point, return the first symbol from the
+top-level form.  If there is no top-level form, return nil.
+
+(\"defun\" here means \"form that defines something\", and is
+decided heuristically.)"
   (save-excursion
-    (let ((location (point)))
+    (let ((location (point))
+          name)
       ;; If we are now precisely at the beginning of a defun, make sure
       ;; beginning-of-defun finds that one rather than the previous one.
-      (or (eobp) (forward-char 1))
+      (unless (eobp)
+        (forward-char 1))
       (beginning-of-defun)
       ;; Make sure we are really inside the defun found, not after it.
-      (when (and (looking-at "\\s(")
-                (progn (end-of-defun)
-                       (< location (point)))
-                (progn (forward-sexp -1)
-                       (>= location (point))))
-       (if (looking-at "\\s(")
-           (forward-char 1))
-       ;; Skip the defining construct name, typically "defun" or
+      (when (and (looking-at "(")
+                (progn
+                   (end-of-defun)
+                  (< location (point)))
+                (progn
+                   (forward-sexp -1)
+                  (>= location (point))))
+       (when (looking-at "(")
+         (forward-char 1))
+       ;; Read the defining construct name, typically "defun" or
        ;; "defvar".
-       (forward-sexp 1)
-       ;; The second element is usually a symbol being defined.  If it
-       ;; is not, use the first symbol in it.
-       (skip-chars-forward " \t\n'(")
-       (buffer-substring-no-properties (point)
-                                       (progn (forward-sexp 1)
-                                              (point)))))))
+        (let ((symbol (ignore-errors (read (current-buffer)))))
+          (when (and symbol (not (symbolp symbol)))
+            (setq symbol nil))
+          ;; If there's an edebug spec, use that to determine what the
+          ;; name is.
+          (when symbol
+            (let ((spec (get symbol 'edebug-form-spec)))
+              (save-excursion
+                (when (and (eq (car spec) '&define)
+                           (memq 'name spec))
+                  (pop spec)
+                  (while (and spec (not name))
+                    (let ((candidate (ignore-errors (read (current-buffer)))))
+                      (when (eq (pop spec) 'name)
+                        (setq name candidate
+                              spec nil))))))))
+          ;; We didn't have an edebug spec (or couldn't find the
+          ;; name).  If the symbol starts with \"def\", then it's
+          ;; likely that the next symbol is the name.
+          (when (and (not name)
+                     (string-match-p "\\`def" (symbol-name symbol)))
+            (when-let ((candidate (ignore-errors (read (current-buffer)))))
+              (when (symbolp candidate)
+                (setq name candidate))))
+          (when-let ((result (or name symbol)))
+            (symbol-name result)))))))
 
 (defvar-keymap lisp-mode-shared-map
   :doc "Keymap for commands shared by all sorts of Lisp modes."
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 2e8e8d2319..4fe4edc164 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -61,6 +61,9 @@
 
 ;;; Code:
 
+;; So that we can use the edebug spec in `lisp-current-defun-name'.
+(require 'edebug)
+
 ;; Variables for customization
 ;; ---------------------------
 ;;
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el 
b/test/lisp/emacs-lisp/lisp-mode-tests.el
index fd1af75ba3..d3e78aa1d7 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -330,5 +330,28 @@ Expected initialization file: `%s'\"
       (faceup-clean-buffer)
       (should (faceup-test-font-lock-buffer 'emacs-lisp-mode faceup)))))
 
+(ert-deftest test-lisp-current-defun-name ()
+  (require 'edebug)
+  (with-temp-buffer
+    (emacs-lisp-mode)
+    (insert "(defun foo ()\n'bar)\n")
+    (goto-char 5)
+    (should (equal (lisp-current-defun-name) "foo")))
+  (with-temp-buffer
+    (emacs-lisp-mode)
+    (insert "(define-flabbergast-test zot ()\n'bar)\n")
+    (goto-char 5)
+    (should (equal (lisp-current-defun-name) "zot")))
+  (with-temp-buffer
+    (emacs-lisp-mode)
+    (insert "(progn\n ;; comment\n ;; about that\n (define-key ...)\n )")
+    (goto-char 5)
+    (should (equal (lisp-current-defun-name) "progn")))
+  (with-temp-buffer
+    (emacs-lisp-mode)
+    (insert "(defblarg \"a\" 'b)")
+    (goto-char 5)
+    (should (equal (lisp-current-defun-name) "defblarg"))))
+
 (provide 'lisp-mode-tests)
 ;;; lisp-mode-tests.el ends here