diff options
| -rw-r--r-- | pearl.el | 44 | ||||
| -rw-r--r-- | tests/test-pearl-sort.el | 10 |
2 files changed, 46 insertions, 8 deletions
@@ -6813,13 +6813,18 @@ order. The keyed sort is stable, so equal keys keep document order." (ordered (cl-stable-sort (copy-sequence keyed) cmp))) (append ordered unkeyed)))) -(defun pearl--reorder-issue-subtrees (sort order) +(defun pearl--reorder-issue-subtrees (sort order &optional id-ranks) "Reorder the active view's issue subtrees in place by SORT in ORDER. Moves whole subtrees byte-for-byte -- descriptions, comments, drawers, and any unsaved local edits survive unchanged -- rather than reconstructing them from parsed data. A non-issue level-2 subtree (no `LINEAR-ID') is kept and sorted last. Returns t on success, `grouped' when issues sit below level 2 (a grouped -view, unsupported in v1), or `no-issues' when there are none." +view, unsupported in v1), or `no-issues' when there are none. + +ID-RANKS, when non-nil, is a hash mapping `LINEAR-ID' to an integer position; +each subtree is keyed by its rank and laid out ascending, so the buffer matches +a server-fetched order (SORT/ORDER are then ignored). This is how the +server-side sort reorders the merged buffer without losing local edits." (save-excursion (let ((markers (pearl--issue-subtree-markers))) (cond @@ -6845,7 +6850,8 @@ view, unsupported in v1), or `no-issues' when there are none." (end (save-excursion (org-end-of-subtree t t) (point))) (id (org-entry-get nil "LINEAR-ID")) (key (and id (not (string-empty-p id)) - (pearl--issue-sort-key sort))) + (if id-ranks (gethash id id-ranks) + (pearl--issue-sort-key sort)))) (text (buffer-substring-no-properties beg end))) (unless block-beg (setq block-beg beg)) (setq block-end end) @@ -6854,7 +6860,8 @@ view, unsupported in v1), or `no-issues' when there are none." (goto-char end)) (goto-char (save-excursion (org-end-of-subtree t t) (point))))) (when (and block-beg block-end) - (let ((sorted (pearl--sort-subtree-entries (nreverse children) order))) + (let ((sorted (pearl--sort-subtree-entries + (nreverse children) (if id-ranks 'asc order)))) (delete-region block-beg block-end) (goto-char block-beg) (insert (mapconcat (lambda (c) (plist-get c :text)) sorted "")))) @@ -6877,11 +6884,30 @@ toggle until you sort it." (cons 'updated 'desc) (cons s (if (eq o 'asc) 'desc 'asc)))))) +(defun pearl--issue-id-ranks (result source) + "Build a `LINEAR-ID' -> position hash from RESULT, in SOURCE's sort order. +The fetched nodes are normalized and sorted the same way the render path sorts +them, so the hash captures the order the server returned for the new `orderBy'." + (let* ((eff (pearl--effective-sort-order source)) + (issues (pearl--sort-issues + (mapcar #'pearl--normalize-issue + (pearl--query-result-issues result)) + (car eff) (cdr eff))) + (ranks (make-hash-table :test 'equal)) + (i 0)) + (dolist (issue issues) + (puthash (plist-get issue :id) i ranks) + (setq i (1+ i))) + ranks)) + (defun pearl--apply-server-sort (source sort order) "Refetch SOURCE (a filter) with the server `orderBy' for SORT, then persist. -On success merges the result and writes the updated `#+LINEAR-SOURCE' header; on -an empty/failed fetch it leaves the header unchanged and reports the merge -outcome, so a failed sort never advertises an order the buffer doesn't show." +Merges the result (so unpushed edits survive), reorders the buffer's issue +subtrees to the fetched order -- a merge alone updates issues in place and never +moves them, so the new order would be invisible -- and writes the updated +`#+LINEAR-SOURCE' header. An empty/failed fetch leaves the header unchanged and +just reports the merge outcome, so a failed sort never advertises an order the +buffer doesn't show." (let ((buffer (current-buffer))) (pearl--progress "Refetching %s ordered by %s %s..." (pearl--source-name source) sort order) @@ -6892,7 +6918,9 @@ outcome, so a failed sort never advertises an order the buffer doesn't show." (with-current-buffer buffer (pcase (pearl--query-result-status result) ('ok - (pearl--merge-query-result result source) + (let ((ranks (pearl--issue-id-ranks result source))) + (pearl--merge-query-result result source) + (pearl--reorder-issue-subtrees nil 'asc ranks)) (pearl--write-linear-source-header source) (message "Refetched %s ordered by %s %sending" (pearl--source-name source) sort diff --git a/tests/test-pearl-sort.el b/tests/test-pearl-sort.el index 6527989..a5292b3 100644 --- a/tests/test-pearl-sort.el +++ b/tests/test-pearl-sort.el @@ -191,6 +191,16 @@ leaving its server :sort (an IssueSortInput) untouched." (goto-char (point-min)) (should (search-forward "A stray local heading" nil t)))) +(ert-deftest test-pearl-reorder-by-id-ranks () + "With an id-rank hash, subtrees are laid out in the ranked order (server sort)." + (test-pearl-sort--in-org test-pearl-sort--flat + (let ((ranks (make-hash-table :test 'equal))) + ;; Rank i1 before i2, the reverse of the buffer's i2,i1 order. + (puthash "i1" 0 ranks) + (puthash "i2" 1 ranks) + (should (eq (pearl--reorder-issue-subtrees nil 'asc ranks) t)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2")))))) + ;;; toggle target (ert-deftest test-pearl-toggle-target-filter-no-sort-defaults () |