diff options
| -rw-r--r-- | README.org | 3 | ||||
| -rw-r--r-- | pearl.el | 124 | ||||
| -rw-r--r-- | tests/test-pearl-fetch-all-comments.el | 128 | ||||
| -rw-r--r-- | tests/test-pearl-menu.el | 4 |
4 files changed, 255 insertions, 4 deletions
@@ -316,6 +316,7 @@ Pearl has one write path. Edit an issue however you like in the buffer, then sav | =pearl-create-comment= | Add a new Linear comment | | =pearl-edit-current-comment= | Edit one of your own comments | | =pearl-delete-current-comment= | Delete one of your own comments after confirming | +| =pearl-fetch-all-comments= | Load the issue's full comment thread (=C-; L f c=) | | =pearl-delete-current-issue= | Soft-delete the current issue after confirmation | | =pearl-open-current-issue= | Open the issue URL in a browser | | =pearl-open-current-view-in-linear= | Open the active view in Linear | @@ -326,7 +327,7 @@ How each field is edited: - *Priority* -- the Org priority cookie (=C-c ,=, or =S-up= / =S-down=). =[#A]/[#B]/[#C]/[#D]= are Urgent/High/Medium/Low; no cookie is None. - *State* -- =pearl-edit-state=, completing over the team's workflow states. - *Assignee and labels* -- =pearl-edit-assignee= / =pearl-edit-labels=, completing over the team's members and labels. Labels also render as Org tags on the heading (=:bug:backend:=), so you can filter, sparse-tree, and build agendas on them. The =:LINEAR-LABELS:= drawer stays the source of truth; hand-edited heading tags are ignored and rewritten from Linear on the next change or fetch, so change labels with =pearl-edit-labels=. The assignee renders as a leading =@=-tag (=:@eric:bug:backend:=) so you can see who owns an issue at a glance on a team or "by person" view; set =pearl-show-assignee= to nil to omit it. It is display-only -- the =:LINEAR-ASSIGNEE-ID:= drawer is the source of truth, and the tag stays outside the title hash, so it never affects sync. -- *Comments* -- edit your own in place, or =pearl-create-comment= for a new one. +- *Comments* -- edit your own in place, or =pearl-create-comment= for a new one. A bulk list or view shows only the newest few comments per issue, marked =N/M+= when there are more. =pearl-fetch-all-comments= (=C-; L f c=) pulls the whole thread for the issue at point and replaces its Comments subtree with the full set. It refuses if you have unsaved comment edits, so save or discard those first. - *Mentions* -- in a comment or description compose buffer, type =@= at the start of a word to pop a picker over the team's members and insert =@displayName= (Linear's mention handle), so you never have to recall a teammate's exact spelling. =C-; L @= (=pearl-mention-user=) runs the same picker explicitly, and works inline in an issue buffer too. An =@= mid-word (an email, say) stays literal, and cancelling the picker leaves a literal =@=. Picking a constrained field writes the value into the buffer and marks it changed; it doesn't push until you save. The display name or label text is there to read -- Pearl reconciles by the underlying id, and a refresh rewrites the display from the remote, so hand-editing the visible name has no effect. @@ -1552,6 +1552,19 @@ exact count for busier issues at the cost of a larger fetch." "id body createdAt user { id name displayName } botActor { name } externalUser { name }" "The comment node field selection shared by every query that pulls comments.") +(defconst pearl--all-comments-query + (format "query AllComments($id: String!, $after: String) { + issue(id: $id) { + comments(first: 100, after: $after, orderBy: createdAt) { + nodes { %s } + pageInfo { hasNextPage endCursor } + } + } +}" pearl--comment-node-fields) + "Query for one issue's full comment thread; paged with first/after. +Unlike `pearl--list-comments-fragment' (which caps the bulk list), this pulls +every comment so `pearl-fetch-all-comments' can show the whole thread.") + (defun pearl--list-comments-fragment () "Return the GraphQL comments fragment for the bulk/view list, or empty string. Fetches one more than `pearl-list-comments-count-cap', newest first, so the @@ -3618,6 +3631,110 @@ create callback fires with another buffer current (the compose path)." (pearl--surface-buffer buf))) (message "Added comment to %s" issue-id))))) +(defun pearl--fetch-all-comments-async (issue-id callback) + "Fetch every comment on ISSUE-ID, calling CALLBACK with the normalized list. +Pages the comment connection via first/after. On a transport/GraphQL error +CALLBACK receives the symbol `error' (already logged) so the caller can leave +the buffer untouched rather than mistake a failure for an empty thread." + (let (acc) + (cl-labels + ((collect (data) + (let* ((issue (cdr (assoc 'issue (cdr (assoc 'data data))))) + (conn (and issue (cdr (assoc 'comments issue)))) + (nodes (append (cdr (assoc 'nodes conn)) nil)) + (page (cdr (assoc 'pageInfo conn)))) + (dolist (n nodes) + (push (pearl--normalize-comment n) acc)) + (if (eq (cdr (assoc 'hasNextPage page)) t) + (pearl--graphql-request-async + pearl--all-comments-query + (list (cons "id" issue-id) + (cons "after" (cdr (assoc 'endCursor page)))) + #'collect + (lambda (&rest _) (funcall callback 'error))) + (funcall callback (nreverse acc)))))) + (pearl--graphql-request-async + pearl--all-comments-query + (list (cons "id" issue-id)) + #'collect + (lambda (&rest _) (funcall callback 'error)))))) + +(defun pearl--replace-comments-subtree (comments) + "Replace the issue-at-point's Comments subtree with COMMENTS (the full thread). +Climbs to the issue heading, removes its existing Comments subtree if any, and +inserts a freshly formatted one carrying an exact `N/N' count (no `+'). Empty +COMMENTS clears the subtree. Only the Comments subtree is touched, so the issue +title, drawer, and description body -- including unsaved description edits -- +survive." + (save-excursion + (pearl--goto-issue-heading-or-error) + (let* ((level (org-current-level)) + (issue-end (save-excursion (org-end-of-subtree t t) (point))) + (comments-pos + (save-excursion + (when (re-search-forward + "^\\*+ \\(?:💬 \\)?Comments\\(?:[ \t].*\\)?$" issue-end t) + (match-beginning 0)))) + (n (length comments)) + (count-info (and (> n 0) (list :shown n :total n :overflow nil))) + (rendered (pearl--format-comments comments count-info level))) + ;; The Comments subtree is the issue's last child, so its region runs from + ;; the Comments heading to the end of the issue subtree. + (if comments-pos + (progn (goto-char comments-pos) + (delete-region comments-pos issue-end)) + (goto-char issue-end)) + (let ((start (point))) + (insert rendered) + (pearl--hide-drawers-in-region start (point)))))) + +(defun pearl--unpushed-comment-edits-p () + "Non-nil when the issue at point has comments with unpushed local edits. +The guard for `pearl-fetch-all-comments': replacing the thread would discard a +comment whose body was edited but not yet saved, so the fetch refuses while any +exist." + (save-excursion + (pearl--goto-issue-heading-or-error) + (consp (pearl--changed-comment-candidates)))) + +;;;###autoload +(defun pearl-fetch-all-comments () + "Fetch every comment on the Linear issue at point and render the full thread. +The bulk/view fetch shows only the newest `pearl-list-comments-shown' comments +\(with a ` N/M+' marker when more exist); this pages the issue's whole comment +connection and replaces its Comments subtree with the complete set. Works from +anywhere inside the issue subtree. Refuses when the issue has unpushed local +comment edits, so the fetch never clobbers an unsent change -- save or discard +those first." + (interactive) + (pearl--require-account-context) + (save-excursion + (pearl--goto-issue-heading-or-error) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (ident (or (org-entry-get nil "LINEAR-IDENTIFIER") "this issue")) + (marker (point-marker)) + (buf (current-buffer))) + (when (pearl--unpushed-comment-edits-p) + (user-error "This issue has unpushed comment edits; save or discard them before fetching the full thread")) + (pearl--progress "Fetching all comments for %s..." ident) + (pearl--fetch-all-comments-async + issue-id + (lambda (comments) + (cond + ((eq comments 'error) + (message "Pearl: couldn't fetch comments for %s" ident)) + ((not (buffer-live-p buf)) nil) + (t + (with-current-buffer buf + (save-excursion + (goto-char marker) + (pearl--replace-comments-subtree comments)) + (pearl-highlight-comments)) + (pearl--surface-buffer buf) + (message "Fetched all %d comment%s for %s" + (length comments) + (if (= 1 (length comments)) "" "s") ident)))))))) + ;;;###autoload (defun pearl-create-comment (&optional body) "Add a comment to the Linear issue at point. @@ -7603,6 +7720,7 @@ body stay." ["Buffer" ("g" "refresh view" pearl-refresh-current-view) ("r" "refresh issue" pearl-refresh-current-issue) + ("F" "all comments for issue" pearl-fetch-all-comments) ("b" "open view in Linear" pearl-open-current-view-in-linear) ("o" "open issue in browser" pearl-open-current-issue) ("y" "copy issue URL" pearl-copy-issue-url)] @@ -7642,11 +7760,13 @@ body stay." (define-key map "o" (cons "my open issues" #'pearl-list-issues)) (define-key map "p" (cons "by project" #'pearl-list-issues-by-project)) (define-key map "f" (cons "build a filter" #'pearl-list-issues-filtered)) + (define-key map "c" (cons "all comments for issue" #'pearl-fetch-all-comments)) map) "Pearl issue-fetch commands; a sub-keymap of `pearl-prefix-map'. Issue sources only -- pick a source, your open issues, a project, or an -ad-hoc filter. View-movement commands (run / publish / save-locally) live -in `pearl-views-map' so this group stays one concern.") +ad-hoc filter -- plus `c' to pull the full comment thread of the issue at +point. View-movement commands (run / publish / save-locally) live in +`pearl-views-map' so this group stays one concern.") (defvar pearl-views-map (let ((map (make-sparse-keymap))) diff --git a/tests/test-pearl-fetch-all-comments.el b/tests/test-pearl-fetch-all-comments.el new file mode 100644 index 0000000..04dfe31 --- /dev/null +++ b/tests/test-pearl-fetch-all-comments.el @@ -0,0 +1,128 @@ +;;; test-pearl-fetch-all-comments.el --- Tests for fetching a full comment thread -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for pearl-fetch-all-comments: the keybinding, the in-place +;; Comments-subtree replacement with an exact N/N count, and the unpushed-edit +;; guard that refuses to clobber a locally-edited comment. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl-fac--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT." + (declare (indent 1)) + `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(defconst test-pearl-fac--with-comments + (concat + "* My open issues\n" + "** TODO SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:LINEAR-IDENTIFIER: SE-1\n:END:\n" + "The description body.\n" + "*** Comments 2/5+\n" + "**** Old Author — 2026-01-01T00:00:00.000Z\n" + ":PROPERTIES:\n:LINEAR-COMMENT-ID: oc1\n:LINEAR-COMMENT-AUTHOR-ID: u1\n" + ":LINEAR-COMMENT-SHA256: deadbeef\n:LINEAR-COMMENT-ORG-SHA256: deadbeef\n:END:\n" + "old comment one\n") + "An issue with a capped (overflowing) Comments subtree and a stale-hash comment.") + +(defconst test-pearl-fac--no-comments + (concat + "* My open issues\n" + "** TODO SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:LINEAR-IDENTIFIER: SE-1\n:END:\n" + "The description body.\n") + "An issue with no Comments subtree.") + +(defun test-pearl-fac--goto-issue () + "Move point onto the issue heading." + (goto-char (point-min)) + (re-search-forward "^\\*\\* TODO SE-1") + (beginning-of-line)) + +;;; keybinding + +(ert-deftest test-pearl-fetch-all-comments-bound () + "The command is bound under the fetch sub-keymap at `c'." + (should (eq 'pearl-fetch-all-comments (lookup-key pearl-fetch-map (kbd "c"))))) + +;;; subtree replacement + +(ert-deftest test-pearl-replace-comments-subtree-replaces-and-counts () + "Replacing swaps the capped thread for the full set with an exact N/N count." + (test-pearl-fac--in-org test-pearl-fac--with-comments + (test-pearl-fac--goto-issue) + (pearl--replace-comments-subtree + (list '(:id "c1" :author "Bob" :created-at "2026-02-01T00:00:00.000Z" :body "new one") + '(:id "c2" :author "Sue" :created-at "2026-02-02T00:00:00.000Z" :body "new two"))) + (goto-char (point-min)) + (should (search-forward "Comments 2/2" nil t)) + (goto-char (point-min)) + (should (search-forward "The description body." nil t)) + (goto-char (point-min)) + (should (search-forward "new one" nil t)) + (goto-char (point-min)) + (should-not (search-forward "old comment one" nil t)))) + +(ert-deftest test-pearl-replace-comments-subtree-creates-when-absent () + "An issue with no Comments subtree gets one inserted." + (test-pearl-fac--in-org test-pearl-fac--no-comments + (test-pearl-fac--goto-issue) + (pearl--replace-comments-subtree + (list '(:id "c1" :author "Bob" :created-at "2026-02-01T00:00:00.000Z" :body "hello"))) + (goto-char (point-min)) + (should (search-forward "Comments 1/1" nil t)) + (goto-char (point-min)) + (should (search-forward "hello" nil t)) + (goto-char (point-min)) + (should (search-forward "The description body." nil t)))) + +(ert-deftest test-pearl-replace-comments-subtree-empty-clears () + "An empty thread clears the Comments subtree." + (test-pearl-fac--in-org test-pearl-fac--with-comments + (test-pearl-fac--goto-issue) + (pearl--replace-comments-subtree nil) + (goto-char (point-min)) + (should-not (search-forward "Comments" nil t)) + (goto-char (point-min)) + (should (search-forward "The description body." nil t)))) + +;;; unpushed-edit guard + +(ert-deftest test-pearl-unpushed-comment-edits-p-detects-dirty () + "A comment whose body no longer matches its stored hash is an unpushed edit." + (test-pearl-fac--in-org test-pearl-fac--with-comments + (test-pearl-fac--goto-issue) + (should (pearl--unpushed-comment-edits-p)))) + +(ert-deftest test-pearl-unpushed-comment-edits-p-clean-when-no-comments () + "An issue with no comments has no unpushed comment edits." + (test-pearl-fac--in-org test-pearl-fac--no-comments + (test-pearl-fac--goto-issue) + (should-not (pearl--unpushed-comment-edits-p)))) + +(provide 'test-pearl-fetch-all-comments) +;;; test-pearl-fetch-all-comments.el ends here diff --git a/tests/test-pearl-menu.el b/tests/test-pearl-menu.el index 8d23023..825d6bc 100644 --- a/tests/test-pearl-menu.el +++ b/tests/test-pearl-menu.el @@ -76,7 +76,9 @@ menu entry that still points at it fails here." pearl-switch-account pearl-copy-issue-url ;; set-default-view: the new Views-group entry - pearl-set-default-view)) + pearl-set-default-view + ;; fetch the full comment thread for the issue at point + pearl-fetch-all-comments)) (should (memq expected cmds))))) (provide 'test-pearl-menu) |