diff options
| -rw-r--r-- | pearl.el | 156 | ||||
| -rw-r--r-- | tests/test-pearl-compose.el | 153 |
2 files changed, 291 insertions, 18 deletions
@@ -2013,6 +2013,82 @@ nothing is lost." (message "Synced merged %s to Linear" label)) (message "Failed to push merged %s" label))))))))) +;;; Compose Buffer +;; +;; A focused Org buffer for composing multi-line text (comments, descriptions) +;; that's awkward in the one-line minibuffer. A read-only instructional header +;; sits at the top, like a git commit template; the editable body is below it. +;; C-c C-c hands the body to an armed callback, C-c C-k aborts. The shared +;; sibling of the smerge conflict buffer below. + +(defvar-local pearl--compose-on-finish nil + "Callback invoked with the composed Org body when a compose buffer submits.") + +(defvar-local pearl--compose-body-start nil + "Marker at the start of the editable body, just past the read-only header.") + +(defconst pearl--compose-comment-instructions + "# Write a comment below, then C-c C-c to send or C-c C-k to cancel. +# This is Org markup; it is converted to Markdown for Linear. +" + "Read-only header shown atop the comment compose buffer.") + +(defconst pearl--compose-description-instructions + "# Edit the description below, then C-c C-c to sync or C-c C-k to cancel. +# This is Org markup; it is converted to Markdown for Linear. +# The usual conflict check still applies on sync. +" + "Read-only header shown atop the description compose buffer.") + +(defun pearl--compose-body () + "Return the trimmed editable body of the current compose buffer. +The text below the read-only header, from `pearl--compose-body-start' on." + (string-trim + (buffer-substring-no-properties pearl--compose-body-start (point-max)))) + +(defun pearl--compose-submit () + "Submit the compose buffer: hand the body to the armed callback, kill the buffer." + (interactive) + (let ((body (pearl--compose-body)) + (callback pearl--compose-on-finish)) + (kill-buffer (current-buffer)) + (when callback (funcall callback body)))) + +(defun pearl--compose-abort () + "Abort the compose buffer without submitting." + (interactive) + (kill-buffer (current-buffer)) + (message "Compose canceled")) + +(defun pearl--compose-in-buffer (label instructions initial on-finish) + "Pop an Org compose buffer for LABEL with a read-only INSTRUCTIONS header. +INITIAL is the editable body (Org markup, may be empty). \\<global-map>C-c C-c +\(`pearl--compose-submit') hands the body to ON-FINISH and kills the buffer; +C-c C-k (`pearl--compose-abort') cancels. ON-FINISH receives the Org body and +is responsible for any markdown conversion. The shared multi-line composer, +sibling of `pearl--resolve-conflict-in-smerge'." + (let ((buf (get-buffer-create (format "*pearl-compose: %s*" label)))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + ;; `org-mode' clears buffer-local vars, so set ours after it + (org-mode) + (insert instructions) + (let ((end (point))) + ;; the whole header is read-only; only its last char is rear-nonsticky + ;; so the body inserted just after stays editable (the interior is not, + ;; so edits inside the header are refused) + (add-text-properties (point-min) end '(read-only t)) + (add-text-properties (1- end) end '(rear-nonsticky t)) + (setq pearl--compose-body-start (copy-marker end nil))) + (insert (or initial ""))) + (setq-local pearl--compose-on-finish on-finish) + (local-set-key (kbd "C-c C-c") #'pearl--compose-submit) + (local-set-key (kbd "C-c C-k") #'pearl--compose-abort) + (goto-char (point-max))) + (pop-to-buffer buf) + buf)) + (defvar-local pearl--conflict-on-finish nil "Callback invoked with the reconciled text when a conflict buffer commits.") @@ -2430,30 +2506,73 @@ that subtree at the end of the issue when it does not exist yet." (insert "*** Comments\n" (pearl--format-comment comment)))))) ;;;###autoload -(defun pearl-add-comment (body) - "Add a comment with BODY to the Linear issue at point and insert it. -Works from anywhere inside an issue subtree. The new comment is the viewer's -own, so it renders editable; edit it later with -`pearl-edit-current-comment'." - (interactive "sComment: ") +(defun pearl--create-and-append-comment (issue-id marker body) + "Create a comment with BODY on ISSUE-ID, appending it at MARKER on success. +MARKER points at the issue heading; the append, comment highlighting, and +buffer surfacing all run in the marker's buffer, so it works even when the +create callback fires with another buffer current (the compose path)." + (pearl--progress "Adding comment to %s..." issue-id) + (pearl--create-comment-async + issue-id body + (lambda (comment) + (if (null comment) + (message "Failed to add comment to %s" issue-id) + (let ((buf (marker-buffer marker))) + (when (buffer-live-p buf) + (with-current-buffer buf + (save-excursion + (goto-char marker) + (pearl--append-comment-to-issue comment)) + (pearl-highlight-comments)) + (pearl--surface-buffer buf))) + (message "Added comment to %s" issue-id))))) + +;;;###autoload +(defun pearl-add-comment (&optional body) + "Add a comment to the Linear issue at point. +Interactively, opens an Org compose buffer (C-c C-c sends, C-c C-k cancels) and +converts the composed Org to Markdown before sending -- room to write a real +comment instead of the one-line minibuffer. BODY, when supplied +non-interactively, is sent as-is. Works from anywhere inside an issue subtree; +the new comment is the viewer's own, so it renders editable." + (interactive (list nil)) (save-excursion (pearl--goto-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (marker (point-marker))) (unless issue-id (user-error "Not on a Linear issue heading")) - (pearl--progress "Adding comment to %s..." issue-id) - (pearl--create-comment-async - issue-id body - (lambda (comment) - (if (null comment) - (message "Failed to add comment to %s" issue-id) - (save-excursion - (goto-char marker) - (pearl--append-comment-to-issue comment)) - (pearl-highlight-comments) - (pearl--surface-buffer (marker-buffer marker)) - (message "Added comment to %s" issue-id))))))) + (if body + (pearl--create-and-append-comment issue-id marker body) + (pearl--compose-in-buffer + (format "comment on %s" issue-id) + pearl--compose-comment-instructions "" + (lambda (org) + (pearl--create-and-append-comment + issue-id marker (pearl--org-to-md org)))))))) + +;;;###autoload +(defun pearl-compose-current-description () + "Edit the description of the Linear issue at point in an Org compose buffer. +Pops the current description into a focused buffer; C-c C-c writes it back into +the issue body and syncs to Linear through the usual conflict gate, C-c C-k +cancels. An alternative to editing the description inline for anyone who wants +a dedicated buffer. Works from anywhere inside an issue subtree." + (interactive) + (save-excursion + (pearl--goto-heading-or-error) + (let ((issue-id (org-entry-get nil "LINEAR-ID")) + (marker (point-marker))) + (unless issue-id + (user-error "Not on a Linear issue heading")) + (pearl--compose-in-buffer + (format "description for %s" issue-id) + pearl--compose-description-instructions + (org-with-point-at marker (pearl--issue-body-at-point)) + (lambda (org) + (org-with-point-at marker + (pearl--set-entry-body-at-point org) + (pearl-sync-current-issue))))))) ;;;###autoload (defun pearl-open-current-issue () @@ -3674,6 +3793,7 @@ reported (refresh to reconcile)." ("b" "Open view in Linear" pearl-open-current-view-in-linear)] ["Issue at point" ("e" "Edit desc -> push" pearl-sync-current-issue) + ("D" "Compose desc -> push" pearl-compose-current-description) ("t" "Edit title -> push" pearl-sync-current-issue-title) ("s" "Set state" pearl-set-state) ("a" "Set assignee" pearl-set-assignee) diff --git a/tests/test-pearl-compose.el b/tests/test-pearl-compose.el new file mode 100644 index 0000000..bda75cb --- /dev/null +++ b/tests/test-pearl-compose.el @@ -0,0 +1,153 @@ +;;; test-pearl-compose.el --- Tests for the compose buffer -*- 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 the shared compose buffer (`pearl--compose-in-buffer' and its +;; submit/abort/body helpers) and the two commands wired onto it: +;; `pearl-add-comment' (interactive composer path) and +;; `pearl-compose-current-description'. The body is extracted below a read-only +;; header and converted Org->Markdown by the callers. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl--with-compose (initial &rest body) + "Open a compose buffer holding INITIAL, run BODY in it, capturing the submit. +Binds `captured' to the value the on-finish receives (or `:none'). Stubs +`pop-to-buffer' so the helper does not touch windows in batch." + (declare (indent 1)) + `(let ((captured :none)) + (cl-letf (((symbol-function 'pop-to-buffer) (lambda (b &rest _) b))) + (let ((buf (pearl--compose-in-buffer + "test" "# header line\n" ,initial + (lambda (text) (setq captured text))))) + (with-current-buffer buf ,@body) + (when (buffer-live-p buf) (kill-buffer buf)))))) + +;;; --compose-in-buffer setup + +(ert-deftest test-pearl-compose-sets-up-org-buffer () + "The compose buffer is an Org buffer with the header and the initial body." + (test-pearl--with-compose "draft text" + (should (eq major-mode 'org-mode)) + (should (markerp pearl--compose-body-start)) + (should (string-match-p "# header line" (buffer-string))) + (should (string= "draft text" (pearl--compose-body))))) + +(ert-deftest test-pearl-compose-body-excludes-header () + "The body is only the text below the read-only header." + (test-pearl--with-compose "" + (goto-char (point-max)) + (insert "the new body") + (should (string= "the new body" (pearl--compose-body))))) + +(ert-deftest test-pearl-compose-header-is-read-only () + "Editing inside the header is refused." + (test-pearl--with-compose "body" + (goto-char (+ (point-min) 3)) + (should-error (insert "x") :type 'text-read-only))) + +;;; submit / abort + +(ert-deftest test-pearl-compose-submit-hands-body-to-callback () + "C-c C-c hands the trimmed body to the callback and kills the buffer." + (let ((captured :none) buf) + (cl-letf (((symbol-function 'pop-to-buffer) (lambda (b &rest _) b))) + (setq buf (pearl--compose-in-buffer + "t" "# h\n" " hello " + (lambda (text) (setq captured text)))) + (with-current-buffer buf (pearl--compose-submit)) + (should (string= "hello" captured)) + (should-not (buffer-live-p buf))))) + +(ert-deftest test-pearl-compose-abort-skips-callback () + "C-c C-k kills the buffer without invoking the callback." + (let ((called nil) buf) + (cl-letf (((symbol-function 'pop-to-buffer) (lambda (b &rest _) b))) + (setq buf (pearl--compose-in-buffer + "t" "# h\n" "body" (lambda (_) (setq called t)))) + (with-current-buffer buf (pearl--compose-abort)) + (should-not called) + (should-not (buffer-live-p buf))))) + +;;; add-comment composer wiring + +(defmacro test-pearl--in-issue (&rest body) + "Run BODY in an org buffer with point inside a Linear issue subtree." + (declare (indent 0)) + `(let ((pearl-state-to-todo-mapping '(("Todo" . "TODO")))) + (with-temp-buffer + (insert "** TODO [#B] ENG-1: Issue\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n") + (org-mode) + (goto-char (point-min)) + (re-search-forward "Body\\.") + ,@body))) + +(ert-deftest test-pearl-add-comment-interactive-composes-and-converts () + "An interactive add-comment composes Org and sends the Markdown conversion." + (test-pearl--in-issue + (let (sent) + (cl-letf (((symbol-function 'pearl--compose-in-buffer) + (lambda (_label _instr initial on-finish) + ;; the composer would start empty for a new comment + (should (string= "" initial)) + (funcall on-finish "see *bold* and `code`"))) + ((symbol-function 'pearl--create-comment-async) + (lambda (_id body _cb) (setq sent body)))) + (pearl-add-comment) ; interactive form: body nil + ;; Org markup converted to Markdown before sending + (should (string= "see **bold** and `code`" sent)))))) + +(ert-deftest test-pearl-add-comment-with-body-skips-composer () + "A non-interactive add-comment with BODY sends it directly, no composer." + (test-pearl--in-issue + (let ((composed nil) sent) + (cl-letf (((symbol-function 'pearl--compose-in-buffer) + (lambda (&rest _) (setq composed t))) + ((symbol-function 'pearl--create-comment-async) + (lambda (_id body _cb) (setq sent body)))) + (pearl-add-comment "literal body") + (should-not composed) + (should (string= "literal body" sent)))))) + +;;; compose-current-description wiring + +(ert-deftest test-pearl-compose-description-seeds-body-and-syncs () + "The description composer seeds the current body and, on submit, writes it back and syncs." + (test-pearl--in-issue + (let (seeded synced) + (cl-letf (((symbol-function 'pearl--compose-in-buffer) + (lambda (_label _instr initial on-finish) + (setq seeded initial) + (funcall on-finish "Edited description"))) + ((symbol-function 'pearl-sync-current-issue) + (lambda () (setq synced t)))) + (pearl-compose-current-description) + ;; seeded with the existing body + (should (string= "Body." seeded)) + ;; the edited text was written into the issue body, then synced + (should synced) + (goto-char (point-min)) + (should (re-search-forward "Edited description" nil t)))))) + +(provide 'test-pearl-compose) +;;; test-pearl-compose.el ends here |