Patch: source in help buffer refactored & 'on-demand' option

Patch: source in help buffer refactored & 'on-demand' option

[Arthur Miller]

[-- Attachment #1: Type: text/plain, Size: 769 bytes --]


Ok, just a slight update after todas input:

I have reworked the patch to be able to show/hide source code for the current
symbol 'on-demand', mostly after input from Martin R.

The source when asked to be shown on demand will display source regardless of
the global option, so it can be used by users who generally would not like to
display source code by default, but would like to fetch it in some rare cases.

When global option is on, it will remove the source from the view. It works only
on visible help buffer.

Any ideas? Bugs yet? I have been playing with it today for quite some time,
clicking on links in help buffer and trying to find if it does not display
something correctly, but thus far I didn't found anything. It feels like a
little code browser.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Display-source-code-in-help-mode-buffers.patch --]
[-- Type: text/x-patch, Size: 7267 bytes --]

From 4b9e6acbec8cc9203692adbbc7ccd6f76d8cae2a Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Tue, 21 Sep 2021 01:34:33 +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--insert-source): New function.
(help--remove-source): New function.
(help--toggle-source-view): New function.
(help-make-xrefs): Check for 'help-mode-inline-source' and
call 'help--insert-source' to perform insertion when possible.
---
 lisp/help-mode.el | 139 ++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 135 insertions(+), 4 deletions(-)

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 551cf7e1a3..4bc77446cf 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")
 \f
 ;; Button types used by help
 
@@ -503,6 +512,103 @@ 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--insert-source ()
+  "Fnd and insert source for the current symbol into the help-mode buffer."
+  (with-silent-modifications
+    (with-current-buffer (help-buffer)
+      (save-excursion
+        (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 "Source code not available."))
+          (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)))
+          (goto-char (point-max))
+          (forward-line -2)
+          (insert (concat "\nSource Code:\n" src "\n")))))))
+
+(defun help--remove-source ()
+  "Remove source code from the help buffer when present."
+  (with-current-buffer (help-buffer)
+    (with-silent-modifications
+      (save-excursion
+        (goto-char (point-max))
+        (forward-line -2)
+        (let ((end (point)))
+          (when (search-backward "\nSource Code:" nil t)
+            (delete-region (point) end)))))))
+
 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -651,6 +757,20 @@ 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
+            ;; 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))))))))
+            (help--insert-source))
           (when (or help-xref-stack help-xref-forward-stack)
             (insert "\n"))
           ;; Make a back-reference in this buffer if appropriate.
@@ -819,10 +939,21 @@ help-do-xref
                         (append args (list (generate-new-buffer-name "*info*")))
                       args))))
 
-;; The doc string is meant to explain what buttons do.
-(defun help-follow-mouse ()
-  "Follow the cross-reference that you click on."
-  (declare (obsolete nil "28.1"))
+(defun help-toggle-source-view ()
+  "Toggle source code display in help buffer for the current symbol."
+  (interactive)
+  (when (get-buffer-window (help-buffer))
+    (with-current-buffer (help-buffer)
+      (save-excursion
+        (goto-char (point-min))
+        (if (search-forward "Source Code:" nil t)
+            (help--remove-source)
+          (help--insert-source))))))
+
+  ;; The doc string is meant to explain what buttons do.
+  (defun help-follow-mouse ()
+    "Follow the cross-reference that you click on."
+    (declare (obsolete nil "28.1"))
   (interactive)
   (error "No cross-reference here"))
 
-- 
2.33.0