path: root/tests/test-pearl-keymap.el

;;; test-pearl-keymap.el --- Tests for the prefix keymap and minor mode -*- 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' and `pearl-mode'.  Hot-path commands bind
;; directly under the prefix; the rest live in category sub-maps.  Fetch
;; (`f') is issue-fetching only; views have their own group (`v'); workspace
;; / setup commands live under `w'.  The common commands appear both as a
;; direct hot key and inside their group.  `pearl-mode' makes the map live
;; inside Pearl buffers under `pearl-keymap-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-direct-hot-keys ()
  "The hot-path commands resolve in one key under the prefix.
The lowercase `c' is no longer a direct command -- it is the create prefix.
`l' opens the configurable default view, not the literal my-open-issues fetch."
  (should (eq 'pearl-open-default-view (lookup-key pearl-prefix-map (kbd "l"))))
  (should (eq 'pearl-refresh-current-view (lookup-key pearl-prefix-map (kbd "g"))))
  (should (eq 'pearl-refresh-current-issue (lookup-key pearl-prefix-map (kbd "r"))))
  (should (eq 'pearl-save-issue (lookup-key pearl-prefix-map (kbd "s"))))
  (should (eq 'pearl-save-all (lookup-key pearl-prefix-map (kbd "S"))))
  (should (eq 'pearl-edit-description (lookup-key pearl-prefix-map (kbd "d"))))
  (should (eq 'pearl-menu (lookup-key pearl-prefix-map (kbd "m")))))

(ert-deftest test-pearl-prefix-map-sub-prefixes-are-verbs ()
  "Each category key is a sub-prefix keymap named for an action verb or noun."
  (should (keymapp (lookup-key pearl-prefix-map (kbd "f"))))  ; fetch
  (should (keymapp (lookup-key pearl-prefix-map (kbd "v"))))  ; views
  (should (keymapp (lookup-key pearl-prefix-map (kbd "e"))))  ; edit
  (should (keymapp (lookup-key pearl-prefix-map (kbd "c"))))  ; create
  (should (keymapp (lookup-key pearl-prefix-map (kbd "k"))))  ; delete
  (should (keymapp (lookup-key pearl-prefix-map (kbd "o"))))  ; open
  (should (keymapp (lookup-key pearl-prefix-map (kbd "y"))))  ; copy
  (should (keymapp (lookup-key pearl-prefix-map (kbd "w")))))  ; workspace

(ert-deftest test-pearl-prefix-map-fetch-group-is-issue-sources-only ()
  "The fetch group resolves the four issue-source commands and nothing else.
View-movement commands moved to the dedicated views group, so the old
`f l' / `f v' / `f u' / `f d' / `f P' chains are gone."
  (should (eq 'pearl-pick-source (lookup-key pearl-prefix-map (kbd "f s"))))
  (should (eq 'pearl-list-issues (lookup-key pearl-prefix-map (kbd "f o"))))
  (should (eq 'pearl-list-issues-by-project (lookup-key pearl-prefix-map (kbd "f p"))))
  (should (eq 'pearl-list-issues-filtered (lookup-key pearl-prefix-map (kbd "f f"))))
  ;; the view commands are no longer under fetch
  (should-not (lookup-key pearl-prefix-map (kbd "f l")))
  (should-not (lookup-key pearl-prefix-map (kbd "f v")))
  (should-not (lookup-key pearl-prefix-map (kbd "f u")))
  (should-not (lookup-key pearl-prefix-map (kbd "f d")))
  (should-not (lookup-key pearl-prefix-map (kbd "f P"))))

(ert-deftest test-pearl-prefix-map-views-group ()
  "The dedicated views group gathers run / create / edit / delete / copy-direction.
Lowercase `l'/`L' run local / Linear; `c'/`e'/`k' create / edit / delete a
local view; `u'/`U' publish (copy up); `d' saves a Linear view locally
\(copy down)."
  (should (eq 'pearl-run-local-view (lookup-key pearl-prefix-map (kbd "v l"))))
  (should (eq 'pearl-run-linear-view (lookup-key pearl-prefix-map (kbd "v L"))))
  (should (eq 'pearl-create-local-view (lookup-key pearl-prefix-map (kbd "v c"))))
  (should (eq 'pearl-edit-local-view (lookup-key pearl-prefix-map (kbd "v e"))))
  (should (eq 'pearl-delete-local-view (lookup-key pearl-prefix-map (kbd "v k"))))
  (should (eq 'pearl-publish-local-view (lookup-key pearl-prefix-map (kbd "v u"))))
  (should (eq 'pearl-publish-current-view (lookup-key pearl-prefix-map (kbd "v U"))))
  (should (eq 'pearl-save-linear-view-locally (lookup-key pearl-prefix-map (kbd "v d")))))

(ert-deftest test-pearl-prefix-map-views-set-default ()
  "`v D' binds set-default-view -- the slot the keybinding reservation held."
  (should (eq 'pearl-set-default-view (lookup-key pearl-prefix-map (kbd "v D")))))

(ert-deftest test-pearl-prefix-map-edit-group ()
  "The edit group resolves field-edit commands only -- no view edit anymore."
  (should (eq 'pearl-edit-description (lookup-key pearl-prefix-map (kbd "e d"))))
  (should (eq 'pearl-edit-state (lookup-key pearl-prefix-map (kbd "e s"))))
  (should (eq 'pearl-edit-assignee (lookup-key pearl-prefix-map (kbd "e a"))))
  (should (eq 'pearl-edit-labels (lookup-key pearl-prefix-map (kbd "e l"))))
  (should (eq 'pearl-edit-current-comment (lookup-key pearl-prefix-map (kbd "e c"))))
  ;; view-edit moved to the views group
  (should-not (lookup-key pearl-prefix-map (kbd "e v")))
  ;; priority has no edit command (org-native cookie); e p is unbound
  (should-not (lookup-key pearl-prefix-map (kbd "e p"))))

(ert-deftest test-pearl-prefix-map-create-and-delete-groups ()
  "Create and delete groups resolve issue / comment only -- views moved out."
  (should (eq 'pearl-create-issue (lookup-key pearl-prefix-map (kbd "c t"))))
  (should (eq 'pearl-create-comment (lookup-key pearl-prefix-map (kbd "c c"))))
  (should (eq 'pearl-delete-current-issue (lookup-key pearl-prefix-map (kbd "k t"))))
  (should (eq 'pearl-delete-current-comment (lookup-key pearl-prefix-map (kbd "k c"))))
  ;; view create / delete moved to the views group
  (should-not (lookup-key pearl-prefix-map (kbd "c v")))
  (should-not (lookup-key pearl-prefix-map (kbd "k v"))))

(ert-deftest test-pearl-prefix-map-open-and-copy-groups ()
  "The open group resolves the two open actions; copy resolves copy-url."
  (should (eq 'pearl-open-current-issue (lookup-key pearl-prefix-map (kbd "o i"))))
  (should (eq 'pearl-open-current-view-in-linear (lookup-key pearl-prefix-map (kbd "o v"))))
  (should (eq 'pearl-copy-issue-url (lookup-key pearl-prefix-map (kbd "y u")))))

(ert-deftest test-pearl-prefix-map-workspace-group ()
  "The workspace group binds account switching plus the setup commands.
`pearl-switch-account' was previously unbound on every surface."
  (should (eq 'pearl-switch-account (lookup-key pearl-prefix-map (kbd "w a"))))
  (should (eq 'pearl-test-connection (lookup-key pearl-prefix-map (kbd "w t"))))
  (should (eq 'pearl-check-setup (lookup-key pearl-prefix-map (kbd "w c"))))
  (should (eq 'pearl-toggle-debug (lookup-key pearl-prefix-map (kbd "w !"))))
  (should (eq 'pearl-clear-cache (lookup-key pearl-prefix-map (kbd "w x")))))

(ert-deftest test-pearl-prefix-map-hot-keys-vs-groups ()
  "edit-description is dual-bound; the l hot key opens the default while the
literal my-open-issues fetch stays at f o (they are no longer the same command)."
  ;; edit-description: direct d and e d resolve to the same command
  (should (eq (lookup-key pearl-prefix-map (kbd "d"))
              (lookup-key pearl-prefix-map (kbd "e d"))))
  ;; l opens the configurable default; f o is the literal fetch -- distinct now
  (should (eq 'pearl-open-default-view (lookup-key pearl-prefix-map (kbd "l"))))
  (should (eq 'pearl-list-issues (lookup-key pearl-prefix-map (kbd "f o"))))
  (should-not (eq (lookup-key pearl-prefix-map (kbd "l"))
                  (lookup-key pearl-prefix-map (kbd "f o")))))

(ert-deftest test-pearl-prefix-map-which-key-labels ()
  "Leaf bindings carry verb labels; sub-prefixes carry +labels."
  (should (string= "edit state"
                   (test-pearl-keymap--label-of pearl-edit-map 'pearl-edit-state)))
  (should (string= "create issue"
                   (test-pearl-keymap--label-of pearl-create-map 'pearl-create-issue)))
  (should (string= "open issue in browser"
                   (test-pearl-keymap--label-of pearl-open-map 'pearl-open-current-issue)))
  (should (string= "copy issue URL"
                   (test-pearl-keymap--label-of pearl-copy-map 'pearl-copy-issue-url)))
  (should (string= "run local view"
                   (test-pearl-keymap--label-of pearl-views-map 'pearl-run-local-view)))
  (should (string= "set default view"
                   (test-pearl-keymap--label-of pearl-views-map 'pearl-set-default-view)))
  (should (string= "switch account"
                   (test-pearl-keymap--label-of pearl-workspace-map 'pearl-switch-account)))
  (should (string= "edit..." (test-pearl-keymap--label-of pearl-prefix-map pearl-edit-map)))
  (should (string= "views..." (test-pearl-keymap--label-of pearl-prefix-map pearl-views-map)))
  (should (string= "workspace..."
                   (test-pearl-keymap--label-of pearl-prefix-map pearl-workspace-map))))

(ert-deftest test-pearl-prefix-map-not-bound-at-load ()
  "Loading pearl binds nothing globally; the keys are live only via pearl-mode."
  (should-not (where-is-internal 'pearl-save-issue (current-global-map)))
  (should-not (where-is-internal 'pearl-list-issues (current-global-map))))

;;; minor mode

(ert-deftest test-pearl-mode-is-a-minor-mode ()
  "`pearl-mode' is defined as a command."
  (should (fboundp 'pearl-mode))
  (should (commandp 'pearl-mode)))

(ert-deftest test-pearl-mode-map-binds-the-prefix ()
  "`pearl-mode-map' binds `pearl-keymap-prefix' to the command map."
  (should (eq pearl-prefix-map
              (lookup-key pearl-mode-map (kbd pearl-keymap-prefix)))))

(ert-deftest test-pearl-buffer-is-pearl-p-detects-source-header ()
  "A buffer with a #+LINEAR-SOURCE header reads as a Pearl buffer; one without does not."
  (with-temp-buffer
    (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter)\n")
    (should (pearl--buffer-is-pearl-p)))
  (with-temp-buffer
    (insert "#+title: notes\n* a heading\n")
    (should-not (pearl--buffer-is-pearl-p))))

(ert-deftest test-pearl-maybe-enable-mode-only-in-pearl-org-buffers ()
  "`pearl--maybe-enable-mode' turns the mode on in a Pearl org buffer, not elsewhere."
  ;; Pearl org buffer -> enabled.  `delay-mode-hooks' keeps `org-mode-hook'
  ;; (which itself carries the auto-enable) from firing, so the explicit call
  ;; is what flips the mode.
  (with-temp-buffer
    (delay-mode-hooks (org-mode))
    (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter)\n")
    (pearl--maybe-enable-mode)
    (should pearl-mode))
  ;; Plain org buffer -> left off.
  (with-temp-buffer
    (delay-mode-hooks (org-mode))
    (insert "#+title: notes\n* a heading\n")
    (pearl--maybe-enable-mode)
    (should-not pearl-mode))
  ;; Non-org buffer with the header -> left off (org-mode gate).
  (with-temp-buffer
    (fundamental-mode)
    (insert "#+LINEAR-SOURCE: (:type filter)\n")
    (pearl--maybe-enable-mode)
    (should-not pearl-mode)))

(ert-deftest test-pearl-views-map-shaping-bindings ()
  "The views sub-map binds the view-shaping commands: sort, group, reverse order."
  (should (eq 'pearl-set-sort (lookup-key pearl-views-map (kbd "s"))))
  (should (eq 'pearl-set-grouping (lookup-key pearl-views-map (kbd "g"))))
  (should (eq 'pearl-toggle-sort-order (lookup-key pearl-views-map (kbd "r"))))
  (should (string= "sort view"
                   (test-pearl-keymap--label-of pearl-views-map 'pearl-set-sort)))
  (should (string= "group view"
                   (test-pearl-keymap--label-of pearl-views-map 'pearl-set-grouping)))
  (should (string= "reverse order"
                   (test-pearl-keymap--label-of pearl-views-map 'pearl-toggle-sort-order))))

(provide 'test-pearl-keymap)
;;; test-pearl-keymap.el ends here