blob: 6294da233928453d21ce35de66308c0f67baa179 (
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
;;; test-pearl-menu.el --- Tests for the transient menu -*- lexical-binding: t; -*-
;;; Commentary:
;; Tests for `pearl-menu', the transient dispatcher. The menu is
;; interactive UI, so these test the integration -- the prefix is a real
;; command, every suffix dispatches to a bound command, and the key bindings
;; don't collide -- rather than transient's own rendering behavior.
;;; Code:
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"
(file-name-directory
(or load-file-name buffer-file-name))))
(require 'transient)
(defun test-pearl-menu--suffixes (node)
"Collect (KEY . COMMAND) pairs from a transient layout NODE.
Walks vectors and lists recursively; whenever it reaches a suffix plist it
reads :key and :command from it. Transient has stored a suffix two ways:
inside a (LEVEL CLASS (:key ... :command ...)) list, where the bare plist is
reached by recursion, and, since transient 0.13 (the version Emacs 31
bundles), as a list headed by the class symbol (transient-suffix :key ...).
Both shapes are read here so the test survives the library's own layout
changes."
(cond
((vectorp node)
(apply #'append (mapcar #'test-pearl-menu--suffixes
(append node nil))))
((and (consp node)
(or (keywordp (car node))
(and (symbolp (car node)) (keywordp (cadr node)))))
(let* ((plist (if (keywordp (car node)) node (cdr node)))
(cmd (plist-get plist :command))
(key (plist-get plist :key)))
(when cmd (list (cons key cmd)))))
((consp node)
(apply #'append (mapcar #'test-pearl-menu--suffixes node)))
(t nil)))
(defun test-pearl-menu--pairs ()
"Return the (KEY . COMMAND) pairs declared in `pearl-menu'."
(test-pearl-menu--suffixes
(get 'pearl-menu 'transient--layout)))
(ert-deftest test-pearl-menu-is-command ()
"The dispatcher is defined and is an interactive command."
(should (fboundp 'pearl-menu))
(should (commandp 'pearl-menu)))
(ert-deftest test-pearl-menu-suffixes-dispatch-to-real-commands ()
"Every suffix in the menu names a bound, interactive command.
This is the regression guard: rename or remove a command and the
menu entry that still points at it fails here."
(let ((pairs (test-pearl-menu--pairs)))
(should pairs)
(dolist (pair pairs)
(let ((cmd (cdr pair)))
(should (fboundp cmd))
(should (commandp cmd))))))
(ert-deftest test-pearl-menu-keys-are-unique ()
"No two suffixes share a key binding."
(let* ((pairs (test-pearl-menu--pairs))
(keys (delq nil (mapcar #'car pairs))))
(should (= (length keys) (length (delete-dups (copy-sequence keys)))))))
(ert-deftest test-pearl-menu-covers-core-commands ()
"A representative slice of the command surface is reachable from the menu."
(let ((cmds (mapcar #'cdr (test-pearl-menu--pairs))))
(dolist (expected '(pearl-list-issues
pearl-open-default-view
pearl-run-linear-view
pearl-run-local-view
pearl-publish-local-view
pearl-publish-current-view
pearl-save-issue
pearl-save-all
pearl-edit-state
pearl-create-comment
pearl-create-issue
pearl-delete-current-issue
;; previously missing from the menu -- added in the
;; keybinding reconciliation so both surfaces agree
pearl-switch-account
pearl-copy-issue-url
;; set-default-view: the new Views-group entry
pearl-set-default-view
;; fetch the full comment thread for the issue at point
pearl-fetch-all-comments
;; single-issue source: open one issue by identifier
pearl-open-issue-by-id
;; view-shaping commands added to the Views group
pearl-set-sort
pearl-set-grouping
pearl-toggle-sort-order))
(should (memq expected cmds)))))
;; Synthetic layouts pin both suffix shapes the walker must read, so the
;; branch for whichever transient version isn't installed can't rot unseen.
(defconst test-pearl-menu--old-layout
'([1 transient-columns nil
([1 transient-column (:description "Save")
((1 transient-suffix (:key "s" :command pearl-save-issue))
(1 transient-suffix (:key "S" :command pearl-save-all)))])])
"A menu layout in the pre-0.13 transient shape: (LEVEL CLASS PLIST) suffixes.")
(defconst test-pearl-menu--new-layout
'([transient-columns nil
([transient-column (:description "Save")
((transient-suffix :key "s" :command pearl-save-issue)
(transient-suffix :key "S" :command pearl-save-all))])])
"The same menu in the transient 0.13 shape: (CLASS :key ...) suffixes.")
(ert-deftest test-pearl-menu-suffixes-reads-old-layout-shape ()
"The walker finds every suffix in the pre-0.13 (LEVEL CLASS PLIST) layout."
(should (equal (test-pearl-menu--suffixes test-pearl-menu--old-layout)
'(("s" . pearl-save-issue) ("S" . pearl-save-all)))))
(ert-deftest test-pearl-menu-suffixes-reads-new-layout-shape ()
"The walker finds every suffix in the transient 0.13 (CLASS :key ...) layout."
(should (equal (test-pearl-menu--suffixes test-pearl-menu--new-layout)
'(("s" . pearl-save-issue) ("S" . pearl-save-all)))))
(ert-deftest test-pearl-menu-suffixes-empty-layout-is-nil ()
"An empty layout and a group with no suffixes both yield no pairs."
(should (null (test-pearl-menu--suffixes nil)))
(should (null (test-pearl-menu--suffixes '([transient-column (:description "x") ()])))))
(provide 'test-pearl-menu)
;;; test-pearl-menu.el ends here
|
