From 37315f9895406e7ba4c7dce3a5fe179fa658c04c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 25 Jun 2022 12:25:58 +0200 Subject: [PATCH] Don't error out on invalid literal key substitutions It would be backwards-incompatible to error out on invalid literal key substitutions. Consider this docstring fragment, where "\\`" should have been escaped but wasn't: "Example value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\"." If we error out, we can't display this docstring at all. However, it is clearly better to display something in such cases, even if suboptimal, than refusing to display anything at all. * lisp/help.el (substitute-command-keys): Don't error out on invalid literal key substitutions: just ignore them instead. * test/lisp/help-tests.el (help-tests-substitute-command-keys/literal-key-sequence-errors): Delete test. (help-tests-substitute-command-keys/literal-key-sequence-ignore-invalid): New test. --- lisp/help.el | 34 ++++++++++++++++------------------ test/lisp/help-tests.el | 10 ++++++---- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index f14617b4371..fbcf8461e61 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1165,26 +1165,24 @@ Otherwise, return a new string." (delete-char 2) (ignore-errors (forward-char 1))) + ;; 1C. \`f' is replaced with a fontified f. ((and (= (following-char) ?`) (save-excursion (prog1 (search-forward "'" nil t) - (setq end-point (- (point) 2))))) - (goto-char orig-point) - (delete-char 2) - (goto-char (1- end-point)) - (delete-char 1) - ;; (backward-char 1) - (let ((k (buffer-substring-no-properties orig-point (point)))) - (cond ((= (length k) 0) - (error "Empty key sequence in substitution")) - ((and (not (string-match-p "\\`M-x " k)) - (not (key-valid-p k))) - (error "Invalid key sequence in substitution: `%s'" k)))) - (unless no-face - (add-text-properties orig-point (point) - '( face help-key-binding - font-lock-face help-key-binding)))) - ;; 1C. \[foo] is replaced with the keybinding. + (setq end-point (1- (point)))))) + (let ((k (buffer-substring-no-properties (+ orig-point 2) + end-point))) + (when (or (key-valid-p k) + (string-match-p "\\`M-x " k)) + (goto-char orig-point) + (delete-char 2) + (goto-char (- end-point 2)) ; nb. take deletion into account + (delete-char 1) + (unless no-face + (add-text-properties orig-point (point) + '( face help-key-binding + font-lock-face help-key-binding)))))) + ;; 1D. \[foo] is replaced with the keybinding. ((and (= (following-char) ?\[) (save-excursion (prog1 (search-forward "]" nil t) @@ -1228,7 +1226,7 @@ Otherwise, return a new string." (help-mode--add-function-link key fun) key) key))))))) - ;; 1D. \{foo} is replaced with a summary of the keymap + ;; 1E. \{foo} is replaced with a summary of the keymap ;; (symbol-value foo). ;; \ just sets the keymap used for \[cmd]. ((and (or (and (= (following-char) ?{) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 14a1fb49aec..5c935965f78 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -95,10 +95,12 @@ (test "\\`C-m'\\`C-j'" "C-mC-j") (test "foo\\`C-m'bar\\`C-j'baz" "fooC-mbarC-jbaz"))) -(ert-deftest help-tests-substitute-command-keys/literal-key-sequence-errors () - (should-error (substitute-command-keys "\\`'")) - (should-error (substitute-command-keys "\\`c-c'")) - (should-error (substitute-command-keys "\\`'"))) +(ert-deftest help-tests-substitute-command-keys/literal-key-sequence-ignore-invalid () + "Ignore any invalid literal key sequence." + (with-substitute-command-keys-test + (test-re "ab\\`'cd" "ab\\\\[`'‘]['’]cd") + (test-re "\\`c-c'" "\\\\[`'‘]c-c['’]") + (test-re "\\`'" "\\\\[`'‘]['’]"))) (ert-deftest help-tests-substitute-key-bindings/help-key-binding-face () (let ((A (substitute-command-keys "\\[next-line]"))