Add new Lisp implementation of substitute-command-keys
This is only the first step towards a full Lisp implementation, and does not remove the old C code. On the contrary, it is partly based on using the old C code, which is to be replaced in steps. This also makes it easy to test that it produces the same output as the old. * src/doc.c (Fsubstitute_command_keys_old): Rename from Fsubstitute_command_keys. (Fget_quoting_style): New defun to expose text_quoting_style to Lisp. (syms_of_doc): Expose above symbols. * lisp/help.el (substitute-command-keys): New Lisp version of substitute-command-keys. (Bug#8951) * src/keymap.c (Fdescribe_map_tree): New defun to expose describe_map_tree to Lisp. (syms_of_keymap): New defsubr for Fdescribe_map_tree. * src/keyboard.c (help_echo_substitute_command_keys): * src/doc.c (Fdocumentation, Fdocumentation_property): * src/print.c (print_error_message): * src/syntax.c (Finternal_describe_syntax_value): Fix calls to use new Lisp implementation of substitute-command-keys. * test/src/doc-tests.el: Remove file. * test/lisp/help-tests.el: Add tests for substitute-command-keys copied from above file.
This commit is contained in:
Stefan Kangas
Stefan Kangas
parent
282f35083c
commit
dcf9cd47ae
8 changed files with 419 additions and 109 deletions
144
lisp/help.el
144
lisp/help.el
|
|
@ -973,6 +973,150 @@ is currently activated with completion."
|
|||
minor-modes nil)
|
||||
(setq minor-modes (cdr minor-modes)))))
|
||||
result))
|
||||
|
||||
|
||||
(defun substitute-command-keys (string)
|
||||
"Substitute key descriptions for command names in STRING.
|
||||
Each substring of the form \\\\=[COMMAND] is replaced by either a
|
||||
keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
|
||||
is not on any keys.
|
||||
|
||||
Each substring of the form \\\\={MAPVAR} is replaced by a summary of
|
||||
the value of MAPVAR as a keymap. This summary is similar to the one
|
||||
produced by ‘describe-bindings’. The summary ends in two newlines
|
||||
(used by the helper function ‘help-make-xrefs’ to find the end of the
|
||||
summary).
|
||||
|
||||
Each substring of the form \\\\=<MAPVAR> specifies the use of MAPVAR
|
||||
as the keymap for future \\\\=[COMMAND] substrings.
|
||||
|
||||
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’.
|
||||
|
||||
\\\\== quotes the following character and is discarded; thus, \\\\==\\\\== puts \\\\==
|
||||
into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` into the
|
||||
output.
|
||||
|
||||
Return the original STRING if no substitutions are made.
|
||||
Otherwise, return a new string (without any text properties)."
|
||||
(when (not (null string))
|
||||
;; KEYMAP is either nil (which means search all the active
|
||||
;; keymaps) or a specified local map (which means search just that
|
||||
;; and the global map). If non-nil, it might come from
|
||||
;; overriding-local-map, or from a \\<mapname> construct in STRING
|
||||
;; itself.
|
||||
(let ((keymap overriding-local-map)
|
||||
(inhibit-modification-hooks t)
|
||||
(orig-buf (current-buffer)))
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(while (< (point) (point-max))
|
||||
(let ((orig-point (point))
|
||||
end-point active-maps
|
||||
close generate-summary)
|
||||
(cond
|
||||
;; 1. Handle all sequences starting with "\"
|
||||
((= (following-char) ?\\)
|
||||
(ignore-errors
|
||||
(forward-char 1))
|
||||
(cond
|
||||
;; 1A. Ignore \= at end of string.
|
||||
((and (= (+ (point) 1) (point-max))
|
||||
(= (following-char) ?=))
|
||||
(forward-char 1))
|
||||
;; 1B. \= quotes the next character; thus, to put in \[
|
||||
;; without its special meaning, use \=\[.
|
||||
((= (following-char) ?=)
|
||||
(goto-char orig-point)
|
||||
(delete-char 2)
|
||||
(ignore-errors
|
||||
(forward-char 1)))
|
||||
;; 1C. \[foo] is replaced with the keybinding.
|
||||
((and (= (following-char) ?\[)
|
||||
(save-excursion
|
||||
(prog1 (search-forward "]" nil t)
|
||||
(setq end-point (- (point) 2)))))
|
||||
(goto-char orig-point)
|
||||
(delete-char 2)
|
||||
(let* ((fun (intern (buffer-substring (point) (1- end-point))))
|
||||
(key (with-current-buffer orig-buf
|
||||
(where-is-internal fun keymap t))))
|
||||
;; If this a command remap, we need to follow it.
|
||||
(when (and (vectorp key)
|
||||
(> (length key) 1)
|
||||
(eq (aref key 0) 'remap)
|
||||
(symbolp (aref key 1)))
|
||||
(setq fun (aref key 1))
|
||||
(setq key (with-current-buffer orig-buf
|
||||
(where-is-internal fun keymap t))))
|
||||
(if (not key)
|
||||
;; Function is not on any key.
|
||||
(progn (insert "M-x ")
|
||||
(goto-char (+ end-point 3))
|
||||
(delete-char 1))
|
||||
;; Function is on a key.
|
||||
(delete-char (- end-point (point)))
|
||||
(insert (key-description key)))))
|
||||
;; 1D. \{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) ?{)
|
||||
(setq close "}")
|
||||
(setq generate-summary t))
|
||||
(and (= (following-char) ?<)
|
||||
(setq close ">")))
|
||||
(or (save-excursion
|
||||
(prog1 (search-forward close nil t)
|
||||
(setq end-point (- (point) 2))))))
|
||||
(goto-char orig-point)
|
||||
(delete-char 2)
|
||||
(let* ((name (intern (buffer-substring (point) (1- end-point))))
|
||||
this-keymap)
|
||||
(delete-char (- end-point (point)))
|
||||
;; Get the value of the keymap in TEM, or nil if
|
||||
;; undefined. Do this in the user's current buffer
|
||||
;; in case it is a local variable.
|
||||
(with-current-buffer orig-buf
|
||||
;; This is for computing the SHADOWS arg for
|
||||
;; describe-map-tree.
|
||||
(setq active-maps (current-active-maps))
|
||||
(when (boundp name)
|
||||
(setq this-keymap (and (keymapp (symbol-value name))
|
||||
(symbol-value name)))))
|
||||
(cond
|
||||
((null this-keymap)
|
||||
(insert "\nUses keymap "
|
||||
(substitute-command-keys "`")
|
||||
(symbol-name name)
|
||||
(substitute-command-keys "'")
|
||||
", which is not currently defined.\n")
|
||||
(unless generate-summary
|
||||
(setq keymap nil)))
|
||||
((not generate-summary)
|
||||
(setq keymap this-keymap))
|
||||
(t
|
||||
;; Get the list of active keymaps that precede this one.
|
||||
;; If this one's not active, get nil.
|
||||
(let ((earlier-maps (cdr (memq this-keymap (reverse active-maps)))))
|
||||
(describe-map-tree this-keymap t (nreverse earlier-maps)
|
||||
nil nil t nil nil))))))))
|
||||
;; 2. Handle quotes.
|
||||
((and (eq (get-quoting-style) 'curve)
|
||||
(or (and (= (following-char) ?\`)
|
||||
(prog1 t (insert "‘")))
|
||||
(and (= (following-char) ?')
|
||||
(prog1 t (insert "’")))))
|
||||
(delete-char 1))
|
||||
((and (eq (get-quoting-style) 'straight)
|
||||
(= (following-char) ?\`))
|
||||
(insert "'")
|
||||
(delete-char 1))
|
||||
;; 3. Nothing to do -- next character.
|
||||
(t (forward-char 1)))))
|
||||
(buffer-string)))))
|
||||
|
||||
|
||||
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
|
||||
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
|
||||
|
|
|
|||
36
src/doc.c
36
src/doc.c
|
|
@ -415,7 +415,7 @@ string is passed through `substitute-command-keys'. */)
|
|||
}
|
||||
|
||||
if (NILP (raw))
|
||||
doc = Fsubstitute_command_keys (doc);
|
||||
doc = call1 (Qsubstitute_command_keys, doc);
|
||||
return doc;
|
||||
}
|
||||
|
||||
|
|
@ -472,7 +472,7 @@ aren't strings. */)
|
|||
tem = Feval (tem, Qnil);
|
||||
|
||||
if (NILP (raw) && STRINGP (tem))
|
||||
tem = Fsubstitute_command_keys (tem);
|
||||
tem = call1 (Qsubstitute_command_keys, tem);
|
||||
return tem;
|
||||
}
|
||||
|
||||
|
|
@ -696,8 +696,27 @@ text_quoting_style (void)
|
|||
return CURVE_QUOTING_STYLE;
|
||||
}
|
||||
|
||||
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
|
||||
Ssubstitute_command_keys, 1, 1, 0,
|
||||
/* This is just a Lisp wrapper for text_quoting_style above. */
|
||||
DEFUN ("get-quoting-style", Fget_quoting_style,
|
||||
Sget_quoting_style, 0, 0, 0,
|
||||
doc: /* Return the current effective text quoting style.
|
||||
See variable `text-quoting-style'. */)
|
||||
(void)
|
||||
{
|
||||
switch (text_quoting_style ())
|
||||
{
|
||||
case STRAIGHT_QUOTING_STYLE:
|
||||
return Qstraight;
|
||||
case CURVE_QUOTING_STYLE:
|
||||
return Qcurve;
|
||||
case GRAVE_QUOTING_STYLE:
|
||||
default:
|
||||
return Qgrave;
|
||||
}
|
||||
}
|
||||
|
||||
DEFUN ("substitute-command-keys-old", Fsubstitute_command_keys_old,
|
||||
Ssubstitute_command_keys_old, 1, 1, 0,
|
||||
doc: /* Substitute key descriptions for command names in STRING.
|
||||
Each substring of the form \\=\\[COMMAND] is replaced by either a
|
||||
keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
|
||||
|
|
@ -884,12 +903,12 @@ Otherwise, return a new string (without any text properties). */)
|
|||
{
|
||||
name = Fsymbol_name (name);
|
||||
AUTO_STRING (msg_prefix, "\nUses keymap `");
|
||||
insert1 (Fsubstitute_command_keys (msg_prefix));
|
||||
insert1 (Fsubstitute_command_keys_old (msg_prefix));
|
||||
insert_from_string (name, 0, 0,
|
||||
SCHARS (name),
|
||||
SBYTES (name), 1);
|
||||
AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
|
||||
insert1 (Fsubstitute_command_keys (msg_suffix));
|
||||
insert1 (Fsubstitute_command_keys_old (msg_suffix));
|
||||
if (!generate_summary)
|
||||
keymap = Qnil;
|
||||
}
|
||||
|
|
@ -1002,9 +1021,11 @@ Otherwise, return a new string (without any text properties). */)
|
|||
void
|
||||
syms_of_doc (void)
|
||||
{
|
||||
DEFSYM (Qsubstitute_command_keys, "substitute-command-keys");
|
||||
DEFSYM (Qfunction_documentation, "function-documentation");
|
||||
DEFSYM (Qgrave, "grave");
|
||||
DEFSYM (Qstraight, "straight");
|
||||
DEFSYM (Qcurve, "curve");
|
||||
|
||||
DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
|
||||
doc: /* Name of file containing documentation strings of built-in symbols. */);
|
||||
|
|
@ -1036,5 +1057,6 @@ otherwise. */);
|
|||
defsubr (&Sdocumentation);
|
||||
defsubr (&Sdocumentation_property);
|
||||
defsubr (&Ssnarf_documentation);
|
||||
defsubr (&Ssubstitute_command_keys);
|
||||
defsubr (&Sget_quoting_style);
|
||||
defsubr (&Ssubstitute_command_keys_old);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2040,7 +2040,7 @@ help_echo_substitute_command_keys (Lisp_Object help)
|
|||
help)))
|
||||
return help;
|
||||
|
||||
return Fsubstitute_command_keys (help);
|
||||
return call1 (Qsubstitute_command_keys, help);
|
||||
}
|
||||
|
||||
/* Display the help-echo property of the character after the mouse pointer.
|
||||
|
|
@ -7856,7 +7856,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
|
|||
/* The previous code preferred :key-sequence to :keys, so we
|
||||
preserve this behavior. */
|
||||
if (STRINGP (keyeq) && !CONSP (keyhint))
|
||||
keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq));
|
||||
keyeq = concat2 (space_space, call1 (Qsubstitute_command_keys, keyeq));
|
||||
else
|
||||
{
|
||||
Lisp_Object prefix = keyeq;
|
||||
|
|
|
|||
32
src/keymap.c
32
src/keymap.c
|
|
@ -2915,6 +2915,37 @@ You type Translation\n\
|
|||
|
||||
Any inserted text ends in two newlines (used by `help-make-xrefs'). */
|
||||
|
||||
DEFUN ("describe-map-tree", Fdescribe_map_tree, Sdescribe_map_tree, 1, 8, 0,
|
||||
doc: /* This is just temporary. */)
|
||||
(Lisp_Object startmap, Lisp_Object partial, Lisp_Object shadow,
|
||||
Lisp_Object prefix, Lisp_Object title, Lisp_Object nomenu,
|
||||
Lisp_Object transl, Lisp_Object always_title)
|
||||
{
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
char *title_string;
|
||||
|
||||
if ( !NILP (title) )
|
||||
{
|
||||
CHECK_STRING (title);
|
||||
title_string = SSDATA(title);
|
||||
}
|
||||
else
|
||||
{
|
||||
title_string = NULL;
|
||||
}
|
||||
|
||||
bool b_partial = NILP (partial) ? false : true;
|
||||
bool b_nomenu = NILP (nomenu) ? false : true;
|
||||
bool b_transl = NILP (transl) ? false : true;
|
||||
bool b_always_title = NILP (always_title) ? false : true;
|
||||
|
||||
/* specbind (Qstandard_output, Fcurrent_buffer ()); */
|
||||
describe_map_tree (startmap, b_partial, shadow, prefix, title_string,
|
||||
b_nomenu, b_transl, b_always_title, true);
|
||||
|
||||
return unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
void
|
||||
describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
|
||||
Lisp_Object prefix, const char *title, bool nomenu,
|
||||
|
|
@ -3708,6 +3739,7 @@ be preferred. */);
|
|||
defsubr (&Scurrent_active_maps);
|
||||
defsubr (&Saccessible_keymaps);
|
||||
defsubr (&Skey_description);
|
||||
defsubr (&Sdescribe_map_tree);
|
||||
defsubr (&Sdescribe_vector);
|
||||
defsubr (&Ssingle_key_description);
|
||||
defsubr (&Stext_char_description);
|
||||
|
|
|
|||
|
|
@ -941,7 +941,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
|
|||
else
|
||||
{
|
||||
Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
|
||||
errmsg = Fsubstitute_command_keys (Fget (errname, Qerror_message));
|
||||
errmsg = call1 (Qsubstitute_command_keys, Fget (errname, Qerror_message));
|
||||
file_error = Fmemq (Qfile_error, error_conditions);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1421,7 +1421,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
|
|||
{
|
||||
AUTO_STRING (prefixdoc,
|
||||
",\n\t is a prefix character for `backward-prefix-chars'");
|
||||
insert1 (Fsubstitute_command_keys (prefixdoc));
|
||||
insert1 (call1 (Qsubstitute_command_keys, prefixdoc));
|
||||
}
|
||||
|
||||
return syntax;
|
||||
|
|
|
|||
|
|
@ -3,6 +3,8 @@
|
|||
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Juanma Barranquero <lekktu@gmail.com>
|
||||
;; Eli Zaretskii <eliz@gnu.org>
|
||||
;; Stefan Kangas <stefankangas@gmail.com>
|
||||
;; Keywords: help, internal
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
|
@ -23,6 +25,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(ert-deftest help-split-fundoc-SECTION ()
|
||||
"Test new optional arg SECTION."
|
||||
|
|
@ -51,6 +54,213 @@
|
|||
(should (equal (help-split-fundoc nil t 'usage) nil))
|
||||
(should (equal (help-split-fundoc nil t 'doc) nil))))
|
||||
|
||||
|
||||
;;; substitute-command-keys
|
||||
|
||||
(defmacro with-substitute-command-keys-test (&rest body)
|
||||
`(cl-flet* ((should-be-same-as-c-version
|
||||
;; TODO: Remove this when old C function is removed.
|
||||
(lambda (orig)
|
||||
(should (equal-including-properties
|
||||
(substitute-command-keys orig)
|
||||
(substitute-command-keys-old orig)))))
|
||||
(test
|
||||
(lambda (orig result)
|
||||
(should (equal-including-properties
|
||||
(substitute-command-keys orig)
|
||||
result))
|
||||
(should-be-same-as-c-version orig)))
|
||||
(test-re
|
||||
(lambda (orig regexp)
|
||||
(should (string-match (concat "^" regexp "$")
|
||||
(substitute-command-keys orig)))
|
||||
(should-be-same-as-c-version orig))))
|
||||
,@body))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/no-change ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "foo" "foo")
|
||||
(test "\\invalid-escape" "\\invalid-escape")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/commands ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "foo \\[goto-char]" "foo M-g c")
|
||||
(test "\\[next-line]" "C-n")
|
||||
(test "\\[next-line]\n\\[next-line]" "C-n\nC-n")
|
||||
(test "\\[next-line]\\[previous-line]" "C-nC-p")
|
||||
(test "\\[next-line]\\=\\[previous-line]" "C-n\\[previous-line]")
|
||||
;; Allow any style of quotes, since the terminal might not support
|
||||
;; UTF-8. Same thing is done below.
|
||||
(test-re "\\[next-line]`foo'" "C-n[`'‘]foo['’]")
|
||||
(test "\\[emacs-version]" "M-x emacs-version")
|
||||
(test "\\[emacs-version]\\[next-line]" "M-x emacs-versionC-n")
|
||||
(test-re "\\[emacs-version]`foo'" "M-x emacs-version[`'‘]foo['’]")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/keymaps ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "\\{minibuffer-local-must-match-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
C-g abort-recursive-edit
|
||||
TAB minibuffer-complete
|
||||
C-j minibuffer-complete-and-exit
|
||||
RET minibuffer-complete-and-exit
|
||||
ESC Prefix Command
|
||||
SPC minibuffer-complete-word
|
||||
? minibuffer-completion-help
|
||||
<C-tab> file-cache-minibuffer-complete
|
||||
<XF86Back> previous-history-element
|
||||
<XF86Forward> next-history-element
|
||||
<down> next-line-or-history-element
|
||||
<next> next-history-element
|
||||
<prior> switch-to-completions
|
||||
<up> previous-line-or-history-element
|
||||
|
||||
M-v switch-to-completions
|
||||
|
||||
M-< minibuffer-beginning-of-buffer
|
||||
M-n next-history-element
|
||||
M-p previous-history-element
|
||||
M-r previous-matching-history-element
|
||||
M-s next-matching-history-element
|
||||
|
||||
")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g")
|
||||
(test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/undefined-map ()
|
||||
(with-substitute-command-keys-test
|
||||
(test-re "\\{foobar-map}"
|
||||
"\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/quotes ()
|
||||
(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-command-keys/literals ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "foo \\=\\[goto-char]" "foo \\[goto-char]")
|
||||
(test "foo \\=\\=" "foo \\=")
|
||||
(test "\\=\\=" "\\=")
|
||||
(test "\\=\\[" "\\[")
|
||||
(let ((text-quoting-style 'curve))
|
||||
(test "\\=`x\\='" "`x'"))
|
||||
(let ((text-quoting-style 'straight))
|
||||
(test "\\=`x\\='" "`x'"))
|
||||
(let ((text-quoting-style 'grave))
|
||||
(test "\\=`x\\='" "`x'"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/no-change ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "\\[foobar" "\\[foobar")
|
||||
(test "\\=" "\\=")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/multibyte ()
|
||||
;; Cannot use string= here, as that compares unibyte and multibyte
|
||||
;; strings not equal.
|
||||
(should (compare-strings
|
||||
(substitute-command-keys "\200 \\[goto-char]") nil nil
|
||||
"\200 M-g c" nil nil)))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/apropos ()
|
||||
(save-window-excursion
|
||||
(apropos "foo")
|
||||
(switch-to-buffer "*Apropos*")
|
||||
(goto-char (point-min))
|
||||
(should (looking-at "Type RET on"))))
|
||||
|
||||
(defvar help-tests-major-mode-map
|
||||
(let ((map (make-keymap)))
|
||||
(define-key map "x" 'foo-original)
|
||||
map))
|
||||
|
||||
(define-derived-mode help-tests-major-mode nil
|
||||
"Major mode for testing shadowing.")
|
||||
|
||||
(defvar help-tests-minor-mode-map
|
||||
(let ((map (make-keymap)))
|
||||
(define-key map "x" 'foo-shadow)
|
||||
map))
|
||||
|
||||
(define-minor-mode help-tests-minor-mode
|
||||
"Minor mode for testing shadowing.")
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/shadow ()
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(help-tests-major-mode)
|
||||
(test "\\{help-tests-major-mode-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
x foo-original
|
||||
|
||||
")
|
||||
(help-tests-minor-mode)
|
||||
(test "\\{help-tests-major-mode-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
x foo-original
|
||||
(this binding is currently shadowed)
|
||||
|
||||
"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/command-remap ()
|
||||
(with-substitute-command-keys-test
|
||||
(let ((help-tests-major-mode-map (make-keymap))) ; Protect from changes.
|
||||
(with-temp-buffer
|
||||
(help-tests-major-mode)
|
||||
(define-key help-tests-major-mode-map [remap foo] 'bar)
|
||||
(test "\\{help-tests-major-mode-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
<remap> Prefix Command
|
||||
|
||||
<remap> <foo> bar
|
||||
|
||||
")))))
|
||||
|
||||
;; TODO: This is a temporary test that should be removed together with
|
||||
;; substitute-command-keys-old.
|
||||
(ert-deftest help-tests-substitute-command-keys/compare ()
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(Info-mode)
|
||||
(outline-minor-mode)
|
||||
(test-re "\\{Info-mode-map}" ".*")))
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(c-mode)
|
||||
(outline-minor-mode)
|
||||
(test-re "\\{c-mode-map}" ".*"))))
|
||||
|
||||
(provide 'help-tests)
|
||||
|
||||
;;; help-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -1,98 +0,0 @@
|
|||
;;; doc-tests.el --- Tests for doc.c -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest doc-test-substitute-command-keys ()
|
||||
;; Bindings.
|
||||
(should (string= (substitute-command-keys "foo \\[goto-char]") "foo M-g c"))
|
||||
;; Cannot use string= here, as that compares unibyte and multibyte
|
||||
;; strings not equal.
|
||||
(should (compare-strings
|
||||
(substitute-command-keys "\200 \\[goto-char]") nil nil
|
||||
"\200 M-g c" nil nil))
|
||||
;; Literals.
|
||||
(should (string= (substitute-command-keys "foo \\=\\[goto-char]")
|
||||
"foo \\[goto-char]"))
|
||||
(should (string= (substitute-command-keys "foo \\=\\=")
|
||||
"foo \\="))
|
||||
;; Keymaps.
|
||||
;; I don't see that this is testing anything useful.
|
||||
;; AFAICS all it does it fail whenever someone modifies the
|
||||
;; minibuffer map.
|
||||
;;; (should (string= (substitute-command-keys
|
||||
;;; "\\{minibuffer-local-must-match-map}")
|
||||
;;; "\
|
||||
;;; key binding
|
||||
;;; --- -------
|
||||
;;;
|
||||
;;; C-g abort-recursive-edit
|
||||
;;; TAB minibuffer-complete
|
||||
;;; C-j minibuffer-complete-and-exit
|
||||
;;; RET minibuffer-complete-and-exit
|
||||
;;; ESC Prefix Command
|
||||
;;; SPC minibuffer-complete-word
|
||||
;;; ? minibuffer-completion-help
|
||||
;;; <C-tab> file-cache-minibuffer-complete
|
||||
;;; <XF86Back> previous-history-element
|
||||
;;; <XF86Forward> next-history-element
|
||||
;;; <down> next-line-or-history-element
|
||||
;;; <next> next-history-element
|
||||
;;; <prior> switch-to-completions
|
||||
;;; <up> previous-line-or-history-element
|
||||
;;;
|
||||
;;; M-v switch-to-completions
|
||||
;;;
|
||||
;;; M-< minibuffer-beginning-of-buffer
|
||||
;;; M-n next-history-element
|
||||
;;; M-p previous-history-element
|
||||
;;; M-r previous-matching-history-element
|
||||
;;; M-s next-matching-history-element
|
||||
;;;
|
||||
;;; "))
|
||||
(should (string=
|
||||
(substitute-command-keys
|
||||
"\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]")
|
||||
"C-g"))
|
||||
;; Allow any style of quotes, since the terminal might not support
|
||||
;; UTF-8.
|
||||
(should (string-match
|
||||
"\nUses keymap [`‘']foobar-map['’], which is not currently defined.\n"
|
||||
(substitute-command-keys "\\{foobar-map}")))
|
||||
;; Quotes.
|
||||
(should (let ((text-quoting-style 'grave))
|
||||
(string= (substitute-command-keys "quotes `like this'")
|
||||
"quotes `like this'")))
|
||||
(should (let ((text-quoting-style 'grave))
|
||||
(string= (substitute-command-keys "quotes ‘like this’")
|
||||
"quotes ‘like this’")))
|
||||
(should (let ((text-quoting-style 'straight))
|
||||
(string= (substitute-command-keys "quotes `like this'")
|
||||
"quotes 'like this'")))
|
||||
;; Bugs.
|
||||
(should (string= (substitute-command-keys "\\[foobar") "\\[foobar"))
|
||||
(should (string= (substitute-command-keys "\\=") "\\="))
|
||||
)
|
||||
|
||||
(provide 'doc-tests)
|
||||
;;; doc-tests.el ends here
|
||||
Loading…
Add table
Reference in a new issue