[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/substitute-command-keys 4052d20: Add new Lisp implementation of
|
From: |
Stefan Kangas |
|
Subject: |
scratch/substitute-command-keys 4052d20: Add new Lisp implementation of substitute-command-keys |
|
Date: |
Sun, 17 May 2020 18:56:25 -0400 (EDT) |
branch: scratch/substitute-command-keys
commit 4052d20a6b7df8ddf27f2d3c2146f25c70f4236e
Author: Stefan Kangas <address@hidden>
Commit: Stefan Kangas <address@hidden>
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.
---
lisp/help.el | 144 +++++++++++++++++++++++++++++++++
src/doc.c | 37 +++++++--
src/keyboard.c | 4 +-
src/keymap.c | 32 ++++++++
src/print.c | 2 +-
src/syntax.c | 2 +-
test/lisp/help-tests.el | 207 ++++++++++++++++++++++++++++++++++++++++++++++++
test/src/doc-tests.el | 96 ----------------------
8 files changed, 417 insertions(+), 107 deletions(-)
diff --git a/lisp/help.el b/lisp/help.el
index b7d867e..f0511db 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -974,6 +974,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."
+ (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)))))
+ ;; FIXME: Maybe just return string if nothing substituted?
+ ;; (if (string= string (buffer-string)) string (buffer-string))
+ (buffer-string)))))
+
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
diff --git a/src/doc.c b/src/doc.c
index 285c0db..cfec707 100644
--- a/src/doc.c
+++ b/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,28 @@ 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)
+{
+ enum text_quoting_style style = text_quoting_style();
+ switch (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 +904,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 +1022,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 +1058,6 @@ otherwise. */);
defsubr (&Sdocumentation);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
- defsubr (&Ssubstitute_command_keys);
+ defsubr (&Sget_quoting_style);
+ defsubr (&Ssubstitute_command_keys_old);
}
diff --git a/src/keyboard.c b/src/keyboard.c
index f9b9399..54e66df 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2036,7 +2036,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.
@@ -7851,7 +7851,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;
diff --git a/src/keymap.c b/src/keymap.c
index d98b27b..5f94d9d 100644
--- a/src/keymap.c
+++ b/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);
diff --git a/src/print.c b/src/print.c
index bd17691..de93688 100644
--- a/src/print.c
+++ b/src/print.c
@@ -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);
}
diff --git a/src/syntax.c b/src/syntax.c
index a03202d..342b0a4 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -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;
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 0862d12..c102b8c 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -3,6 +3,8 @@
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <address@hidden>
+;; Eli Zaretskii <address@hidden>
+;; Stefan Kangas <address@hidden>
;; 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,210 @@
(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
+ (that binding is currently shadowed by another mode)
+
+"))))
+
+(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 "\\{cc-mode-map}" ".*"))))
+
(provide 'help-tests)
;;; help-tests.el ends here
diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el
deleted file mode 100644
index 50cf014..0000000
--- a/test/src/doc-tests.el
+++ /dev/null
@@ -1,96 +0,0 @@
-;;; doc-tests.el --- Tests for doc.c -*- lexical-binding: t -*-
-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
-
-;; Author: Eli Zaretskii <address@hidden>
-
-;; This program 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.
-
-;; This program 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 this program. 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