blob: 260b6fa64e1edf8604b77f3f4f79851bafa0a2ba (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
;;; test-pearl-keymap.el --- Tests for the opt-in prefix keymap -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Craig Jennings
;; Author: Craig Jennings <c@cjennings.net>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for `pearl-prefix-map' (see docs/ticket-save-model-spec.org, the
;; keybinding section): the opt-in prefix keymap that organizes the commands
;; under save / edit / new / delete sub-maps with which-key labels. The map is
;; defined but never bound at load -- the user binds it to a free prefix.
;;; Code:
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(defun test-pearl-keymap--label-of (map command)
"Return the menu-item label bound to COMMAND in MAP, or nil.
Walks MAP looking for a labeled binding (\"label\" . COMMAND)."
(let (found)
(map-keymap
(lambda (_ev binding)
(when (and (consp binding) (stringp (car binding))
(eq (cdr binding) command))
(setq found (car binding))))
map)
found))
(ert-deftest test-pearl-prefix-map-is-a-keymap ()
"`pearl-prefix-map' is defined as a keymap."
(should (keymapp pearl-prefix-map)))
(ert-deftest test-pearl-prefix-map-resolves-leaf-commands ()
"Each chord resolves to its command (existing names, not yet renamed)."
(should (eq 'pearl-save-issue (lookup-key pearl-prefix-map (kbd "s s"))))
(should (eq 'pearl-save-all (lookup-key pearl-prefix-map (kbd "s a"))))
(should (eq 'pearl-compose-current-description (lookup-key pearl-prefix-map (kbd "e d"))))
(should (eq 'pearl-edit-current-comment (lookup-key pearl-prefix-map (kbd "e c"))))
(should (eq 'pearl-set-priority (lookup-key pearl-prefix-map (kbd "e p"))))
(should (eq 'pearl-set-state (lookup-key pearl-prefix-map (kbd "e s"))))
(should (eq 'pearl-set-assignee (lookup-key pearl-prefix-map (kbd "e a"))))
(should (eq 'pearl-set-labels (lookup-key pearl-prefix-map (kbd "e l"))))
(should (eq 'pearl-new-issue (lookup-key pearl-prefix-map (kbd "n t"))))
(should (eq 'pearl-add-comment (lookup-key pearl-prefix-map (kbd "n c"))))
(should (eq 'pearl-delete-current-issue (lookup-key pearl-prefix-map (kbd "d t"))))
(should (eq 'pearl-menu (lookup-key pearl-prefix-map (kbd "m")))))
(ert-deftest test-pearl-prefix-map-sub-prefixes-are-keymaps ()
"The category keys are sub-prefixes, not commands."
(should (keymapp (lookup-key pearl-prefix-map (kbd "s"))))
(should (keymapp (lookup-key pearl-prefix-map (kbd "e"))))
(should (keymapp (lookup-key pearl-prefix-map (kbd "n"))))
(should (keymapp (lookup-key pearl-prefix-map (kbd "d")))))
(ert-deftest test-pearl-prefix-map-delete-comment-bound ()
"Delete-comment fills the d c slot under the delete prefix."
(should (eq 'pearl-delete-current-comment (lookup-key pearl-prefix-map (kbd "d c")))))
(ert-deftest test-pearl-prefix-map-not-bound-at-load ()
"Loading pearl does not bind the commands to any active key (opt-in)."
(should-not (where-is-internal 'pearl-save-issue))
(should-not (where-is-internal 'pearl-save-all)))
(ert-deftest test-pearl-prefix-map-which-key-labels ()
"Leaf bindings carry the edit/new verb labels; sub-prefixes carry +labels."
(should (string= "edit priority"
(test-pearl-keymap--label-of pearl-edit-map 'pearl-set-priority)))
(should (string= "edit description"
(test-pearl-keymap--label-of pearl-edit-map 'pearl-compose-current-description)))
(should (string= "new ticket"
(test-pearl-keymap--label-of pearl-new-map 'pearl-new-issue)))
(should (string= "new comment"
(test-pearl-keymap--label-of pearl-new-map 'pearl-add-comment)))
(should (string= "save ticket"
(test-pearl-keymap--label-of pearl-save-map 'pearl-save-issue)))
;; sub-prefix label on the base map
(should (string= "+edit" (test-pearl-keymap--label-of pearl-prefix-map pearl-edit-map))))
(provide 'test-pearl-keymap)
;;; test-pearl-keymap.el ends here
|
