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.

6 files changed, 79 insertions, 38 deletions

diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index faebe26904..a6db5e9e69 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 ab82b7eaef..0d3b21b833 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 d59eeab83e..931e8af4df 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 fd5cbc66ab..b766cd0e98 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 5d5f258ce7..11c9b16a3c 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 ba87593f42..4815ac6825 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