master 6cd9e586cc: New function substitute-quotes

[Lars Ingebrigtsen]

branch: master
commit 6cd9e586cc065f02d69c97b23163ec91ccc2b5dd
Author: Stefan Kangas <stefan@marxist.se>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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'.
---
 doc/lispref/help.texi          |  5 ++++
 etc/NEWS                       |  5 ++++
 lisp/cedet/srecode/srt-mode.el |  4 ++--
 lisp/cus-theme.el              |  2 +-
 lisp/emacs-lisp/cl-extra.el    | 10 ++++----
 lisp/emacs-lisp/eieio-opt.el   |  2 +-
 lisp/emacs-lisp/package.el     |  2 +-
 lisp/help-fns.el               | 18 +++++++--------
 lisp/help.el                   | 16 +++++++++++--
 lisp/progmodes/octave.el       |  4 ++--
 test/lisp/help-tests.el        | 52 +++++++++++++++++++++++++++++-------------
 11 files changed, 81 insertions(+), 39 deletions(-)

diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index ac284f745f..154a7abeb6 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 35b74aa7de..ba2f57772c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -144,6 +144,11 @@ and then execute the rest of the script file as Emacs 
Lisp.  When it
 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 724a6e0a94..56b482e100 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 69ec837db8..90680ff68f 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 607810ee14..7c7f027d77 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 5f67263f17..b599aabb7f 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 ed23ee5f22..bf71447681 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 dac4a03cd9..d5b576de28 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 15ab3192ad..92b87cf799 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 721dfa51ad..18b9899169 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 833c32ffb2..6f1dcfa5b6 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