summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-12 17:17:55 -0500
committerCraig Jennings <c@cjennings.net>2026-05-12 17:17:55 -0500
commit040038d42f82d48c2e6b57a0d4494d9aabf453a9 (patch)
treef28b9f0c681e1828422e0b19adf56cc2c3d8e389 /tests
parent2c5d1c518addd736f618e0441930062d97152760 (diff)
downloaddotemacs-040038d42f82d48c2e6b57a0d4494d9aabf453a9.tar.gz
dotemacs-040038d42f82d48c2e6b57a0d4494d9aabf453a9.zip
test(keyboard-compat): cover the terminal and GUI setup functions
`cj/keyboard-compat-terminal-setup` (8 `define-key`s into `input-decode-map` for arrow escape sequences) and `cj/keyboard-compat-gui-setup` (18 `M-<UPPER>` → `M-S-<lower>` translations into `key-translation-map`) had no tests — that's the bulk of the module's executable lines. I added `tests/test-keyboard-compat-setup.el` — 7 ERT tests that `let`-bind those keymaps to fresh copies, stub `env-terminal-p` / `env-gui-p`, and check the decode/translate entries land, with completeness loops over all 8 arrow sequences and all 18 Meta-Shift letters, plus the gate-off boundary for each. `cj/--icon-blank-in-terminal` was already covered. `lookup-key` on an ESC-prefixed string can return a meta-prefix event count instead of nil, so the "no-op when not on a terminal" case asserts the keymap is still empty rather than checking individual lookups.
Diffstat (limited to 'tests')
-rw-r--r--tests/test-keyboard-compat-setup.el101
1 files changed, 101 insertions, 0 deletions
diff --git a/tests/test-keyboard-compat-setup.el b/tests/test-keyboard-compat-setup.el
new file mode 100644
index 00000000..1c5cd434
--- /dev/null
+++ b/tests/test-keyboard-compat-setup.el
@@ -0,0 +1,101 @@
+;;; test-keyboard-compat-setup.el --- Tests for the keyboard-compat setup functions -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; `cj/keyboard-compat-terminal-setup' and `cj/keyboard-compat-gui-setup' each
+;; gate on the display type (`env-terminal-p' / `env-gui-p') and then mutate a
+;; global keymap -- `input-decode-map' (arrow escape sequences) for terminals,
+;; `key-translation-map' (M-<UPPER> -> M-S-<lower>) for GUI. These tests
+;; `let'-bind those keymaps to fresh copies and stub the env predicates, so the
+;; real maps are never touched.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
+(require 'keyboard-compat)
+
+;; ----------------------- cj/keyboard-compat-terminal-setup -------------------
+
+(defmacro test-kbc--terminal (terminal-p &rest body)
+ "Run BODY with `env-terminal-p' stubbed to TERMINAL-P and a fresh
+`input-decode-map'."
+ (declare (indent 1))
+ `(cl-letf (((symbol-function 'env-terminal-p) (lambda () ,terminal-p)))
+ (let ((input-decode-map (make-sparse-keymap)))
+ ,@body)))
+
+(ert-deftest test-keyboard-compat-terminal-setup-decodes-csi-arrows ()
+ "Normal: on a terminal, the ESC-[ arrow sequences decode to arrow events."
+ (test-kbc--terminal t
+ (cj/keyboard-compat-terminal-setup)
+ (should (equal (lookup-key input-decode-map "\e[A") [up]))
+ (should (equal (lookup-key input-decode-map "\e[B") [down]))
+ (should (equal (lookup-key input-decode-map "\e[C") [right]))
+ (should (equal (lookup-key input-decode-map "\e[D") [left]))))
+
+(ert-deftest test-keyboard-compat-terminal-setup-decodes-application-arrows ()
+ "Normal: the application-mode ESC-O arrow sequences also decode."
+ (test-kbc--terminal t
+ (cj/keyboard-compat-terminal-setup)
+ (should (equal (lookup-key input-decode-map "\eOA") [up]))
+ (should (equal (lookup-key input-decode-map "\eOB") [down]))
+ (should (equal (lookup-key input-decode-map "\eOC") [right]))
+ (should (equal (lookup-key input-decode-map "\eOD") [left]))))
+
+(ert-deftest test-keyboard-compat-terminal-setup-covers-all-eight-sequences ()
+ "Normal: every direction is mapped under both the ESC-[ and ESC-O prefixes."
+ (test-kbc--terminal t
+ (cj/keyboard-compat-terminal-setup)
+ (dolist (cell '((?A . up) (?B . down) (?C . right) (?D . left)))
+ (dolist (prefix '("\e[" "\eO"))
+ (should (equal (lookup-key input-decode-map (concat prefix (string (car cell))))
+ (vector (cdr cell))))))))
+
+(ert-deftest test-keyboard-compat-terminal-setup-no-op-off-terminal ()
+ "Boundary: not on a terminal -> `input-decode-map' is left untouched.
+\(Compared against an empty keymap because `lookup-key' on an ESC-prefixed
+string can return a meta-prefix event count rather than nil.)"
+ (test-kbc--terminal nil
+ (cj/keyboard-compat-terminal-setup)
+ (should (equal input-decode-map (make-sparse-keymap)))))
+
+;; -------------------------- cj/keyboard-compat-gui-setup ---------------------
+
+(defmacro test-kbc--gui (gui-p &rest body)
+ "Run BODY with `env-gui-p' stubbed to GUI-P and a fresh `key-translation-map'."
+ (declare (indent 1))
+ `(cl-letf (((symbol-function 'env-gui-p) (lambda () ,gui-p)))
+ (let ((key-translation-map (make-sparse-keymap)))
+ ,@body)))
+
+(defconst test-kbc--meta-shift-letters
+ '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b ?k)
+ "The 18 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.")
+
+(ert-deftest test-keyboard-compat-gui-setup-translates-spot-checks ()
+ "Normal: in GUI mode, M-O -> M-S-o and M-K -> M-S-k (sampled)."
+ (test-kbc--gui t
+ (cj/keyboard-compat-gui-setup)
+ (should (equal (lookup-key key-translation-map (kbd "M-O")) (kbd "M-S-o")))
+ (should (equal (lookup-key key-translation-map (kbd "M-K")) (kbd "M-S-k")))
+ (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d")))))
+
+(ert-deftest test-keyboard-compat-gui-setup-translates-all-eighteen ()
+ "Normal: every documented M-<UPPER> maps to its M-S-<lower> form."
+ (test-kbc--gui t
+ (cj/keyboard-compat-gui-setup)
+ (dolist (l test-kbc--meta-shift-letters)
+ (should (equal (lookup-key key-translation-map (kbd (format "M-%c" (upcase l))))
+ (kbd (format "M-S-%c" l)))))))
+
+(ert-deftest test-keyboard-compat-gui-setup-no-op-off-gui ()
+ "Boundary: not in GUI mode -> `key-translation-map' is left untouched."
+ (test-kbc--gui nil
+ (cj/keyboard-compat-gui-setup)
+ (should-not (lookup-key key-translation-map (kbd "M-O")))
+ (should-not (lookup-key key-translation-map (kbd "M-K")))))
+
+(provide 'test-keyboard-compat-setup)
+;;; test-keyboard-compat-setup.el ends here