From 040038d42f82d48c2e6b57a0d4494d9aabf453a9 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Tue, 12 May 2026 17:17:55 -0500 Subject: test(keyboard-compat): cover the terminal and GUI setup functions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `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-` → `M-S-` 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. --- tests/test-keyboard-compat-setup.el | 101 ++++++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 tests/test-keyboard-compat-setup.el (limited to 'tests') 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- -> M-S-) 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- form is translated to M-S- 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- maps to its M-S- 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 -- cgit v1.2.3