Path & Demo: Source View in Help Buffers

[Arthur Miller <arthur.miller@live.com>]

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


I had some fun and implemented somewhat different version of how code is
fetched, and buttonized toggle function.

Since I really didn't got much more input than what Martin gave me yesterday, I
have had some fun and recorded a small demo of how it looks like:

https://youtu.be/yiS1eXdgcYI

Sorry, but I don't have better place to put it on, use yt-download if you prefer
not to open it in a web browser. It is just a two minute of me showing how it
looks when used in practice. I reason that looking at the code is one thing,
seeing it is the other.

I have also changed it a bit, and pasting the source after the navigation
buttons. so they don't jump out of the screen when a function is very big. Don't
know if it is better strategy, it is just a prototype anyway.


[-- 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: 8814 bytes --]

From cd49759ff81466e31e4c96276dcdb2ff6d378d0f Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Wed, 22 Sep 2021 01:47:41 +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-source-view): New button.
(help-make-xrefs): Check for 'help-mode-inline-source' and
call 'help--insert-source' to perform insertion when possible.
---
 lisp/help-mode.el | 165 ++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 160 insertions(+), 5 deletions(-)

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 551cf7e1a3..bec7d25270 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -149,6 +149,16 @@ help-mode-hook
   "Hook run by `help-mode'."
   :type 'hook
   :group 'help)
+
+(defcustom help-mode-inline-source nil
+  "Display inlined source code in `help-mode' buffers.
+
+When enabled the source code of a symbol currently shown in the
+help-buffer 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
 
@@ -367,6 +377,11 @@ 'help-news
     (view-buffer-other-window (find-file-noselect file))
     (goto-char pos))
   'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
+
+(define-button-type 'help-source-view
+  :supertype 'help-xref
+  'help-function #'help-toggle-source-view
+  'help-echo (purecopy "mouse-2, RET: toggle source view in help-buffer"))
 \f
 (defvar bookmark-make-record-function)
 (defvar help-mode--current-data nil)
@@ -503,6 +518,115 @@ 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 (symbol type file)
+  "Find C source code for a Lisp SYMBOL in a FILE.
+
+symbol - the symbol to find.
+type - the type as obtained by 'describe-*' functions.
+file - the source file to search in."
+  (let (src beg)
+    (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
+          (require 'find-func)
+          ;; Either or both an alias and its target might be advised.
+          (setq symbol (find-function-advised-original
+		            (indirect-function
+		             (find-function-advised-original symbol)))))
+        (when (re-search-forward
+	       (if type
+		   (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
+			   (regexp-quote (symbol-name symbol))
+			   "\"")
+	         (concat "DEFUN[ \t\n]*([ \t\n]*\""
+		         (regexp-quote (subr-name (advice--cd*r symbol)))
+		         "\""))
+	       nil t)
+          (if type ;; defvar here
+              (progn
+                (goto-char (line-beginning-position))
+                (skip-chars-forward "[\s\t\n\r]")
+                (setq beg (point))
+                (re-search-forward ");$" nil t)
+                (narrow-to-region beg (point)))
+            ;;(narrow-to-defun)
+            (and (re-search-backward "DEFUN" nil t)
+                 (setq beg (point))
+                 (re-search-forward ")[\n\s\t\r]*{")
+                 (re-search-forward "^}[\n\s\t\r]+")
+                 (narrow-to-region beg (point))))
+          (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 (symbol type file)
+  "Find emacs-lisp source code for a Lisp SYMBOL in a FILE.
+
+symbol - the symbol to find.
+type - the type as obtained by 'describe-*' functions.
+file - the source file to search in."
+  (let (src pos)
+    (when file
+      (setq file (or file (find-lisp-object-file-name symbol type))))
+    (with-temp-buffer
+      (insert-file-contents file)
+      (delay-mode-hooks (funcall 'emacs-lisp-mode))
+      (require 'find-func)
+      ;; Either or both an alias and its target might be advised.
+      ;; (setq symbol (find-function-advised-original
+      ;;   	    (indirect-function
+      ;;   	     (find-function-advised-original symbol)))))
+      (setq pos (cdr (find-function-search-for-symbol symbol type file)))
+      (when pos
+        (goto-char pos)
+        (forward-sexp)
+        (narrow-to-region pos (point))
+        (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))
+          (let ((end (point)))
+            (when (search-backward "View Source Code:" nil t)
+              (delete-region (point) end)
+              (help-insert-xref-button "Hide Source Code:" 'help-source-view)
+              (insert (concat "\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))
+        (let ((end (point)))
+          (when (search-backward "Hide Source Code:" nil t)
+            (delete-region (point) end)
+            (help-insert-xref-button
+             "View Source Code:" 'help-source-view)))))))
+
 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -664,7 +788,25 @@ help-make-xrefs
             (help-insert-xref-button help-forward-label 'help-forward
                                      (current-buffer)))
           (when (or help-xref-stack help-xref-forward-stack)
-            (insert "\n")))
+            (insert "\n"))
+          (insert "\n")
+          ;; get source string if needed and available
+          ;; 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))))))))
+          (if help-mode-inline-source
+              (progn
+                (insert "View Source Code:") ;; just a little hack
+                (help--insert-source))
+            (help-insert-xref-button "View Source Code:" 'help-source-view)))
         (set-buffer-modified-p old-modified)))))
 
 ;;;###autoload
@@ -819,10 +961,23 @@ 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)
+      (unless (plist-get help-mode--current-data :file)
+        (error "Source file for the current help item is not defined"))
+      (save-excursion
+        (goto-char (point-min))
+        (if (search-forward "Hide 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