From 841ad680dbbfa3a4a95a3b09a7409fcd9ce6cdd7 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Fri, 6 Jan 2023 08:54:34 +0000
Subject: [PATCH] Try to find where dynamically defined functions were defined

* lisp/help-mode.el
(help-function-def--find-probable-definition-place): New function.
(help-function-def--button-function): Use it.  See bug#60568.
---
 lisp/help-mode.el | 111 +++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 110 insertions(+), 1 deletion(-)

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index bf64d032b6..15fd23c1cd 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -252,6 +252,91 @@ 'help-customize-face
 		   (customize-face v))
   'help-echo (purecopy "mouse-2, RET: customize face"))
 
+(defun help-function-def--find-probable-definition-place (fun)
+  "Find the function in which FUN was likely defined.
+FUN is the symbol of a function.
+The current buffer must be visiting the file in which the
+function was defined (see `symbol-file').
+If the function in which FUN was likely defined is found, return
+a cons with its name and its beginning position.
+Otherwise, return nil."
+  (save-excursion
+    ;; Build a list of strings with the symbols (and strings) of FUN.
+    (let ((names
+           (mapcar (lambda (el)
+                     (concat
+                      "\\_<"
+                      (regexp-quote (format "%s" el))
+                      "\\_>"))
+                   (flatten-tree (symbol-function fun))))
+          results)
+      (delete-dups names)
+      (when names
+        ;; Build an alist with all functions in which each symbol is
+        ;; found.
+        (dolist (el names)
+          ;; Exclude symbols that are 3 characters or less.
+          (when (> (length el) 9)
+            (let (result)
+              (goto-char (point-min))
+              (while (re-search-forward el nil t)
+                (push (lisp-current-defun-name) result))
+              (delete-dups result)
+              (when result
+                (push (cons el result) results)))))
+        (when results
+          ;; First check if one of the symbols is found in a single
+          ;; function.
+          (let ((el (catch 'found
+                      (progn
+                      (mapcar
+                       (lambda (el)
+                         (if (= (length el) 2)
+                             (throw 'found (car el))))
+                       results)))))
+            (if (stringp el)
+                ;; If one such function was found, it's the function
+                ;; we are after.
+                (progn
+                  (goto-char (point-min))
+                  (re-search-forward el nil t)
+                  (beginning-of-defun)
+                  (cons (lisp-current-defun-name) (point)))
+              ;; Otherwise, find which function contains the most
+              ;; symbols in FUN.
+              (let (places)
+                (dolist (el results)
+                  (dolist (e (cdr el))
+                    (push e places)))
+                (let* ((sorted-places (sort places #'string<))
+                       (ptr sorted-places)
+                       (count 1)
+                       (max 0)
+                       result)
+                  (while ptr
+                    (if (string= (car ptr) (cadr ptr))
+                        (setq count (1+ count))
+                      (when (> count max)
+                        (setq max count)
+                        (setq result (car ptr)))
+                      (setq count 1))
+                    (setq ptr (cdr ptr)))
+                  (when result
+                    ;; Determine the beginning position of that
+                    ;; function.
+                    (goto-char (point-min))
+                    (when (catch 'found
+                            (while (re-search-forward
+                                    (concat "\\_<"
+                                            (regexp-quote result)
+                                            "\\_>"))
+                              (when (string= (lisp-current-defun-name)
+                                             result)
+                                (throw 'found t)))
+                            (throw 'found nil))
+                      (beginning-of-defun)
+                      (cons result (point)))))))))))))
+
 (defun help-function-def--button-function (fun &optional file type)
   (or file
       (setq file (find-lisp-object-file-name fun type)))
@@ -281,7 +366,31 @@ help-function-def--button-function
             (unless (= (point) position)
               (push-mark nil t))
             (goto-char position))
-        (message "Unable to find location in file")))))
+        (let ((probable-definition-place
+               (help-function-def--find-probable-definition-place fun)))
+          (when probable-definition-place
+            (goto-char (cdr probable-definition-place)))
+          (let ((help-buffer-under-preparation t))
+            (help-setup-xref (list #'help-function-def--button-function
+                                   fun file)
+		             (called-interactively-p 'interactive))
+	    (with-help-window (help-buffer)
+	      (insert (substitute-command-keys
+                       (format "Function %s could not be found in `%s'.\n\n"
+                              fun (file-name-nondirectory file))))
+              (setq help-mode--current-data (list :symbol fun
+                                                  :file file))
+	      (save-excursion
+	        (re-search-backward
+                 (substitute-command-keys "`\\([^`']+\\)'")
+                 nil t)
+	        (help-xref-button 1 'help-function-def fun file))
+              (when probable-definition-place
+                (insert (substitute-command-keys
+                         (format "It was probably defined by `%s'.\n\n"
+                                (car probable-definition-place)))))
+	      (insert "Function definition:\n\n")
+	      (insert (pp-to-string (symbol-function fun))))))))))
 
 (define-button-type 'help-function-def
   :supertype 'help-xref
-- 
2.39.0