diff options
| -rw-r--r-- | pearl.el | 134 | ||||
| -rw-r--r-- | tests/test-pearl-keymap.el | 153 |
2 files changed, 224 insertions, 63 deletions
@@ -2920,6 +2920,7 @@ just writing the file and leaving it off-screen." org-file-path (length issues)) (let ((buf (find-file-noselect org-file-path))) (with-current-buffer buf + (pearl-mode 1) (pearl--restore-page-visibility) (pearl-highlight-comments)) (pearl--surface-buffer buf))) @@ -4787,39 +4788,45 @@ body stay." ("!" "toggle debug" pearl-toggle-debug) ("x" "clear cache" pearl-clear-cache)]]) -;;; Prefix Keymap +;;; Prefix Keymap and minor mode ;; -;; An opt-in prefix keymap organizing the commands under save / edit / new / -;; delete sub-maps. It is defined but NOT bound at load -- a global prefix -;; isn't reliably free across terminals and GUIs, and auto-installing one is a -;; compatibility call the user should own. Bind it to a free prefix, e.g. -;; -;; (global-set-key (kbd "C-; L") pearl-prefix-map) -;; ;; or, with use-package: :bind-keymap ("C-; L" . pearl-prefix-map) +;; A prefix keymap that makes the whole command surface reachable from the +;; keyboard. The hot-path commands sit directly under the prefix (one key); +;; the rest are grouped into category sub-maps (two keys). The most common +;; commands appear in both places -- e.g. edit-description is the direct `d' +;; and also `e d' under the edit group. ;; ;; Each binding is a (LABEL . COMMAND) menu item, so `which-key' shows the -;; verb-matched label (e.g. "edit priority") without pearl depending on -;; which-key. Lookups still resolve straight to the command. +;; verb-matched label without pearl depending on which-key. Lookups still +;; resolve straight to the command. +;; +;; `pearl-mode' (below) binds this map under `pearl-keymap-prefix' inside +;; Pearl-rendered buffers and turns on automatically, so the keys are live +;; without any global setup. To bind the map globally as well: ;; -;; The labels follow the edit/new verbs. The edit commands are named to match -;; (`pearl-edit-description', `pearl-edit-state', ...); the new-comment command -;; keeps its `pearl-add-comment' name pending that rename. Priority has no edit -;; command -- it is edited org-natively via the heading cookie (C-c , / S-up). +;; (global-set-key (kbd "C-; L") pearl-prefix-map) +;; +;; Priority has no edit command -- it is edited org-natively via the heading +;; cookie (C-c , / S-up). State also cycles org-natively (C-c C-t); the +;; picker `pearl-edit-state' (e s) reaches any team state. -(defvar pearl-save-map +(defvar pearl-fetch-map (let ((map (make-sparse-keymap))) - (define-key map "s" (cons "save ticket" #'pearl-save-issue)) - (define-key map "a" (cons "save all" #'pearl-save-all)) + (define-key map "o" (cons "my open issues" #'pearl-list-issues)) + (define-key map "p" (cons "by project" #'pearl-list-issues-by-project)) + (define-key map "f" (cons "build a filter" #'pearl-list-issues-filtered)) + (define-key map "v" (cons "custom view" #'pearl-run-view)) + (define-key map "q" (cons "saved query" #'pearl-run-saved-query)) map) - "Pearl save commands; a sub-keymap of `pearl-prefix-map'.") + "Pearl fetch commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-edit-map (let ((map (make-sparse-keymap))) (define-key map "d" (cons "edit description" #'pearl-edit-description)) - (define-key map "c" (cons "edit comment" #'pearl-edit-current-comment)) (define-key map "s" (cons "edit state" #'pearl-edit-state)) (define-key map "a" (cons "edit assignee" #'pearl-edit-assignee)) (define-key map "l" (cons "edit labels" #'pearl-edit-labels)) + (define-key map "c" (cons "edit comment" #'pearl-edit-current-comment)) map) "Pearl edit commands; a sub-keymap of `pearl-prefix-map'.") @@ -4837,17 +4844,94 @@ body stay." map) "Pearl delete commands; a sub-keymap of `pearl-prefix-map'.") +(defvar pearl-url-map + (let ((map (make-sparse-keymap))) + (define-key map "o" (cons "open issue in browser" #'pearl-open-current-issue)) + (define-key map "v" (cons "open view in Linear" #'pearl-open-current-view-in-linear)) + ;; "c" (copy the issue URL to the clipboard) lands with + ;; `pearl-copy-issue-url' -- see the todo. + map) + "Pearl URL commands; a sub-keymap of `pearl-prefix-map'.") + (defvar pearl-prefix-map (let ((map (make-sparse-keymap))) - (define-key map "s" (cons "+save" pearl-save-map)) + ;; Hot path -- one key under the prefix. + (define-key map "l" (cons "list my open issues" #'pearl-list-issues)) + (define-key map "g" (cons "refresh view" #'pearl-refresh-current-view)) + (define-key map "r" (cons "refresh issue" #'pearl-refresh-current-issue)) + (define-key map "s" (cons "save ticket" #'pearl-save-issue)) + (define-key map "S" (cons "save all" #'pearl-save-all)) + (define-key map "d" (cons "edit description" #'pearl-edit-description)) + (define-key map "c" (cons "new comment" #'pearl-add-comment)) + (define-key map "m" (cons "menu" #'pearl-menu)) + ;; Category sub-maps -- two keys. + (define-key map "f" (cons "+fetch" pearl-fetch-map)) (define-key map "e" (cons "+edit" pearl-edit-map)) (define-key map "n" (cons "+new" pearl-new-map)) - (define-key map "d" (cons "+delete" pearl-delete-map)) - (define-key map "m" (cons "menu" #'pearl-menu)) + (define-key map "k" (cons "+delete" pearl-delete-map)) + (define-key map "u" (cons "+url" pearl-url-map)) map) - "Opt-in Pearl command prefix keymap. -Not bound at load. Bind it to a free prefix, such as the suggested -\\=`C-; L\\=', in your own configuration (see the Commentary above).") + "Pearl command prefix keymap. +Hot-path commands are bound directly; the rest live under the category +sub-maps (fetch / edit / new / delete / url). `pearl-mode' binds this under +`pearl-keymap-prefix' inside Pearl buffers; you can also bind it globally +\(see the Commentary above).") + +(defcustom pearl-keymap-prefix "C-; L" + "Prefix key that `pearl-mode' binds to `pearl-prefix-map'. +Inside a Pearl-rendered buffer this makes the whole command surface reachable +without any global binding. Set to nil to bind nothing (then bind +`pearl-prefix-map' yourself). Changing this through Customize updates +`pearl-mode-map' immediately; setting it by hand needs `pearl-mode' re-enabled +in already-open buffers." + :type '(choice (key-sequence :tag "Prefix") (const :tag "None" nil)) + :group 'pearl + :set (lambda (sym val) + (set-default sym val) + (when (boundp 'pearl-mode-map) + ;; Rebuild the mode map so a customized prefix takes effect. + (setcdr pearl-mode-map nil) + (when val + (define-key pearl-mode-map (kbd val) pearl-prefix-map))))) + +(defvar pearl-mode-map + (let ((map (make-sparse-keymap))) + (when pearl-keymap-prefix + (define-key map (kbd pearl-keymap-prefix) pearl-prefix-map)) + map) + "Keymap for `pearl-mode'.") + +;;;###autoload +(define-minor-mode pearl-mode + "Minor mode for Pearl's Linear org buffers. +Binds `pearl-prefix-map' under `pearl-keymap-prefix' so every Pearl command is +reachable from the keyboard. Turns on automatically in any buffer Pearl +rendered (one carrying a `#+LINEAR-SOURCE' header); see +`pearl--maybe-enable-mode' on `org-mode-hook'." + :lighter " Pearl" + :keymap pearl-mode-map) + +(defun pearl--buffer-is-pearl-p () + "Non-nil when the current buffer is a Pearl-rendered Linear file. +Detected by the `#+LINEAR-SOURCE' header Pearl writes into every view; the +search is bounded to the file preamble so it stays cheap on large buffers." + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (re-search-forward "^#\\+LINEAR-SOURCE:" 4000 t)))) + +(defun pearl--maybe-enable-mode () + "Enable `pearl-mode' when the current org buffer is a Pearl Linear file. +Hung on `org-mode-hook'; a no-op in any other org buffer." + (when (and (derived-mode-p 'org-mode) (pearl--buffer-is-pearl-p)) + (pearl-mode 1))) + +;; Registered at load, not via an autoload cookie: an autoloaded hook would +;; fire before pearl is loaded (calling a void function) and would pull all of +;; pearl into every org buffer the user opens. Once any autoloaded pearl +;; command has loaded the package, this hook auto-enables the mode in Pearl +;; files; freshly fetched buffers are also enabled directly in the writer. +(add-hook 'org-mode-hook #'pearl--maybe-enable-mode) (provide 'pearl) ;;; pearl.el ends here
\ No newline at end of file diff --git a/tests/test-pearl-keymap.el b/tests/test-pearl-keymap.el index 7cfc603..0e12da3 100644 --- a/tests/test-pearl-keymap.el +++ b/tests/test-pearl-keymap.el @@ -1,4 +1,4 @@ -;;; test-pearl-keymap.el --- Tests for the opt-in prefix keymap -*- lexical-binding: t; -*- +;;; test-pearl-keymap.el --- Tests for the prefix keymap and minor mode -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings @@ -19,10 +19,11 @@ ;;; 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. +;; Tests for `pearl-prefix-map' and `pearl-mode'. Hot-path commands bind +;; directly under the prefix; the rest live in category sub-maps (fetch / edit +;; / new / delete / url). The common commands appear in both places. +;; `pearl-mode' makes the map live inside Pearl buffers under +;; `pearl-keymap-prefix'. ;;; Code: @@ -44,52 +45,128 @@ Walks MAP looking for a labeled binding (\"label\" . COMMAND)." "`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." - (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-edit-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-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")))) - ;; priority has no edit command (org-native cookie); e p is unbound - (should-not (lookup-key pearl-prefix-map (kbd "e p"))) - (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")))) +(ert-deftest test-pearl-prefix-map-direct-hot-keys () + "The hot-path commands resolve in one key under the prefix." + (should (eq 'pearl-list-issues (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-add-comment (lookup-key pearl-prefix-map (kbd "c")))) (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 "f")))) (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"))))) + (should (keymapp (lookup-key pearl-prefix-map (kbd "k")))) + (should (keymapp (lookup-key pearl-prefix-map (kbd "u"))))) + +(ert-deftest test-pearl-prefix-map-fetch-group () + "The fetch group resolves each source command." + (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")))) + (should (eq 'pearl-run-view (lookup-key pearl-prefix-map (kbd "f v")))) + (should (eq 'pearl-run-saved-query (lookup-key pearl-prefix-map (kbd "f q"))))) + +(ert-deftest test-pearl-prefix-map-edit-group () + "The edit group resolves each field-edit command." + (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")))) + ;; 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-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-new-and-delete-groups () + "New and delete groups resolve ticket/comment, with delete under k." + (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 "k t")))) + (should (eq 'pearl-delete-current-comment (lookup-key pearl-prefix-map (kbd "k c"))))) + +(ert-deftest test-pearl-prefix-map-url-group () + "The url group resolves open-in-browser and open-view; copy-url is not yet bound." + (should (eq 'pearl-open-current-issue (lookup-key pearl-prefix-map (kbd "u o")))) + (should (eq 'pearl-open-current-view-in-linear (lookup-key pearl-prefix-map (kbd "u v")))) + ;; "u c" (copy URL) lands with `pearl-copy-issue-url' + (should-not (lookup-key pearl-prefix-map (kbd "u c")))) + +(ert-deftest test-pearl-prefix-map-common-commands-bound-twice () + "The most common commands resolve both directly and inside their group." + ;; edit-description: direct d and e d + (should (eq (lookup-key pearl-prefix-map (kbd "d")) + (lookup-key pearl-prefix-map (kbd "e d")))) + ;; new comment: direct c and n c + (should (eq (lookup-key pearl-prefix-map (kbd "c")) + (lookup-key pearl-prefix-map (kbd "n c")))) + ;; list issues: direct l and f o + (should (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 the edit/new verb labels; sub-prefixes carry +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= "edit description" - (test-pearl-keymap--label-of pearl-edit-map 'pearl-edit-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)))) + (should (string= "open issue in browser" + (test-pearl-keymap--label-of pearl-url-map 'pearl-open-current-issue))) + (should (string= "+edit" (test-pearl-keymap--label-of pearl-prefix-map pearl-edit-map))) + (should (string= "+url" (test-pearl-keymap--label-of pearl-prefix-map pearl-url-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))) (provide 'test-pearl-keymap) ;;; test-pearl-keymap.el ends here |