diff options
Diffstat (limited to 'pearl.el')
| -rw-r--r-- | pearl.el | 129 |
1 files changed, 129 insertions, 0 deletions
@@ -6973,6 +6973,135 @@ server-side sort reorders the merged buffer without losing local edits." (insert (mapconcat (lambda (c) (plist-get c :text)) sorted "")))) t)))))) +(defun pearl--shift-heading-levels (text delta) + "Return TEXT with every Org heading line's star count shifted by DELTA. +A positive DELTA demotes (adds stars), negative promotes (removes, floor 1). +Only heading lines (`^\\*+ ') are touched; body and drawer lines are left +alone. pearl-rendered issue bodies never begin a line with `* ' (markdown +headings render as bold, bullets as `-'), so a captured issue subtree shifts +its issue + comment headings together without disturbing content." + (if (= delta 0) + text + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (re-search-forward "^\\(\\*+\\) " nil t) + (let ((n (max 1 (+ (length (match-string 1)) delta)))) + (replace-match (concat (make-string n ?*) " ") t t))) + (buffer-string)))) + +(defun pearl--buffer-issue-group-label (grouping) + "Return the group label for the issue subtree at point under GROUPING. +Reads the relevant `LINEAR-*' drawer field at point and maps it to the same +bucket `pearl--view-group-label' produces from a normalized issue, so a buffer +regroup matches a server-grouped render. Point must be on the issue heading. +GROUPING outside the drawer-backed set yields nil." + (pcase grouping + ("workflowState" + (let ((v (org-entry-get nil "LINEAR-STATE-NAME"))) + (if (and v (not (string-empty-p v))) v "No status"))) + ("project" + (let ((v (org-entry-get nil "LINEAR-PROJECT-NAME"))) + (if (and v (not (string-empty-p v))) v "No project"))) + ("assignee" + (let ((v (org-entry-get nil "LINEAR-ASSIGNEE-NAME"))) + (if (and v (not (string-empty-p v))) v "No assignee"))) + ("priority" + (pearl--get-linear-priority-name + (string-to-number (or (org-entry-get nil "LINEAR-PRIORITY") "0")))) + (_ nil))) + +(defun pearl--subtree-contains-issue-p (beg end) + "Return non-nil when the region BEG..END holds an issue heading (a `LINEAR-ID')." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (catch 'found + (while (re-search-forward "^\\*+ " nil t) + (let ((id (org-entry-get nil "LINEAR-ID"))) + (when (and id (not (string-empty-p id))) (throw 'found t)))) + nil)))) + +(defun pearl--regroup-issue-subtrees (grouping) + "Re-lay-out the active view's issue subtrees by GROUPING, in place. +GROUPING is an `issueGrouping' value (issues sectioned under level-2 group +headings, at level 3) or nil (a flat level-2 list). Each issue subtree moves +byte-for-byte with only its heading levels shifted, so unsaved edits survive; +the group label is read from the subtree's drawer (see +`pearl--buffer-issue-group-label'). Non-issue level-2 subtrees are kept, after +the issue groups. Works whether the buffer is currently flat or already +grouped. Returns t, or `no-issues' when there are none." + (save-excursion + (let ((markers (pearl--issue-subtree-markers))) + (if (null markers) + 'no-issues + ;; Climb from the first issue to the level-1 view parent. + (goto-char (cdr (car markers))) + (while (> (or (org-current-level) 1) 1) + (org-up-heading-safe)) + (let ((content-beg (save-excursion (forward-line 1) (point))) + (parent-end (save-excursion (org-end-of-subtree t t) (point))) + (issues '()) ; (:label L :text canonical-level-2-text), doc order + (malformed '())) ; non-issue level-2 subtree text, kept last + (goto-char content-beg) + (while (re-search-forward "^\\*\\* " parent-end t) + (beginning-of-line) + (let* ((beg (point)) + (end (save-excursion (org-end-of-subtree t t) (point))) + (id (org-entry-get nil "LINEAR-ID"))) + (cond + ;; A level-2 issue (flat buffer): already canonical level 2. + ((and id (not (string-empty-p id))) + (push (list :label (pearl--buffer-issue-group-label grouping) + :text (buffer-substring-no-properties beg end)) + issues)) + ;; A level-2 group heading (contains issues): descend, capture each + ;; level-3 issue normalized to level 2, drop the group heading. + ;; pearl only ever emits issues under a group section, so a + ;; non-issue heading nested here isn't expected; if one appears + ;; it's skipped (not re-emitted) rather than mis-bucketed. + ((pearl--subtree-contains-issue-p beg end) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward "^\\*+ " nil t) + (beginning-of-line) + (let ((cid (org-entry-get nil "LINEAR-ID"))) + (if (and cid (not (string-empty-p cid))) + (let* ((ibeg (point)) + (iend (save-excursion (org-end-of-subtree t t) (point))) + (lvl (org-current-level))) + (push (list :label (pearl--buffer-issue-group-label grouping) + :text (pearl--shift-heading-levels + (buffer-substring-no-properties ibeg iend) + (- 2 lvl))) + issues) + (goto-char iend)) + (forward-line 1)))))) + ;; A level-2 non-issue with no issues inside: malformed, keep it. + (t + (push (buffer-substring-no-properties beg end) malformed))) + (goto-char end))) + (setq issues (nreverse issues) + malformed (nreverse malformed)) + (delete-region content-beg parent-end) + (goto-char content-beg) + (if grouping + (let ((order '()) (table (make-hash-table :test 'equal))) + (dolist (it issues) + (let ((label (plist-get it :label))) + (unless (gethash label table) (push label order)) + (push it (gethash label table)))) + (dolist (label (nreverse order)) + (insert (format "** %s\n" label)) + (dolist (it (nreverse (gethash label table))) + (insert (pearl--shift-heading-levels (plist-get it :text) 1))))) + (dolist (it issues) + (insert (plist-get it :text)))) + (dolist (m malformed) (insert m)) + t))))) + (defun pearl--toggle-sort-target (source) "Return the (SORT . ORDER) to apply when toggling SOURCE's order. On a filter with no sort, establishes `updated' descending; otherwise flips the |