unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Arthur Miller <arthur.miller@live.com>
To: emacs-devel@gnu.org
Subject: Patch proposal: display symbol source code in help buffers
Date: Sun, 19 Sep 2021 21:50:35 +0200	[thread overview]
Message-ID: <AM9PR09MB497721FD0F28CCD1FBAFBA0B96DF9@AM9PR09MB4977.eurprd09.prod.outlook.com> (raw)

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

Here is my second proposal to bring built-in help on par with external
offerings.

This one is little bit more than just three lines as the previous one was, so I
would really appreciate if I could get some thorough review and testing. It
works fine for me, but Emacs source code is big; so there is always possibility
that something is not displaying correctly. I had thoughts of writing automated
test, a scraper sort of like autloads collects help to collect docs from files
and than call new help routines and compare results, but that would be far more
involved than actually hacking help-mode :).

What I am worried about is how does it work with compressed sources? How do I
test it and what would I need to do to get it to work?

Do I need to manually decompress tar-ed sources or is it already taken care? I
believe, and I hope, that it is, but I am really not at home with how that part
of Emacs work. I appreciate advice and help there, also if someone can test.

Another thing: can I assume that all DEFVAR_LISP statements in .c files end with
a ');$'? I am using this in a regexp to fetch the entire source for those
defvars.

I have tried to be as least intrusive as I could, so everything is in
help-mode.

There is also a defcustom defaulting to nil to enable/disable this, and I think
it should always stay at nil since this can be cpu intensive. I think it
actually works quite well, I see no hickups, but I do run Emacs from surce
directory, and I use it as 'source-directory'. By the way, this patch expects
sources to be found in what this variable shows.

If this would be acceptable, I can write some NEWS and manual, unless someone
more english language savvy would like to help with that one.


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

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")
 \f
 ;; 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


             reply	other threads:[~2021-09-19 19:50 UTC|newest]

Thread overview: 58+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-09-19 19:50 Arthur Miller [this message]
2021-09-20  5:46 ` Patch proposal: display symbol source code in help buffers Lars Ingebrigtsen
2021-09-20  6:09   ` Stefan Kangas
2021-09-20  6:14     ` Lars Ingebrigtsen
2021-09-20  7:17       ` Ihor Radchenko
2021-09-20  7:43         ` Stefan Kangas
2021-09-20  8:29           ` martin rudalics
2021-09-20  9:04           ` Ihor Radchenko
2021-09-20 23:45             ` Arthur Miller
2021-09-21  4:16             ` Lars Ingebrigtsen
2021-09-21  6:59               ` Ihor Radchenko
2021-09-21  7:41                 ` Stefan Kangas
2021-09-21  8:38                   ` Eli Zaretskii
2021-09-21  9:17                     ` Ihor Radchenko
2021-09-21 16:49                       ` Lars Ingebrigtsen
2021-10-01  7:05                         ` Ihor Radchenko
2021-10-01  7:09                           ` Lars Ingebrigtsen
2021-10-01  7:21                             ` Ihor Radchenko
2021-10-01  7:21                               ` Lars Ingebrigtsen
2021-10-01  9:04                                 ` Ihor Radchenko
2021-10-01 12:20                                   ` Lars Ingebrigtsen
2021-10-01  7:24                           ` Eli Zaretskii
2021-10-01  9:08                             ` Ihor Radchenko
2021-10-01 10:24                               ` Eli Zaretskii
2021-10-01 14:14                                 ` Ihor Radchenko
2021-09-21  8:34               ` martin rudalics
2021-09-20 15:01           ` Arthur Miller
2021-09-21  7:41             ` Stefan Kangas
2021-09-20 15:27         ` Arthur Miller
2021-09-20  6:47     ` Eli Zaretskii
2021-09-20 15:27       ` Arthur Miller
2021-09-20 14:55     ` Arthur Miller
2021-09-21  4:18       ` Lars Ingebrigtsen
2021-09-21 10:26         ` Arthur Miller
2021-09-20 15:23   ` Arthur Miller
2021-09-20  5:59 ` Eli Zaretskii
2021-09-20  6:37   ` Gregor Zattler
2021-09-20  7:01     ` Eli Zaretskii
2021-09-20 15:21       ` Arthur Miller
2021-09-20  8:21     ` martin rudalics
2021-09-20 18:13       ` Arthur Miller
2021-09-21  8:34         ` martin rudalics
2021-09-21 10:24           ` Arthur Miller
2021-09-21 16:52             ` martin rudalics
2021-09-21 18:56               ` Arthur Miller
2021-09-21 17:30           ` Juri Linkov
2021-09-21 19:13             ` Arthur Miller
2021-09-22  7:49               ` martin rudalics
2021-09-22 16:04                 ` Juri Linkov
2021-09-22 17:52                   ` martin rudalics
2021-09-23  8:15                     ` martin rudalics
2021-09-23 15:52                       ` Juri Linkov
2021-09-26  9:10                         ` martin rudalics
2021-09-22 22:38                 ` Arthur Miller
2021-09-23  8:22                   ` martin rudalics
2021-09-20 12:19     ` Dmitry Gutov
2021-09-20 15:13       ` Arthur Miller
2021-09-20 15:11   ` Arthur Miller

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=AM9PR09MB497721FD0F28CCD1FBAFBA0B96DF9@AM9PR09MB4977.eurprd09.prod.outlook.com \
    --to=arthur.miller@live.com \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).