Subject: Re: bug#51040: No curved quotes in format-prompt and minibuffer-default-prompt-format

From: Stefan Kangas <[email-masked]>
Date: Mon, 11 Oct 2021 13:58:58 -0700

tags 51040 + patch
thanks

Lars Ingebrigtsen <[email-masked]> writes:

> Yeah, having a separate function for this would be good, because those
> bits are pretty confusing.  But as you say, in this `format-prompt'
> case, using `substitute-command-keys' is probably the right thing, since
> we could be actually using key defs in the prompt.

OK, so here's what I propose.  The first patch adds a function
`substitute-quotes' and could go to master, the second one changes
`format-prompt' to use `substitute-command-keys' and could go to
emacs-28.
From e455d509a27b2705f006bc2111228a9a8b8df0b4 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
Date: Mon, 11 Oct 2021 22:46:31 +0200
Subject: [PATCH 1/2] New function substitute-quotes

* lisp/help.el (substitute-quotes): New function.  (Bug#51040)
* 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'.
* test/lisp/help-tests.el (help-tests-substitute-quotes): New test.
---
 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                   | 17 +++++++++++++++--
 lisp/progmodes/octave.el       |  4 ++--
 test/lisp/help-tests.el        | 20 ++++++++++++++++++++
 9 files changed, 56 insertions(+), 23 deletions(-)

diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 7157915849..0fc2a12822 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -260,9 +260,9 @@ srecode-macro-help
 	    (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 f618e3341c..fc278ba164 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -496,7 +496,7 @@ describe-theme-1
       (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 499d26b737..7a0ecbdf81 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -769,7 +769,7 @@ cl--describe-class
       (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.
@@ -779,7 +779,7 @@ cl--describe-class
         (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 "', " "'"))))
@@ -793,7 +793,7 @@ cl--describe-class
       (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 "', " "'"))))
@@ -812,10 +812,10 @@ cl--describe-class
       (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 9c842f4682..17931f29f3 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -152,7 +152,7 @@ eieio-help-constructor
         (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 5445fa970f..bb0ba20a4f 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2546,7 +2546,7 @@ describe-package-1
                         "',\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 6be5cd4a50..8e4f4d7ac8 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -614,13 +614,13 @@ help-fns--parent-mode
                           (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.
@@ -1307,7 +1307,7 @@ help-fns--var-risky
     (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")))))
 
@@ -1357,8 +1357,8 @@ help-fns--var-file-local
 	          (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)
@@ -1436,10 +1436,10 @@ help-fns--var-bufferlocal
      ((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"))))))
 
@@ -1515,9 +1515,9 @@ describe-face
                   (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 eaca33795a..9da4f03786 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1172,9 +1172,9 @@ substitute-command-keys
                   (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)))
@@ -1201,6 +1201,19 @@ substitute-command-keys
              (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)
+         (replace-regexp-in-string
+          "`" "‘"
+          (replace-regexp-in-string "'" "’" string)))
+        ((eq (text-quoting-style) 'straight)
+         (replace-regexp-in-string "`" "'" string))
+        (t string))))
+
 (defvar help--keymaps-seen nil)
 (defun describe-map-tree (startmap partial shadow prefix title no-menu
                                    transl always-title mention-shadow)
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 6bf070cf9e..c7b1b4f61d 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1721,12 +1721,12 @@ octave-help
                  (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 871417da3d..13403050b9 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -167,6 +167,26 @@ help-tests-substitute-command-keys/quotes
     (test "'" "'")
     (test "\\`" "\\`"))))
 
+(ert-deftest help-tests-substitute-quotes ()
+ (let ((text-quoting-style 'curve))
+   (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))
+   (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))
+   (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
    (test "foo \\=\\[goto-char]" "foo \\[goto-char]")
-- 
2.30.2

From 7c229589833db0ef21128efd0672281279ba1823 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
Date: Mon, 11 Oct 2021 22:50:38 +0200
Subject: [PATCH 2/2] Use substitute-command-keys in format-prompt

* lisp/minibuffer.el (format-prompt): Use substitute-command-keys.
(Bug#51040)
---
 lisp/minibuffer.el | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1e1a6f852e..694800de7c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4229,18 +4229,19 @@ format-prompt
 
 If DEFAULT is nil or an empty string, no \"default value\" string
 is included in the return value."
-  (concat
-   (if (null format-args)
-       prompt
-     (apply #'format prompt format-args))
-   (and default
-        (or (not (stringp default))
-            (length> default 0))
-        (format minibuffer-default-prompt-format
-                (if (consp default)
-                    (car default)
-                  default)))
-   ": "))
+  (substitute-command-keys
+   (concat
+    (if (null format-args)
+        prompt
+      (apply #'format prompt format-args))
+    (and default
+         (or (not (stringp default))
+             (length> default 0))
+         (format minibuffer-default-prompt-format
+                 (if (consp default)
+                     (car default)
+                   default)))
+    ": ")))
 
 (provide 'minibuffer)
 
-- 
2.30.2