diff options
| -rw-r--r-- | pearl.el | 68 | ||||
| -rw-r--r-- | tests/test-pearl-merge.el | 92 |
2 files changed, 151 insertions, 9 deletions
@@ -298,10 +298,41 @@ folds shut like the rest of the page, rather than rendering expanded." (narrow-to-region start end) (pearl--hide-or-tidy-drawers))) +(defun pearl--fold-subtree-at-marker (marker) + "Fold the subtree at MARKER to outline-only and tidy its drawers. +The subtree's heading stays visible; everything under it (body, drawers, +comment children) is collapsed. A merge refresh re-renders updated +subtrees and inserts new ones expanded; this folds just those so they +match what the buffer's `#+STARTUP' visibility would have produced, +without touching subtrees the user left expanded. A nil or dead MARKER +is a silent no-op." + (when (and marker (marker-buffer marker)) + (save-excursion + (goto-char marker) + (org-back-to-heading t) + (let ((beg (point)) + (end (save-excursion (org-end-of-subtree t t) (point)))) + (cond ((fboundp 'org-fold-subtree) (org-fold-subtree t)) + ((fboundp 'outline-hide-subtree) (outline-hide-subtree))) + (pearl--hide-drawers-in-region beg end))))) + +(defun pearl--fold-touched-subtrees (markers) + "Fold each subtree at the markers in MARKERS. +Used after `pearl--merge-issues-into-buffer' so the page stays as the +user had it. Untouched and locally-edited subtrees are left exactly as +they were; only the subtrees the merge actually re-rendered (updated) +or appended (added) come in folded. A no-op when +`pearl-fold-after-update' is nil." + (when pearl-fold-after-update + (dolist (m markers) + (pearl--fold-subtree-at-marker m)))) + (defun pearl--restore-page-visibility () "Re-fold the whole current buffer to its `#+STARTUP' visibility and hide drawers. -Used after a full repopulation (list / view / merge refresh) so the page does -not sprawl open. A no-op when `pearl-fold-after-update' is nil." +Used after a full repopulation (list / view replace path) so the page does +not sprawl open. A no-op when `pearl-fold-after-update' is nil. The merge +path uses `pearl--fold-touched-subtrees' instead so an edit-then-merge flow +keeps the user's expanded subtrees visible." (when pearl-fold-after-update ;; A full in-place rebuild (Branch B / merge) leaves Org's parsed startup ;; options stale -- the new `#+STARTUP:' text is in the buffer but @@ -3256,7 +3287,11 @@ just writing the file and leaving it off-screen." (pearl--update-source-header (length issues) truncated) (pearl--update-derived-todo-header (pearl--gather-header-states issues)) (pearl-highlight-comments) - (pearl--restore-page-visibility) + ;; Fold only the subtrees the merge re-rendered or appended; leave + ;; the rest of the page (and point) as the user had them, so an + ;; edit-then-merge flow doesn't collapse the subtree they were + ;; editing. + (pearl--fold-touched-subtrees (plist-get counts :touched-markers)) (message "Merged into %s: %d updated, %d added, %d dropped%s" (file-name-nondirectory org-file-path) (plist-get counts :updated) @@ -5153,11 +5188,18 @@ in place; an issue new to ISSUES is appended after the last one; an issue no longer in ISSUES is dropped. A subtree with any unpushed local edit (see `pearl--subtree-has-local-edits-p' -- title, state, priority, assignee, labels, description, or a comment) is never overwritten and never dropped; it is kept -and counted, so a refresh can't lose un-synced work. Returns a plist of counts -\(:updated :added :dropped :skipped)." +and counted, so a refresh can't lose un-synced work. + +Returns a plist of counts plus markers: +\(:updated N :added N :dropped N :skipped N :touched-markers (M1 M2 ...)) +where `:touched-markers' carries one marker per subtree the merge re-rendered +(updated) or appended (added). Callers use the marker list to fold just +those subtrees rather than re-folding the whole buffer, so an +edit-then-merge flow keeps the user's expanded subtrees expanded." (let ((existing (pearl--issue-subtree-markers)) (fetched-ids (mapcar (lambda (i) (plist-get i :id)) issues)) - (updated 0) (added 0) (dropped 0) (skipped 0)) + (updated 0) (added 0) (dropped 0) (skipped 0) + (touched-markers '())) ;; Existing issues still in the result: re-render in place, unless dirty. (dolist (issue issues) (let ((marker (cdr (assoc (plist-get issue :id) existing)))) @@ -5167,6 +5209,9 @@ and counted, so a refresh can't lose un-synced work. Returns a plist of counts (if (pearl--subtree-has-local-edits-p) (setq skipped (1+ skipped)) (pearl--replace-issue-subtree-at-point issue) + ;; `marker' still points at the new heading -- markers track + ;; the buffer position across the replace's delete-then-insert. + (push (copy-marker marker) touched-markers) (setq updated (1+ updated))))))) ;; Existing issues absent from the result: drop them, but keep dirty ones. (dolist (cell existing) @@ -5184,9 +5229,12 @@ and counted, so a refresh can't lose un-synced work. Returns a plist of counts (save-excursion (goto-char (point-max)) (unless (bolp) (insert "\n")) - (insert (pearl--format-issue-as-org-entry issue))) + (let ((insertion-start (point-marker))) + (insert (pearl--format-issue-as-org-entry issue)) + (push insertion-start touched-markers))) (setq added (1+ added)))) - (list :updated updated :added added :dropped dropped :skipped skipped))) + (list :updated updated :added added :dropped dropped :skipped skipped + :touched-markers (nreverse touched-markers)))) (defun pearl--update-source-header (issue-count truncated) "Refresh the active file's run-at, count, and truncation header lines. @@ -5258,7 +5306,9 @@ of the replace path." (pearl--update-source-header (length issues) truncated) (pearl--update-derived-todo-header (pearl--gather-header-states issues)) (pearl-highlight-comments) - (pearl--restore-page-visibility) + ;; Same as the dirty-merge path: fold only the touched subtrees, leave + ;; the rest of the page and point alone. + (pearl--fold-touched-subtrees (plist-get counts :touched-markers)) (pearl--surface-buffer (current-buffer)) (message "Refreshed %s: %d updated, %d added, %d dropped%s" (pearl--source-name source) diff --git a/tests/test-pearl-merge.el b/tests/test-pearl-merge.el index 122e5fa..711e772 100644 --- a/tests/test-pearl-merge.el +++ b/tests/test-pearl-merge.el @@ -175,6 +175,98 @@ Merge must protect any locally-edited field, not only the description." (goto-char (point-min)) (should (re-search-forward "UNPUSHED EDIT" nil t))))) +;;; touched-markers + per-subtree fold + +(ert-deftest test-pearl-merge-returns-touched-markers-for-updated-and-added () + "The merge result carries one marker per re-rendered or appended subtree. +The marker list is the foundation of the per-subtree fold path that +replaced the global re-fold: callers fold just the touched subtrees so +an edit-then-merge flow leaves the rest of the page (and point) alone." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc.") + (test-pearl-merge--issue "b" "Beta" "Desc.")) + (let* ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha Renamed" "Desc.") + (test-pearl-merge--issue "b" "Beta" "Desc.") + (test-pearl-merge--issue "c" "Gamma" "Desc.")))) + (markers (plist-get counts :touched-markers))) + ;; 2 updated + 1 added = 3 markers + (should (= 3 (length markers))) + ;; Every marker points at a live position in this buffer + (dolist (m markers) + (should (markerp m)) + (should (eq (current-buffer) (marker-buffer m)))) + ;; Each marker sits on or before an issue heading + (dolist (m markers) + (save-excursion + (goto-char m) + (org-back-to-heading t) + (should (org-entry-get nil "LINEAR-ID"))))))) + +(ert-deftest test-pearl-merge-skipped-issues-do-not-add-to-touched-markers () + "A locally-edited subtree the merge kept (skipped) is not in :touched-markers. +The fold should leave kept subtrees exactly as the user had them, so they +must not appear in the marker list the fold iterates." + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta" "Desc Beta.")) + ;; Mark the "a" subtree dirty by editing its description. + (goto-char (point-min)) + (re-search-forward "Desc Alpha.") + (replace-match "Desc Alpha (locally edited).") + (let* ((counts (pearl--merge-issues-into-buffer + (list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.") + (test-pearl-merge--issue "b" "Beta Renamed" "Desc Beta.")))) + (markers (plist-get counts :touched-markers))) + (should (= 1 (plist-get counts :skipped))) ; a was kept + (should (= 1 (plist-get counts :updated))) ; b was re-rendered + ;; Only one marker, and it sits on the "b" subtree. + (should (= 1 (length markers))) + (save-excursion + (goto-char (car markers)) + (org-back-to-heading t) + (should (equal "b" (org-entry-get nil "LINEAR-ID"))))))) + +;;; pearl--fold-subtree-at-marker + +(ert-deftest test-pearl-fold-subtree-at-marker-folds-heading-content () + "Folding a subtree leaves the heading visible and hides the content." + (let ((pearl-fold-after-update t)) + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Body line.")) + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + (beginning-of-line) + (let ((heading-pos (point))) + (pearl--fold-subtree-at-marker (copy-marker heading-pos)) + ;; The heading itself is visible + (goto-char heading-pos) + (should-not (invisible-p (point))) + ;; A position inside the body is now invisible + (re-search-forward "Body line.") + (should (invisible-p (point))))))) + +(ert-deftest test-pearl-fold-touched-subtrees-no-op-when-disabled () + "With `pearl-fold-after-update' nil, the fold helper does nothing." + (let ((pearl-fold-after-update nil)) + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Body.")) + (goto-char (point-min)) + (re-search-forward "^\\*\\* ") + (beginning-of-line) + (let ((m (copy-marker (point)))) + (pearl--fold-touched-subtrees (list m)) + ;; Body stays visible + (re-search-forward "Body") + (should-not (invisible-p (point))))))) + +(ert-deftest test-pearl-fold-subtree-at-marker-tolerates-nil-marker () + "A nil or dead marker is a silent no-op rather than erroring." + (let ((pearl-fold-after-update t)) + (test-pearl-merge--in-org + (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Body.")) + (should-not (pearl--fold-subtree-at-marker nil))))) + (ert-deftest test-pearl-merge-updates-rich-description-issue-in-place () "An unedited issue with lossy markdown (a heading) is updated, not skipped. Regression: the dirty check round-tripped Org back to markdown and mistook a |