From 6cd9e586cc065f02d69c97b23163ec91ccc2b5dd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 10 Sep 2022 07:37:36 +0200 Subject: [PATCH] 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 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 @@ -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 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 -- 2.39.2