Package: emacs;
Reported by: Dmitry Alexandrov <321942 <at> gmail.com>
Date: Fri, 12 May 2017 02:20:01 UTC
Severity: minor
Tags: fixed, patch
Found in version 25.1
Fixed in version 26.1
Done: npostavs <at> users.sourceforge.net
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 26894 in the body.
You can then email your comments to 26894 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-gnu-emacs <at> gnu.org:bug#26894; Package emacs.
(Fri, 12 May 2017 02:20:02 GMT) Full text and rfc822 format available.Dmitry Alexandrov <321942 <at> gmail.com>:bug-gnu-emacs <at> gnu.org.
(Fri, 12 May 2017 02:20:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Dmitry Alexandrov <321942 <at> gmail.com> To: bug-gnu-emacs <at> gnu.org Subject: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’ Date: Fri, 12 May 2017 05:18:52 +0300
‘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. I encounered two user-visible consequences of this, which perceived as bugs by me: — When ‘*Help*’ buffer is configured to be shown in a dedicated frame (e. g. (setq pop-up-frames t)), every ‘$ which <build-in command>’ generates a new frame and do not close it. - When ‘*Help*‘ buffer is already opened, ‘$ which <build-in command>’: (1) raises the frame where it’s opened; (2) kills it, losing its history ([back] / [forward]). [0] http://git.sv.gnu.org/gitweb/?p=emacs.git;a=blob;f=lisp/eshell/esh-cmd.el;hb=cee4128#l1151
bug-gnu-emacs <at> gnu.org:bug#26894; Package emacs.
(Sun, 04 Jun 2017 02:50:01 GMT) Full text and rfc822 format available.Message #8 received at 26894 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Dmitry Alexandrov <321942 <at> gmail.com> Cc: 26894 <at> debbugs.gnu.org Subject: Re: bug#26894: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’ Date: Sat, 03 Jun 2017 22:50:58 -0400
[Message part 1 (text/plain, inline)]
tags 26894 patch quit Dmitry Alexandrov <321942 <at> gmail.com> 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.
[v1-0001-Don-t-read-eshell-which-output-from-Help-buffer-B.patch (text/x-diff, inline)]
From d4e1da8e3384c67a91c0466a0a5b60f543195b81 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
Date: Sat, 3 Jun 2017 22:15:19 -0400
Subject: [PATCH v1] 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..fd1dec19bf 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)
+
+ (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
+ (pcase-let* ((`(,real-function ,def ,_aliased ,real-def)
+ (help-fns--analyse-function function))
+ (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
npostavs <at> users.sourceforge.net
to control <at> debbugs.gnu.org.
(Sun, 04 Jun 2017 02:50:02 GMT) Full text and rfc822 format available.bug-gnu-emacs <at> gnu.org:bug#26894; Package emacs.
(Sun, 04 Jun 2017 03:47:02 GMT) Full text and rfc822 format available.Message #13 received at 26894 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Dmitry Alexandrov <321942 <at> gmail.com> Cc: 26894 <at> debbugs.gnu.org Subject: Re: bug#26894: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’ Date: Sat, 03 Jun 2017 23:47:50 -0400
[Message part 1 (text/plain, inline)]
npostavs <at> users.sourceforge.net writes: > Dmitry Alexandrov <321942 <at> gmail.com> 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.
[v2-0001-Don-t-read-eshell-which-output-from-Help-buffer-B.patch (text/x-diff, inline)]
From ce259d2b7518a6822f5e0271ccf66d0fb53e63a1 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
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
bug-gnu-emacs <at> gnu.org:bug#26894; Package emacs.
(Sat, 24 Jun 2017 20:20:02 GMT) Full text and rfc822 format available.Message #16 received at 26894 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Dmitry Alexandrov <321942 <at> gmail.com> Cc: 26894 <at> debbugs.gnu.org Subject: Re: bug#26894: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’ Date: Sat, 24 Jun 2017 16:20:46 -0400
[Message part 1 (text/plain, inline)]
npostavs <at> users.sourceforge.net writes: > npostavs <at> users.sourceforge.net writes: > >> Dmitry Alexandrov <321942 <at> gmail.com> 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. Um, 3rd time's the charm?
[v3-0001-Don-t-read-eshell-which-output-from-Help-buffer-B.patch (text/x-diff, inline)]
From bb5022bb6dac31ee5a0b14b9b2764a2b61fbffb6 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
Date: Sat, 3 Jun 2017 22:15:19 -0400
Subject: [PATCH v3] 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'.
---
lisp/eshell/esh-cmd.el | 32 +++++++--------
lisp/help-fns.el | 103 +++++++++++++++++++++++++++----------------------
2 files changed, 70 insertions(+), 65 deletions(-)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 86e7b83c28..2434220877 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 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 @@ (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)))
+ (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 2c635ffa50..32324ae3bc 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 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 @@ (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))))
+ (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)
--
2.11.1
bug-gnu-emacs <at> gnu.org:bug#26894; Package emacs.
(Wed, 28 Jun 2017 00:37:02 GMT) Full text and rfc822 format available.Message #19 received at 26894 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Dmitry Alexandrov <321942 <at> gmail.com> Cc: 26894 <at> debbugs.gnu.org Subject: Re: bug#26894: 25.1, 26.0.50; ‘eshell/which’ abuses ‘describe-function’ Date: Tue, 27 Jun 2017 20:38:11 -0400
tags 26894 fixed close 26894 26.1 quit > Um, 3rd time's the charm? Pushed to master: [1: 2d992690de]. [1: 2d992690de]: 2017-06-27 20:34:14 -0400 Don't read eshell/which output from *Help* buffer (Bug#26894) http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2d992690de5bcb2036eeb4d2854761596b863704
npostavs <at> users.sourceforge.net
to control <at> debbugs.gnu.org.
(Wed, 28 Jun 2017 00:37:02 GMT) Full text and rfc822 format available.npostavs <at> users.sourceforge.net
to control <at> debbugs.gnu.org.
(Wed, 28 Jun 2017 00:37:02 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Wed, 26 Jul 2017 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.