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.

diff --git a/lisp/help.el b/lisp/help.el
index f14617b43719818d423ee298af5181558a3b731a..fbcf8461e613c7b5ce6ba6f6272678f692225bec 100644 (file)
--- 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).
                ;;     \<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 14a1fb49aeca81c5eeb56de38743fe5632fc5c3d..5c935965f786b5c3b56d1cb9c25cad7290139e9f 100644 (file)
--- 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 "\\`<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]"))