>From 58eac63f759146cf7a601e1ae974dd373c837957 Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Sun, 19 Sep 2021 21:28:01 +0200
Subject: [PATCH] Display source code in 'help-mode' buffers

* lisp/help-mode.el ('help-mode-inline-source'): New option.
('help--fetch-c-src'): New function.
('help--fetch-lisp-src'): New function.
('help--symbol-source'): New function.
('help-make-xrefs): Check for 'help-mode-inline-source' and
call 'help--symbol-source' to perform insertion when possible.
---
 lisp/help-mode.el | 110 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 551cf7e1a3..935c54a6eb 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -149,6 +149,15 @@ help-mode-hook
   "Hook run by `help-mode'."
   :type 'hook
   :group 'help)
+
+(defcustom help-mode-inline-source nil
+  "Display inlined source code for SYMBOL in `help-mode' buffer.
+
+When enabled the source code of a symbol will be displayed inlined in
+the help buffer, if the source code for the symbol is available."
+  :type 'boolean
+  :group 'help
+  :version "28.1")
 
 ;; Button types used by help
 
@@ -503,6 +512,91 @@ describe-symbol-backends
     and a frame), inserts the description of that symbol in the current buffer
     and returns that text as well.")
 
+(defun help--fetch-c-src (sym type file)
+  "Find C source code for a Lisp symbol in a `file'.
+
+sym is the symbol to find.
+type is the type as obtained by 'describe-*' functions.
+file is the source file to search in."
+  (let (src pos)
+    (setq file (expand-file-name file source-directory))
+    (when (file-readable-p file)
+      (with-temp-buffer
+        (insert-file-contents-literally file)
+        (delay-mode-hooks (funcall 'c-mode))
+        (goto-char (point-min))
+        (unless type
+          ;; Either or both an alias and its target might be advised.
+          (setq sym (find-function-advised-original
+		            (indirect-function
+		             (find-function-advised-original sym)))))
+        (when (re-search-forward
+	       (if type
+		   (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
+			   (regexp-quote (symbol-name sym))
+			   "\"")
+	         (concat "DEFUN[ \t\n]*([ \t\n]*\""
+		         (regexp-quote (subr-name (advice--cd*r sym)))
+		         "\""))
+	       nil t)
+          (if type ;; defvar here
+              (progn
+                (goto-char (line-beginning-position))
+                (skip-chars-forward "[:blank:]")
+                (setq pos (point))
+                (re-search-forward ");$" nil t)
+                (narrow-to-region pos (point)))
+            (narrow-to-defun))
+          (if (fboundp 'font-lock-ensure)
+               (font-lock-ensure)
+             (with-no-warnings (font-lock-fontify-buffer)))
+          (setq src (buffer-string)))))
+    src))
+
+(defun help--fetch-lisp-src (sym type file)
+  "Find emacs-lisp source code for a Lisp symbol in a `file'.
+
+sym is the symbol to find.
+type is the type as obtained by 'describe-*' functions.
+file is the source file to search in."
+  (let (src pos sxp)
+    (when file
+      (setq file (or file (find-lisp-object-file-name sym type))))
+    (with-temp-buffer
+      (insert-file-contents file)
+      (delay-mode-hooks (funcall 'emacs-lisp-mode))
+      (require 'find-func)
+      (setq pos (cdr (find-function-search-for-symbol sym type file)))
+      (when pos
+        (goto-char pos)
+        (forward-sexp)
+        (setq sxp (buffer-substring-no-properties pos (point)))
+        (when sxp
+          (erase-buffer)
+          (insert sxp)
+          (if (fboundp 'font-lock-ensure)
+              (font-lock-ensure)
+            (with-no-warnings (font-lock-fontify-buffer)))
+          (setq src (buffer-string)))))
+    src))
+
+(defun help--symbol-source ()
+  "Fnd and return string to be inserted in help-mode buffer for the
+source code of the symbol.
+
+Used internally for `help-make-refs'."
+  (let* ((file (plist-get help-mode--current-data :file))
+        (type (plist-get help-mode--current-data :type))
+        (sym (plist-get help-mode--current-data :symbol))
+        src)
+    (when (eq file 'C-source)
+      (setq file
+            (help-C-file-name (indirect-function sym) 'fun)))
+    (setq src (if (string-suffix-p ".c" file)
+                  (help--fetch-c-src sym type file)
+                (help--fetch-lisp-src sym type file)))
+  (if src src "Source code not available.")))
+
 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -651,6 +745,22 @@ help-make-xrefs
           (while (and (not (bobp)) (bolp))
             (delete-char -1))
           (insert "\n")
+          ;; get source string if needed and available
+          (when help-mode-inline-source
+            (insert "\nSource Code: \n")
+            ;; describe-symbol does not produce 'current-data' plist
+            (unless help-mode--current-data
+              (save-excursion
+                (goto-char (point-min))
+                (when (re-search-forward "\\.\\(el\\|c\\)" nil t)
+                  (goto-char (- (point) 2))
+                  (let ((props (get-text-property (point) 'help-args)))
+                    (when props
+                      (setq help-mode--current-data
+                            (list :symbol (nth 0 props)
+                                  :file (nth 1 props))))))))
+              (insert (help--symbol-source))
+            (insert "\n"))
           (when (or help-xref-stack help-xref-forward-stack)
             (insert "\n"))
           ;; Make a back-reference in this buffer if appropriate.
-- 
2.33.0