bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#26894: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’


From: npostavs
Subject: bug#26894: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’
Date: Sat, 03 Jun 2017 23:47:50 -0400
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux)

address@hidden writes:

> Dmitry Alexandrov <address@hidden> writes:
>
>> ‘eshell/which’ in its part, that locates built-in commands (‘$ which
>> which’ for example) and elisp functions in general, looks like a dirty
>> hack [0]: it calls interactive ‘describe-function’ command and parses
>> *Help* buffer.
>
> Yeah, that's not great.  Here's a patch.

Sorry, I sent a broken version, here's the right one.

>From ce259d2b7518a6822f5e0271ccf66d0fb53e63a1 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <address@hidden>
Date: Sat, 3 Jun 2017 22:15:19 -0400
Subject: [PATCH v2] Don't read eshell/which output from *Help* buffer
 (Bug#26894)

* lisp/help-fns.el (help-fns--analyse-function)
(describe-function-header): New functions, extracted from
describe-function-1.
(describe-function-1): Use them.
* lisp/eshell/esh-cmd.el (eshell/which): Use
`describe-function-header' instead of `describe-function-1'.
---
 lisp/eshell/esh-cmd.el |  31 ++++++---------
 lisp/help-fns.el       | 103 +++++++++++++++++++++++++++----------------------
 2 files changed, 69 insertions(+), 65 deletions(-)

diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 86e7b83c28..91e41b7224 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1148,6 +1148,8 @@ (defun eshell-do-eval (form &optional synchronous-p)
 
 ;; command invocation
 
+(declare-function describe-function-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,16 @@ (defun eshell/which (command &rest names)
                (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)))
+                    (require 'help-fns)
+                    (or (with-output-to-string
+                          (describe-function-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 2c635ffa50..66e06df677 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -560,8 +560,9 @@ (defun help-fns-short-filename (filename)
             (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 @@ (defun describe-function-1 (function)
                          (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 describe-function-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 @@ (defun describe-function-1 (function)
            (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))))
+    (describe-function-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)
-- 
2.11.1


reply via email to

[Prev in Thread] Current Thread [Next in Thread]