;;; 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