1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-13 09:32:47 +00:00

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.
This commit is contained in:
Stefan Kangas 2022-06-25 12:25:58 +02:00
parent 2f346b0ab1
commit 37315f9895
2 changed files with 22 additions and 22 deletions

View File

@ -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).
;; \<foo> just sets the keymap used for \[cmd].
((and (or (and (= (following-char) ?{)

View File

@ -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 "\\`<foo bar baz>'")))
(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 "\\`<foo bar baz>'" "\\\\[`']<foo bar baz>[']")))
(ert-deftest help-tests-substitute-key-bindings/help-key-binding-face ()
(let ((A (substitute-command-keys "\\[next-line]"))