New function substitute-quotes

* lisp/help.el (substitute-quotes): New function.  (Bug#51040)
* doc/lispref/help.texi (Keys in Documentation): Document
substitute-quotes.
* test/lisp/help-tests.el (help-tests-substitute-quotes): New test.

* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-theme.el (describe-theme-1):
* lisp/emacs-lisp/cl-extra.el (cl--describe-class):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor):
* lisp/emacs-lisp/package.el (describe-package-1):
* lisp/help-fns.el (help-fns--parent-mode, help-fns--var-risky)
(help-fns--var-file-local, help-fns--var-bufferlocal)
(describe-face):
* lisp/help.el (substitute-command-keys):
* lisp/progmodes/octave.el (octave-help): Use the new function
instead of 'substitute-command-keys'.

11 files changed, 81 insertions, 39 deletions

diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index ac284f745f4..154a7abeb63 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -384,6 +384,11 @@ given a special face @code{help-key-binding}, but if the optional
 argument @var{no-face} is non-@code{nil}, the function doesn't add
 this face to the produced string.
 
+@defun substitute-quotes string
+This function works like @code{substitute-command-keys}, but only
+replaces quote characters.
+@end defun
+
 @cindex advertised binding
 If a command has multiple bindings, this function normally uses the
 first one it finds.  You can specify one particular key binding by
diff --git a/etc/NEWS b/etc/NEWS
index 35b74aa7de6..ba2f57772c5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -145,6 +145,11 @@ reaches the end of the script, Emacs will exit with an exit code from
 the value of the final form.
 
 +++
+** New function 'substitute-quotes'.
+This function works like 'substitute-command-keys' but only
+substitutes quote characters.
+
++++
 ** Emacs now supports setting 'user-emacs-directory' via '--init-directory'.
 
 +++
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 724a6e0a941..56b482e1001 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -260,9 +260,9 @@ we can tell font lock about them.")
 	    (when (class-abstract-p C)
 	      (throw 'skip nil))
 
-	    (princ (substitute-command-keys "`"))
+            (princ (substitute-quotes "`"))
 	    (princ name)
-	    (princ (substitute-command-keys "'"))
+            (princ (substitute-quotes "'"))
 	    (when (slot-exists-p C 'key)
 	      (when key
 		(princ " - Character Key: ")
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 69ec837db88..90680ff68f8 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -496,7 +496,7 @@ It includes all faces in list FACES."
       (princ (substitute-command-keys " in `"))
       (help-insert-xref-button (file-name-nondirectory fn)
 			       'help-theme-def fn)
-      (princ (substitute-command-keys "'")))
+      (princ (substitute-quotes "'")))
     (princ ".\n")
     (if (custom-theme-p theme)
 	(progn
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 607810ee141..7c7f027d777 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -772,7 +772,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
       (help-insert-xref-button
        (help-fns-short-filename location)
        'cl-type-definition type location 'define-type)
-      (insert (substitute-command-keys "'")))
+      (insert (substitute-quotes "'")))
     (insert ".\n")
 
     ;; Parents.
@@ -782,7 +782,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
         (insert " Inherits from ")
         (while (setq cur (pop pl))
           (setq cur (cl--class-name cur))
-          (insert (substitute-command-keys "`"))
+          (insert (substitute-quotes "`"))
           (help-insert-xref-button (symbol-name cur)
                                    'cl-help-type cur)
           (insert (substitute-command-keys (if pl "', " "'"))))
@@ -796,7 +796,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
       (when ch
         (insert " Children ")
         (while (setq cur (pop ch))
-          (insert (substitute-command-keys "`"))
+          (insert (substitute-quotes "`"))
           (help-insert-xref-button (symbol-name cur)
                                    'cl-help-type cur)
           (insert (substitute-command-keys (if ch "', " "'"))))
@@ -815,10 +815,10 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
       (when generics
         (insert (propertize "Specialized Methods:\n\n" 'face 'bold))
         (dolist (generic generics)
-          (insert (substitute-command-keys "`"))
+          (insert (substitute-quotes "`"))
           (help-insert-xref-button (symbol-name generic)
                                    'help-function generic)
-          (insert (substitute-command-keys "'"))
+          (insert (substitute-quotes "'"))
           (pcase-dolist (`(,qualifiers ,args ,doc)
                          (cl--generic-method-documentation generic type))
             (insert (format " %s%S\n" qualifiers args)
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 5f67263f177..b599aabb7f7 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -153,7 +153,7 @@ are not abstract."
         (help-insert-xref-button
 	 (help-fns-short-filename location)
 	 'cl-type-definition ctr location 'define-type)
-	(insert (substitute-command-keys "'")))
+        (insert (substitute-quotes "'")))
       (insert ".\nCreates an object of class " (symbol-name ctr) ".")
       (goto-char (point-max))
       (if (autoloadp def)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ed23ee5f221..bf71447681b 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2648,7 +2648,7 @@ Helper function for `describe-package'."
                         "',\n             shadowing a ")
                        (propertize "built-in package"
                                    'font-lock-face 'package-status-built-in))
-             (insert (substitute-command-keys "'")))
+             (insert (substitute-quotes "'")))
            (if signed
                (insert ".")
              (insert " (unsigned)."))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index dac4a03cd94..d5b576de285 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -712,13 +712,13 @@ the C sources, too."
                           (get function
                                'derived-mode-parent))))
     (when parent-mode
-      (insert (substitute-command-keys "  Parent mode: `"))
+      (insert (substitute-quotes "  Parent mode: `"))
       (let ((beg (point)))
         (insert (format "%s" parent-mode))
         (make-text-button beg (point)
                           'type 'help-function
                           'help-args (list parent-mode)))
-      (insert (substitute-command-keys "'.\n")))))
+      (insert (substitute-quotes "'.\n")))))
 
 (defun help-fns--obsolete (function)
   ;; Ignore lambda constructs, keyboard macros, etc.
@@ -1559,7 +1559,7 @@ This cancels value editing without updating the value."
     (princ "  This variable may be risky if used as a \
 file-local variable.\n")
     (when (assq variable safe-local-variable-values)
-      (princ (substitute-command-keys
+      (princ (substitute-quotes
               "  However, you have added it to \
 `safe-local-variable-values'.\n")))))
 
@@ -1609,8 +1609,8 @@ variable.\n")))
 	          (insert-text-button
 	           file 'type 'help-dir-local-var-def
                    'help-args (list variable file)))
-	        (princ (substitute-command-keys "'.\n"))))
-          (princ (substitute-command-keys
+                (princ (substitute-quotes "'.\n"))))
+          (princ (substitute-quotes
 	          "  This variable's value is file-local.\n")))))))
 
 (add-hook 'help-fns-describe-variable-functions #'help-fns--var-watchpoints)
@@ -1690,10 +1690,10 @@ variable.\n")))
      ((not permanent-local))
      ((bufferp locus)
       (princ
-       (substitute-command-keys
+       (substitute-quotes
         "  This variable's buffer-local value is permanent.\n")))
      (t
-      (princ (substitute-command-keys
+      (princ (substitute-quotes
 	      "  This variable's value is permanent \
 if it is given a local binding.\n"))))))
 
@@ -1770,9 +1770,9 @@ If FRAME is omitted or nil, use the selected frame."
                     (setq help-mode--current-data (list :symbol f))
                   (setq help-mode--current-data (list :symbol f
                                                       :file file-name))
-		  (princ (substitute-command-keys "Defined in `"))
+                (princ (substitute-quotes "Defined in `"))
 		  (princ (help-fns-short-filename file-name))
-		  (princ (substitute-command-keys "'"))
+                (princ (substitute-quotes "'"))
 		  ;; Make a hyperlink to the library.
 		  (save-excursion
 		    (re-search-backward
diff --git a/lisp/help.el b/lisp/help.el
index 15ab3192ad7..92b87cf7999 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1260,9 +1260,9 @@ Otherwise, return a new string."
                   (cond
                    ((null this-keymap)
                     (insert "\nUses keymap "
-                            (substitute-command-keys "`")
+                            (substitute-quotes "`")
                             (symbol-name name)
-                            (substitute-command-keys "'")
+                            (substitute-quotes "'")
                             ", which is not currently defined.\n")
                     (unless generate-summary
                       (setq keymap nil)))
@@ -1291,6 +1291,18 @@ Otherwise, return a new string."
              (t (forward-char 1)))))
         (buffer-string)))))
 
+(defun substitute-quotes (string)
+  "Substitute quote characters for display.
+Each grave accent \\=` is replaced by left quote, and each
+apostrophe \\=' is replaced by right quote.  Left and right quote
+characters are specified by `text-quoting-style'."
+  (cond ((eq (text-quoting-style) 'curve)
+         (string-replace "`" "‘"
+                         (string-replace "'" "’" string)))
+        ((eq (text-quoting-style) 'straight)
+         (string-replace "`" "'" string))
+        (t string)))
+
 (defvar help--keymaps-seen nil)
 (defun describe-map-tree (startmap &optional partial shadow prefix title
                                    no-menu transl always-title mention-shadow
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 721dfa51ad3..18b98991692 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1722,12 +1722,12 @@ code line."
                  (dir (file-name-directory
                        (directory-file-name (file-name-directory file)))))
             (replace-match "" nil nil nil 1)
-            (insert (substitute-command-keys "`"))
+            (insert (substitute-quotes "`"))
             ;; Include the parent directory which may be regarded as
             ;; the category for the FN.
             (help-insert-xref-button (file-relative-name file dir)
                                      'octave-help-file fn)
-            (insert (substitute-command-keys "'"))))
+            (insert (substitute-quotes "'"))))
         ;; Make 'See also' clickable.
         (with-syntax-table octave-mode-syntax-table
           (when (re-search-forward "^\\s-*See also:" nil t)
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 833c32ffb27..6f1dcfa5b6b 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -200,25 +200,45 @@ M-g M-c		switch-to-completions
             "\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n")))
 
 (ert-deftest help-tests-substitute-command-keys/quotes ()
- (with-substitute-command-keys-test
+  (with-substitute-command-keys-test
+   (let ((text-quoting-style 'curve))
+     (test "quotes ‘like this’" "quotes ‘like this’")
+     (test "`x'" "‘x’")
+     (test "`" "‘")
+     (test "'" "’")
+     (test "\\`" "\\‘"))
+   (let ((text-quoting-style 'straight))
+     (test "quotes `like this'" "quotes 'like this'")
+     (test "`x'" "'x'")
+     (test "`" "'")
+     (test "'" "'")
+     (test "\\`" "\\'"))
+   (let ((text-quoting-style 'grave))
+     (test "quotes `like this'" "quotes `like this'")
+     (test "`x'" "`x'")
+     (test "`" "`")
+     (test "'" "'")
+     (test "\\`" "\\`"))))
+
+(ert-deftest help-tests-substitute-quotes ()
   (let ((text-quoting-style 'curve))
-    (test "quotes ‘like this’" "quotes ‘like this’")
-    (test "`x'" "‘x’")
-    (test "`" "‘")
-    (test "'" "’")
-    (test "\\`" "\\‘"))
+    (should (string= (substitute-quotes "quotes ‘like this’") "quotes ‘like this’"))
+    (should (string= (substitute-quotes "`x'") "‘x’"))
+    (should (string= (substitute-quotes "`") "‘"))
+    (should (string= (substitute-quotes "'") "’"))
+    (should (string= (substitute-quotes "\\`") "\\‘")))
   (let ((text-quoting-style 'straight))
-    (test "quotes `like this'" "quotes 'like this'")
-    (test "`x'" "'x'")
-    (test "`" "'")
-    (test "'" "'")
-    (test "\\`" "\\'"))
+    (should (string= (substitute-quotes "quotes `like this'") "quotes 'like this'"))
+    (should (string= (substitute-quotes "`x'") "'x'"))
+    (should (string= (substitute-quotes "`") "'"))
+    (should (string= (substitute-quotes "'") "'"))
+    (should (string= (substitute-quotes "\\`") "\\'")))
   (let ((text-quoting-style 'grave))
-    (test "quotes `like this'" "quotes `like this'")
-    (test "`x'" "`x'")
-    (test "`" "`")
-    (test "'" "'")
-    (test "\\`" "\\`"))))
+    (should (string= (substitute-quotes "quotes `like this'") "quotes `like this'"))
+    (should (string= (substitute-quotes "`x'") "`x'"))
+    (should (string= (substitute-quotes "`") "`"))
+    (should (string= (substitute-quotes "'") "'"))
+    (should (string= (substitute-quotes "\\`") "\\`"))))
 
 (ert-deftest help-tests-substitute-command-keys/literals ()
   (with-substitute-command-keys-test