Don't read eshell/which output from *Help* buffer (Bug#26894)

* lisp/help-fns.el (help-fns--analyse-function)
(help-fns-function-description-header): New functions, extracted from
describe-function-1.
(describe-function-1): Use them.
* lisp/eshell/esh-cmd.el (eshell/which): Use
`help-fns-function-description-header' instead of
`describe-function-1'.

diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 86e7b83c2817e2f0d1f7d910e82b308cea363949..24342208771515de8697def6cf3a936d177eea62 100644 (file)
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1148,6 +1148,8 @@ be finished later after the completion of an asynchronous subprocess."
 
 ;; command invocation
 
+(declare-function help-fns-function-description-header "help-fns")
+
 (defun eshell/which (command &rest names)
   "Identify the COMMAND, and where it is located."
   (dolist (name (cons command names))
@@ -1164,25 +1166,17 @@ be finished later after the completion of an asynchronous subprocess."
                (concat name " is an alias, defined as \""
                        (cadr alias) "\"")))
       (unless program
-       (setq program (eshell-search-path name))
-       (let* ((esym (eshell-find-alias-function name))
-              (sym (or esym (intern-soft name))))
-         (if (and (or esym (and sym (fboundp sym)))
-                  (or eshell-prefer-lisp-functions (not direct)))
-             (let ((desc (let ((inhibit-redisplay t))
-                           (save-window-excursion
-                             (prog1
-                                 (describe-function sym)
-                               (message nil))))))
-               (setq desc (if desc (substring desc 0
-                                              (1- (or (string-match "\n" desc)
-                                                      (length desc))))
-                            ;; This should not happen.
-                            (format "%s is defined, \
-but no documentation was found" name)))
-               (if (buffer-live-p (get-buffer "*Help*"))
-                   (kill-buffer "*Help*"))
-               (setq program (or desc name))))))
+        (setq program
+              (let* ((esym (eshell-find-alias-function name))
+                     (sym (or esym (intern-soft name))))
+                (if (and (or esym (and sym (fboundp sym)))
+                         (or eshell-prefer-lisp-functions (not direct)))
+                    (or (with-output-to-string
+                          (require 'help-fns)
+                          (princ (format "%s is " sym))
+                          (help-fns-function-description-header sym))
+                        name)
+                  (eshell-search-path name)))))
       (if (not program)
          (eshell-error (format "which: no %s in (%s)\n"
                                name (getenv "PATH")))

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 2c635ffa5005b93c11be5d019a5a1a395c1c9976..32324ae3bcb6d7d5c38f90722b47e61010f143ff 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -560,8 +560,9 @@ FILE is the file where FUNCTION was probably defined."
             (setq short rel))))
     short))
 
-;;;###autoload
-(defun describe-function-1 (function)
+(defun help-fns--analyse-function (function)
+  "Return information about FUNCTION.
+Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
   (let* ((advised (and (symbolp function)
                       (featurep 'nadvice)
                       (advice--p (advice--symbol-function function))))
@@ -594,22 +595,24 @@ FILE is the file where FUNCTION was probably defined."
                          (setq f (symbol-function f)))
                        f))
                    ((subrp def) (intern (subr-name def)))
-                   (t def)))
-        (sig-key (if (subrp def)
-                      (indirect-function real-def)
-                    real-def))
-        (file-name (find-lisp-object-file-name function (if aliased 'defun
-                                                           def)))
-         (pt1 (with-current-buffer (help-buffer) (point)))
-        (beg (if (and (or (byte-code-function-p def)
-                          (keymapp def)
-                          (memq (car-safe def) '(macro lambda closure)))
-                      (stringp file-name)
-                      (help-fns--autoloaded-p function file-name))
-                 (if (commandp def)
-                     "an interactive autoloaded "
-                   "an autoloaded ")
-               (if (commandp def) "an interactive " "a "))))
+                    (t def))))
+    (list real-function def aliased real-def)))
+
+(defun help-fns-function-description-header (function)
+  "Print a line describing FUNCTION to `standard-output'."
+  (pcase-let* ((`(,_real-function ,def ,aliased ,real-def)
+                (help-fns--analyse-function function))
+               (file-name (find-lisp-object-file-name function (if aliased 'defun
+                                                                 def)))
+               (beg (if (and (or (byte-code-function-p def)
+                                 (keymapp def)
+                                 (memq (car-safe def) '(macro lambda closure)))
+                             (stringp file-name)
+                             (help-fns--autoloaded-p function file-name))
+                        (if (commandp def)
+                            "an interactive autoloaded "
+                          "an autoloaded ")
+                      (if (commandp def) "an interactive " "a "))))
 
     ;; Print what kind of function-like object FUNCTION is.
     (princ (cond ((or (stringp def) (vectorp def))
@@ -676,34 +679,42 @@ FILE is the file where FUNCTION was probably defined."
            (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
                                 nil t)
            (help-xref-button 1 'help-function-def function file-name))))
-      (princ ".")
-      (with-current-buffer (help-buffer)
-       (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
-                                 (point)))
-      (terpri)(terpri)
-
-      (let ((doc-raw (documentation function t))
-            (key-bindings-buffer (current-buffer)))
-
-       ;; If the function is autoloaded, and its docstring has
-       ;; key substitution constructs, load the library.
-       (and (autoloadp real-def) doc-raw
-            help-enable-auto-load
-            (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
-            (autoload-do-load real-def))
-
-        (help-fns--key-bindings function)
-        (with-current-buffer standard-output
-          (let ((doc (help-fns--signature function doc-raw sig-key
-                                          real-function key-bindings-buffer)))
-            (run-hook-with-args 'help-fns-describe-function-functions function)
-            (insert "\n"
-                    (or doc "Not documented."))
-            ;; Avoid asking the user annoying questions if she decides
-            ;; to save the help buffer, when her locale's codeset
-            ;; isn't UTF-8.
-            (unless (memq text-quoting-style '(straight grave))
-              (set-buffer-file-coding-system 'utf-8))))))))
+      (princ "."))))
+
+;;;###autoload
+(defun describe-function-1 (function)
+  (let ((pt1 (with-current-buffer (help-buffer) (point))))
+    (help-fns-function-description-header function)
+    (with-current-buffer (help-buffer)
+      (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
+                                (point))))
+  (terpri)(terpri)
+
+  (pcase-let ((`(,real-function ,def ,_aliased ,real-def)
+               (help-fns--analyse-function function))
+              (doc-raw (documentation function t))
+              (key-bindings-buffer (current-buffer)))
+
+    ;; If the function is autoloaded, and its docstring has
+    ;; key substitution constructs, load the library.
+    (and (autoloadp real-def) doc-raw
+         help-enable-auto-load
+         (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
+         (autoload-do-load real-def))
+
+    (help-fns--key-bindings function)
+    (with-current-buffer standard-output
+      (let ((doc (help-fns--signature
+                  function doc-raw
+                  (if (subrp def) (indirect-function real-def) real-def)
+                  real-function key-bindings-buffer)))
+        (run-hook-with-args 'help-fns-describe-function-functions function)
+        (insert "\n" (or doc "Not documented.")))
+      ;; Avoid asking the user annoying questions if she decides
+      ;; to save the help buffer, when her locale's codeset
+      ;; isn't UTF-8.
+      (unless (memq text-quoting-style '(straight grave))
+        (set-buffer-file-coding-system 'utf-8)))))
 
 ;; Add defaults to `help-fns-describe-function-functions'.
 (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)