From 805e288178ce2b96dd4a0277b49904131853e8fe Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Wed, 27 May 2026 15:44:21 -0500 Subject: feat(commands): add pearl-copy-issue-url, bound at u c I added pearl-copy-issue-url. It copies the Linear URL of the issue at point to the kill ring and the system clipboard, reading the stored LINEAR-URL drawer property so there's no network call, and works from anywhere inside the issue subtree. kill-new carries it to the clipboard through interprogram-cut-function, so nothing shells out to a clipboard tool. Bound at u c in the url group, beside u o (open in browser). --- pearl.el | 19 +++++++++++++++++-- tests/test-pearl-keymap.el | 7 +++---- tests/test-pearl-open.el | 24 ++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 6 deletions(-) diff --git a/pearl.el b/pearl.el index f5d0489..bc9319d 100644 --- a/pearl.el +++ b/pearl.el @@ -2575,6 +2575,22 @@ Reads the `LINEAR-URL' property of the enclosing issue heading and hands it to (user-error "No LINEAR-URL on the issue at point")) (browse-url url))) +;;;###autoload +(defun pearl-copy-issue-url () + "Copy the Linear URL of the issue at point to the kill ring and clipboard. +Reads the `LINEAR-URL' property of the enclosing issue heading. Works from +anywhere inside the issue subtree and makes no network call. `kill-new' adds +the URL to the kill ring and, through `interprogram-cut-function', the system +clipboard." + (interactive) + (let ((url (save-excursion + (pearl--goto-issue-heading-or-error) + (org-entry-get nil "LINEAR-URL")))) + (unless (and url (not (string-empty-p url))) + (user-error "No LINEAR-URL on the issue at point")) + (kill-new url) + (message "Copied %s" url))) + (defun pearl--delete-issue-async (issue-id callback) "Delete ISSUE-ID on Linear via issueDelete, calling CALLBACK with the outcome. CALLBACK receives a plist (:success BOOL). Linear's `issueDelete' is a soft @@ -4847,9 +4863,8 @@ body stay." (defvar pearl-url-map (let ((map (make-sparse-keymap))) (define-key map "o" (cons "open issue in browser" #'pearl-open-current-issue)) + (define-key map "c" (cons "copy issue URL" #'pearl-copy-issue-url)) (define-key map "v" (cons "open view in Linear" #'pearl-open-current-view-in-linear)) - ;; "c" (copy the issue URL to the clipboard) lands with - ;; `pearl-copy-issue-url' -- see the todo. map) "Pearl URL commands; a sub-keymap of `pearl-prefix-map'.") diff --git a/tests/test-pearl-keymap.el b/tests/test-pearl-keymap.el index 0e12da3..25b63d9 100644 --- a/tests/test-pearl-keymap.el +++ b/tests/test-pearl-keymap.el @@ -90,11 +90,10 @@ Walks MAP looking for a labeled binding (\"label\" . COMMAND)." (should (eq 'pearl-delete-current-comment (lookup-key pearl-prefix-map (kbd "k c"))))) (ert-deftest test-pearl-prefix-map-url-group () - "The url group resolves open-in-browser and open-view; copy-url is not yet bound." + "The url group resolves open-in-browser, copy-url, and open-view." (should (eq 'pearl-open-current-issue (lookup-key pearl-prefix-map (kbd "u o")))) - (should (eq 'pearl-open-current-view-in-linear (lookup-key pearl-prefix-map (kbd "u v")))) - ;; "u c" (copy URL) lands with `pearl-copy-issue-url' - (should-not (lookup-key pearl-prefix-map (kbd "u c")))) + (should (eq 'pearl-copy-issue-url (lookup-key pearl-prefix-map (kbd "u c")))) + (should (eq 'pearl-open-current-view-in-linear (lookup-key pearl-prefix-map (kbd "u v"))))) (ert-deftest test-pearl-prefix-map-common-commands-bound-twice () "The most common commands resolve both directly and inside their group." diff --git a/tests/test-pearl-open.el b/tests/test-pearl-open.el index 1be6114..f01ecd3 100644 --- a/tests/test-pearl-open.el +++ b/tests/test-pearl-open.el @@ -62,5 +62,29 @@ (test-pearl--in-org "plain text, no heading\n" (should-error (pearl-open-current-issue) :type 'user-error))) +;;; pearl-copy-issue-url + +(ert-deftest test-pearl-copy-issue-url-copies-to-kill-ring () + "The command copies the heading's LINEAR-URL to the kill ring." + (let ((kill-ring nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-URL: https://linear.app/x/ENG-1\n:END:\nbody\n" + (goto-char (point-max)) + (pearl-copy-issue-url) + (should (string= "https://linear.app/x/ENG-1" (car kill-ring)))))) + +(ert-deftest test-pearl-copy-issue-url-no-url-errors () + "An issue heading without a LINEAR-URL signals a user error, nothing copied." + (let ((kill-ring nil)) + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" + (should-error (pearl-copy-issue-url) :type 'user-error) + (should-not kill-ring)))) + +(ert-deftest test-pearl-copy-issue-url-not-on-issue-errors () + "Running outside a heading signals a user error." + (test-pearl--in-org "plain text, no heading\n" + (should-error (pearl-copy-issue-url) :type 'user-error))) + (provide 'test-pearl-open) ;;; test-pearl-open.el ends here -- cgit v1.2.3