* bug#20759: 25.0.50; pcase doc: (‘ QPAT) instead of (` QPAT)
2015-06-07 15:41 bug#20759: 25.0.50; pcase doc: (‘ QPAT) instead of (` QPAT) Michael Heerdegen
2015-06-07 18:14 ` Glenn Morris
2015-06-07 20:42 ` Dmitry Gutov
@ 2015-06-11 17:37 ` Paul Eggert
2015-06-12 12:20 ` Michael Heerdegen
2 siblings, 1 reply; 11+ messages in thread
From: Paul Eggert @ 2015-06-11 17:37 UTC (permalink / raw)
To: 20759; +Cc: michael_heerdegen, Dmitry Gutov
[-- Attachment #1: Type: text/plain, Size: 636 bytes --]
That bug was a symptom of a more general confusion between raw
docstrings and formatted docstrings, which I attempted to fix in commit
b2205626370071bc85dc07b043c833bc50c0baec with the attached patch.
As the patch mentions, I'm puzzled about the syntax ‘(` PAT)’ in the
docstring, since lread.c says that syntax is obsolete and ‘format’
quotes the grave accent. The attached patch causes C-h f to suggest the
syntax ‘(\` PAT)’ which is "safer" in some sense, I suppose. If it's
intended that pcase usage omit the backslash, then I guess that ‘format’
and/or lread.c need to be updated accordingly.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-quoting-of-help-for-functions-with-odd-names.patch --]
[-- Type: text/x-patch; name="0001-Fix-quoting-of-help-for-functions-with-odd-names.patch", Size: 13393 bytes --]
From df62898b1b606f73afa0686b54eca345b1234f3d Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 11 Jun 2015 10:23:46 -0700
Subject: [PATCH] Fix quoting of help for functions with odd names
While investigating Bug#20759, I discovered other quoting problems:
C-h f mishandled characters like backslash and quote in function names.
This fix changes the behavior so that 'C-h f pcase RET' now
generates "... (\` QPAT) ..." instead of "... (` QPAT) ...",
because '(format "%S" '(` FOO))' returns "(\\` FOO)". A comment
in src/lread.c's read1 function says that the backslash will be
needed starting in Emacs 25, which implies that 'format' is
correct and the old pcase documention was wrong to omit the backslash.
* lisp/emacs-lisp/nadvice.el (advice--make-docstring):
* lisp/help-fns.el (help-fns--signature):
* lisp/help.el (help-add-fundoc-usage):
* lisp/progmodes/elisp-mode.el (elisp-function-argstring):
Use help--make-usage-docstring rather than formatting
help-make-usage.
* lisp/emacs-lisp/pcase.el (pcase--make-docstring):
Return raw docstring.
* lisp/help-fns.el (help-fns--signature): New arg RAW, to return
raw docstring. Take more care to distinguish raw from cooked dstrings.
(describe-function-1): Let help-fns--signature substitute
command keys.
* lisp/help.el (help--docstring-quote): New function.
(help-split-fundoc): Use it, to quote funny characters more
systematically.
(help--make-usage): Rename from help-make-usage, since this
should be private. Leave an obsolete alias for the old name.
(help--make-usage-docstring): New function.
* test/automated/help-fns.el (help-fns-test-funny-names): New test.
---
lisp/emacs-lisp/nadvice.el | 2 +-
lisp/emacs-lisp/pcase.el | 6 ++---
lisp/help-fns.el | 53 +++++++++++++++++++++++---------------------
lisp/help.el | 31 +++++++++++++++++++-------
lisp/progmodes/elisp-mode.el | 2 +-
test/automated/help-fns.el | 23 +++++++++++++++++++
6 files changed, 79 insertions(+), 38 deletions(-)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index faebe26..a6db5e9 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -114,7 +114,7 @@ Each element has the form (WHERE BYTECODE STACK) where:
(usage (help-split-fundoc origdoc function)))
(setq usage (if (null usage)
(let ((arglist (help-function-arglist flist)))
- (format "%S" (help-make-usage function arglist)))
+ (help--make-usage-docstring function arglist))
(setq origdoc (cdr usage)) (car usage)))
(help-add-fundoc-usage (concat docstring origdoc) usage))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ab82b7e..0d3b21b 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -163,7 +163,7 @@ Currently, the following patterns are provided this way:"
expansion))))
(declare-function help-fns--signature "help-fns"
- (function doc real-def real-function))
+ (function doc real-def real-function raw))
;; FIXME: Obviously, this will collide with nadvice's use of
;; function-documentation if we happen to advise `pcase'.
@@ -183,7 +183,7 @@ Currently, the following patterns are provided this way:"
(insert "\n\n-- ")
(let* ((doc (documentation me 'raw)))
(setq doc (help-fns--signature symbol doc me
- (indirect-function me)))
+ (indirect-function me) t))
(insert "\n" (or doc "Not documented.")))))))
(let ((combined-doc (buffer-string)))
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
@@ -870,7 +870,7 @@ QPAT can take the following forms:
(QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
[QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
its 0..(n-1)th elements, respectively.
- ,PAT matches if the pattern PAT matches.
+ ,PAT matches if the pattern PAT matches.
STRING matches if the object is `equal' to STRING.
ATOM matches if the object is `eq' to ATOM."
(declare (debug (pcase-QPAT)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index d59eeab..931e8af 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -353,7 +353,7 @@ suitable file is found, return nil."
(help-xref-button 1 'help-function-cmacro function lib)))))
(insert ".\n"))))
-(defun help-fns--signature (function doc real-def real-function)
+(defun help-fns--signature (function doc real-def real-function raw)
"Insert usage at point and return docstring. With highlighting."
(if (keymapp function)
doc ; If definition is a keymap, skip arglist note.
@@ -365,7 +365,7 @@ suitable file is found, return nil."
(let* ((use (cond
((and usage (not (listp advertised))) (car usage))
((listp arglist)
- (format "%S" (help-make-usage function arglist)))
+ (help--make-usage-docstring function arglist))
((stringp arglist) arglist)
;; Maybe the arglist is in the docstring of a symbol
;; this one is aliased to.
@@ -379,16 +379,20 @@ suitable file is found, return nil."
(car usage))
((or (stringp real-def)
(vectorp real-def))
- (format "\nMacro: %s" (format-kbd-macro real-def)))
+ (format "\nMacro: %s"
+ (help--docstring-quote
+ (format-kbd-macro real-def))))
(t "[Missing arglist. Please make a bug report.]")))
- (high (help-highlight-arguments
- ;; Quote any quotes in the function name (bug#20759).
- (replace-regexp-in-string "\\(\\)[`']" "\\=" use t t 1)
- doc)))
- (let ((fill-begin (point)))
- (insert (car high) "\n")
- (fill-region fill-begin (point)))
- (cdr high)))))
+ (high (if raw
+ (cons use doc)
+ (help-highlight-arguments (substitute-command-keys use)
+ (substitute-command-keys doc)))))
+ (let ((fill-begin (point))
+ (high-usage (car high))
+ (high-doc (cdr high)))
+ (insert high-usage "\n")
+ (fill-region fill-begin (point))
+ high-doc)))))
(defun help-fns--parent-mode (function)
;; If this is a derived mode, link to the parent.
@@ -579,23 +583,22 @@ FILE is the file where FUNCTION was probably defined."
(point)))
(terpri)(terpri)
- (let* ((doc-raw (documentation function t))
- ;; If the function is autoloaded, and its docstring has
- ;; key substitution constructs, load the library.
- (doc (progn
- (and (autoloadp real-def) doc-raw
- help-enable-auto-load
- (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
- doc-raw)
- (autoload-do-load real-def))
- (substitute-command-keys doc-raw))))
+ (let ((doc-raw (documentation function t)))
+
+ ;; 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
- (setq doc (help-fns--signature function doc sig-key real-function))
- (run-hook-with-args 'help-fns-describe-function-functions function)
- (insert "\n"
- (or doc "Not documented.")))))))
+ (let ((doc (help-fns--signature function doc-raw sig-key
+ real-function nil)))
+ (run-hook-with-args 'help-fns-describe-function-functions function)
+ (insert "\n"
+ (or doc "Not documented."))))))))
;; Add defaults to `help-fns-describe-function-functions'.
(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
diff --git a/lisp/help.el b/lisp/help.el
index fd5cbc6..b766cd0 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1349,6 +1349,11 @@ the help window if the current value of the user option
(princ msg)))))
\f
+(defun help--docstring-quote (string)
+ "Return a doc string that represents STRING.
+The result, when formatted by ‘substitute-command-keys’, should equal STRING."
+ (replace-regexp-in-string "['\\`]" "\\\\=\\&" string))
+
;; The following functions used to be in help-fns.el, which is not preloaded.
;; But for various reasons, they are more widely needed, so they were
;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001
@@ -1364,12 +1369,17 @@ DEF is the function whose usage we're looking for in DOCSTRING."
;; function's name in the doc string so we use `fn' as the anonymous
;; function name instead.
(when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
- (cons (format "(%s%s"
- ;; Replace `fn' with the actual function name.
- (if (symbolp def) def "anonymous")
- (match-string 1 docstring))
- (unless (zerop (match-beginning 0))
- (substring docstring 0 (match-beginning 0))))))
+ (let ((doc (unless (zerop (match-beginning 0))
+ (substring docstring 0 (match-beginning 0))))
+ (usage-tail (match-string 1 docstring)))
+ (cons (format "(%s%s"
+ ;; Replace `fn' with the actual function name.
+ (if (symbolp def)
+ (help--docstring-quote
+ (substring (format "%S" (list def)) 1 -1))
+ 'anonymous)
+ usage-tail)
+ doc))))
(defun help-add-fundoc-usage (docstring arglist)
"Add the usage info to DOCSTRING.
@@ -1387,7 +1397,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
(if (and (stringp arglist)
(string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
(concat "(fn" (match-string 1 arglist) ")")
- (format "%S" (help-make-usage 'fn arglist))))))
+ (help--make-usage-docstring 'fn arglist)))))
(defun help-function-arglist (def &optional preserve-names)
"Return a formal argument list for the function DEF.
@@ -1442,7 +1452,7 @@ the same names as used in the original source code, when possible."
"[Arg list not available until function definition is loaded.]")
(t t)))
-(defun help-make-usage (function arglist)
+(defun help--make-usage (function arglist)
(cons (if (symbolp function) function 'anonymous)
(mapcar (lambda (arg)
(if (not (symbolp arg)) arg
@@ -1454,6 +1464,11 @@ the same names as used in the original source code, when possible."
(t (intern (upcase name)))))))
arglist)))
+(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
+
+(defun help--make-usage-docstring (fn arglist)
+ (help--docstring-quote (format "%S" (help--make-usage fn arglist))))
+
\f
(provide 'help)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 5d5f258..11c9b16 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1436,7 +1436,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
ARGLIST is either a string, or a list of strings or symbols."
(let ((str (cond ((stringp arglist) arglist)
((not (listp arglist)) nil)
- (t (format "%S" (help-make-usage 'toto arglist))))))
+ (t (help--make-usage-docstring 'toto arglist)))))
(if (and str (string-match "\\`([^ )]+ ?" str))
(replace-match "(" t t str)
str)))
diff --git a/test/automated/help-fns.el b/test/automated/help-fns.el
index ba87593..4815ac6 100644
--- a/test/automated/help-fns.el
+++ b/test/automated/help-fns.el
@@ -34,4 +34,27 @@
(goto-char (point-min))
(should (search-forward "autoloaded Lisp macro" (line-end-position)))))
+(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x)
+ "A function with a funny name.
+
+\(fn XYYZZY)"
+ x)
+
+(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x)
+ "Another function with a funny name."
+ x)
+
+(ert-deftest help-fns-test-funny-names ()
+ "Test for help with functions with funny names."
+ (describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f)
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward
+ "(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYYZZY)")))
+ (describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f)
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward
+ "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)"))))
+
;;; help-fns.el ends here
--
2.1.0
^ permalink raw reply related [flat|nested] 11+ messages in thread