diff options
| -rw-r--r-- | pearl.el | 165 | ||||
| -rw-r--r-- | tests/test-pearl-modified.el | 175 |
2 files changed, 334 insertions, 6 deletions
@@ -63,6 +63,7 @@ (require 'cl-lib) (require 'transient) (require 'auth-source) +(require 'diff-mode) ; for the `diff-changed' face pearl-modified-highlight inherits ;;; Customization and Variables (defgroup pearl nil @@ -651,13 +652,40 @@ semantics. A personal workspace's teams must never bleed into a work one." pearl--cache-viewer nil pearl--cache-org-url-key nil)) +(defcustom pearl-show-modified-indicator t + "When non-nil, show the unsaved-ticket cues. +That is the per-field highlight on a ticket with unsaved local edits and the +mode-line count of such tickets. Set to nil to turn the whole indicator off." + :type 'boolean + :group 'pearl) + +(defcustom pearl-modified-mode-line-format " %d %s changed" + "Format of the mode-line unsaved-ticket segment. +Takes two arguments: the ticket count (%d) and a label (%s) -- the +`pearl-ticket-glyph' when it's set, else the word \"tickets\". Appended to the +`pearl-mode' lighter when any ticket in the buffer has unsaved pushable work." + :type 'string + :group 'pearl) + +(defvar-local pearl--modified-count 0 + "Cached count of tickets in this buffer with unsaved pushable work. +Refreshed by the redecorate pass (`pearl--refresh-modified-count'); read by +`pearl--mode-line-lighter' so mode-line redisplay never rescans.") + (defun pearl--mode-line-lighter () "Return the `pearl-mode' mode-line lighter, naming the active account. -\" Pearl[work]\" when accounts are configured and one is active; plain -\" Pearl\" in legacy single-account mode." - (if (and pearl-accounts pearl-active-account) - (format " Pearl[%s]" pearl-active-account) - " Pearl")) +\" Pearl[work]\" when accounts are configured and one is active, plain +\" Pearl\" in legacy single-account mode, with \" N <glyph> changed\" appended +when the buffer holds unsaved tickets and `pearl-show-modified-indicator' is on." + (let ((base (if (and pearl-accounts pearl-active-account) + (format " Pearl[%s]" pearl-active-account) + " Pearl"))) + (if (and pearl-show-modified-indicator (> pearl--modified-count 0)) + (concat base (format pearl-modified-mode-line-format + pearl--modified-count + (if (string-empty-p pearl-ticket-glyph) + "tickets" pearl-ticket-glyph))) + base))) (defun pearl-switch-account (name) "Switch the active Linear account to NAME. @@ -6575,6 +6603,119 @@ wait for the next save (each field's content is still re-read at push)." (push (cons marker dirty) result)))) (nreverse result))) +(defun pearl--count-pushable-tickets (scan viewer-id &optional viewer-failed) + "Count tickets in SCAN with unsaved pushable work -- each ticket once. +SCAN is a list of (MARKER . DIRTY) from `pearl--scan-all-dirty'. A ticket is +pushable when any non-comment field is dirty, or it has an own dirty comment +\(author = VIEWER-ID). A comment-only ticket does not count while VIEWER-ID is +nil or VIEWER-FAILED is non-nil -- ownership is then unknown, so the cue waits. +This mirrors what `pearl-save-all' would actually push, so the count and the +save agree." + (let ((n 0)) + (dolist (cell scan) + (let* ((dirty (cdr cell)) + (field-dirty (or (plist-get dirty :title) (plist-get dirty :description) + (plist-get dirty :priority) (plist-get dirty :state) + (plist-get dirty :assignee) (plist-get dirty :labels))) + (own-comment (and (not viewer-failed) viewer-id + (plist-get (pearl--classify-comment-candidates + (plist-get dirty :comment-candidates) viewer-id) + :own)))) + (when (or field-dirty own-comment) (setq n (1+ n))))) + n)) + +(defun pearl--buffer-dirty-issue-count (viewer-id &optional viewer-failed) + "Count this buffer's tickets with unsaved pushable work (see +`pearl--count-pushable-tickets'). No network -- VIEWER-ID is supplied by the +caller (resolved once via `pearl--viewer-async')." + (pearl--count-pushable-tickets (pearl--scan-all-dirty) viewer-id viewer-failed)) + +(defun pearl--refresh-modified-count (&optional buffer) + "Recompute BUFFER's cached unsaved-ticket count and refresh the mode line. +Resolves the viewer once (cached) so own comments are classified; a failed +lookup counts only field-dirty tickets. Best-effort: a viewer failure must +never abort the operation that triggered the redecorate." + (let ((buffer (or buffer (current-buffer)))) + (ignore-errors + (pearl--viewer-async + (lambda (viewer) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (setq pearl--modified-count + (pearl--buffer-dirty-issue-count + (and viewer (plist-get viewer :id)) + (null viewer))) + (force-mode-line-update)))))))) + +(defun pearl--issue-description-region () + "Return (BEG . END) of the description body of the issue at point, or nil. +The body runs from after the property drawer to the first child heading +(`Comments' or any sub-heading), or to the subtree end when there are none." + (save-excursion + (org-back-to-heading t) + (let* ((subtree-end (save-excursion (org-end-of-subtree t t) (point))) + (beg (progn + (forward-line 1) + (when (looking-at-p "^[ \t]*:PROPERTIES:") + (when (re-search-forward "^[ \t]*:END:[ \t]*$" subtree-end t) + (forward-line 1))) + (point))) + (child (save-excursion + (if (re-search-forward "^\\*+ " subtree-end t) + (line-beginning-position) + subtree-end)))) + (when (< beg child) (cons beg child))))) + +(defun pearl--modified-highlight-regions (dirty viewer-id &optional viewer-failed) + "Region kinds to highlight for a ticket's DIRTY plist. +DIRTY is a `pearl--issue-dirty-fields' value. Returns a subset of (heading +description). `heading' fires for fold-visible bubble-up when any field is +dirty or an own comment is (VIEWER-ID classifies, VIEWER-FAILED forces unknown); +`description' adds the body region. Comment regions are laid separately." + (let* ((field (or (plist-get dirty :title) (plist-get dirty :description) + (plist-get dirty :priority) (plist-get dirty :state) + (plist-get dirty :assignee) (plist-get dirty :labels))) + (own (and (not viewer-failed) viewer-id + (plist-get (pearl--classify-comment-candidates + (plist-get dirty :comment-candidates) viewer-id) + :own))) + regions) + (when (or field own) (push 'heading regions)) + (when (plist-get dirty :description) (push 'description regions)) + (nreverse regions))) + +(defun pearl--modified-overlay (beg end face) + "Lay a `pearl-modified' overlay with FACE over BEG..END and return it." + (let ((ov (make-overlay beg end))) + (overlay-put ov 'pearl-modified t) + (overlay-put ov 'evaporate t) + (overlay-put ov 'face face) + ov)) + +(defun pearl--apply-modified-highlights (&optional viewer-id viewer-failed) + "Overlay `pearl-modified-highlight' on the unsaved fields of each issue. +Clears prior `pearl-modified' overlays first, so it's idempotent and a saved +field's highlight drops on the next pass. Highlights the heading line of any +pushable-dirty ticket (fold-visible bubble-up) and the description body when the +description changed. VIEWER-ID classifies own comments for the bubble-up; +per-comment highlighting is a later phase. No-op when +`pearl-show-modified-indicator' is nil." + (remove-overlays (point-min) (point-max) 'pearl-modified t) + (when pearl-show-modified-indicator + (save-excursion + (dolist (cell (pearl--issue-subtree-markers)) + (org-with-point-at (cdr cell) + (let ((regions (pearl--modified-highlight-regions + (pearl--issue-dirty-fields) viewer-id viewer-failed))) + (when (memq 'heading regions) + (pearl--modified-overlay (line-beginning-position) (line-end-position) + 'pearl-modified-highlight)) + (when (memq 'description regions) + (let ((r (pearl--issue-description-region))) + (when r + (pearl--modified-overlay (car r) (cdr r) + 'pearl-modified-highlight)))))))))) + (defun pearl--save-all-counts (scan viewer-id &optional viewer-failed) "Tally the dirty fields in SCAN, classifying comments with VIEWER-ID. When VIEWER-FAILED is non-nil (the viewer lookup ran and failed), every comment @@ -7789,6 +7930,14 @@ account's key in memory. Use `:api-key-source (:env \"...\")' in ;;; Comment Editing +(defface pearl-modified-highlight + '((t :inherit diff-changed :extend t)) + "Highlight over a field of an issue that has unsaved local edits. +Inherits the theme's `diff-changed' background -- a muted \"changed\" color that +stays legible as a background under the field's own text. Chosen over +`diff-refine-changed', which some themes render too bright to read against." + :group 'pearl) + (defface pearl-editable-comment '((t :inherit success)) "Face for comment headings the current user can edit." @@ -7966,6 +8115,9 @@ invoke by hand." ;; coloring but must show even when the viewer can't be resolved (offline, ;; missing key). (pearl--apply-heading-glyphs buffer) + ;; Field-level unsaved highlights need no viewer, so lay them synchronously + ;; (own-comment bubble-up and per-comment highlights come with the viewer). + (with-current-buffer buffer (pearl--apply-modified-highlights)) ;; Best-effort: highlighting is a display nicety and must never abort the ;; operation that triggered it (e.g. a missing API key errors in the ;; request layer), so a failure to resolve the viewer just skips coloring. @@ -7974,7 +8126,8 @@ invoke by hand." (lambda (viewer) (when (and viewer (buffer-live-p buffer)) (with-current-buffer buffer - (pearl--apply-comment-highlights (plist-get viewer :id))))))))) + (pearl--apply-comment-highlights (plist-get viewer :id))))))) + (pearl--refresh-modified-count buffer))) ;;;###autoload (defun pearl-edit-current-comment () diff --git a/tests/test-pearl-modified.el b/tests/test-pearl-modified.el new file mode 100644 index 0000000..cfef923 --- /dev/null +++ b/tests/test-pearl-modified.el @@ -0,0 +1,175 @@ +;;; test-pearl-modified.el --- Tests for the modified-ticket indicator -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;;; Commentary: + +;; Tests for the modified-ticket indicator (docs/modified-ticket-indicator-spec.org): +;; phase 1 covers the pushable-ticket count and its mode-line segment. The count +;; is "tickets, not fields": each ticket with pushable dirty work counts once. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defun test-pearl-modified--scan (&rest dirtys) + "Build a scan list ((MARKER . DIRTY) ...) from DIRTY plists (marker unused)." + (mapcar (lambda (d) (cons nil d)) dirtys)) + +;;; pushable-ticket count + +(ert-deftest test-pearl-count-pushable-field-dirty-ticket-counts () + "A ticket with any dirty non-comment field counts, regardless of the viewer." + (let ((scan (test-pearl-modified--scan '(:title t) '(:description t) '(:state t)))) + (should (= 3 (pearl--count-pushable-tickets scan "v"))) + (should (= 3 (pearl--count-pushable-tickets scan nil))))) + +(ert-deftest test-pearl-count-pushable-many-fields-one-ticket-counts-once () + "A ticket dirty in several fields counts once, not per field." + (let ((scan (test-pearl-modified--scan '(:title t :description t :labels t)))) + (should (= 1 (pearl--count-pushable-tickets scan "v"))))) + +(ert-deftest test-pearl-count-pushable-own-comment-only-counts () + "A ticket dirty only via an own comment (author = viewer) counts." + (let ((scan (test-pearl-modified--scan + '(:comment-candidates ((:author-id "v")))))) + (should (= 1 (pearl--count-pushable-tickets scan "v"))))) + +(ert-deftest test-pearl-count-pushable-readonly-comment-only-excluded () + "A ticket dirty only via a non-own comment does not count." + (let ((scan (test-pearl-modified--scan + '(:comment-candidates ((:author-id "someone-else")))))) + (should (= 0 (pearl--count-pushable-tickets scan "v"))))) + +(ert-deftest test-pearl-count-pushable-comment-only-unknown-viewer-excluded () + "Comment-only dirt doesn't count while the viewer is unresolved or failed." + (let ((scan (test-pearl-modified--scan + '(:comment-candidates ((:author-id "v")))))) + (should (= 0 (pearl--count-pushable-tickets scan nil))) + (should (= 0 (pearl--count-pushable-tickets scan "v" t))))) ; viewer-failed + +(ert-deftest test-pearl-count-pushable-mixed () + "A field-dirty ticket counts even when another ticket is only read-only-dirty." + (let ((scan (test-pearl-modified--scan + '(:priority t) + '(:comment-candidates ((:author-id "other")))))) + (should (= 1 (pearl--count-pushable-tickets scan "v"))))) + +;;; mode-line segment + +(ert-deftest test-pearl-mode-line-appends-changed-count-with-glyph () + "The lighter appends \"N <glyph> changed\" and keeps the account name." + (let ((pearl-accounts '(("work" :api-key "k"))) + (pearl-active-account "work") + (pearl-show-modified-indicator t) + (pearl-ticket-glyph "🎫") + (pearl--modified-count 3)) + (let ((s (pearl--mode-line-lighter))) + (should (string-match-p "Pearl\\[work\\]" s)) + (should (string-match-p "3" s)) + (should (string-match-p "🎫" s)) + (should (string-match-p "changed" s))))) + +(ert-deftest test-pearl-mode-line-changed-count-falls-back-to-word () + "With the glyph unset, the segment reads \"N tickets changed\"." + (let ((pearl-accounts '(("work" :api-key "k"))) + (pearl-active-account "work") + (pearl-show-modified-indicator t) + (pearl-ticket-glyph "") + (pearl--modified-count 2)) + (should (string-match-p "2 tickets changed" (pearl--mode-line-lighter))))) + +(ert-deftest test-pearl-mode-line-no-segment-when-clean () + "A zero count adds no segment; the account name still shows." + (let ((pearl-accounts '(("work" :api-key "k"))) + (pearl-active-account "work") + (pearl-show-modified-indicator t) + (pearl--modified-count 0)) + (let ((s (pearl--mode-line-lighter))) + (should (string-match-p "Pearl\\[work\\]" s)) + (should-not (string-match-p "changed" s))))) + +(ert-deftest test-pearl-mode-line-indicator-off-suppresses-count () + "With the indicator disabled, no count shows even when dirty." + (let ((pearl-accounts nil) + (pearl-active-account nil) + (pearl-show-modified-indicator nil) + (pearl--modified-count 5)) + (should-not (string-match-p "changed" (pearl--mode-line-lighter))))) + +;;; phase 2 -- field-region highlight + +(ert-deftest test-pearl-modified-regions-clean-is-nil () + "A clean ticket highlights nothing." + (should (null (pearl--modified-highlight-regions '() "v")))) + +(ert-deftest test-pearl-modified-regions-title-lights-heading () + (should (equal '(heading) (pearl--modified-highlight-regions '(:title t) "v")))) + +(ert-deftest test-pearl-modified-regions-description-lights-both () + "A dirty description lights the heading (bubble-up) and the body." + (should (equal '(heading description) + (pearl--modified-highlight-regions '(:description t) "v")))) + +(ert-deftest test-pearl-modified-regions-own-comment-lights-heading () + (should (equal '(heading) + (pearl--modified-highlight-regions + '(:comment-candidates ((:author-id "v"))) "v")))) + +(ert-deftest test-pearl-modified-regions-readonly-comment-nothing () + "A non-own comment does not light the heading." + (should (null (pearl--modified-highlight-regions + '(:comment-candidates ((:author-id "other"))) "v")))) + +(ert-deftest test-pearl-modified-regions-comment-unknown-viewer-nothing () + "A comment-only ticket lights nothing while the viewer is unresolved." + (should (null (pearl--modified-highlight-regions + '(:comment-candidates ((:author-id "v"))) nil)))) + +(ert-deftest test-pearl-issue-description-region-spans-body-only () + "The description region covers the body, not the drawer or the Comments child." + (with-temp-buffer + (insert "* F\n** TODO PEARL-1 Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n" + "Body one.\nBody two.\n*** Comments\n**** c\nhi\n") + (org-mode) + (goto-char (point-min)) (re-search-forward "PEARL-1") (org-back-to-heading t) + (let* ((r (pearl--issue-description-region)) + (text (buffer-substring-no-properties (car r) (cdr r)))) + (should (string-match-p "Body one" text)) + (should (string-match-p "Body two" text)) + (should-not (string-match-p "Comments" text)) + (should-not (string-match-p "LINEAR-ID" text))))) + +(ert-deftest test-pearl-apply-modified-highlights-marks-dirty-heading-idempotently () + "A title-dirty issue gets exactly one heading overlay, even on a second pass." + (with-temp-buffer + (insert "* F\n** TODO PEARL-1 Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n" + ":LINEAR-TITLE-SHA256: deadbeef\n:END:\n") + (org-mode) + (let ((pearl-show-modified-indicator t)) + (cl-flet ((modified-ovs () + (seq-filter (lambda (o) (overlay-get o 'pearl-modified)) + (overlays-in (point-min) (point-max))))) + (pearl--apply-modified-highlights) + (should (= 1 (length (modified-ovs)))) + (pearl--apply-modified-highlights) + (should (= 1 (length (modified-ovs)))))))) + +(ert-deftest test-pearl-apply-modified-highlights-off-clears () + "With the indicator disabled, the applier lays nothing (and clears prior)." + (with-temp-buffer + (insert "* F\n** TODO PEARL-1 Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n" + ":LINEAR-TITLE-SHA256: deadbeef\n:END:\n") + (org-mode) + (let ((pearl-show-modified-indicator t)) + (pearl--apply-modified-highlights)) + (let ((pearl-show-modified-indicator nil)) + (pearl--apply-modified-highlights)) + (should (null (seq-filter (lambda (o) (overlay-get o 'pearl-modified)) + (overlays-in (point-min) (point-max))))))) + +(provide 'test-pearl-modified) +;;; test-pearl-modified.el ends here |