diff options
| -rw-r--r-- | pearl.el | 41 | ||||
| -rw-r--r-- | tests/test-pearl-grouping.el | 41 |
2 files changed, 82 insertions, 0 deletions
@@ -7235,6 +7235,47 @@ sort -- with none set, asks you to run `pearl-set-sort' first." (target (pearl--toggle-sort-target source))) (pearl--apply-sort source (car target) (cdr target)))) +(defun pearl--apply-grouping (source value) + "Regroup the current buffer by VALUE and persist it on SOURCE. +VALUE is an `issueGrouping' value, or nil to flatten. Re-lays-out the issue +subtrees, re-folds (the regroup's delete+insert drops fold overlays, like +sort), and writes the updated `:client-group' into `#+LINEAR-SOURCE' only after +a successful regroup, so a failed/empty buffer never advertises a grouping it +doesn't show. Returns `grouped' on success or `no-issues' when there's nothing +to group." + (pcase (pearl--regroup-issue-subtrees value) + ('no-issues + (message "No issues to group in this buffer") + 'no-issues) + (_ + (pearl--restore-page-visibility) + (pearl--write-linear-source-header (pearl--source-with-grouping source value)) + (if value + (message "Grouped current buffer by %s" + (car (rassoc value pearl--grouping-choices))) + (message "Ungrouped current buffer")) + 'grouped))) + +;;;###autoload +(defun pearl-set-grouping (display) + "Group the active Linear view by DISPLAY, or ungroup it. +Interactively completes the dimension (status/project/assignee/priority/none). +Regroups the buffer in place client-side -- no refetch -- reading each issue's +group from its drawer, and persists the choice under `:client-group' so a +refresh reproduces it. `none' ungroups back to the flat list (and, on a Custom +View, restores the view's own server grouping on the next refresh). Cycle is +not offered: it isn't in the drawer, so an offline regroup can't read it." + (interactive + (list (completing-read + "Group by: " + (pearl--completion-table-keep-order + (mapcar #'car pearl--grouping-choices)) + nil t))) + (pearl--require-account-context) + (let ((value (pearl--grouping-display-to-value display))) + (pearl--check-grouping value) + (pearl--apply-grouping (pearl--active-source-or-error) value))) + (defun pearl--view-node-prefs (view) "Extract the runnable view preferences from a Custom View node VIEW. Returns `(:sort SORT :show-completed SC)': SORT is the `IssueSortInput' for the diff --git a/tests/test-pearl-grouping.el b/tests/test-pearl-grouping.el index af9c969..13a84d5 100644 --- a/tests/test-pearl-grouping.el +++ b/tests/test-pearl-grouping.el @@ -286,5 +286,46 @@ SE-1 has a comment subtree; SE-2 has no assignee.") "#+LINEAR-SOURCE: (:type filter :name \"F\" :filter nil)\n\n* F\n" (should (eq (pearl--regroup-issue-subtrees "workflowState") 'no-issues)))) +;;; command core (phase 3) + +(ert-deftest test-pearl-apply-grouping-groups-and-persists () + "Applying a grouping regroups the buffer and writes :client-group to the header." + (test-pearl-grouping--in-org test-pearl-grouping--flat + (cl-letf (((symbol-function 'pearl--restore-page-visibility) (lambda () nil))) + (should (eq (pearl--apply-grouping + '(:type filter :name "F" :filter (:open t)) "workflowState") + 'grouped))) + (should (equal (plist-get (pearl--read-active-source) :client-group) "workflowState")) + (should (= (test-pearl-grouping--issue-level "i1") 3)))) + +(ert-deftest test-pearl-apply-grouping-none-clears-and-flattens () + "Applying none flattens the buffer and leaves no :client-group in the header." + (test-pearl-grouping--in-org test-pearl-grouping--flat + (cl-letf (((symbol-function 'pearl--restore-page-visibility) (lambda () nil))) + (pearl--apply-grouping + '(:type view :name "v" :id "vid" :client-group "workflowState") "workflowState") + (should (eq (pearl--apply-grouping (pearl--read-active-source) nil) 'grouped))) + (should-not (plist-member (pearl--read-active-source) :client-group)) + (should (= (test-pearl-grouping--issue-level "i1") 2)))) + +(ert-deftest test-pearl-apply-grouping-refolds-on-success () + "A successful regroup re-folds the page." + (test-pearl-grouping--in-org test-pearl-grouping--flat + (let (folded) + (cl-letf (((symbol-function 'pearl--restore-page-visibility) + (lambda () (setq folded t)))) + (pearl--apply-grouping '(:type filter :name "F" :filter (:open t)) "workflowState")) + (should folded)))) + +(ert-deftest test-pearl-apply-grouping-no-issues-skips-fold-and-header () + "An issue-free buffer reports no-issues without folding or writing the header." + (test-pearl-grouping--in-org + "#+LINEAR-SOURCE: (:type filter :name \"F\" :filter nil)\n\n* F\n" + (cl-letf (((symbol-function 'pearl--restore-page-visibility) + (lambda () (error "should not re-fold a no-issues buffer")))) + (should (eq (pearl--apply-grouping '(:type filter :name "F" :filter nil) "workflowState") + 'no-issues))) + (should-not (plist-get (pearl--read-active-source) :client-group)))) + (provide 'test-pearl-grouping) ;;; test-pearl-grouping.el ends here |