mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
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'.
This commit is contained in:
Noam Postavsky
parent
4a5653cd28
commit
2d992690de
@ -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")))
|
||||
|
||||
@ -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)
|
||||
(princ "."))))
|
||||
|
||||
(let ((doc-raw (documentation function t))
|
||||
(key-bindings-buffer (current-buffer)))
|
||||
;;;###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)
|
||||
|
||||
;; 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))
|
||||
(pcase-let ((`(,real-function ,def ,_aliased ,real-def)
|
||||
(help-fns--analyse-function function))
|
||||
(doc-raw (documentation function t))
|
||||
(key-bindings-buffer (current-buffer)))
|
||||
|
||||
(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))))))))
|
||||
;; 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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user