From b2205626370071bc85dc07b043c833bc50c0baec Mon Sep 17 00:00:00 2001 From: Paul Eggert 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 faebe269044..a6db5e9e696 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 ab82b7eaef3..0d3b21b8330 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 d59eeab83e3..931e8af4df0 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 fd5cbc66ab2..b766cd0e983 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))))) +(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)))) + (provide 'help) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 5d5f258ce77..11c9b16a3c9 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 ba87593f420..4815ac68257 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.11.4.GIT