>From 4b9e6acbec8cc9203692adbbc7ccd6f76d8cae2a Mon Sep 17 00:00:00 2001 From: Arthur Miller 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") ;; 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