;;; pearl.el --- Linear.app integration -*- lexical-binding: t; -*- ;; Copyright (C) 2025 ;; Author: Craig Jennings ;; Based on and inspired by Gael Blanchemain's linear-emacs. ;; Version: 1.0.0 ;; Package-Requires: ((emacs "27.1") (request "0.3.0") (dash "2.17.0") (s "1.12.0") (transient "0.3.0")) ;; Keywords: tools ;; URL: https://git.cjennings.net/pearl.git ;; This file is not part of GNU Emacs. ;; 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 . ;;; Commentary: ;; pearl integrates Linear.app issue tracking with Emacs and org-mode. ;; Fetch your issues -- open issues, a project, an ad-hoc filter, a Linear ;; Custom View, or a named saved query -- into a single self-describing org ;; file: each issue is a heading, its description and comments render in the ;; body, and its structured fields live in a namespaced LINEAR-* drawer. ;; ;; Edit a description or title and push it back with conflict-aware sync; set ;; priority, state, assignee, or labels by command; add comments; and create ;; or delete issues -- all without leaving Emacs. See README.org for the full ;; command surface and configuration. ;;; Code: ;; ;; This file is organized into the following sections: ;; ;; - Dependencies and requirements ;; - Customization and variables ;; - Core API functions (async-first) ;; - Team management functions ;; - Issue management functions ;; - Issue state management functions ;; - Org-mode integration functions ;; - Mapping functions (between Linear and org-mode) ;; - User-facing commands ;; - Org-mode sync hooks ;; - Backward compatibility functions ;; ;; Dependencies (require 'request) (require 'json) (require 'dash) (require 's) (require 'org) (require 'cl-lib) (require 'transient) ;;; Customization and Variables (defgroup pearl nil "Integration with Linear issue tracking." :group 'tools :prefix "pearl-") (defcustom pearl-api-key nil "API key for Linear.app. Can be set manually or loaded from LINEAR_API_KEY environment variable using `pearl-load-api-key-from-env'." :type 'string :group 'pearl) (defcustom pearl-graphql-url "https://api.linear.app/graphql" "GraphQL endpoint URL for Linear API." :type 'string :group 'pearl) (defcustom pearl-default-team-id nil "Default team ID to use for creating issues. When set, skips team selection prompt when creating new issues." :type 'string :group 'pearl) (defcustom pearl-debug nil "Enable debug logging for Linear requests. When enabled, detailed API request and response information will be logged to the *Messages* buffer." :type 'boolean :group 'pearl) (defcustom pearl-org-file-path (expand-file-name "gtd/linear.org" org-directory) "Path to the org file where Linear issues are stored. This file is created or updated by `pearl-list-issues'. Defaults to \\='gtd/linear.org\\=' in your `org-directory'." :type 'file :group 'pearl) (defcustom pearl-async-default t "Use async API calls by default. When t, all API calls will be asynchronous unless explicitly overridden. Set to nil to use synchronous calls by default for backward compatibility." :type 'boolean :group 'pearl) (defcustom pearl-progress-messages t "Show progress messages during long operations. When enabled, displays messages about ongoing API operations." :type 'boolean :group 'pearl) (defcustom pearl-max-issue-pages 10 "Maximum number of issue pages to fetch, at 100 issues per page. `pearl-list-issues' stops after this many pages and warns that the result may be truncated. Raise it if you are assigned more issues than this cap can hold." :type 'integer :group 'pearl) (defcustom pearl-request-timeout 30 "Seconds a synchronous Linear request waits before giving up. The synchronous wrappers busy-wait for their async counterpart to call back. If it never does (dropped connection, server stall), they return nil after this many seconds rather than hanging Emacs." :type 'number :group 'pearl) (defcustom pearl-surface-buffer t "When non-nil, surface the active org buffer after a command updates it. A command run while the buffer is buried (its async result lands after you have navigated away) brings the buffer back to a window so the result is visible. Set to nil to leave window layout untouched." :type 'boolean :group 'pearl) (defcustom pearl-surface-select-window nil "When non-nil, surfacing the active buffer also selects its window. With the default nil, `pearl-surface-buffer' shows the buffer via `display-buffer' without moving focus. Set non-nil to have focus follow \(via `pop-to-buffer') so point lands in the surfaced buffer." :type 'boolean :group 'pearl) (defcustom pearl-compose-window-side 'bottom "Side of the frame Pearl's compose and conflict buffers open from. One of `bottom', `top', `left', or `right'. Pearl always applies this side window when popping a compose buffer, overriding any `display-buffer-alist' entry for those buffers." :type '(choice (const bottom) (const top) (const left) (const right)) :group 'pearl) (defcustom pearl-compose-window-size 0.3 "Size of Pearl's compose and conflict side window. A float below 1 is a fraction of the frame (0.3 = 30%); an integer is an absolute size in lines (for `bottom'/`top') or columns (for `left'/`right'). Paired with `pearl-compose-window-side'." :type 'number :group 'pearl) (defun pearl--compose-display-action () "Return the `display-buffer' action for a compose or conflict buffer. A side window on `pearl-compose-window-side', sized by `pearl-compose-window-size' -- `window-width' for the left/right sides, `window-height' for top/bottom." (cons '(display-buffer-in-side-window) (list (cons 'side pearl-compose-window-side) (cons (if (memq pearl-compose-window-side '(left right)) 'window-width 'window-height) pearl-compose-window-size)))) (defun pearl--surface-buffer (buffer) "Bring BUFFER to a window after a command updated it, unless already shown. No-op when `pearl-surface-buffer' is nil, BUFFER is dead, or BUFFER is already visible in some window (so the common already-on-screen case causes no window churn). Uses `pop-to-buffer' when `pearl-surface-select-window' is non-nil \(focus follows) and `display-buffer' otherwise (shown without stealing focus)." (when (and pearl-surface-buffer (buffer-live-p buffer) (not (get-buffer-window buffer t))) (if pearl-surface-select-window (pop-to-buffer buffer) (display-buffer buffer)))) (defcustom pearl-fold-after-update t "When non-nil, re-fold the Linear page after a fetch or refresh repopulates it. `#+STARTUP:' visibility only applies on a file's first visit, so a repopulation that replaces a visited buffer's contents in place would otherwise leave the page fully expanded. Folding restores the scannable outline -- issue headings visible, descriptions, comments, and property drawers hidden. Set to nil to leave the buffer expanded after updates." :type 'boolean :group 'pearl) (defcustom pearl-title-case-headings nil "When non-nil, render issue titles in the heading in smart title case. The default is nil: titles render verbatim, exactly as Linear stores them, so the buffer mirrors what you would see opening the issue in Linear itself. Set this to t for opt-in tidying — it capitalizes each word for a neater outline, keeping minor words (articles, short conjunctions and prepositions) lowercase unless they are first or last, and leaving words that already contain an uppercase letter (acronyms like API, identifiers, camelCase) untouched. Display-only either way: the title's provenance hash is taken over the rendered form, so an unedited title is still a no-op on sync and is never rewritten on Linear." :type 'boolean :group 'pearl) (defcustom pearl-show-identifier-in-heading t "When non-nil, prefix the issue heading title with the Linear identifier. For example `** TODO [#B] SE-401: Fix the bug'. Display-only: title sync strips the `IDENT: ' prefix before hashing and pushing, so the identifier never leaks into the title on Linear. Set to nil to omit the prefix." :type 'boolean :group 'pearl) (defconst pearl--title-case-minor-words '("a" "an" "and" "as" "at" "but" "by" "for" "if" "in" "nor" "of" "on" "or" "per" "the" "to" "vs" "via") "Words kept lowercase by `pearl--title-case' unless first or last.") (defun pearl--title-case (title) "Return TITLE in smart title case. Each word is capitalized except minor words (see `pearl--title-case-minor-words') in non-edge positions; a word that already contains an uppercase letter is left as-is so acronyms and identifiers survive. Internal whitespace is normalized to single spaces." (let* ((words (split-string title)) (last (1- (length words))) (case-fold-search nil)) ; so [[:upper:]] is genuinely upper-only (mapconcat (lambda (cell) (let ((i (car cell)) (w (cdr cell))) (cond ((string-match-p "[[:upper:]]" w) w) ((and (/= i 0) (/= i last) (member (downcase w) pearl--title-case-minor-words)) (downcase w)) ;; upcase only the first char (not `capitalize', which treats an ;; apostrophe/hyphen as a word break: "don't" -> "Don'T") ((string-empty-p w) w) (t (concat (upcase (substring w 0 1)) (substring w 1)))))) (let ((i -1)) (mapcar (lambda (w) (cons (cl-incf i) w)) words)) " "))) (defun pearl--heading-title (issue) "Return the displayed heading title for ISSUE (the form the renderer writes). Brackets are stripped (they break Org parsing); title case is applied when `pearl-title-case-headings' is non-nil. This is the bare title without the identifier prefix -- the form the title provenance hash is taken over." (let ((stripped (replace-regexp-in-string "\\[\\|\\]" "" (or (plist-get issue :title) "")))) (if pearl-title-case-headings (pearl--title-case stripped) stripped))) (defun pearl--heading-with-identifier (display-title identifier) "Prefix DISPLAY-TITLE with \"IDENTIFIER: \" when prefixing is enabled. Returns DISPLAY-TITLE unchanged when `pearl-show-identifier-in-heading' is nil or IDENTIFIER is empty." (if (and pearl-show-identifier-in-heading identifier (not (string-empty-p identifier))) (format "%s: %s" identifier display-title) display-title)) (defun pearl--strip-identifier-prefix (heading identifier) "Strip a leading \"IDENTIFIER: \" prefix from HEADING when present. Returns HEADING unchanged when IDENTIFIER is empty or absent from the front." (let ((prefix (and identifier (not (string-empty-p identifier)) (concat identifier ": ")))) (if (and prefix (string-prefix-p prefix heading)) (substring heading (length prefix)) heading))) (defun pearl--hide-all-drawers () "Collapse every property drawer in the current buffer, across Org versions." (cond ((fboundp 'org-fold-hide-drawer-all) (org-fold-hide-drawer-all)) ((fboundp 'org-cycle-hide-drawers) (org-cycle-hide-drawers 'all)))) (defun pearl--hide-or-tidy-drawers () "Hide property drawers in the accessible buffer, honoring org-tidy if active. With `org-tidy-mode' on, re-tidy via `org-tidy-buffer' so freshly rendered drawers pick up org-tidy's compact display instead of a plain fold; otherwise fold them natively. org-tidy stays an optional soft dependency -- the native fold is the fallback when it is absent or off." (if (and (bound-and-true-p org-tidy-mode) (fboundp 'org-tidy-buffer)) (org-tidy-buffer) (pearl--hide-all-drawers))) (defun pearl--hide-drawers-in-region (start end) "Collapse property drawers between START and END. Used after inserting a single subtree (a freshly added comment) so its drawer folds shut like the rest of the page, rather than rendering expanded." (save-restriction (narrow-to-region start end) (pearl--hide-or-tidy-drawers))) (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." (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 ;; `org-startup-folded' still holds the value read on first visit. Re-read ;; the options so the fold honors the buffer's actual `#+STARTUP'. (when (fboundp 'org-set-regexps-and-options) (org-set-regexps-and-options)) ;; `org-set-startup-visibility' was renamed in Org 9.6; funcall picks the ;; available name without tripping the byte-compiler's obsoletion warning. (funcall (if (fboundp 'org-cycle-set-startup-visibility) 'org-cycle-set-startup-visibility 'org-set-startup-visibility)) (pearl--hide-or-tidy-drawers))) ;; Cache variables (defvar pearl--cache-teams nil "Cache for teams.") (defvar pearl--cache-states nil "Cache of workflow states per team, an alist of (TEAM-ID . STATES). Populated on first state lookup; clear it to force a refresh.") (defvar pearl--cache-team-collections nil "Cache of per-team collections for name->id resolution. An alist keyed by (KIND . TEAM-ID) where KIND is one of `projects', `labels', `members', `cycles'; the value is the list of nodes. Clear it (or pass a force argument) to refresh.") (defvar pearl--cache-views nil "Cache of the workspace's Linear Custom Views (a list of node alists). Populated on first listing; clear it (or pass a force argument) to refresh.") (defvar pearl--cache-viewer nil "Cached current-viewer plist (:id :name), fetched once per session. Backs the comment-edit permission check; clear it to force a refresh.") ;; Progress tracking variables (defvar pearl--active-requests 0 "Number of currently active API requests.") ;;; Core API Functions (Async-First Architecture) (defun pearl--headers () "Return headers for Linear API requests." (unless pearl-api-key (error "Linear API key not set. Use M-x customize-variable RET pearl-api-key")) ;; For personal API keys, the format is: "Authorization: " ;; No "Bearer" prefix for personal API keys `(("Content-Type" . "application/json") ("Authorization" . ,pearl-api-key))) (defun pearl--log (format-string &rest args) "Log message with FORMAT-STRING and ARGS if debug is enabled." (when pearl-debug (apply #'message (concat "[Linear] " format-string) args))) (defun pearl--progress (format-string &rest args) "Show a progress message built from FORMAT-STRING and ARGS. Shown only when `pearl-progress-messages' is non-nil." (when pearl-progress-messages (apply #'message (concat "[Linear] " format-string) args))) (defun pearl--wait-for (predicate) "Busy-wait until PREDICATE is non-nil or the request timeout elapses. Return the final value of PREDICATE: non-nil when it succeeded, nil when the wait timed out after `pearl-request-timeout' seconds. This keeps the synchronous wrappers from hanging Emacs when a callback never fires." (let ((deadline (+ (float-time) pearl-request-timeout))) (while (and (not (funcall predicate)) (< (float-time) deadline)) (sleep-for 0.1)) (funcall predicate))) (defun pearl--graphql-request-async (query &optional variables success-fn error-fn) "Make an asynchronous GraphQL request to Linear API. QUERY is the GraphQL query string. VARIABLES is an optional alist of variables to include in the request. SUCCESS-FN is called with the response data on success. ERROR-FN is called with error information on failure. If SUCCESS-FN or ERROR-FN are not provided, default handlers will be used." (pearl--log "Making async GraphQL request with query: %s" query) (when variables (pearl--log "Variables: %s" (prin1-to-string variables))) (unless success-fn (setq success-fn (lambda (data) (pearl--log "Request completed: %s" (prin1-to-string data))))) (unless error-fn (setq error-fn (lambda (error-thrown _response data) (message "Linear API error: %s" error-thrown) (pearl--log "Error response: %s" (prin1-to-string data))))) (let ((request-data (json-encode `(("query" . ,query) ,@(when variables `(("variables" . ,variables)))))) ;; Build headers before bumping the counter: `pearl--headers' signals ;; when the API key is unset, and that must happen before the increment ;; or no callback ever runs to decrement it (leaking the count). (headers (pearl--headers))) (pearl--log "Request payload: %s" request-data) (setq pearl--active-requests (1+ pearl--active-requests)) (request pearl-graphql-url :type "POST" :headers headers :data request-data :parser 'json-read :success (cl-function (lambda (&key data &allow-other-keys) (setq pearl--active-requests (1- pearl--active-requests)) (pearl--log "Response received: %s" (prin1-to-string data)) (funcall success-fn data))) :error (cl-function (lambda (&key error-thrown response data &allow-other-keys) (setq pearl--active-requests (1- pearl--active-requests)) (pearl--log "Error: %s" error-thrown) ;; Guard the status-code read: `response' can be nil on some ;; transport failures, and the accessor errors on a non-struct. (when (request-response-p response) (pearl--log "Response status: %s" (request-response-status-code response))) (when data (pearl--log "Error response: %s" (prin1-to-string data))) (funcall error-fn error-thrown response data)))))) (defun pearl--graphql-request (query &optional variables) "Synchronous wrapper for GraphQL requests (backward compatibility). QUERY is the GraphQL query string. VARIABLES is an optional alist of variables. Returns the response data or nil on error. This function blocks until the request completes." (pearl--log "Making synchronous GraphQL request (backward compatibility mode)") (let ((response nil) (error-response nil) (completed nil)) (pearl--graphql-request-async query variables (lambda (data) (setq response data) (setq completed t)) (lambda (error-thrown _response _data) (setq error-response error-thrown) (setq completed t))) ;; Legacy busy-wait: this wrapper predates `pearl--wait-for' and keeps its ;; own hardcoded 30s bound rather than honoring `pearl-request-timeout'. (let ((timeout 30) (start-time (current-time))) (while (and (not completed) (< (float-time (time-subtract (current-time) start-time)) timeout)) (sleep-for 0.1))) (if error-response (progn (message "Linear API error: %s" error-response) nil) response))) ;;; Team Management (Async) (defun pearl-get-teams-async (&optional callback) "Asynchronously get a list of teams from Linear. CALLBACK is called with the list of teams on success." (pearl--log "Fetching teams asynchronously") (pearl--progress "Fetching teams...") (let* ((query "query { teams { nodes { id name } } }") (success-fn (lambda (response) (if response (let ((teams (cdr (assoc 'nodes (assoc 'teams (assoc 'data response)))))) (pearl--log "Retrieved %d teams" (length teams)) (setq pearl--cache-teams teams) (when callback (funcall callback teams))) (message "Failed to retrieve teams") (when callback (funcall callback nil))))) (error-fn (lambda (_error _response _data) (message "Failed to retrieve teams") (when callback (funcall callback nil))))) (pearl--graphql-request-async query nil success-fn error-fn))) (defun pearl-get-teams () "Get a list of teams from Linear (synchronous for backward compatibility)." (let ((teams nil) (completed nil)) (pearl-get-teams-async (lambda (result) (setq teams result) (setq completed t))) (pearl--wait-for (lambda () completed)) teams)) (defun pearl-select-team-async (callback) "Asynchronously prompt user to select a team. CALLBACK is called with the selected team." (if pearl--cache-teams ;; Use cached teams (let* ((team-names (mapcar (lambda (team) (cons (cdr (assoc 'name team)) team)) pearl--cache-teams)) (selected (completing-read "Select team: " team-names nil t))) (funcall callback (cdr (assoc selected team-names)))) ;; Fetch teams first (pearl-get-teams-async (lambda (teams) (if teams (let* ((team-names (mapcar (lambda (team) (cons (cdr (assoc 'name team)) team)) teams)) (selected (completing-read "Select team: " team-names nil t))) (funcall callback (cdr (assoc selected team-names)))) (funcall callback nil)))))) (defun pearl-select-team () "Prompt user to select a team (synchronous for backward compatibility)." (let ((result nil) (completed nil)) (pearl-select-team-async (lambda (team) (setq result team) (setq completed t))) (pearl--wait-for (lambda () completed)) result)) ;;; Issue Filter DSL (Layer 1) ;; A pure compiler from an authoring plist to a Linear `IssueFilter' object (a ;; json-encodable alist passed as the `$filter' variable of an `issues(filter:)' ;; query). Name->id resolution for `:project' / `:cycle' happens upstream; this ;; layer assumes resolved values and never touches the network. (defconst pearl--open-state-types '("completed" "canceled" "duplicate") "Workflow-state types that count as not open. `:open t' compiles to a `state.type' nin this list. Linear's state types are triage, backlog, unstarted, started, completed, canceled, and duplicate; the first four are the open ones.") (defconst pearl--priority-symbols '((none . 0) (urgent . 1) (high . 2) (medium . 3) (low . 4)) "Alist mapping priority symbols to Linear's numeric priority values.") (defconst pearl--filter-keys '(:assignee :assignee-id :open :state :state-type :project :team :labels :label-id :priority :cycle :sort :order) "Keys recognized in an issue-filter authoring plist. `:sort' and `:order' steer result ordering, not the `IssueFilter' itself. `:assignee-id' and `:label-id' are the rename-proof id-based forms used when resolving a favorite to a filter; the name/email forms (`:assignee', `:labels') remain for the ad-hoc builder where the user is choosing live.") (defun pearl--eq (value) "Return a Linear comparator alist matching VALUE exactly." (list (cons "eq" value))) (defun pearl--in (values) "Return a Linear comparator alist matching any of VALUES. VALUES is a list, encoded as a JSON array." (list (cons "in" (vconcat values)))) (defun pearl--nin (values) "Return a Linear comparator alist matching none of VALUES. VALUES is a list, encoded as a JSON array." (list (cons "nin" (vconcat values)))) (defun pearl--compile-priority (priority) "Return Linear's numeric value for PRIORITY. PRIORITY is an integer 0-4 or a symbol in `pearl--priority-symbols'." (cond ((integerp priority) priority) ((assq priority pearl--priority-symbols) (cdr (assq priority pearl--priority-symbols))) (t (error "Invalid priority: %S" priority)))) (defun pearl--compile-state-filter (plist) "Return the state sub-filter alist for PLIST, or nil when no state key is set. An explicit `:state' (name) or `:state-type' (one type or a list) takes precedence over `:open', the broad not-closed predicate." (let ((state (plist-get plist :state)) (state-type (plist-get plist :state-type)) (open (plist-get plist :open))) (cond (state (list (cons "name" (pearl--eq state)))) (state-type (list (cons "type" (pearl--in (if (listp state-type) state-type (list state-type)))))) (open (list (cons "type" (pearl--nin pearl--open-state-types)))) (t nil)))) (defun pearl--build-issue-filter (plist) "Compile filter PLIST into a json-encodable Linear `IssueFilter' alist. The result is meant for the `$filter' variable of an `issues(filter:)' query; sibling keys are AND-ed by Linear. This function is pure and assumes `:project' / `:cycle' values are already resolved ids (see the resolution helpers for name->id). Recognized keys are `pearl--filter-keys', minus the ordering keys `:sort' / `:order'." (let (filter) (let ((assignee (plist-get plist :assignee))) (cond ((eq assignee :me) (push (cons "assignee" (list (cons "isMe" (pearl--eq t)))) filter)) ((stringp assignee) (push (cons "assignee" (list (cons "email" (pearl--eq assignee)))) filter)))) (let ((state-filter (pearl--compile-state-filter plist))) (when state-filter (push (cons "state" state-filter) filter))) (let ((project (plist-get plist :project))) (when project (push (cons "project" (list (cons "id" (pearl--eq project)))) filter))) (let ((team (plist-get plist :team))) (when team (push (cons "team" (list (cons "key" (pearl--eq team)))) filter))) (let ((labels (plist-get plist :labels))) ;; v1 semantics: "carries any of these labels" -- labels.some.name in set. (when labels (push (cons "labels" (list (cons "some" (list (cons "name" (pearl--in labels)))))) filter))) (let ((priority (plist-get plist :priority))) (when priority (push (cons "priority" (pearl--eq (pearl--compile-priority priority))) filter))) (let ((cycle (plist-get plist :cycle))) (when cycle (push (cons "cycle" (list (cons "id" (pearl--eq cycle)))) filter))) (let ((assignee-id (plist-get plist :assignee-id))) (when assignee-id (push (cons "assignee" (list (cons "id" (pearl--eq assignee-id)))) filter))) (let ((label-id (plist-get plist :label-id))) (when label-id (push (cons "labels" (list (cons "some" (list (cons "id" (pearl--in (list label-id))))))) filter))) (nreverse filter))) (defun pearl--validate-issue-filter (plist) "Validate issue-filter PLIST, signaling a `user-error' on any problem. Return t when PLIST is well-formed. Checks plist shape, unknown keys, the `:priority' range/symbol, the `:assignee' form, the `:order' value, empty strings, and the `:labels' type. Name ambiguity (a project or state name that needs team context) is resolved upstream, not here." (unless (and (listp plist) (cl-evenp (length plist))) (user-error "Issue filter must be a plist")) (cl-loop for (key _val) on plist by #'cddr unless (memq key pearl--filter-keys) do (user-error "Unknown issue-filter key: %S" key)) (let ((priority (plist-get plist :priority))) (when priority (cond ((integerp priority) (unless (<= 0 priority 4) (user-error "Priority integer must be 0-4, got %d" priority))) ((not (assq priority pearl--priority-symbols)) (user-error "Invalid :priority %S (use 0-4 or none/urgent/high/medium/low)" priority))))) (let ((assignee (plist-get plist :assignee))) (when (and assignee (not (eq assignee :me)) (not (stringp assignee))) (user-error ":assignee must be :me or an email string, got %S" assignee))) (let ((order (plist-get plist :order))) (when (and order (not (memq order '(asc desc)))) (user-error ":order must be `asc' or `desc', got %S" order))) (dolist (key '(:state :project :team :cycle :assignee-id :label-id)) (let ((val (plist-get plist key))) (when (and (stringp val) (string-empty-p val)) (user-error "%s must not be an empty string" key)))) (let ((labels (plist-get plist :labels))) (when (and labels (or (not (listp labels)) (cl-some (lambda (x) (not (and (stringp x) (not (string-empty-p x))))) labels))) (user-error ":labels must be a list of non-empty strings"))) t) ;;; Issue Model Normalization ;; Convert raw Linear response alists (json-read shaped: symbol keys, vectors ;; for arrays, t / `:json-false' booleans, and a missing key for an absent ;; field) into flat internal plists, so rendering, filtering, and command code ;; never has to know the transport shape. (defun pearl--node-list (connection) "Return CONNECTION's nodes as a list. CONNECTION is an alist with a `nodes' key holding a vector, a list, or nil." (let ((nodes (cdr (assoc 'nodes connection)))) (cond ((vectorp nodes) (append nodes nil)) ((listp nodes) nodes) (t nil)))) (defun pearl--normalize-user (raw) "Normalize a Linear user alist RAW to a plist, or nil when RAW is nil." (when raw (list :id (cdr (assoc 'id raw)) :name (or (cdr (assoc 'name raw)) (cdr (assoc 'displayName raw))) :email (cdr (assoc 'email raw))))) (defun pearl--normalize-state (raw) "Normalize a Linear workflow-state alist RAW to a plist, or nil." (when raw (list :id (cdr (assoc 'id raw)) :name (cdr (assoc 'name raw)) :type (cdr (assoc 'type raw))))) (defun pearl--normalize-team (raw) "Normalize a Linear team alist RAW to a plist, or nil." (when raw (list :id (cdr (assoc 'id raw)) :key (cdr (assoc 'key raw)) :name (cdr (assoc 'name raw))))) (defun pearl--normalize-project (raw) "Normalize a Linear project alist RAW to a plist, or nil." (when raw (list :id (cdr (assoc 'id raw)) :name (cdr (assoc 'name raw))))) (defun pearl--normalize-labels (raw) "Normalize an issue's labels connection RAW to a list of (:id :name) plists." (mapcar (lambda (label) (list :id (cdr (assoc 'id label)) :name (cdr (assoc 'name label)))) (pearl--node-list raw))) ;;; Favorites layer (spec: docs/issue-sources-spec.org) (defun pearl--favorite-entity-id (node entity-key) "Pick ENTITY-KEY's id from favorite NODE, or nil if absent." (cdr (assoc 'id (cdr (assoc entity-key node))))) (defun pearl--normalize-favorite (node) "Normalize a Linear Favorite NODE alist to a typed plist for dispatch. Returns (:kind KIND :title T :url U :sort-order N :id ID [:identifier IDENT]). KIND is one of `view', `project', `cycle', `label', `user', `team', `issue', `document', `dashboard', or `other' (a favorite type Pearl cannot dispatch into a list source). For an issue favorite, `:identifier' carries the human key like ENG-1; everything else carries only `:id'. =label= and =projectLabel= both normalize to `:kind label' so the dispatch collapses them." (let* ((type (cdr (assoc 'type node))) (title (or (cdr (assoc 'title node)) "")) (url (cdr (assoc 'url node))) (sort-order (cdr (assoc 'sortOrder node))) (kind+id (pcase type ("customView" (cons 'view (pearl--favorite-entity-id node 'customView))) ("project" (cons 'project (pearl--favorite-entity-id node 'project))) ("cycle" (cons 'cycle (pearl--favorite-entity-id node 'cycle))) ("label" (cons 'label (pearl--favorite-entity-id node 'label))) ("projectLabel" (cons 'label (pearl--favorite-entity-id node 'projectLabel))) ("user" (cons 'user (pearl--favorite-entity-id node 'user))) ("team" (cons 'team (pearl--favorite-entity-id node 'team))) ("issue" (cons 'issue (pearl--favorite-entity-id node 'issue))) ("document" (cons 'document (pearl--favorite-entity-id node 'document))) ("dashboard" (cons 'dashboard (pearl--favorite-entity-id node 'dashboard))) (_ (cons 'other nil)))) (base (list :kind (car kind+id) :title title :url url :sort-order sort-order :id (cdr kind+id)))) (if (eq (car kind+id) 'issue) (append base (list :identifier (cdr (assoc 'identifier (cdr (assoc 'issue node)))))) base))) (defun pearl--favorite->source (fav) "Resolve a normalized FAV into a runnable source plist for the existing query/render path, or a browser action `(:browser t :url U :title T :kind K)' when the favorite is not a list source in v1 (issue / team / document / dashboard / other)." (let ((kind (plist-get fav :kind)) (title (plist-get fav :title)) (url (plist-get fav :url)) (id (plist-get fav :id))) (pcase kind ('view (list :type 'view :name title :id id :url url)) ('project (list :type 'filter :name title :filter (list :project id :open t))) ('cycle (list :type 'filter :name title :filter (list :cycle id :open t))) ('label (list :type 'filter :name title :filter (list :label-id id :open t))) ('user (list :type 'filter :name title :filter (list :assignee-id id :open t))) (_ (list :browser t :url url :title title :kind kind))))) (defconst pearl--favorites-query "query Favorites($after: String) { favorites(first: 100, after: $after) { nodes { id type title url sortOrder customView { id } project { id } cycle { id } label { id } user { id } issue { id identifier } team { id } projectLabel { id } document { id } dashboard { id } } pageInfo { hasNextPage endCursor } } }" "GraphQL query for the viewer's favorites; paged with first/after.") (defun pearl--favorites-async (callback) "Fetch the viewer's favorites and call CALLBACK with a list of normalized favorite plists (Linear sort-order preserved). Paged via first/after; on a transport/GraphQL error, CALLBACK receives whatever was collected so far so the picker can fall back to local saved queries rather than hanging." (let (acc) (cl-labels ((collect (data) (let* ((favs (cdr (assoc 'favorites (cdr (assoc 'data data))))) (nodes (append (cdr (assoc 'nodes favs)) nil)) (page (cdr (assoc 'pageInfo favs)))) (dolist (n nodes) (push (pearl--normalize-favorite n) acc)) (if (eq (cdr (assoc 'hasNextPage page)) t) (pearl--graphql-request-async pearl--favorites-query (list (cons "after" (cdr (assoc 'endCursor page)))) #'collect (lambda (&rest _) (funcall callback (nreverse acc)))) (funcall callback (nreverse acc)))))) (pearl--graphql-request-async pearl--favorites-query nil #'collect (lambda (&rest _) ;; HP5: a fetch error is not "no favorites" -- message it so the ;; picker's fallback to saved queries doesn't masquerade as success. (message "Pearl: favorites fetch failed; showing saved queries only") (funcall callback (nreverse acc))))))) (defun pearl--normalize-comment (raw) "Normalize a Linear comment alist RAW to a plist. The author falls back through user, then botActor, then externalUser, because `Comment.user' is null for integration and bot comments." (let ((user (pearl--normalize-user (cdr (assoc 'user raw)))) (bot (cdr (assoc 'botActor raw))) (ext (cdr (assoc 'externalUser raw)))) (list :id (cdr (assoc 'id raw)) :body (cdr (assoc 'body raw)) :created-at (cdr (assoc 'createdAt raw)) :author-id (when user (plist-get user :id)) :author (cond (user (plist-get user :name)) (bot (or (cdr (assoc 'name bot)) "automation")) (ext (or (cdr (assoc 'name ext)) "external")) (t nil))))) (defun pearl--normalize-cycle (raw) "Normalize a Linear cycle alist RAW to a plist, or nil." (when raw (list :id (cdr (assoc 'id raw)) :number (cdr (assoc 'number raw)) :name (cdr (assoc 'name raw))))) (defun pearl--normalize-issue (raw) "Normalize a Linear issue node RAW to a flat internal plist, or nil. Vectors become lists and absent/`:json-false' fields become nil. Nested objects (state, assignee, team, project, labels, cycle, comments) are normalized in turn; comments are omitted unless the fetch requested them." (when raw (list :id (cdr (assoc 'id raw)) :identifier (cdr (assoc 'identifier raw)) :title (cdr (assoc 'title raw)) :description (cdr (assoc 'description raw)) :priority (cdr (assoc 'priority raw)) :url (cdr (assoc 'url raw)) :updated-at (cdr (assoc 'updatedAt raw)) :state (pearl--normalize-state (cdr (assoc 'state raw))) :assignee (pearl--normalize-user (cdr (assoc 'assignee raw))) :team (pearl--normalize-team (cdr (assoc 'team raw))) :project (pearl--normalize-project (cdr (assoc 'project raw))) :labels (pearl--normalize-labels (cdr (assoc 'labels raw))) :cycle (pearl--normalize-cycle (cdr (assoc 'cycle raw))) :comments (let ((comments (assoc 'comments raw))) (when comments (mapcar #'pearl--normalize-comment (pearl--node-list (cdr comments)))))))) (defun pearl--normalize-custom-view (raw) "Normalize a Linear custom-view alist RAW to a plist, or nil. A workspace-wide view has a nil `:team'; `:shared' is a real boolean." (when raw (list :id (cdr (assoc 'id raw)) :name (cdr (assoc 'name raw)) :description (cdr (assoc 'description raw)) :shared (eq t (cdr (assoc 'shared raw))) :icon (cdr (assoc 'icon raw)) :color (cdr (assoc 'color raw)) :team (pearl--normalize-team (cdr (assoc 'team raw))) :owner (pearl--normalize-user (cdr (assoc 'owner raw)))))) ;;; Query Result Shape ;; A small tagged result so callers can tell apart success-with-issues, ;; success-with-none, an invalid filter (caught before the request), a ;; transport failure, and a GraphQL-level failure, instead of collapsing them ;; all to nil. A result is a plist: (:status SYM :issues LIST :message STR ;; :truncated BOOL). The fetch layer builds one; commands read it to message ;; the user precisely. (defun pearl--make-query-result (status &rest props) "Build a query-result plist with STATUS and optional PROPS. STATUS is one of `ok', `empty', `invalid-filter', `request-failed', or `graphql-failed'. PROPS may set `:issues', `:message', and `:truncated'." (append (list :status status) props)) (defun pearl--query-result-status (result) "Return the status symbol of query RESULT." (plist-get result :status)) (defun pearl--query-result-issues (result) "Return the issues list carried by query RESULT." (plist-get result :issues)) (defun pearl--query-result-message (result) "Return the user-facing message carried by query RESULT, if any." (plist-get result :message)) (defun pearl--query-result-truncated-p (result) "Return non-nil when query RESULT was cut off at the page cap." (plist-get result :truncated)) (defun pearl--query-result-ok-p (result) "Return non-nil when RESULT is a successful query (issues or empty)." (memq (pearl--query-result-status result) '(ok empty))) (defun pearl--query-result-error-p (result) "Return non-nil when RESULT is a failure rather than a result set." (memq (pearl--query-result-status result) '(invalid-filter request-failed graphql-failed))) (defun pearl--graphql-error-message (response) "Return the first GraphQL error message in RESPONSE, or nil. RESPONSE's `errors' may be a vector (live API) or a list (test fixtures)." (let ((errors (cdr (assoc 'errors response)))) (when errors (let ((first (if (vectorp errors) (and (> (length errors) 0) (aref errors 0)) (car errors)))) (cdr (assoc 'message first)))))) (defun pearl--classify-response (response &optional issues truncated) "Classify a raw GraphQL RESPONSE into a query-result plist. A nil RESPONSE, or one without a `data' key, is a transport failure; a RESPONSE carrying `errors' is a GraphQL failure. Otherwise the result is `ok', or `empty' when ISSUES is empty, carrying ISSUES and the TRUNCATED flag. ISSUES is the already-extracted (normalized) list, so this stays pure." (cond ((null response) (pearl--make-query-result 'request-failed :message "No response from Linear")) ((assoc 'errors response) (pearl--make-query-result 'graphql-failed :message (or (pearl--graphql-error-message response) "Linear returned an error"))) ((not (assoc 'data response)) (pearl--make-query-result 'request-failed :message "Malformed response from Linear")) (t (pearl--make-query-result (if issues 'ok 'empty) :issues issues :truncated (and truncated t))))) (defun pearl--invalid-filter-result (message) "Return an `invalid-filter' query-result carrying MESSAGE." (pearl--make-query-result 'invalid-filter :message message)) ;;; General Issue Query (Layer 2a) ;; The general fetch: a top-level `issues(filter:)' query paged through a ;; reusable accumulator, returning a tagged query-result. Issues come back as ;; raw nodes (the query fetches the full field superset); normalization happens ;; at the render boundary, not here. (defcustom pearl-fetch-comments-in-list t "When non-nil, the bulk list and Custom View fetch each issue's recent comments. A populated list then renders the latest few comments per issue with a `💬 shown/total' marker on the Comments heading, instead of looking like nothing has comments. Set to nil to keep the list fetch light (comments load only on a single-issue refresh)." :type 'boolean :group 'pearl) (defcustom pearl-list-comments-shown 5 "How many of an issue's most recent comments render in the bulk list. The single-issue refresh always shows the full thread; this caps only the list/view view. See `pearl-fetch-comments-in-list'." :type 'integer :group 'pearl) (defcustom pearl-list-comments-count-cap 25 "Ceiling for the exact comment total shown in the bulk list marker. The fetch pulls one more than this so the marker can show an exact total up to the cap (`💬 5/18') and a `+' beyond it (`💬 5/25+'). A higher cap means an exact count for busier issues at the cost of a larger fetch." :type 'integer :group 'pearl) (defconst pearl--comment-node-fields "id body createdAt user { id name displayName } botActor { name } externalUser { name }" "The comment node field selection shared by every query that pulls comments.") (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 renderer can show an exact total up to the cap and a `+' beyond it. Empty when `pearl-fetch-comments-in-list' is nil, so the list fetch stays light." (if pearl-fetch-comments-in-list (format "comments(first: %d, orderBy: createdAt) { nodes { %s } }" (1+ pearl-list-comments-count-cap) pearl--comment-node-fields) "")) (defun pearl--issues-query () "GraphQL query for a filtered, ordered page of issues. Pulls each issue's recent comments (see `pearl--list-comments-fragment') so a populated list renders them, not just the single-issue refresh." (format "query Issues($filter: IssueFilter, $first: Int!, $after: String, $orderBy: PaginationOrderBy) { issues(filter: $filter, first: $first, after: $after, orderBy: $orderBy) { nodes { id identifier title description priority url updatedAt state { id name type } assignee { id name displayName email } team { id key name } project { id name } labels { nodes { id name } } cycle { id number name } %s } pageInfo { hasNextPage endCursor } } }" (pearl--list-comments-fragment))) (defconst pearl--single-issue-query "query Issue($id: String!) { issue(id: $id) { id identifier title description priority url updatedAt state { id name type } assignee { id name displayName email } team { id key name } project { id name } labels { nodes { id name } } cycle { id number name } comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } } }" "GraphQL query for one issue by id. The single-issue refresh path: pulls the full comment thread uncapped (unlike the bulk list, which caps via `pearl--list-comments-fragment').") (defun pearl--fetch-issue-async (issue-id callback) "Fetch the full issue node for ISSUE-ID, calling CALLBACK with the outcome. CALLBACK receives one of: the raw issue node (normalized at the render boundary, as on the list path); `:missing' when the request succeeded but the issue is null (deleted, or no access); or `:error' on a GraphQL or transport failure. Separating missing from error lets the caller tell \"the issue is gone\" apart from \"the API call failed.\"" (pearl--graphql-request-async pearl--single-issue-query `(("id" . ,issue-id)) (lambda (response) (if (or (null response) (assoc 'errors response) (not (assoc 'data response))) (funcall callback :error) (let ((issue (cdr (assoc 'issue (cdr (assoc 'data response)))))) (funcall callback (or issue :missing))))) (lambda (_error _response _data) (funcall callback :error)))) (defun pearl--view-issues-query () "GraphQL query running a Custom View's own filter server-side, by view id. Pulls each issue's recent comments (see `pearl--list-comments-fragment') so a view-populated list renders them." (format "query ViewIssues($id: String!, $first: Int!, $after: String) { customView(id: $id) { issues(first: $first, after: $after) { nodes { id identifier title description priority url updatedAt state { id name type } assignee { id name displayName email } team { id key name } project { id name } labels { nodes { id name } } cycle { id number name } %s } pageInfo { hasNextPage endCursor } } } }" (pearl--list-comments-fragment))) (defun pearl--query-view-async (view-id callback) "Run the Custom View VIEW-ID server-side, calling CALLBACK with a query-result. The view applies its own stored filter on Linear's side; issues come back as raw nodes (normalized at the render boundary), paged like the general fetch." (let ((page-fn (lambda (after page-cb) (pearl--graphql-request-async (pearl--view-issues-query) `(("id" . ,view-id) ("first" . 100) ,@(when after (list (cons "after" after)))) (lambda (response) (if (or (null response) (assoc 'errors response) (not (assoc 'data response))) (funcall page-cb (list :error (pearl--classify-response response))) (let* ((conn (cdr (assoc 'issues (cdr (assoc 'customView (cdr (assoc 'data response))))))) (nodes (pearl--node-list conn)) (info (cdr (assoc 'pageInfo conn)))) (funcall page-cb (list :issues nodes :has-next-page (eq t (cdr (assoc 'hasNextPage info))) :end-cursor (cdr (assoc 'endCursor info))))))) (lambda (_error _response _data) (funcall page-cb (list :error (pearl--make-query-result 'request-failed :message "Failed to fetch view issues")))))))) (pearl--page-issues page-fn callback))) (defun pearl--custom-views (&optional force) "Return the workspace's Custom Views, fetching once and caching. Each node carries id/name/description/shared/url. A non-nil FORCE refetches." (or (and (not force) pearl--cache-views) (let* ((query "query CustomViews($first: Int!, $after: String) { customViews(first: $first, after: $after) { nodes { id name description shared url } pageInfo { hasNextPage endCursor } } }") (response (pearl--graphql-request query '(("first" . 100)))) (views (and response (pearl--node-list (cdr (assoc 'customViews (cdr (assoc 'data response)))))))) (when views (setq pearl--cache-views views)) views))) (defun pearl--page-issues (page-fn callback &optional max-pages) "Accumulate issues across pages via PAGE-FN, then call CALLBACK with a result. PAGE-FN is called as (PAGE-FN AFTER PAGE-CB); it fetches one page and invokes PAGE-CB with a plist (:issues LIST :has-next-page BOOL :end-cursor STR) on success, or (:error RESULT) carrying a failure query-result. CALLBACK receives the final query-result. Paging stops at MAX-PAGES (default `pearl-max-issue-pages'), marking the result truncated." (let ((max (or max-pages pearl-max-issue-pages)) (acc '()) (page 1)) (cl-labels ((fetch (after) (if (> page max) (funcall callback (pearl--make-query-result (if acc 'ok 'empty) :issues acc :truncated t)) (funcall page-fn after (lambda (page-result) (let ((err (plist-get page-result :error))) (if err (funcall callback err) (setq acc (append acc (plist-get page-result :issues))) (if (plist-get page-result :has-next-page) (progn (setq page (1+ page)) (fetch (plist-get page-result :end-cursor))) (funcall callback (pearl--make-query-result (if acc 'ok 'empty) :issues acc)))))))))) (fetch nil)))) (defun pearl--query-issues-async (filter callback &optional order-by) "Fetch issues matching FILTER, calling CALLBACK with a query-result. FILTER is a compiled `IssueFilter' alist (see `pearl--build-issue-filter') or nil for no filter. ORDER-BY is a `PaginationOrderBy' symbol, default `updatedAt'. Issues come back as raw nodes; normalization happens at the render boundary." (let ((page-fn (lambda (after page-cb) (pearl--graphql-request-async (pearl--issues-query) `(,@(when filter (list (cons "filter" filter))) ("first" . 100) ,@(when after (list (cons "after" after))) ("orderBy" . ,(symbol-name (or order-by 'updatedAt)))) (lambda (response) (if (or (null response) (assoc 'errors response) (not (assoc 'data response))) (funcall page-cb (list :error (pearl--classify-response response))) (let* ((conn (cdr (assoc 'issues (cdr (assoc 'data response))))) (nodes (pearl--node-list conn)) (info (cdr (assoc 'pageInfo conn)))) (funcall page-cb (list :issues nodes :has-next-page (eq t (cdr (assoc 'hasNextPage info))) :end-cursor (cdr (assoc 'endCursor info))))))) (lambda (_error _response _data) (funcall page-cb (list :error (pearl--make-query-result 'request-failed :message "Failed to fetch issues from Linear")))))))) (pearl--page-issues page-fn callback))) ;;; Issue Creation (defun pearl--created-issue (response) "Return the created issue node from a create RESPONSE, or nil on failure. Linear answers GraphQL-level failures with HTTP 200 and either an `errors' body or `issueCreate.success' = false / `issue' = null. Checking `success' and the issue node here reports those as failures instead of a phantom \"created\" issue." (let* ((issue-create (cdr (assoc 'issueCreate (cdr (assoc 'data response))))) (success (cdr (assoc 'success issue-create))) (issue (cdr (assoc 'issue issue-create)))) (and success (not (eq success :json-false)) issue))) (defun pearl-create-issue-async (title description team-id callback) "Asynchronously create a new issue. TITLE is the issue title. DESCRIPTION is the issue description. TEAM-ID is the team to create the issue in. CALLBACK is called with the created issue data." (pearl--log "Creating issue: %s" title) (pearl--progress "Creating issue...") (let* ((query "mutation CreateIssue($title: String!, $description: String, $teamId: String!) { issueCreate(input: {title: $title, description: $description, teamId: $teamId}) { success issue { id identifier title } } }") (variables `(("title" . ,title) ("description" . ,description) ("teamId" . ,team-id))) (success-fn (lambda (response) (let ((issue (pearl--created-issue response))) (if issue (progn (message "Created issue %s: %s" (cdr (assoc 'identifier issue)) (cdr (assoc 'title issue))) (when callback (funcall callback issue))) (message "Failed to create issue") (when callback (funcall callback nil)))))) (error-fn (lambda (_error _response _data) (message "Failed to create issue") (when callback (funcall callback nil))))) (pearl--graphql-request-async query variables success-fn error-fn))) (defun pearl--create-issue (title description team-id) "Create a new issue (synchronous wrapper for backward compatibility). TITLE is the issue title. DESCRIPTION is the issue description. TEAM-ID is the team to create the issue in." (let ((issue nil) (completed nil)) (pearl-create-issue-async title description team-id (lambda (result) (setq issue result) (setq completed t))) (pearl--wait-for (lambda () completed)) issue)) ;;; Issue State Management (Async) (defun pearl-get-states-async (team-id callback) "Asynchronously get workflow states for TEAM-ID. CALLBACK is called with the list of states." (pearl--log "Fetching workflow states for team %s" team-id) (let* ((query "query GetWorkflowStates($teamId: String!) { team(id: $teamId) { states { nodes { id name color } } } }") (variables `(("teamId" . ,team-id))) (success-fn (lambda (response) (when response (let ((states (cdr (assoc 'nodes (assoc 'states (assoc 'team (assoc 'data response))))))) (when callback (funcall callback states)))))) (error-fn (lambda (_error _response _data) (when callback (funcall callback nil))))) (pearl--graphql-request-async query variables success-fn error-fn))) (defun pearl-get-states (team-id) "Get workflow states for TEAM-ID (synchronous wrapper)." (let ((states nil) (completed nil)) (pearl-get-states-async team-id (lambda (result) (setq states result) (setq completed t))) (pearl--wait-for (lambda () completed)) states)) (defun pearl--team-states (team-id) "Return the workflow states for TEAM-ID, fetching once and caching. Cached in `pearl--cache-states' keyed by TEAM-ID; org-state syncs resolve a state per heading change, so the cache avoids a network round trip on every one. Clear the cache to force a refresh." (or (cdr (assoc team-id pearl--cache-states)) (let* ((query "query GetTeamWorkflowStates($teamId: String!) { team(id: $teamId) { states { nodes { id name type position } } } }") (variables `(("teamId" . ,team-id))) (response (pearl--graphql-request query variables)) (states (and response (cdr (assoc 'nodes (cdr (assoc 'states (cdr (assoc 'team (cdr (assoc 'data response))))))))))) (when states (push (cons team-id states) pearl--cache-states)) states))) (defun pearl--get-state-id-by-name (state-name team-id) "Get the Linear state ID for the given STATE-NAME in TEAM-ID." (pearl--log "Looking up state ID for %s in team %s" state-name team-id) (let* ((states (pearl--team-states team-id)) (state (and states (seq-find (lambda (s) (string= (downcase (cdr (assoc 'name s))) (downcase state-name))) states)))) (if state (cdr (assoc 'id state)) (message "Could not find state with name: %s in team %s" state-name team-id) nil))) (defun pearl--all-teams () "Return all teams, fetching once and caching in `pearl--cache-teams'. The whole-file org sync resolves a team per heading, so caching here turns N blocking lookups into one. Shares the cache with the team selector." (or pearl--cache-teams (let* ((query "query { teams { nodes { id name } } }") (response (pearl--graphql-request query)) (teams (and response (cdr (assoc 'nodes (cdr (assoc 'teams (cdr (assoc 'data response))))))))) (when teams (setq pearl--cache-teams teams)) teams))) (defun pearl--get-team-id-by-name (team-name) "Get the Linear team ID for the given TEAM-NAME." (pearl--log "Looking up team ID for team %s" team-name) (let* ((teams (pearl--all-teams)) (team (and teams (seq-find (lambda (tm) (string= (cdr (assoc 'name tm)) team-name)) teams)))) (if team (cdr (assoc 'id team)) ;; Log the available teams to help diagnose a name mismatch. (when teams (pearl--log "Available teams: %s" (mapconcat (lambda (tm) (format "%s (%s)" (cdr (assoc 'name tm)) (cdr (assoc 'id tm)))) teams ", "))) (message "Could not find team with name: %s" team-name) nil))) ;;; Per-team Name -> ID Resolution (defun pearl--team-collection (kind team-id &optional force) "Return the KIND collection for TEAM-ID, fetching once and caching. KIND is one of `projects', `labels', `members', `cycles'. Cached in `pearl--cache-team-collections' keyed by (KIND . TEAM-ID); a non-nil FORCE bypasses the cache and refetches. Returns a list of node alists." (let ((cache-key (cons kind team-id))) (if (and (not force) (assoc cache-key pearl--cache-team-collections)) (cdr (assoc cache-key pearl--cache-team-collections)) (let* ((fields (pcase kind ('members "id name displayName email") ('cycles "id number name") (_ "id name"))) (query (format "query TeamCollection($teamId: String!) { team(id: $teamId) { %s { nodes { %s } } } }" (symbol-name kind) fields)) (response (pearl--graphql-request query `(("teamId" . ,team-id)))) (coll (cdr (assoc kind (cdr (assoc 'team (cdr (assoc 'data response))))))) (nodes (pearl--node-list coll))) (when nodes (push (cons cache-key nodes) pearl--cache-team-collections)) nodes)))) (defun pearl--node-label (kind node) "Return a human label for NODE of KIND, shown when disambiguating a match." (pcase kind ('members (or (cdr (assoc 'displayName node)) (cdr (assoc 'name node)) (cdr (assoc 'email node)))) ('cycles (or (cdr (assoc 'name node)) (let ((n (cdr (assoc 'number node))) ) (and n (number-to-string n))))) (_ (cdr (assoc 'name node))))) (defun pearl--node-matches-name-p (kind node name) "Return non-nil when NODE of KIND matches NAME. Members match name, displayName, or email; cycles match name or number; everything else matches name. Comparison is case-insensitive." (let ((needle (downcase name))) (cl-flet ((eqp (field) (let ((v (cdr (assoc field node)))) (and (stringp v) (string= (downcase v) needle))))) (pcase kind ('members (or (eqp 'name) (eqp 'displayName) (eqp 'email))) ('cycles (or (eqp 'name) (let ((n (cdr (assoc 'number node)))) (and n (string= (number-to-string n) name))))) (_ (eqp 'name)))))) (defun pearl--resolve-team-id (kind name team-id &optional force) "Resolve NAME to an id within the KIND collection of TEAM-ID, or nil. Fetches (and caches) the collection via `pearl--team-collection'. With a single match, returns its id; with several, prompts the user to pick; with none, returns nil. FORCE refreshes the collection cache first." (let* ((nodes (pearl--team-collection kind team-id force)) (matches (seq-filter (lambda (n) (pearl--node-matches-name-p kind n name)) nodes))) (pcase (length matches) (0 nil) (1 (cdr (assoc 'id (car matches)))) (_ (let* ((choices (mapcar (lambda (n) (cons (format "%s (%s)" (pearl--node-label kind n) (cdr (assoc 'id n))) (cdr (assoc 'id n)))) matches)) (pick (completing-read (format "Multiple matches for %s: " name) choices nil t))) (cdr (assoc pick choices))))))) ;;;###autoload (defun pearl-clear-cache () "Clear the Linear lookup caches (teams, states, per-team collections, views). Use after renaming things in Linear, or to force the next lookup to refetch." (interactive) (setq pearl--cache-teams nil pearl--cache-states nil pearl--cache-team-collections nil pearl--cache-views nil pearl--cache-viewer nil) (message "Linear caches cleared")) (defun pearl-update-issue-state (issue-id state-name team-id) "Update the state of Linear issue with ISSUE-ID to STATE-NAME for TEAM-ID." (pearl--log "Updating issue %s state to %s for team %s" issue-id state-name team-id) ;; Resolve the state name to an ID first; bail out clearly if the team has ;; no such state rather than firing a mutation with a null stateId. (let ((state-id (pearl--get-state-id-by-name state-name team-id))) (if (null state-id) (message "Cannot update issue %s: no Linear state named %s in team %s" issue-id state-name team-id) (let* ((query "mutation UpdateIssueState($issueId: String!, $stateId: String!) { issueUpdate(id: $issueId, input: {stateId: $stateId}) { success issue { id identifier state { id name } } } }") (variables `(("issueId" . ,issue-id) ("stateId" . ,state-id))) (response (pearl--graphql-request query variables))) (if response (let ((success (and (assoc 'data response) (assoc 'issueUpdate (assoc 'data response)) (cdr (assoc 'success (assoc 'issueUpdate (assoc 'data response))))))) (if success (message "Updated issue %s state to %s" issue-id state-name) (pearl--log "Failed to update issue state: %s" (prin1-to-string response)) (message "Failed to update issue %s state" issue-id))) (message "Failed to update issue %s state: API error" issue-id)))))) ;;; Team Member and Project Management (defun pearl-get-team-members (team-id) "Get members for the given TEAM-ID." (pearl--log "Fetching team members for team %s" team-id) (let* ((query "query GetTeamMembers($teamId: String!) { team(id: $teamId) { members { nodes { id name displayName } } } }") (variables `(("teamId" . ,team-id))) (response (pearl--graphql-request query variables))) (when response (let ((members (cdr (assoc 'nodes (assoc 'members (assoc 'team (assoc 'data response))))))) (pearl--log "Retrieved %d team members" (length members)) (let ((formatted-members (mapcar (lambda (member) (cons (or (cdr (assoc 'displayName member)) (cdr (assoc 'name member))) (cdr (assoc 'id member)))) members))) (pearl--log "Formatted team members: %s" (prin1-to-string formatted-members)) formatted-members))))) (defun pearl-get-projects (team-id) "Get a list of projects for the given TEAM-ID." (pearl--log "Fetching projects for team %s" team-id) (let* ((query "query GetProjects($teamId: String!) { team(id: $teamId) { projects { nodes { id name description state } } } }") (variables `(("teamId" . ,team-id))) (response (pearl--graphql-request query variables))) (when response (let ((projects (cdr (assoc 'nodes (assoc 'projects (assoc 'team (assoc 'data response))))))) ;; Convert vector to list if needed (when (vectorp projects) (setq projects (append projects nil))) (pearl--log "Retrieved %d projects" (length projects)) projects)))) (defun pearl-select-project (team-id) "Prompt user to select a project from TEAM-ID." (let* ((projects (pearl-get-projects team-id)) (project-names (when projects (mapcar (lambda (project) (cons (cdr (assoc 'name project)) project)) projects))) (selected (when project-names (completing-read "Select project (optional): " (cons "None" project-names) nil t nil nil "None")))) ;; Guard the nil case explicitly: a team with no projects (or a failed ;; fetch) leaves SELECTED nil, so only consult the choice when one was made. (when (and selected (not (string= selected "None"))) (cdr (assoc selected project-names))))) ;;; Other Issue Attributes (defun pearl-get-priorities () "Get priority options for Linear issues." ;; Linear uses integers for priorities: 0 (No priority), 1 (Urgent), 2 (High), 3 (Medium), 4 (Low) '(("No priority" . 0) ("Urgent" . 1) ("High" . 2) ("Medium" . 3) ("Low" . 4))) (defun pearl-get-issue-types (team-id) "Get issue types for the given TEAM-ID." (pearl--log "Fetching issue types for team %s" team-id) (let* ((query "query GetIssueTypes($teamId: String!) { team(id: $teamId) { labels { nodes { id name color } } } }") (variables `(("teamId" . ,team-id))) (response (pearl--graphql-request query variables))) (when response (let ((labels (cdr (assoc 'nodes (assoc 'labels (assoc 'team (assoc 'data response))))))) (mapcar (lambda (label) (cons (cdr (assoc 'name label)) (cdr (assoc 'id label)))) labels))))) ;;; Org Mode Integration (defun pearl--extract-org-heading-properties () "Extract Linear issue properties from the org entry at point. Returns a plist with :todo-state, :issue-id, :issue-identifier, and :team-id, read from the entry's LINEAR-* property drawer via org APIs. Works from anywhere inside the entry and at any heading depth, and reads by property name rather than scanning lines, so body text or nested sub-entries don't confuse it. Returns nil when point is not within a heading; the id fields are nil for a non-issue heading. The team id is read directly from `LINEAR-TEAM-ID', so there is no network lookup here." (save-excursion (when (ignore-errors (org-back-to-heading t) t) (list :todo-state (org-get-todo-state) :issue-id (org-entry-get nil "LINEAR-ID") :issue-identifier (org-entry-get nil "LINEAR-IDENTIFIER") :team-id (org-entry-get nil "LINEAR-TEAM-ID"))))) ;;; Mapping Functions (defun pearl--state-name-to-keyword (name) "Slugify a Linear state NAME to an Org TODO keyword. Upcased, each run of non-alphanumerics replaced by a single hyphen (alnum is Unicode-aware, so accented and non-Latin letters survive), with leading and trailing hyphens trimmed. An all-symbol name (empty slug) falls back to \"TODO\". This is the workspace-faithful replacement for the former static state-name-to-keyword mapping." (let ((slug (string-trim (replace-regexp-in-string "[^[:alnum:]]+" "-" (upcase (or name ""))) "-+" "-+"))) (if (string-empty-p slug) "TODO" slug))) (defun pearl--label-name-to-tag (name) "Slugify a Linear label NAME to an Org tag. Downcased, each run of characters outside [[:alnum:]_] replaced by a single underscore (alnum is Unicode-aware, so accented and non-Latin letters survive), with leading and trailing underscores trimmed. Org tags allow no hyphens or spaces, unlike the TODO keywords `pearl--state-name-to-keyword' builds. A name that slugifies to empty (all punctuation) returns the empty string; the caller drops it from the heading and keeps it in the `:LINEAR-LABELS:' drawer." (string-trim (replace-regexp-in-string "[^[:alnum:]_]+" "_" (downcase (or name ""))) "_+" "_+")) (defun pearl--label-tags (labels) "Return the ordered, de-duplicated Org tags for a list of LABEL plists. Each label's `:name' is slugified via `pearl--label-name-to-tag'; empty slugs are dropped and duplicates removed, first occurrence winning, so two label names that slugify to the same tag render it once at the first's position." (let ((seen (make-hash-table :test 'equal)) (tags '())) (dolist (label labels) (let ((tag (pearl--label-name-to-tag (plist-get label :name)))) (unless (or (string-empty-p tag) (gethash tag seen)) (puthash tag t seen) (push tag tags)))) (nreverse tags))) (defun pearl--derive-todo-line (states) "Build the `#+TODO:' keyword string from an ordered STATES list. Each state is a plist with at least :name and :type. States whose :type is completed / canceled / duplicate go after the `|' (the done side); the rest go before it. The caller's order is preserved within each side; keywords are slugified (`pearl--state-name-to-keyword') and de-duplicated by slug, first-seen winning. An empty STATES list returns the hardcoded default so the rendered file always has a valid `#+TODO:' line." (if (null states) "TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE" (let ((active '()) (done '()) (seen (make-hash-table :test 'equal))) (dolist (s states) (let ((kw (pearl--state-name-to-keyword (plist-get s :name)))) (unless (gethash kw seen) (puthash kw t seen) (if (member (plist-get s :type) '("completed" "canceled" "duplicate")) (push kw done) (push kw active))))) (let ((active-str (string-join (nreverse active) " ")) (done-str (string-join (nreverse done) " "))) (concat active-str " |" (if (string-empty-p done-str) "" (concat " " done-str))))))) (defun pearl--map-linear-priority-to-org (priority-num) "Convert Linear PRIORITY-NUM to an Org priority cookie, or \"\" for none. PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low. None (0), nil, and any unknown value map to no cookie -- 1:1 with the cookie so a None issue does not collide with Medium, which the save-model relies on for dirty detection." (cond ((eq priority-num 1) "[#A]") ; Urgent -> A ((eq priority-num 2) "[#B]") ; High -> B ((eq priority-num 3) "[#C]") ; Medium -> C ((eq priority-num 4) "[#D]") ; Low -> D (t ""))) ; None / nil / unknown -> no cookie (defun pearl--get-linear-priority-name (priority-num) "Convert Linear PRIORITY-NUM to a readable name. PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." (cond ((eq priority-num 1) "Urgent") ((eq priority-num 2) "High") ((eq priority-num 3) "Medium") ((eq priority-num 4) "Low") (t "None"))) (defun pearl--md-emphasis-to-org (s) "Convert markdown links / bold / italic in S to Org markup. S must contain no inline code spans -- those are handled by the caller, which splits them out so their contents stay verbatim." ;; [text](url) -> [[url][text]] (setq s (replace-regexp-in-string "\\[\\([^]]+\\)\\](\\([^) ]+\\))" "[[\\2][\\1]]" s)) ;; **bold** -> *bold* (setq s (replace-regexp-in-string "\\*\\*\\([^*\n]+?\\)\\*\\*" "*\\1*" s)) ;; _italic_ -> /italic/, word-bounded so identifiers like foo_bar are left alone (setq s (replace-regexp-in-string "\\(^\\|[^[:alnum:]_]\\)_\\([^_\n]+?\\)_\\([^[:alnum:]_]\\|$\\)" "\\1/\\2/\\3" s)) s) (defun pearl--md-line-to-org (line) "Convert inline markdown in LINE to Org markup. Handles links, inline code, bold, and underscore italics; other inline markup passes through unchanged. Inline code spans are tokenized first and their contents kept verbatim, so markdown-looking text in backticks (`**b**`, `[l](u)`) renders as code rather than being converted." (let ((result "") (pos 0)) (while (string-match "`\\([^`\n]+\\)`" line pos) ;; emphasis/links on the text before this code span, then the span verbatim (setq result (concat result (pearl--md-emphasis-to-org (substring line pos (match-beginning 0))) "~" (match-string 1 line) "~")) (setq pos (match-end 0))) (concat result (pearl--md-emphasis-to-org (substring line pos))))) (defun pearl--md-to-org (md) "Convert markdown MD to Org markup (the pure-elisp conversion tier). Converts fenced code blocks to `#+begin_src'/`#+end_src', markdown headings to bold lines (never Org headings), markdown bullets (`*' / `+') to `-', and the inline markup in `pearl--md-line-to-org'. Any other line that would read as an Org heading is space-guarded. Tables, HTML, and unrecognized constructs pass through as literal text. Returns the empty string for an empty MD." (if (or (null md) (string-empty-p md)) "" (let ((in-code nil) (out '())) (dolist (line (split-string md "\n")) (cond ;; fenced code fence: ``` or ```lang ((string-match "\\`[ \t]*```\\(.*\\)\\'" line) (if in-code (progn (push "#+end_src" out) (setq in-code nil)) (push (format "#+begin_src %s" (string-trim (match-string 1 line))) out) (setq in-code t))) (in-code (push line out)) ;; markdown heading -> bold line, not an Org heading ((string-match "\\`#+[ \t]+\\(.*\\)\\'" line) (push (format "*%s*" (string-trim (match-string 1 line))) out)) ;; markdown bullet -> Org dash bullet ((string-match "\\`\\([ \t]*\\)[*+][ \t]+\\(.*\\)\\'" line) (push (concat (match-string 1 line) "- " (pearl--md-line-to-org (match-string 2 line))) out)) ;; guard any remaining line that Org would read as a heading ((string-match "\\`\\*+ " line) (push (concat " " (pearl--md-line-to-org line)) out)) (t (push (pearl--md-line-to-org line) out)))) (string-join (nreverse out) "\n")))) (defun pearl--org-emphasis-to-md (s) "Convert Org links / bold / italic in S back to markdown. S must contain no verbatim ~code~ spans -- the caller splits those out so their contents stay literal. Italics are word-bounded so paths and URLs are left alone." ;; [[url][text]] -> [text](url) (setq s (replace-regexp-in-string "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" "[\\2](\\1)" s)) ;; [[url]] -> url (setq s (replace-regexp-in-string "\\[\\[\\([^]]+\\)\\]\\]" "\\1" s)) ;; *bold* -> **bold** (setq s (replace-regexp-in-string "\\*\\([^*\n]+?\\)\\*" "**\\1**" s)) ;; /italic/ -> _italic_, word-bounded so /usr/local paths are left alone (setq s (replace-regexp-in-string "\\(^\\|[^[:alnum:]/]\\)/\\([^/\n]+?\\)/\\([^[:alnum:]/]\\|$\\)" "\\1_\\2_\\3" s)) s) (defun pearl--org-line-to-md (line) "Convert inline Org markup in LINE back to markdown. The inverse of `pearl--md-line-to-org': org links, verbatim, bold, and italics become their markdown forms. Verbatim ~code~ spans are tokenized first and their contents kept literal (symmetric with the md->org direction), so a code span containing markup round-trips exactly." (let ((result "") (pos 0)) (while (string-match "~\\([^~\n]+\\)~" line pos) (setq result (concat result (pearl--org-emphasis-to-md (substring line pos (match-beginning 0))) "`" (match-string 1 line) "`")) (setq pos (match-end 0))) (concat result (pearl--org-emphasis-to-md (substring line pos))))) (defun pearl--org-to-md (org) "Convert Org markup ORG back to markdown (the push direction). The symmetric inverse of `pearl--md-to-org': `#+begin_src'/`#+end_src' become fenced code (language preserved, contents verbatim), `#+begin_quote' blocks become `>'-prefixed lines, Org checkbox marks normalize to markdown lowercase, and the inline markup in `pearl--org-line-to-md' is undone. Tables, HTML, and unrecognized lines pass through literally. Returns the empty string for an empty ORG. Two constructs are intentionally lossy and do not round-trip back to their markdown source: a markdown `# heading' (rendered to a bold line on fetch) stays a bold line, and single-asterisk markdown italics are unsupported on fetch. Both are documented in the conversion matrix." (if (or (null org) (string-empty-p org)) "" (let ((in-code nil) (in-quote nil) (out '())) (dolist (line (split-string org "\n")) (cond ;; src block open: #+begin_src or #+begin_src lang ((string-match "\\`[ \t]*#\\+begin_src\\(.*\\)\\'" line) (push (format "```%s" (string-trim (match-string 1 line))) out) (setq in-code t)) ((and in-code (string-match "\\`[ \t]*#\\+end_src[ \t]*\\'" line)) (push "```" out) (setq in-code nil)) (in-code (push line out)) ;; quote block: drop the markers, prefix the contents with "> " ((string-match "\\`[ \t]*#\\+begin_quote[ \t]*\\'" line) (setq in-quote t)) ((and in-quote (string-match "\\`[ \t]*#\\+end_quote[ \t]*\\'" line)) (setq in-quote nil)) (in-quote (push (concat "> " (pearl--org-line-to-md line)) out)) ;; checkbox: normalize the uppercase Org mark to markdown lowercase ((string-match "\\`\\([ \t]*\\)- \\[\\([ xX]\\)\\] \\(.*\\)\\'" line) (push (concat (match-string 1 line) "- [" (downcase (match-string 2 line)) "] " (pearl--org-line-to-md (match-string 3 line))) out)) (t (push (pearl--org-line-to-md line) out)))) (string-join (nreverse out) "\n")))) (defun pearl--format-comment (comment) "Format a normalized COMMENT plist as a level-4 Org entry. The heading carries the author and timestamp; a property drawer carries the comment id, the author's user id (empty for bot/external comments, which are not editable), and a sha256 of the last-fetched body for the sync conflict gate. The body runs through the same markdown->org tier as the description. A null author renders as `(unknown)'." (let ((author (or (plist-get comment :author) "(unknown)")) (created (or (plist-get comment :created-at) "")) (raw-body (or (plist-get comment :body) "")) (body (pearl--md-to-org (or (plist-get comment :body) "")))) (concat (format "**** %s — %s\n" author created) ":PROPERTIES:\n" (format ":LINEAR-COMMENT-ID: %s\n" (or (plist-get comment :id) "")) (format ":LINEAR-COMMENT-AUTHOR-ID: %s\n" (or (plist-get comment :author-id) "")) (format ":LINEAR-COMMENT-SHA256: %s\n" (secure-hash 'sha256 raw-body)) (format ":LINEAR-COMMENT-ORG-SHA256: %s\n" (secure-hash 'sha256 (string-trim body))) ":END:\n" (if (string-empty-p body) "" (concat body "\n"))))) (defun pearl--comment-count-marker (count-info) "Render COUNT-INFO as a ` shown/total[+]' suffix, or the empty string. COUNT-INFO is a plist (:shown N :total M :overflow BOOL) set on the bulk-list path; nil (the single-issue thread) yields no marker. The 💬 glyph leads the `Comments' heading itself (see `pearl--format-comments'), not this count." (if count-info (format " %d/%d%s" (plist-get count-info :shown) (plist-get count-info :total) (if (plist-get count-info :overflow) "+" "")) "")) (defcustom pearl-comment-sort-order 'newest-first "Order in which an issue's comments render under the Comments heading. `newest-first' puts the most recent comment at the top, and a newly added comment is inserted there. `oldest-first' reads top-to-bottom, oldest to newest, like an email thread, and a new comment appends at the bottom." :type '(choice (const :tag "Newest first (most recent on top)" newest-first) (const :tag "Oldest first (chronological)" oldest-first)) :group 'pearl) (defun pearl--format-comments (comments &optional count-info) "Format COMMENTS (a list of normalized comment plists) as a Comments subtree. Comments render under a level-3 `Comments' heading, ordered per `pearl-comment-sort-order'. Returns the empty string when COMMENTS is nil, so an issue with no comments renders no subtree. The heading leads with a 💬 glyph; COUNT-INFO, when non-nil, appends a ` shown/total' count (the bulk list passes the issue's `:comment-count')." (if (null comments) "" (let* ((newest-first (eq pearl-comment-sort-order 'newest-first)) (sorted (sort (copy-sequence comments) (lambda (a b) (let ((ca (or (plist-get a :created-at) "")) (cb (or (plist-get b :created-at) ""))) (if newest-first (string> ca cb) (string< ca cb))))))) (concat "*** 💬 Comments" (pearl--comment-count-marker count-info) "\n" (mapconcat #'pearl--format-comment sorted ""))))) (defun pearl--format-issue-as-org-entry (issue) "Format a normalized ISSUE plist as an Org entry. The heading carries the title; structured fields live in a namespaced `LINEAR-*' property drawer (changed via commands, not by hand); the issue description renders as the entry body. `LINEAR-DESC-SHA256' (the markdown) and `LINEAR-DESC-UPDATED-AT' record the description's provenance for the sync-back conflict gates; `LINEAR-DESC-ORG-SHA256' hashes the rendered Org body so a later refresh can tell a real local edit from a lossy md->org round-trip without re-deriving the markdown. `LINEAR-TITLE-SHA256' is the title's hash (over the rendered title -- bracket-stripped and title-cased, without the identifier prefix -- so an unedited heading is a no-op on title sync)." (let* ((description (or (plist-get issue :description) "")) (state (plist-get issue :state)) (team (plist-get issue :team)) (project (plist-get issue :project)) (assignee (plist-get issue :assignee)) (todo (pearl--state-name-to-keyword (plist-get state :name))) (priority (pearl--map-linear-priority-to-org (plist-get issue :priority))) (display-title (pearl--heading-title issue)) (heading-title (pearl--heading-with-identifier display-title (plist-get issue :identifier))) (label-names (mapconcat (lambda (l) (or (plist-get l :name) "")) (plist-get issue :labels) ", ")) (label-ids (mapconcat (lambda (l) (or (plist-get l :id) "")) (plist-get issue :labels) " ")) (tags (pearl--label-tags (plist-get issue :labels))) (tag-string (if tags (concat " :" (string-join tags ":") ":") "")) (body-org (pearl--md-to-org description))) (concat (format "** %s %s%s%s\n" todo (if (string-empty-p priority) "" (concat priority " ")) heading-title tag-string) ":PROPERTIES:\n" (format ":LINEAR-ID: %s\n" (or (plist-get issue :id) "")) (format ":LINEAR-IDENTIFIER: %s\n" (or (plist-get issue :identifier) "")) (format ":LINEAR-URL: %s\n" (or (plist-get issue :url) (format "https://linear.app/issue/%s" (or (plist-get issue :identifier) "")))) (format ":LINEAR-TEAM-ID: %s\n" (or (plist-get team :id) "")) (format ":LINEAR-TEAM-NAME: %s\n" (or (plist-get team :name) "")) (format ":LINEAR-PROJECT-ID: %s\n" (or (plist-get project :id) "")) (format ":LINEAR-PROJECT-NAME: %s\n" (or (plist-get project :name) "")) (format ":LINEAR-PRIORITY: %s\n" (or (plist-get issue :priority) "")) (format ":LINEAR-STATE-ID: %s\n" (or (plist-get state :id) "")) (format ":LINEAR-STATE-ID-SYNCED: %s\n" (or (plist-get state :id) "")) (format ":LINEAR-STATE-NAME: %s\n" (or (plist-get state :name) "")) (format ":LINEAR-STATE-TYPE: %s\n" (or (plist-get state :type) "")) (format ":LINEAR-ASSIGNEE-ID: %s\n" (or (plist-get assignee :id) "")) (format ":LINEAR-ASSIGNEE-ID-SYNCED: %s\n" (or (plist-get assignee :id) "")) (format ":LINEAR-ASSIGNEE-NAME: %s\n" (or (plist-get assignee :name) "")) (format ":LINEAR-LABELS: [%s]\n" label-names) (format ":LINEAR-LABEL-IDS: %s\n" label-ids) (format ":LINEAR-LABEL-IDS-SYNCED: %s\n" label-ids) (format ":LINEAR-DESC-SHA256: %s\n" (secure-hash 'sha256 description)) (format ":LINEAR-DESC-ORG-SHA256: %s\n" (secure-hash 'sha256 (string-trim body-org))) (format ":LINEAR-DESC-UPDATED-AT: %s\n" (or (plist-get issue :updated-at) "")) (format ":LINEAR-TITLE-SHA256: %s\n" (secure-hash 'sha256 display-title)) ":END:\n" (if (string-empty-p body-org) "" (concat body-org "\n")) (pearl--format-comments (plist-get issue :comments) (plist-get issue :comment-count))))) ;;; Description Sync-Back (defun pearl--sync-decision (local-md stored-hash remote-md) "Decide how to sync a description edit. LOCAL-MD is the current Org body rendered back to markdown. STORED-HASH is the sha256 of the markdown recorded when the issue was last fetched. REMOTE-MD is the description as it stands on Linear right now. Returns: - `:noop' -- nothing to push (no local edit, or local already matches remote), - `:push' -- a local edit against an unchanged remote: safe to push, - `:conflict' -- both sides changed since the last fetch." (let ((local-hash (secure-hash 'sha256 (or local-md ""))) (remote-hash (secure-hash 'sha256 (or remote-md "")))) (cond ((string= local-hash stored-hash) :noop) ((string= local-hash remote-hash) :noop) ((string= remote-hash stored-hash) :push) (t :conflict)))) ;;; Conflict Resolution ;; When a description, title, or comment changed both locally and on Linear ;; since the last fetch, `pearl--sync-decision' returns `:conflict'. Instead of ;; only refusing, the sync commands offer use-local / use-remote / rewrite (and ;; cancel). The hard rule: no resolution silently discards the local edit, so ;; any destructive choice stashes it first (see `pearl--stash-conflict-text'). (defconst pearl--conflict-backup-buffer "*pearl-conflict-backup*" "Buffer holding stashed local text from destructive conflict resolutions.") (defun pearl--stash-conflict-text (label text) "Stash TEXT so a destructive conflict resolution can't lose it. Pushes TEXT onto the `kill-ring' (recover with `yank') and appends it to the `pearl--conflict-backup-buffer' under a heading naming LABEL and the time. Called before \"use remote\" or a rewrite replaces the local edit. Empty TEXT is a no-op -- there is nothing to lose." (when (and text (not (string-empty-p text))) (kill-new text) (with-current-buffer (get-buffer-create pearl--conflict-backup-buffer) (goto-char (point-max)) (unless (bobp) (insert "\n")) (insert (format "## %s -- %s\n" label (format-time-string "%Y-%m-%d %H:%M:%S"))) (insert text) (unless (string-suffix-p "\n" text) (insert "\n"))))) (defun pearl--conflict-smerge-string (local remote) "Return a git-style merge-conflict string with LOCAL and REMOTE sections. LOCAL is the user's current text, REMOTE is Linear's. Each section is newline terminated so the markers always start their own line; the result is meant to drop into `smerge-mode' for resolution." (concat "<<<<<<< LOCAL (your edit)\n" local (unless (string-suffix-p "\n" local) "\n") "=======\n" remote (unless (string-suffix-p "\n" remote) "\n") ">>>>>>> REMOTE (Linear)\n")) (defun pearl--read-conflict-resolution (label) "Prompt for how to resolve the conflict on LABEL, returning a symbol. One of `use-local' (push mine, overwrite Linear), `use-remote' (take Linear's, stash mine), `rewrite' (merge both in a buffer), or `cancel'. A bare RET defaults to `cancel', leaving everything untouched." (let* ((choices '(("cancel -- leave both untouched" . cancel) ("use local -- push my version, overwrite Linear" . use-local) ("use remote -- take Linear's, stash mine" . use-remote) ("rewrite -- merge both in a buffer" . rewrite))) (default (caar choices)) (pick (completing-read (format "Conflict on %s (RET cancels): " label) (mapcar #'car choices) nil t nil nil default))) (cdr (assoc pick choices)))) (defun pearl--set-entry-body-at-point (org-text) "Replace the body of the org entry at point with ORG-TEXT. The body is the region after the entry's drawers and before its first child heading, so a Comments subtree is left intact. ORG-TEXT is org markup (already converted from markdown); an empty string clears the body. Used to write a resolved description or comment back into the buffer." (save-excursion (org-back-to-heading t) (org-end-of-meta-data t) (let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))) (delete-region beg end) (goto-char beg) (unless (string-empty-p org-text) (insert org-text "\n"))))) (defun pearl--resolve-conflict (label local-md remote-md marker stored-prop apply-fn push-fn &optional outcome-cb) "Interactively resolve a sync conflict on LABEL. LOCAL-MD and REMOTE-MD are the two diverged versions. MARKER anchors the org entry; STORED-PROP is the provenance property advanced on resolution (such as \"LINEAR-DESC-SHA256\"). APPLY-FN takes a text string and writes it into the buffer (re-rendering the body, title, or comment); PUSH-FN takes a text string and a callback invoked with non-nil on a successful push. Resolutions (see `pearl--read-conflict-resolution'): `cancel' leaves both untouched; `use-local' pushes the local text and advances the hash on success; `use-remote' stashes the local text, writes Linear's version in, and advances the hash with no push (the remote is already current). `rewrite' opens an smerge buffer; the reconciled text is applied and pushed on commit, or the field is left in conflict on abort (the local text is stashed either way). OUTCOME-CB, when given, is called once with (STATUS REASON) after the resolution settles, for the save engine: `cancel' -> (conflict cancelled), `use-local' -> (pushed nil) or (failed push-failed), `use-remote' -> \(resolved-remote nil), `rewrite' commit -> (pushed nil) or (failed push-failed), `rewrite' abort -> (conflict aborted)." (pcase (pearl--read-conflict-resolution label) ('cancel (message "Left %s untouched (refresh to see Linear's version)" label) (when outcome-cb (funcall outcome-cb 'conflict 'cancelled))) ('use-local (funcall push-fn local-md (lambda (ok) (if ok (progn (org-entry-put marker stored-prop (secure-hash 'sha256 local-md)) (message "Pushed your %s to Linear" label) (when outcome-cb (funcall outcome-cb 'pushed nil))) (message "Failed to push %s" label) (when outcome-cb (funcall outcome-cb 'failed 'push-failed)))))) ('use-remote (pearl--stash-conflict-text label local-md) (funcall apply-fn remote-md) (org-entry-put marker stored-prop (secure-hash 'sha256 remote-md)) (message "Took Linear's %s; your version is on the kill ring and in %s" label pearl--conflict-backup-buffer) (when outcome-cb (funcall outcome-cb 'resolved-remote nil))) ('rewrite (pearl--stash-conflict-text label local-md) (pearl--resolve-conflict-in-smerge label local-md remote-md (lambda (reconciled) (funcall apply-fn reconciled) (funcall push-fn reconciled (lambda (ok) (if ok (progn (org-entry-put marker stored-prop (secure-hash 'sha256 reconciled)) (message "Synced merged %s to Linear" label) (when outcome-cb (funcall outcome-cb 'pushed nil))) (message "Failed to push merged %s" label) (when outcome-cb (funcall outcome-cb 'failed 'push-failed)))))) (lambda () (when outcome-cb (funcall outcome-cb 'conflict 'aborted))))))) (defun pearl--read-atomic-conflict-resolution (label) "Prompt for resolving an atomic-field conflict on LABEL, returning a symbol. One of `use-local' (push mine, overwrite Linear), `use-remote' (take Linear's), or `cancel'. There is no merge option -- an enum or relation value can't be combined. A bare RET defaults to `cancel'." (let* ((choices '(("cancel -- leave the field in conflict" . cancel) ("use local -- push my value, overwrite Linear" . use-local) ("use remote -- take Linear's value" . use-remote))) (default (caar choices)) (pick (completing-read (format "Conflict on %s (RET cancels): " label) (mapcar #'car choices) nil t nil nil default))) (cdr (assoc pick choices)))) (defun pearl--resolve-atomic-conflict (label local-display remote-display push-local-fn take-remote-fn outcome-cb) "Resolve an atomic-field (enum/relation) conflict on LABEL interactively. The sibling of `pearl--resolve-conflict' for fields whose value is a single id or scalar, not mergeable text -- so there is no smerge/rewrite branch and no SHA hash is written. LOCAL-DISPLAY and REMOTE-DISPLAY are human-readable values for the prompt. PUSH-LOCAL-FN takes a callback invoked with non-nil on a successful push of the local value (the caller advances the baseline on success). TAKE-REMOTE-FN adopts Linear's value locally and advances the baseline, with no push. OUTCOME-CB is called once with (STATUS REASON): `cancel' -> (conflict cancelled); `use-local' -> (pushed nil) or (failed push-failed); `use-remote' -> (resolved-remote nil)." (pcase (pearl--read-atomic-conflict-resolution label) ('cancel (message "Left %s in conflict (refresh to see Linear's %s)" label remote-display) (funcall outcome-cb 'conflict 'cancelled)) ('use-local (funcall push-local-fn (lambda (ok) (if ok (progn (message "Pushed your %s (%s) to Linear" label local-display) (funcall outcome-cb 'pushed nil)) (message "Failed to push %s" label) (funcall outcome-cb 'failed 'push-failed))))) ('use-remote (funcall take-remote-fn) (message "Took Linear's %s (%s)" label remote-display) (funcall outcome-cb 'resolved-remote nil)))) ;;; 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). \\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 (pearl--compose-display-action)) buf)) (defvar-local pearl--conflict-on-finish nil "Callback invoked with the reconciled text when a conflict buffer commits.") (defvar-local pearl--conflict-on-abort nil "Thunk invoked when a conflict buffer is aborted, for save-outcome reporting.") (defun pearl--conflict-has-markers-p (text) "Return non-nil if any git-style conflict markers remain in TEXT. Used to refuse a commit while the user has left a section unresolved." (and (string-match-p "^\\(<<<<<<<\\|=======\\|>>>>>>>\\)" text) t)) (defun pearl--resolve-conflict-in-smerge (label local remote on-finish &optional on-abort) "Open an smerge buffer to reconcile LOCAL vs REMOTE for LABEL. The user resolves the conflict markers with the usual `smerge-mode' commands, then \\[pearl--conflict-commit] hands the reconciled text to ON-FINISH and kills the buffer, while \\[pearl--conflict-abort] cancels (the local text is already stashed). ON-FINISH runs only when no conflict markers remain. ON-ABORT, when given, is a thunk run on abort so the save engine can report the outcome." (require 'smerge-mode) (let ((buf (get-buffer-create (format "*pearl-merge: %s*" label)))) (with-current-buffer buf (erase-buffer) (insert (pearl--conflict-smerge-string local remote)) (goto-char (point-min)) (smerge-mode 1) (setq-local pearl--conflict-on-finish on-finish) (setq-local pearl--conflict-on-abort on-abort) (local-set-key (kbd "C-c C-c") #'pearl--conflict-commit) (local-set-key (kbd "C-c C-k") #'pearl--conflict-abort) (setq-local header-line-format (substitute-command-keys "Resolve the conflict, then \\[pearl--conflict-commit] to push, \\[pearl--conflict-abort] to abort"))) (pop-to-buffer buf (pearl--compose-display-action)))) (defun pearl--conflict-commit () "Finish the current pearl conflict buffer, pushing the reconciled text. Refuses while conflict markers remain; otherwise hands the buffer text to the armed ON-FINISH callback and kills the buffer." (interactive) (let ((text (buffer-string))) (when (pearl--conflict-has-markers-p text) (user-error "Unresolved conflict markers remain; resolve them or abort with C-c C-k")) (let ((cb pearl--conflict-on-finish)) (kill-buffer (current-buffer)) (when cb (funcall cb text))))) (defun pearl--conflict-abort () "Abort the current pearl conflict buffer without pushing. The local text was stashed before the buffer opened, so nothing is lost. Runs the armed `pearl--conflict-on-abort' thunk (if any) so the save engine can report the field as left in conflict." (interactive) (let ((cb pearl--conflict-on-abort)) (kill-buffer (current-buffer)) (message "Conflict resolution aborted; your text is on the kill ring and in %s" pearl--conflict-backup-buffer) (when cb (funcall cb)))) (defun pearl--entry-body-at-point () "Return the body of the Org entry at point, before any child heading. The body is the text after the property drawer and before the first child heading (so an issue's Comments subtree is excluded), trimmed of surrounding whitespace. Returns the empty string when the entry has no body. Used for both issue descriptions and comment bodies -- hence \"entry\", not \"issue\"." (save-excursion (org-back-to-heading t) ;; Fix the body's end (the next heading: a Comments child or the next ;; issue) from the heading itself, before `org-end-of-meta-data' moves ;; point. For an empty body that call skips blank lines and lands on the ;; next heading, so without this clamp the body would overshoot into the ;; next issue's whole subtree. (let ((end (save-excursion (outline-next-heading) (point)))) (org-end-of-meta-data t) (if (>= (point) end) "" (string-trim (buffer-substring-no-properties (point) end)))))) (defun pearl--fetch-issue-description-async (issue-id callback) "Fetch ISSUE-ID's current description and timestamp from Linear. CALLBACK is called with a plist (:description STR :updated-at STR) on success, or nil on error." (let ((query "query IssueDescription($id: String!) { issue(id: $id) { description updatedAt } }") (variables `(("id" . ,issue-id)))) (pearl--graphql-request-async query variables (lambda (data) (let ((issue (cdr (assoc 'issue (assoc 'data data))))) (funcall callback (when issue (list :description (or (cdr (assoc 'description issue)) "") :updated-at (cdr (assoc 'updatedAt issue))))))) (lambda (_error _response _data) (funcall callback nil))))) (defun pearl--update-issue-description-async (issue-id markdown callback) "Push MARKDOWN as ISSUE-ID's description via issueUpdate. CALLBACK is called with a plist (:success BOOL :updated-at STR)." (let ((query "mutation UpdateIssueDescription($id: String!, $description: String!) { issueUpdate(id: $id, input: {description: $description}) { success issue { id updatedAt } } }") (variables `(("id" . ,issue-id) ("description" . ,markdown)))) (pearl--graphql-request-async query variables (lambda (data) (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) (success (eq t (cdr (assoc 'success payload)))) (issue (cdr (assoc 'issue payload)))) (funcall callback (list :success success :updated-at (cdr (assoc 'updatedAt issue)))))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) (defun pearl--fetch-issue-title-async (issue-id callback) "Fetch ISSUE-ID's current title and timestamp from Linear. CALLBACK is called with a plist (:title STR :updated-at STR) on success, or nil on error." (let ((query "query IssueTitle($id: String!) { issue(id: $id) { title updatedAt } }") (variables `(("id" . ,issue-id)))) (pearl--graphql-request-async query variables (lambda (data) (let ((issue (cdr (assoc 'issue (assoc 'data data))))) (funcall callback (when issue (list :title (or (cdr (assoc 'title issue)) "") :updated-at (cdr (assoc 'updatedAt issue))))))) (lambda (_error _response _data) (funcall callback nil))))) (defun pearl--update-issue-title-async (issue-id title callback) "Push TITLE as ISSUE-ID's title via issueUpdate. CALLBACK is called with a plist (:success BOOL :updated-at STR)." (let ((query "mutation UpdateIssueTitle($id: String!, $title: String!) { issueUpdate(id: $id, input: {title: $title}) { success issue { id updatedAt } } }") (variables `(("id" . ,issue-id) ("title" . ,title)))) (pearl--graphql-request-async query variables (lambda (data) (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) (success (eq t (cdr (assoc 'success payload)))) (issue (cdr (assoc 'issue payload)))) (funcall callback (list :success success :updated-at (cdr (assoc 'updatedAt issue)))))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) (defun pearl--issue-title-at-point () "Return the title of the Linear issue heading at point. Strips the TODO keyword, priority cookie, and tags, then strips the `IDENT: ' identifier prefix the renderer may have added, leaving the bare title text (the form the renderer hashed into `LINEAR-TITLE-SHA256')." (save-excursion (org-back-to-heading t) (pearl--strip-identifier-prefix (org-get-heading t t t t) (org-entry-get nil "LINEAR-IDENTIFIER")))) (defun pearl--goto-heading-or-error (&optional message) "Move point to the enclosing heading, or signal a `user-error'. The shared guard for the issue-at-point commands. MESSAGE overrides the default \"Not on a Linear issue heading\" (e.g. for a comment subtree). Callers wrap this in `save-excursion' when they must not move point." (unless (ignore-errors (org-back-to-heading t) t) (user-error "%s" (or message "Not on a Linear issue heading")))) (defun pearl--issue-id-at-point () "Return the `LINEAR-ID' of the issue heading enclosing point, or nil. Climbs ancestors: from inside a comment subtree (a heading carrying `LINEAR-COMMENT-ID' but no `LINEAR-ID') it walks up to the issue heading. Does not move point or signal." (save-excursion (when (ignore-errors (org-back-to-heading t) t) (while (and (not (org-entry-get nil "LINEAR-ID")) (org-up-heading-safe))) (org-entry-get nil "LINEAR-ID")))) (defun pearl--goto-issue-heading-or-error () "Move point to the enclosing issue heading (one carrying `LINEAR-ID'), or error. The guard for issue-scoped commands that must work from anywhere inside an issue subtree, including from a comment heading or body: it climbs out of the comment to the issue heading. Signals a `user-error' when no ancestor heading carries `LINEAR-ID'." (pearl--goto-heading-or-error) (while (and (not (org-entry-get nil "LINEAR-ID")) (org-up-heading-safe))) (unless (org-entry-get nil "LINEAR-ID") (user-error "Not on a Linear issue heading"))) ;;;###autoload (defun pearl-sync-current-issue () "Push the description edited in the Org body of the issue at point to Linear. Works from anywhere inside an issue subtree. A thin wrapper over the save engine's description saver: an unchanged body sends nothing; an edit against an unchanged remote is pushed and both description hashes advance; a both-changed case is offered conflict resolution (cancel leaves it untouched)." (interactive) (save-excursion (pearl--goto-heading-or-error) (unless (org-entry-get nil "LINEAR-ID") (user-error "Not on a Linear issue heading")) (let ((buf (current-buffer))) (pearl--progress "Saving description...") (pearl--save-description-field (point-marker) (lambda (outcome) (pearl--report-save-outcome outcome buf)))))) ;;;###autoload (defun pearl-sync-current-issue-title () "Push the title edited in the heading of the issue at point to Linear. A thin wrapper over the save engine's title saver, sharing the conflict gate with the description sync and working from anywhere inside an issue subtree. The title is lossy: the renderer strips square brackets, so the heading holds the stripped form and a push sends that stripped title." (interactive) (save-excursion (pearl--goto-heading-or-error) (unless (org-entry-get nil "LINEAR-ID") (user-error "Not on a Linear issue heading")) (let ((buf (current-buffer))) (pearl--progress "Saving title...") (pearl--save-title-field (point-marker) (lambda (outcome) (pearl--report-save-outcome outcome buf)))))) (defun pearl--replace-issue-subtree-at-point (issue) "Replace the issue subtree at point with a freshly formatted ISSUE entry. ISSUE is a normalized issue plist. The whole subtree (heading, drawer, body, and any comment children) is rewritten from the entry, so the rendered result matches a first fetch." (save-excursion (org-back-to-heading t) (let ((beg (point)) (end (save-excursion (org-end-of-subtree t t) (point)))) (delete-region beg end) (goto-char beg) (insert (pearl--format-issue-as-org-entry issue)) ;; Close the rewritten subtree's drawer(s) but leave the issue itself ;; expanded -- a single-issue refresh keeps the user on the issue they ;; were looking at, unlike a full repopulation which re-folds the page. (when pearl-fold-after-update (save-excursion (goto-char beg) (save-restriction (org-narrow-to-subtree) (pearl--hide-or-tidy-drawers))))))) ;;;###autoload (defun pearl-refresh-current-issue () "Re-fetch the issue at point from Linear and rewrite its subtree in place. Works from anywhere inside an issue subtree. If the description body has unpushed local edits, they are stashed first (kill ring + the conflict-backup buffer) so the refresh can't silently lose them (decision 4), then the refresh proceeds and the subtree is replaced with Linear's version." (interactive) (save-excursion (pearl--goto-issue-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (marker (point-marker))) (progn ;; Stash an unpushed edit before the overwrite rather than refusing, so ;; an explicit single-issue refresh always proceeds without data loss. ;; Use the Org-hash-first dirty check (`pearl--subtree-dirty-p') so a ;; clean description whose markdown is lossy under org->md isn't falsely ;; flagged dirty and stashed -- the same fix the merge refresh uses. (when (pearl--subtree-dirty-p) (pearl--stash-conflict-text (format "%s description (pre-refresh)" issue-id) (pearl--org-to-md (pearl--entry-body-at-point)))) (pearl--progress "Refreshing %s from Linear..." issue-id) (pearl--fetch-issue-async issue-id (lambda (result) (pcase result ((or :error (pred null)) (message "Linear returned an error fetching %s; not refreshing" issue-id)) (:missing (message "Issue %s is no longer on Linear (deleted or no access); not refreshing" issue-id)) (raw ;; The fetch may complete after the buffer was killed; only ;; rewrite it when it's still live. (if (buffer-live-p (marker-buffer marker)) (progn (save-excursion (goto-char marker) (pearl--replace-issue-subtree-at-point (pearl--normalize-issue raw))) (pearl-highlight-comments) (pearl--surface-buffer (marker-buffer marker)) (message "Refreshed %s from Linear" issue-id)) (message "Refreshed %s; its buffer was closed" issue-id)))))))))) (defun pearl--create-comment-async (issue-id body callback) "Create a comment with BODY on ISSUE-ID via commentCreate. CALLBACK is called with the normalized comment plist on success, or nil on a GraphQL/transport failure or a non-success payload." (let ((query "mutation CommentCreate($issueId: String!, $body: String!) { commentCreate(input: {issueId: $issueId, body: $body}) { success comment { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } }") (variables `(("issueId" . ,issue-id) ("body" . ,body)))) (pearl--graphql-request-async query variables (lambda (data) (let* ((payload (cdr (assoc 'commentCreate (assoc 'data data)))) (success (eq t (cdr (assoc 'success payload)))) (comment (cdr (assoc 'comment payload)))) (funcall callback (and success comment (pearl--normalize-comment comment))))) (lambda (_error _response _data) (funcall callback nil))))) (defun pearl--bump-comments-count-marker () "Increment the ` N/M[+]' count on the Comments heading at point, if present. A locally added comment grows both the shown and total counts by one. A heading that carries no count marker (the single-issue view) is left untouched, and the leading 💬 glyph is preserved either way." (save-excursion (let ((eol (line-end-position))) (beginning-of-line) (when (re-search-forward " \\([0-9]+\\)/\\([0-9]+\\)\\(\\+?\\)[ \t]*$" eol t) (replace-match (format " %d/%d%s" (1+ (string-to-number (match-string 1))) (1+ (string-to-number (match-string 2))) (match-string 3)) t t))))) (defun pearl--append-comment-to-issue (comment) "Insert COMMENT (a normalized plist) under the issue subtree at point. A new comment is the newest, so it lands where `pearl-comment-sort-order' puts the newest: at the top of the `Comments' subtree (just under the heading) for `newest-first', or after the last comment for `oldest-first'. Creates the subtree at the end of the issue when it does not exist yet." (save-excursion (org-back-to-heading t) (let* ((issue-end (save-excursion (org-end-of-subtree t t) (point))) (comments-pos (save-excursion ;; tolerate the leading 💬 glyph and a trailing count marker; also ;; match the pre-2026-05 "Comments 💬 N/N" layout in older files (when (re-search-forward "^\\*+ \\(?:💬 \\)?Comments\\(?:[ \t].*\\)?$" issue-end t) (match-beginning 0))))) (if comments-pos (progn (goto-char comments-pos) (if (eq pearl-comment-sort-order 'newest-first) (forward-line 1) ; just under the heading, before the first comment (org-end-of-subtree t t)) ; after the last comment (let ((start (point))) (insert (pearl--format-comment comment)) (pearl--hide-drawers-in-region start (point))) ;; the new comment grows the shown/total count on the heading (goto-char comments-pos) (pearl--bump-comments-count-marker)) ;; no Comments subtree yet: this is the first comment, so it is 1/1 (goto-char issue-end) (let ((start (point))) (insert "*** 💬 Comments 1/1\n" (pearl--format-comment comment)) (pearl--hide-drawers-in-region start (point))))))) ;;;###autoload (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-create-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-issue-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (marker (point-marker))) (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-edit-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-issue-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (marker (point-marker))) (pearl--compose-in-buffer (format "description for %s" issue-id) pearl--compose-description-instructions (org-with-point-at marker (pearl--entry-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 () "Open the Linear issue at point in the browser. Reads the `LINEAR-URL' property of the enclosing issue heading and hands it to `browse-url'. Works from anywhere inside the issue subtree." (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")) (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 delete: it moves the issue to Trash (recoverable for about 30 days), not a permanent purge." (let ((query "mutation IssueDelete($id: String!) { issueDelete(id: $id) { success } }") (variables `(("id" . ,issue-id)))) (pearl--graphql-request-async query variables (lambda (data) (let ((payload (cdr (assoc 'issueDelete (assoc 'data data))))) (funcall callback (list :success (eq t (cdr (assoc 'success payload))))))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) ;;;###autoload (defun pearl-delete-current-issue () "Delete the Linear issue at point after confirmation, removing its subtree. Works from anywhere inside an issue subtree. Confirms first, then issues a soft delete (Linear moves the issue to Trash, recoverable for about 30 days); on success the issue's Org subtree is removed from the buffer." (interactive) (let* ((marker (save-excursion (pearl--goto-issue-heading-or-error) (point-marker))) (issue-id (org-entry-get marker "LINEAR-ID")) (ident (or (org-entry-get marker "LINEAR-IDENTIFIER") "this issue"))) (when (yes-or-no-p (format "Delete %s from Linear (moves it to Trash)? " ident)) (pearl--delete-issue-async issue-id (lambda (result) (if (plist-get result :success) (progn (save-excursion (goto-char marker) (org-back-to-heading t) (delete-region (point) (progn (org-end-of-subtree t t) (point)))) (message "Deleted %s (moved to Trash on Linear)" ident) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to delete %s" ident))))))) ;;; Command-managed Drawer Fields (defun pearl--update-issue-async (issue-id input callback) "Push INPUT (an `IssueUpdateInput' alist) to ISSUE-ID via issueUpdate. INPUT is an alist of field names to values, such as a single \"priority\"/2 or \"stateId\"/id pair, json-encoded into the input object. CALLBACK is called with a plist of :success BOOL and :updated-at STR. This is the generic mutation the field commands share." (let ((query "mutation UpdateIssue($id: String!, $input: IssueUpdateInput!) { issueUpdate(id: $id, input: $input) { success issue { id updatedAt } } }") (variables `(("id" . ,issue-id) ("input" . ,input)))) (pearl--graphql-request-async query variables (lambda (data) (let* ((payload (cdr (assoc 'issueUpdate (assoc 'data data)))) (success (eq t (cdr (assoc 'success payload)))) (issue (cdr (assoc 'issue payload)))) (funcall callback (list :success success :updated-at (cdr (assoc 'updatedAt issue)))))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) (defun pearl--set-priority-cookie (priority-num) "Set the Org priority cookie on the heading at point from PRIORITY-NUM. 1-4 map to #A-#D; 0 (None) removes the cookie. The priority range is bound locally so #D is accepted regardless of the user's `org-priority' settings." (save-excursion (org-back-to-heading t) (let ((org-priority-highest ?A) (org-priority-lowest ?D)) (pcase priority-num (1 (org-priority ?A)) (2 (org-priority ?B)) (3 (org-priority ?C)) (4 (org-priority ?D)) (_ (org-priority 'remove)))))) (defun pearl--set-heading-state (state-name state-id) "Update the heading at point to STATE-NAME / STATE-ID. Rewrites the TODO keyword (the slug of STATE-NAME, matching the derived `#+TODO' header) and the LINEAR-STATE-NAME / LINEAR-STATE-ID drawer properties. `org-after-todo-state-change-hook' is bound to nil during the keyword change so programmatically setting the keyword does not fire any todo-change hooks the user has installed." (save-excursion (org-back-to-heading t) (org-entry-put nil "LINEAR-STATE-NAME" state-name) (org-entry-put nil "LINEAR-STATE-ID" state-id) (let ((org-after-todo-state-change-hook nil)) (org-todo (pearl--state-name-to-keyword state-name))))) ;;;###autoload (defun pearl-edit-state (state-name) "Set the workflow state of the issue at point to STATE-NAME in the buffer. Completes over the issue team's workflow states and writes the keyword, name, and id. The change is reconciled and pushed at the next save, not immediately. Works from anywhere inside an issue subtree. This picker reaches any state, including one a TODO-keyword cycle can't express." (interactive (let ((team-id (save-excursion (when (ignore-errors (org-back-to-heading t) t) (org-entry-get nil "LINEAR-TEAM-ID"))))) (list (completing-read "State: " (mapcar (lambda (s) (cdr (assoc 'name s))) (and team-id (pearl--team-states team-id))) nil t)))) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) (states (and team-id (pearl--team-states team-id))) (state (seq-find (lambda (s) (string= (cdr (assoc 'name s)) state-name)) states)) (state-id (and state (cdr (assoc 'id state))))) (unless state-id (user-error "No workflow state named %s in this team" state-name)) (pearl--set-heading-state state-name state-id) (message "Set state to %s (save to push)" state-name)))) (defun pearl--team-collection-names (kind team-id) "Return the display labels of the KIND collection for TEAM-ID, for completion." (mapcar (lambda (n) (pearl--node-label kind n)) (and team-id (pearl--team-collection kind team-id)))) ;;;###autoload (defun pearl-edit-assignee (assignee-name) "Set the assignee of the issue at point to ASSIGNEE-NAME in the buffer. Completes over the issue team's members, resolves the name to a user id, and writes the assignee drawer; the change is reconciled and pushed at the next `pearl-save-issue' / `pearl-save-all', not immediately. Works from anywhere inside an issue subtree." (interactive (let ((team-id (save-excursion (when (ignore-errors (org-back-to-heading t) t) (org-entry-get nil "LINEAR-TEAM-ID"))))) (list (completing-read "Assignee: " (pearl--team-collection-names 'members team-id) nil t)))) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) (assignee-id (and team-id (pearl--resolve-team-id 'members assignee-name team-id)))) (unless assignee-id (user-error "No team member matching %s" assignee-name)) (org-entry-put nil "LINEAR-ASSIGNEE-NAME" assignee-name) (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id) (message "Set assignee to %s (save to push)" assignee-name)))) (defun pearl--set-heading-label-tags (tags) "Replace the Org tags on the issue heading at point with TAGS, a list of strings. Only the heading's tag set changes: the TODO keyword, priority cookie, title, identifier prefix, body, and drawer are preserved. Pearl owns the entire issue-heading tag set, so any hand-added tags are dropped. An empty TAGS list clears the heading's tags. Point must be on or inside the issue heading." (save-excursion (org-back-to-heading t) (org-set-tags tags))) ;;;###autoload (defun pearl-edit-labels (label-names) "Set the labels of the issue at point to LABEL-NAMES in the buffer. Completes (multiple) over the issue team's labels; an empty selection clears them. Resolves each name to a label id and writes the labels drawer plus the `LINEAR-LABEL-IDS' live set; the change is reconciled and pushed at the next `pearl-save-issue' / `pearl-save-all', not immediately. Works from anywhere inside an issue subtree." (interactive (let ((team-id (save-excursion (when (ignore-errors (org-back-to-heading t) t) (org-entry-get nil "LINEAR-TEAM-ID"))))) (list (completing-read-multiple "Labels (comma-separated, empty to clear): " (pearl--team-collection-names 'labels team-id))))) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) (label-ids (mapcar (lambda (name) (or (and team-id (pearl--resolve-team-id 'labels name team-id)) (user-error "No label matching %s" name))) label-names))) (org-entry-put nil "LINEAR-LABELS" (format "[%s]" (mapconcat #'identity label-names ", "))) (org-entry-put nil "LINEAR-LABEL-IDS" (string-join label-ids " ")) (pearl--set-heading-label-tags (pearl--label-tags (mapcar (lambda (n) (list :name n)) label-names))) (message "Set labels to %s (save to push)" (if label-names (mapconcat #'identity label-names ", ") "none"))))) ;;; User-facing Commands (Async) (defun pearl--source-name (source) "Return the display name of a SOURCE descriptor, or a default." (or (plist-get source :name) "Linear issues")) (defun pearl--summarize-filter (filter) "Return a short human-readable summary of a FILTER authoring plist. An empty FILTER summarizes as \"all issues\"." (if (null filter) "all issues" (let (parts) (cl-loop for (key val) on filter by #'cddr do (push (pcase key (:assignee (format "assignee: %s" (if (eq val :me) "me" val))) (:open (if val "open" "any state")) (:labels (format "labels: %s" (mapconcat #'identity (if (listp val) val (list val)) ", "))) (_ (format "%s: %s" (substring (symbol-name key) 1) val))) parts)) (mapconcat #'identity (nreverse parts) ", ")))) (defun pearl--read-active-source () "Read the active source descriptor from the current buffer's header, or nil. Parses the `#+LINEAR-SOURCE:' keyword that `pearl--build-org-content' writes." (save-excursion (goto-char (point-min)) (when (re-search-forward "^#\\+LINEAR-SOURCE: \\(.*\\)$" nil t) (ignore-errors (car (read-from-string (match-string 1))))))) (defun pearl--gather-header-states (issues) "Collect the ordered workflow states for the ISSUES' teams, for the header. Teams in first-seen order across ISSUES; within a team, states by Linear `position'. Each team's full state set is fetched (cached) via `pearl--team-states'. A team whose fetch fails is skipped, but every displayed issue's own state is appended afterward so it is still declared (the coverage guarantee). Returns a list of (:name :type :position) plists; `pearl--derive-todo-line' de-duplicates by slug, so the appended issue states only add the ones a failed team fetch left out." (let ((team-ids '()) (seen (make-hash-table :test 'equal))) (dolist (issue issues) (let ((tid (plist-get (plist-get issue :team) :id))) (when (and tid (not (gethash tid seen))) (puthash tid t seen) (push tid team-ids)))) (let ((team-states (apply #'append (mapcar (lambda (tid) (mapcar (lambda (node) (list :name (cdr (assoc 'name node)) :type (cdr (assoc 'type node)) :position (cdr (assoc 'position node)))) (sort (copy-sequence (or (ignore-errors (pearl--team-states tid)) '())) (lambda (a b) (< (or (cdr (assoc 'position a)) most-positive-fixnum) (or (cdr (assoc 'position b)) most-positive-fixnum)))))) (nreverse team-ids)))) (issue-states (delq nil (mapcar (lambda (issue) (let ((st (plist-get issue :state))) (when (plist-get st :name) (list :name (plist-get st :name) :type (plist-get st :type) :position (plist-get st :position))))) issues)))) (append team-states issue-states)))) (defun pearl--build-org-content (issues &optional source truncated states) "Build the Org content string for the linear org file from ISSUES. SOURCE is the active-source descriptor recorded in the header so a later `pearl-refresh-current-view' can re-run it; TRUNCATED marks that the page cap was hit. STATES is the ordered workflow-state list (see `pearl--gather-header-states') the `#+TODO:' line is derived from; a nil STATES yields the hardcoded default. Pure function, no side effects." (let* ((src (or source '(:type filter :name "Linear issues" :filter nil))) (name (pearl--source-name src)) (filter (plist-get src :filter))) (with-temp-buffer ;; The view name renders verbatim, matching Linear's own capitalization; ;; `pearl-title-case-headings' governs issue headings only. (insert (format "#+title: Linear — %s\n" name)) (insert "#+STARTUP: show3levels\n") (insert (format "#+TODO: %s\n" (pearl--derive-todo-line states))) ;; Source-tracking metadata: the serialized source drives refresh; the ;; rest is human-readable provenance. (insert (format "#+LINEAR-SOURCE: %s\n" (prin1-to-string src))) (insert (format "#+LINEAR-RUN-AT: %s\n" (format-time-string "%Y-%m-%d %H:%M"))) (insert (format "#+LINEAR-FILTER: %s\n" (pearl--summarize-filter filter))) (insert (format "#+LINEAR-COUNT: %d\n" (length issues))) (insert (format "#+LINEAR-TRUNCATED: %s\n" (if truncated "yes" "no"))) ;; Affordance preamble (org comments -- not rendered content). (insert "#\n") (insert "# Body = the issue description; edit it, then M-x pearl-save-issue to push.\n") (insert "# Comments subtree = the thread; add with M-x pearl-create-comment.\n") (insert "# State/assignee/labels: M-x pearl-edit-state / -assignee / -labels; priority: the org cookie (C-c ,). All push at save.\n") (insert "# Refresh with M-x pearl-refresh-current-view (whole file) or -current-issue (one).\n") (insert "\n") ;; Single top-level parent so the issues are sortable as a group ;; (org-sort on this heading) instead of orphan headings, and so a ;; show3levels fold has a level-1 root. Named after the view. (insert (format "* %s\n" name)) (dolist (issue issues) (insert (pearl--format-issue-as-org-entry issue))) (buffer-string)))) (defun pearl--dirty-refresh-choice (path) "Ask how to refresh PATH when its buffer has unsaved changes. Returns one of ?d (discard the edits and rebuild), ?m (merge by LINEAR-ID, keeping unpushed edits), or ?q (cancel and leave the buffer untouched)." (read-char-choice (format (concat "%s has unsaved changes — " "(d)iscard & refresh, (m)erge keeping edits, (q) cancel? ") (file-name-nondirectory path)) '(?d ?m ?q))) (defun pearl--update-org-from-issues (issues &optional source truncated) "Update `pearl-org-file-path' with rendered ISSUES, buffer-aware. SOURCE and TRUNCATED are threaded into the header (see `pearl--build-org-content'). Behavior depends on whether the file is currently visited in a buffer: - No buffer visiting the file: write atomically to disk via `with-temp-file', then visit it so there is a buffer to show. - Buffer exists and is unmodified: replace its contents in place and save, preserving point and avoiding a modtime mismatch warning. - Buffer exists and has unsaved edits: a full rebuild would discard them, so prompt (see `pearl--dirty-refresh-choice') to discard and rebuild, merge by LINEAR-ID keeping the edits, or cancel. In every case the resulting buffer is surfaced (see `pearl--surface-buffer'), so a fetch run from a menu or dashboard actually shows the issues instead of just writing the file and leaving it off-screen." (let* ((org-file-path pearl-org-file-path) (states (pearl--gather-header-states issues)) (new-content (pearl--build-org-content issues source truncated states)) (existing-buf (find-buffer-visiting org-file-path))) (cond ;; Branch A: no buffer visits the file -- atomic file write, then visit. ((not existing-buf) (pearl--log "Writing %d issues to %s (no buffer)" (length issues) org-file-path) (make-directory (file-name-directory org-file-path) t) (with-temp-file org-file-path (insert new-content)) (message "Updated Linear issues in %s with %d active issues" org-file-path (length issues)) (let ((buf (find-file-noselect org-file-path))) (with-current-buffer buf (pearl-mode 1) (pearl--restore-page-visibility) (pearl-highlight-comments)) (pearl--surface-buffer buf))) ;; Branch B: buffer exists and is clean -- replace contents in place. ((not (buffer-modified-p existing-buf)) (pearl--log "Writing %d issues to %s (clean buffer)" (length issues) org-file-path) (with-current-buffer existing-buf (let ((recorded-point (point)) (inhibit-read-only t)) (erase-buffer) (insert new-content) (save-buffer) (goto-char (min recorded-point (point-max))) (pearl--restore-page-visibility) (pearl-highlight-comments))) (message "Updated Linear issues in %s with %d active issues" org-file-path (length issues)) (pearl--surface-buffer existing-buf)) ;; Branch C: buffer is dirty -- a full rebuild would discard unsaved work, ;; so ask before clobbering rather than silently deferring. (t (pcase (pearl--dirty-refresh-choice org-file-path) (?d ; discard the edits, rebuild in place (with-current-buffer existing-buf (let ((inhibit-read-only t)) (set-buffer-modified-p nil) (erase-buffer) (insert new-content) (save-buffer) (goto-char (point-min)) (pearl--restore-page-visibility) (pearl-highlight-comments))) (message "Updated Linear issues in %s with %d active issues" org-file-path (length issues)) (pearl--surface-buffer existing-buf)) (?m ; merge by LINEAR-ID, keeping edits (with-current-buffer existing-buf (let ((counts (pearl--merge-issues-into-buffer issues))) (pearl--update-source-header (length issues) truncated) (pearl--update-derived-todo-header (pearl--gather-header-states issues)) (pearl-highlight-comments) (pearl--restore-page-visibility) (message "Merged into %s: %d updated, %d added, %d dropped%s" (file-name-nondirectory org-file-path) (plist-get counts :updated) (plist-get counts :added) (plist-get counts :dropped) (let ((s (plist-get counts :skipped))) (if (> s 0) (format ", %d kept (unpushed edits)" s) ""))))) (pearl--surface-buffer existing-buf)) (_ ; cancel (message "Linear refresh cancelled; %s left unchanged" (file-name-nondirectory org-file-path)) (pearl--surface-buffer existing-buf))))))) (defcustom pearl-saved-queries nil "Named local issue queries, run with `pearl-run-saved-query'. Each entry is (NAME . SPEC) where SPEC is a plist with `:filter' (an authoring filter plist), and optional `:sort' (`updated', `created', `priority', or `title') and `:order' (`asc' or `desc', default `desc'). AND-only in v1; use a Linear Custom View for OR logic." :type '(alist :key-type string :value-type plist) :group 'pearl) (defun pearl--sort-issues (issues sort order) "Return ISSUES sorted by SORT (a symbol) in ORDER (`asc' or `desc'). SORT is one of `updated', `priority', `title', or nil (no client-side sort). ORDER defaults to descending. Sorting happens after fetch so a refresh always produces the same heading order rather than reshuffling into noise." (let ((key (pcase sort ('updated (lambda (i) (or (plist-get i :updated-at) ""))) ('priority (lambda (i) (or (plist-get i :priority) 99))) ('title (lambda (i) (downcase (or (plist-get i :title) "")))) (_ nil)))) (if (null key) issues (let* ((lessp (if (eq sort 'priority) (lambda (a b) (< (funcall key a) (funcall key b))) (lambda (a b) (string< (funcall key a) (funcall key b))))) (ascending (sort (copy-sequence issues) lessp))) (if (eq order 'asc) ascending (nreverse ascending)))))) (defun pearl--sort->order-by (sort) "Map a SORT symbol to the server `orderBy' value. `created' uses `createdAt'; everything else (including `updated') uses `updatedAt', the only other field Linear's public ordering supports." (if (eq sort 'created) 'createdAt 'updatedAt)) ;;;###autoload (defun pearl-run-saved-query (name) "Run the saved query NAME from `pearl-saved-queries'. Interactively, completes over the configured query names. Compiles the stored filter, fetches, sorts per the query's `:sort'/`:order', and renders into the active file with the query recorded as the source." (interactive (list (completing-read "Saved query: " (mapcar #'car pearl-saved-queries) nil t))) (let ((entry (assoc name pearl-saved-queries))) (unless entry (user-error "No saved query named %s" name)) (let* ((spec (cdr entry)) (filter-plist (plist-get spec :filter)) (sort (plist-get spec :sort)) (order (plist-get spec :order)) (source (list :type 'filter :name name :filter filter-plist :sort sort :order order))) ;; Validate the saved query's authoring plist at the command boundary so ;; a typo'd key or bad value surfaces as a clear user-error instead of ;; being silently dropped or failing deeper in the compiler. (pearl--validate-issue-filter filter-plist) (pearl--progress "Running saved query %s..." name) (pearl--query-issues-async (pearl--build-issue-filter filter-plist) (lambda (result) (pearl--render-query-result result source)) (pearl--sort->order-by sort))))) ;;; pearl-pick-source -- the unified source picker (favorites + saved queries) (defun pearl--pick-source-candidates (favorites saved-queries) "Build the picker's candidate alist `((DISPLAY . SOURCE-OR-ACTION) ...)'. FAVORITES is a list of normalized favorite plists; SAVED-QUERIES is the `pearl-saved-queries' alist. Favorites come first in ascending `:sort-order'; saved queries follow alphabetically. Each DISPLAY is `[KIND] TITLE' and is made unique by appending ` (#N)' on a true collision -- dispatch reads SOURCE-OR-ACTION, not the display string." (let ((fav-sorted (sort (copy-sequence favorites) (lambda (a b) (< (or (plist-get a :sort-order) 0.0) (or (plist-get b :sort-order) 0.0))))) (saved-sorted (sort (copy-sequence saved-queries) (lambda (a b) (string< (car a) (car b))))) (alist nil) (seen (make-hash-table :test 'equal))) (cl-labels ((push-unique (display source) (let ((d display) (n 2)) (while (gethash d seen) (setq d (format "%s (#%d)" display n)) (cl-incf n)) (puthash d t seen) (push (cons d source) alist)))) (dolist (fav fav-sorted) (let* ((kind (plist-get fav :kind)) (title (plist-get fav :title)) (display (format "[%s] %s" (symbol-name kind) title)) (source (pearl--favorite->source fav))) (push-unique display source))) (dolist (sq saved-sorted) (let* ((name (car sq)) (spec (cdr sq)) (display (format "[saved] %s" name)) (source (list :type 'filter :name name :filter (plist-get spec :filter) :sort (plist-get spec :sort) :order (plist-get spec :order)))) (push-unique display source)))) (nreverse alist))) (defun pearl--open-favorite-url (action) "Open ACTION's `:url' in the browser, or refuse with a clear `user-error' when the URL is nil or empty. Messages \"Opened KIND favorite in browser: TITLE\" on success so the user sees what happened." (let ((url (plist-get action :url)) (kind (plist-get action :kind)) (title (plist-get action :title))) (unless (and url (stringp url) (not (string-empty-p url))) (user-error "Favorite has no URL to open")) (browse-url url) (message "Opened %s favorite in browser: %s" (if kind (symbol-name kind) "linear") title))) ;;;###autoload (defun pearl-pick-source () "Pick a Linear favorite or local saved query and fetch it into the active file. Favorites are listed first in Linear's sort order, then local saved queries alphabetically. Non-list favorites (issue, document, ...) open in the browser instead. On a favorites-fetch failure the picker still offers any local saved queries -- favorites-failure is not the same user state as \"no favorites\". With neither favorites nor saved queries, signals a `user-error' naming the missing setup." (interactive) (pearl--progress "Fetching favorites...") (let ((saved pearl-saved-queries)) (pearl--favorites-async (lambda (favorites) (let ((cands (pearl--pick-source-candidates favorites saved))) (unless cands (user-error "No favorites or saved queries -- star views in Linear, or set `pearl-saved-queries'")) (let* ((display (completing-read "Source: " (mapcar #'car cands) nil t)) (source (cdr (assoc display cands)))) (cond ((plist-get source :browser) (pearl--open-favorite-url source)) ((eq (plist-get source :type) 'view) (pearl--progress "Running view %s..." (plist-get source :name)) (pearl--query-view-async (plist-get source :id) (lambda (result) (pearl--render-query-result result source)))) (t (let ((filter (plist-get source :filter))) (pearl--validate-issue-filter filter) (pearl--progress "Running %s..." (plist-get source :name)) (pearl--query-issues-async (pearl--build-issue-filter filter) (lambda (result) (pearl--render-query-result result source)) (pearl--sort->order-by (plist-get source :sort)))))))))))) (defun pearl--assemble-filter (team open state project labels assignee) "Assemble a filter authoring plist from the chosen dimensions. The non-nil of TEAM, OPEN, STATE, PROJECT, LABELS, and ASSIGNEE appear (an empty LABELS list is dropped), feeding `pearl--build-issue-filter' with just what the user set." (append (when team (list :team team)) (cond ((eq assignee :me) (list :assignee :me)) ((stringp assignee) (list :assignee-id assignee))) (when open (list :open t)) (when state (list :state state)) (when project (list :project project)) (when labels (list :labels labels)))) (defun pearl--read-filter-interactively () "Build a filter plist by completing over the chosen team's fetched dimensions. Picks a team first (scoping the rest), then offers open-only, state, project, labels, and assignee. The assignee prompt offers `me' (the viewer), `member' (a specific teammate, resolved to an id), or `any' (no scoping). Empty answers drop the dimension." (let* ((teams (pearl--all-teams)) (team-name (completing-read "Team (empty for any): " (mapcar (lambda (tm) (cdr (assoc 'name tm))) teams) nil nil)) (team-id (and (not (string-empty-p team-name)) (pearl--get-team-id-by-name team-name))) (open (y-or-n-p "Open issues only? ")) (state (and team-id (let ((s (completing-read "State (empty for any): " (mapcar (lambda (st) (cdr (assoc 'name st))) (pearl--team-states team-id)) nil nil))) (unless (string-empty-p s) s)))) (project (and team-id (let ((p (completing-read "Project (empty for any): " (pearl--team-collection-names 'projects team-id) nil nil))) ;; The :project filter compiles to project.id.eq, so ;; resolve the picked name to its id before passing. (unless (string-empty-p p) (pearl--resolve-team-id 'projects p team-id))))) (labels (and team-id (completing-read-multiple "Labels (comma-separated, empty for none): " (pearl--team-collection-names 'labels team-id)))) (assignee (let ((choice (completing-read "Assignee (me / member / any): " '("me" "member" "any") nil t "any"))) (pcase choice ("me" :me) ("member" (and team-id (let ((name (completing-read "Member: " (pearl--team-collection-names 'members team-id) nil t))) (unless (string-empty-p name) (pearl--resolve-team-id 'members name team-id))))) (_ nil))))) ;; The :team filter compiles to team.key.eq, so look the picked name up ;; in the teams alist and pass its key (not the display name). (pearl--assemble-filter (and (not (string-empty-p team-name)) (cdr (assoc 'key (cl-find team-name teams :key (lambda (tm) (cdr (assoc 'name tm))) :test #'string=)))) open state project labels assignee))) (defun pearl--save-query (name filter-plist &optional sort order) "Save FILTER-PLIST as the saved query NAME, replacing any entry of that NAME. Persists `pearl-saved-queries' via Customize. SORT and ORDER are stored when given." (let ((entry (cons name (append (list :filter filter-plist) (when sort (list :sort sort)) (when order (list :order order)))))) (setq pearl-saved-queries (cons entry (assoc-delete-all name (copy-sequence pearl-saved-queries)))) (ignore-errors (customize-save-variable 'pearl-saved-queries pearl-saved-queries)))) ;;;###autoload (defun pearl-list-issues-filtered (filter-plist &optional save-name) "Build an ad-hoc issue filter interactively, run it, and render it. Interactively, completes each dimension from the chosen team's fetched projects/states/labels (so a typo can't produce a confusing empty result), and offers to save the filter as a local query. FILTER-PLIST is the authoring filter; SAVE-NAME, when given, persists it via `pearl--save-query'." (interactive (list (pearl--read-filter-interactively) (when (y-or-n-p "Save this filter locally so you can re-run it (not pushed to Linear)? ") (read-string "Name for this saved query: ")))) ;; Validate before saving or running, so a bad filter never gets persisted ;; or run -- the command boundary is where the clear error belongs. (pearl--validate-issue-filter filter-plist) (when (and save-name (not (string-empty-p save-name))) (pearl--save-query save-name filter-plist)) (let ((source (list :type 'filter :name (if (and save-name (not (string-empty-p save-name))) save-name "Ad-hoc filter") :filter filter-plist))) (pearl--progress "Running ad-hoc filter...") (pearl--query-issues-async (pearl--build-issue-filter filter-plist) (lambda (result) (pearl--render-query-result result source))))) (defun pearl--cap-issue-list-comments (issue) "Cap a bulk-list ISSUE's fetched comments and record a `:comment-count' marker. The list/view fetch pulls the newest `pearl-list-comments-count-cap'+1 comments newest-first; keep the newest `pearl-list-comments-shown' for display (the renderer re-sorts those oldest-first) and set `:comment-count' to (:shown N :total M :overflow BOOL), where the total is exact up to the cap and overflows past it. An issue with no fetched comments is returned unchanged, so it renders no Comments subtree." (let ((comments (plist-get issue :comments))) (if (null comments) issue (let* ((n (length comments)) (cap pearl-list-comments-count-cap) (overflow (> n cap)) (total (if overflow cap n)) (shown (seq-take comments pearl-list-comments-shown))) (plist-put (plist-put (copy-sequence issue) :comments shown) :comment-count (list :shown (length shown) :total total :overflow overflow)))))) (defun pearl--render-query-result (result source) "Render a query RESULT into the active file, tagged with SOURCE. Normalizes the raw nodes, writes them via `pearl--update-org-from-issues' with SOURCE and the truncation flag, and reports the outcome. The one render boundary shared by list-issues, the ad-hoc filter, saved queries, views, and refresh." (pcase (pearl--query-result-status result) ('ok (let ((issues (pearl--sort-issues (mapcar (lambda (n) (pearl--cap-issue-list-comments (pearl--normalize-issue n))) (pearl--query-result-issues result)) (plist-get source :sort) (plist-get source :order))) (truncated (pearl--query-result-truncated-p result))) (condition-case err (progn (pearl--update-org-from-issues issues source truncated) (message "Linear: wrote %d issue%s%s" (length issues) (if (= 1 (length issues)) "" "s") (if truncated (format " (stopped at the %d-page limit; raise `pearl-max-issue-pages')" pearl-max-issue-pages) ""))) (error (pearl--log "Error updating org file: %s" (error-message-string err)) (message "Error updating the Linear org file: %s" (error-message-string err)))))) ('empty (message "Linear: no issues match %s (file left unchanged)" (pearl--source-name source))) (_ (message "Linear: %s" (or (pearl--query-result-message result) "could not fetch issues"))))) (defun pearl--subtree-dirty-p () "Return non-nil when the issue subtree at point has unpushed body edits. Compares the current Org body against `LINEAR-DESC-ORG-SHA256', the hash of the body as it was rendered at the last fetch. This is an Org-to-Org comparison: it does not round-trip through markdown, so a description whose markdown does not survive md->org->md (headings, single-asterisk emphasis) is not mistaken for a local edit. This is what lets a refresh protect a locally edited description from being clobbered while still re-rendering the untouched ones. For subtrees rendered before this hash existed (no `LINEAR-DESC-ORG-SHA256'), fall back to the older markdown-round-trip comparison; those migrate to the Org-baseline hash the next time the subtree is re-rendered." (let ((org-hash (org-entry-get nil "LINEAR-DESC-ORG-SHA256"))) (if org-hash (not (string= (secure-hash 'sha256 (pearl--entry-body-at-point)) org-hash)) (let ((stored (org-entry-get nil "LINEAR-DESC-SHA256")) (local-md (pearl--org-to-md (pearl--entry-body-at-point)))) (not (string= (secure-hash 'sha256 local-md) (or stored ""))))))) (defun pearl--issue-subtree-markers () "Return an alist of (LINEAR-ID . marker) for every issue heading in the buffer. Each marker sits at the start of an issue heading -- one carrying its own `LINEAR-ID' property. Comment headings carry `LINEAR-COMMENT-ID' instead and have no `LINEAR-ID', so they are skipped. Markers (not raw positions) so they track correctly across the in-place inserts and deletes the merge performs." (let (markers) (save-excursion (goto-char (point-min)) (while (re-search-forward "^\\*+ " nil t) (save-excursion (beginning-of-line) (let ((id (org-entry-get nil "LINEAR-ID"))) (when (and id (not (string-empty-p id))) ;; Insertion type t matters here: replacing an earlier subtree ;; deletes then reinserts at its start, collapsing a later ;; marker onto that point. A type-nil marker would stay before ;; the reinserted text and get stranded on the wrong heading; a ;; type-t marker advances past it to its own heading. (push (cons id (copy-marker (point) t)) markers)))))) (nreverse markers))) ;;; Dirty detection (the save model's local scanners) (defun pearl--comment-dirty-p () "Return non-nil when the comment body at point differs from its last fetch. An Org-to-Org comparison against `LINEAR-COMMENT-ORG-SHA256' (the rendered body as fetched), so a comment whose markdown does not survive md->org->md (a heading or single-asterisk emphasis) is not mistaken for a local edit -- the same fix `pearl--subtree-dirty-p' applies to descriptions. Comments rendered before that baseline existed fall back to the older markdown-round-trip comparison against `LINEAR-COMMENT-SHA256'; they migrate on the next re-render." (let ((org-hash (org-entry-get nil "LINEAR-COMMENT-ORG-SHA256"))) (if org-hash (not (string= (secure-hash 'sha256 (pearl--entry-body-at-point)) org-hash)) (let ((stored (or (org-entry-get nil "LINEAR-COMMENT-SHA256") ""))) (not (string= (secure-hash 'sha256 (pearl--org-to-md (pearl--entry-body-at-point))) stored)))))) (defun pearl--changed-comment-candidates () "Return comments under the issue at point whose body changed since fetch. Each is a plist (:comment-id :author-id :marker). Local only, via `pearl--comment-dirty-p'. A candidate only means the body differs; ownership is decided later." (let (candidates) (save-excursion (pearl--goto-heading-or-error) (let ((issue-end (save-excursion (org-end-of-subtree t t) (point)))) (while (and (outline-next-heading) (< (point) issue-end)) (let ((cid (org-entry-get nil "LINEAR-COMMENT-ID"))) (when (and cid (not (string-empty-p cid)) (pearl--comment-dirty-p)) (push (list :comment-id cid :author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID") :marker (point-marker)) candidates)))))) (nreverse candidates))) (defun pearl--priority-number-at-point () "Return the Linear priority (0-4) implied by the heading cookie at point. A/B/C/D map to Urgent/High/Medium/Low (1-4); no cookie is None (0)." (save-excursion (org-back-to-heading t) (let ((case-fold-search nil)) (if (re-search-forward "\\[#\\([A-D]\\)\\]" (line-end-position) t) (cdr (assoc (match-string 1) '(("A" . 1) ("B" . 2) ("C" . 3) ("D" . 4)))) 0)))) (defun pearl--priority-dirty-p () "Non-nil if the heading's priority cookie differs from `LINEAR-PRIORITY'. A missing baseline (a legacy file rendered before this field) is not dirty -- a refresh writes the baseline; the saver's missing-property guard covers the edge." (let ((base (org-entry-get nil "LINEAR-PRIORITY"))) (and base (/= (pearl--priority-number-at-point) (string-to-number base))))) (defun pearl--id-baseline-dirty-p (live-prop base-prop) "Non-nil if LIVE-PROP differs from its present baseline BASE-PROP at point. A missing baseline is not dirty (see `pearl--priority-dirty-p')." (let ((base (org-entry-get nil base-prop))) (and base (not (string= (or (org-entry-get nil live-prop) "") base))))) (defun pearl--label-ids-dirty-p () "Non-nil if `LINEAR-LABEL-IDS' differs from `LINEAR-LABEL-IDS-SYNCED' as a set. Order-insensitive (Linear label order is not meaningful). A missing baseline is not dirty." (let ((base (org-entry-get nil "LINEAR-LABEL-IDS-SYNCED"))) (and base (not (equal (sort (split-string (or (org-entry-get nil "LINEAR-LABEL-IDS") "") " " t) #'string<) (sort (split-string base " " t) #'string<)))))) (defun pearl--state-keyword-cycled-p () "Non-nil when the heading's TODO keyword no longer matches the synced state. Network-free: compares `org-get-todo-state' against the slug of `LINEAR-STATE-NAME' (`pearl--state-name-to-keyword'). A heading with no keyword or no recorded state name can't be judged cycled, so it returns nil. The concrete state id the keyword resolves to is determined in the saver (`pearl--resolve-keyword-to-state'), not here -- this scan stays local." (let ((kw (org-get-todo-state)) (name (org-entry-get nil "LINEAR-STATE-NAME"))) (and kw name (not (string-empty-p name)) (not (string= kw (pearl--state-name-to-keyword name)))))) (defun pearl--resolve-keyword-to-state (keyword team-id) "Resolve KEYWORD to a TEAM-ID workflow state by slug match. Returns a plist (:id :name :type) for the first state -- by `position' -- whose name slugifies to KEYWORD, or nil when none match (a stale or hand-typed keyword). Uses the cached team states; a failed or empty fetch yields nil." (let (best best-pos) (dolist (node (ignore-errors (pearl--team-states team-id))) (when (string= keyword (pearl--state-name-to-keyword (cdr (assoc 'name node)))) (let ((pos (or (cdr (assoc 'position node)) most-positive-fixnum))) (when (or (null best) (< pos best-pos)) (setq best (list :id (cdr (assoc 'id node)) :name (cdr (assoc 'name node)) :type (cdr (assoc 'type node))) best-pos pos))))) best)) (defun pearl--issue-dirty-fields () "Return the locally-changed fields of the issue subtree at point, no network. A plist: `:title', `:description', `:priority', `:state', `:assignee', and `:labels' are booleans; `:comment-candidates' is the list from `pearl--changed-comment-candidates'. The structured-field checks compare each live value against its synced baseline (id/scalar only, no name resolution or remote read). `:state' has two arms: the picker arm (explicit `LINEAR-STATE-ID' vs `LINEAR-STATE-ID-SYNCED') and the keyword-cycle arm (`pearl--state-keyword-cycled-p' -- the keyword slug diverged from `LINEAR-STATE-NAME'); either marks state dirty. This is Phase A of the two-phase save scan -- comment ownership is classified separately once the viewer id is known (see `pearl--classify-comment-candidates')." (save-excursion (pearl--goto-heading-or-error) (list :title (not (string= (secure-hash 'sha256 (pearl--issue-title-at-point)) (or (org-entry-get nil "LINEAR-TITLE-SHA256") ""))) :description (pearl--subtree-dirty-p) :priority (pearl--priority-dirty-p) :state (or (pearl--id-baseline-dirty-p "LINEAR-STATE-ID" "LINEAR-STATE-ID-SYNCED") (pearl--state-keyword-cycled-p)) :assignee (pearl--id-baseline-dirty-p "LINEAR-ASSIGNEE-ID" "LINEAR-ASSIGNEE-ID-SYNCED") :labels (pearl--label-ids-dirty-p) :comment-candidates (pearl--changed-comment-candidates)))) (defun pearl--classify-comment-candidates (candidates viewer-id) "Split CANDIDATES into own dirty comments and read-only ones, by VIEWER-ID. Returns a plist (:own (...) :read-only (...)). A candidate is `:own' when its `:author-id' equals VIEWER-ID (see `pearl--comment-editable-p'); a non-own / bot / external comment is `:read-only' -- edited locally but not pushable." (let (own read-only) (dolist (c candidates) (if (pearl--comment-editable-p (plist-get c :author-id) viewer-id) (push c own) (push c read-only))) (list :own (nreverse own) :read-only (nreverse read-only)))) ;;; Save engine (the save model's per-field savers) ;; ;; Each dirty field runs through `pearl--run-field-save', which performs the ;; fetch + the three-way `pearl--sync-decision' + the push (or conflict ;; resolution) and invokes its callback exactly once with a structured outcome ;; instead of messaging. The per-field savers below build the spec for a ;; title, description, or own comment. The interactive sync commands are thin ;; wrappers that run one saver and message its outcome; `pearl-save-issue' / ;; `pearl-save-all' (later) drive several savers through a queue and aggregate ;; the outcomes -- never message-scraping. (defun pearl--save-outcome-detail (label status reason) "Return a human-readable detail string for LABEL at STATUS/REASON." (pcase status ('pushed (format "%s pushed" label)) ('unchanged (format "%s unchanged" label)) ('resolved-remote (format "%s took Linear's version" label)) ('conflict (format "%s left in conflict (%s)" label (or reason "unresolved"))) ('skipped (format "%s skipped (%s)" label (or reason "not pushable"))) ('failed (format "%s failed (%s)" label (or reason "error"))) (_ (format "%s: %s" label status)))) (defun pearl--save-outcome (spec status reason) "Build a save-outcome plist for SPEC with STATUS and REASON. SPEC is a field-save spec (see `pearl--run-field-save'). STATUS is one of `pushed' `unchanged' `conflict' `resolved-remote' `skipped' `failed'. REASON is nil or a symbol detailing a non-success outcome (`fetch-failed', `push-failed', `cancelled', `aborted', `read-only', `viewer-unavailable', `missing-property')." (list :issue-id (plist-get spec :issue-id) :identifier (plist-get spec :identifier) :field (plist-get spec :field) :comment-id (plist-get spec :comment-id) :status status :reason reason :label (plist-get spec :label) :message (pearl--save-outcome-detail (plist-get spec :label) status reason))) (defun pearl--marker-live-p (marker) "Non-nil if MARKER is nil, or points into a still-live buffer. A nil MARKER (synthetic callers with no buffer) passes; a marker into a killed buffer fails. Guards async commit callbacks that touch the buffer after a push the buffer may not have survived." (or (null marker) (let ((buffer (marker-buffer marker))) (and buffer (buffer-live-p buffer))))) (defun pearl--save-field-push (spec text callback) "Push TEXT for SPEC, advancing the provenance hash on success. CALLBACK gets a `pushed' outcome after any :after-push bookkeeping runs, or a `failed' / `push-failed' outcome when the update reports no success." (let ((marker (plist-get spec :marker))) (funcall (plist-get spec :push) text (lambda (result) (if (plist-get result :success) (progn ;; The push can land after the buffer was killed; only run ;; the buffer-touching bookkeeping when it's still live, but ;; still report the remote success. (when (pearl--marker-live-p marker) (org-entry-put marker (plist-get spec :prop) (secure-hash 'sha256 text)) (when (plist-get spec :after-push) (funcall (plist-get spec :after-push) result marker))) (funcall callback (pearl--save-outcome spec 'pushed nil))) (funcall callback (pearl--save-outcome spec 'failed 'push-failed))))))) (defun pearl--run-field-save (spec callback) "Save one field per SPEC, invoking CALLBACK once with a save-outcome plist. SPEC keys: :issue-id :identifier :field :comment-id :marker :prop :label :local (current text) :stored (stored hash) :fetch (FN CB, calls CB with the remote text or nil) :push (FN TEXT CB, calls CB with a (:success BOOL ...) result) :apply (FN TEXT, writes reconciled text into the buffer) :after-push \(optional FN RESULT MARKER). No-op fast path: when the local hash already equals :stored the field is `unchanged' and no fetch fires. Otherwise the remote is fetched (nil -> `failed' / `fetch-failed'), `pearl--sync-decision' runs, and the field is pushed, taken from the remote, or sent through `pearl--resolve-conflict'. CALLBACK fires exactly once, only after the final outcome is known -- including the deferred smerge path." (let* ((local (or (plist-get spec :local) "")) (stored (or (plist-get spec :stored) ""))) (if (string= (secure-hash 'sha256 local) stored) (funcall callback (pearl--save-outcome spec 'unchanged nil)) (funcall (plist-get spec :fetch) (lambda (remote) (if (null remote) (funcall callback (pearl--save-outcome spec 'failed 'fetch-failed)) (pcase (pearl--sync-decision local stored remote) (:noop (funcall callback (pearl--save-outcome spec 'unchanged nil))) (:push (pearl--save-field-push spec local callback)) (:conflict (pearl--resolve-conflict (plist-get spec :label) local remote (plist-get spec :marker) (plist-get spec :prop) (plist-get spec :apply) (lambda (text cb) (funcall (plist-get spec :push) text (lambda (r) (funcall cb (plist-get r :success))))) (lambda (status reason) (funcall callback (pearl--save-outcome spec status reason)))))))))))) (defun pearl--save-description-field (marker callback) "Save the description of the issue subtree at MARKER, calling CALLBACK. A push advances both `LINEAR-DESC-SHA256' (the markdown baseline used by the remote conflict gate) and `LINEAR-DESC-ORG-SHA256' (the rendered-Org baseline used by the local dirty scan), so the next scan sees the issue as clean." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) (local (pearl--org-to-md (pearl--entry-body-at-point))) (spec (list :issue-id issue-id :identifier identifier :field 'description :comment-id nil :marker marker :prop "LINEAR-DESC-SHA256" :local local :stored (org-entry-get nil "LINEAR-DESC-SHA256") :label (format "%s description" (or identifier issue-id)) :fetch (lambda (cb) (pearl--fetch-issue-description-async issue-id (lambda (remote) (funcall cb (and remote (plist-get remote :description)))))) :push (lambda (text cb) (pearl--update-issue-description-async issue-id text cb)) :apply (lambda (md) (org-with-point-at marker (pearl--set-entry-body-at-point (pearl--md-to-org md)))) :after-push (lambda (result m) (when (plist-get result :updated-at) (org-entry-put m "LINEAR-DESC-UPDATED-AT" (plist-get result :updated-at))))))) (pearl--run-field-save spec (lambda (outcome) ;; A push or use-remote leaves the buffer body current; resync the Org ;; hash from it so the lossless local scan agrees with the markdown one. ;; Skip when the buffer was killed before this async callback fired. (when (and (memq (plist-get outcome :status) '(pushed resolved-remote)) (pearl--marker-live-p marker)) (org-with-point-at marker (org-entry-put marker "LINEAR-DESC-ORG-SHA256" (secure-hash 'sha256 (pearl--entry-body-at-point))))) (funcall callback outcome)))))) (defun pearl--save-title-field (marker callback) "Save the issue title at MARKER, calling CALLBACK with the save outcome." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) (spec (list :issue-id issue-id :identifier identifier :field 'title :comment-id nil :marker marker :prop "LINEAR-TITLE-SHA256" :local (pearl--issue-title-at-point) :stored (org-entry-get nil "LINEAR-TITLE-SHA256") :label (format "%s title" (or identifier issue-id)) :fetch (lambda (cb) (pearl--fetch-issue-title-async issue-id (lambda (remote) (funcall cb (and remote (plist-get remote :title)))))) :push (lambda (text cb) (pearl--update-issue-title-async issue-id text cb)) :apply (lambda (title) (org-with-point-at marker (org-back-to-heading t) (org-edit-headline title)))))) (pearl--run-field-save spec callback)))) (defun pearl--save-comment-field (marker viewer-id callback) "Save the comment at MARKER, calling CALLBACK with the outcome. VIEWER-ID is the resolved viewer id (already known by the caller). A comment authored by anyone else is reported `skipped' / `read-only' with no network; only the viewer's own comments are saved through the gate." (org-with-point-at marker (let* ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) (author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) (spec (list ;; Comment headings carry LINEAR-COMMENT-ID, not LINEAR-ID, so ;; climb to the enclosing issue for the outcome's :issue-id. :issue-id (pearl--issue-id-at-point) :identifier comment-id :field 'comment :comment-id comment-id :marker marker :prop "LINEAR-COMMENT-SHA256" :local (pearl--org-to-md (pearl--entry-body-at-point)) :stored (org-entry-get nil "LINEAR-COMMENT-SHA256") :label (format "comment %s" comment-id) :fetch (lambda (cb) (pearl--fetch-comment-body-async comment-id cb)) :push (lambda (text cb) (pearl--update-comment-async comment-id text cb)) :apply (lambda (md) (org-with-point-at marker (pearl--set-entry-body-at-point (pearl--md-to-org md))))))) (cond ((null viewer-id) (funcall callback (pearl--save-outcome spec 'skipped 'viewer-unavailable))) ((not (pearl--comment-editable-p author-id viewer-id)) (funcall callback (pearl--save-outcome spec 'skipped 'read-only))) (t (pearl--run-field-save spec callback)))))) (defun pearl--report-save-outcome (outcome buffer) "Message a single field-save OUTCOME and surface BUFFER on a push. The reporter for the thin interactive wrappers (`pearl-sync-current-issue' and friends), which save one field; `pearl-save-issue' / `pearl-save-all' aggregate their own summaries instead." (message "%s" (plist-get outcome :message)) (when (memq (plist-get outcome :status) '(pushed resolved-remote)) (pearl--surface-buffer buffer))) (defun pearl--run-save-queue (thunks callback) "Run THUNKS sequentially; CALLBACK gets their outcomes, in order, at the end. Each thunk is a function of one argument DONE, which it calls with a single save-outcome when finished. The next thunk starts only after the current thunk's DONE fires, so at most one conflict-resolution UI is ever live -- the deferred smerge path pauses the queue until it commits or aborts. An empty THUNKS list calls CALLBACK with nil immediately." (let (outcomes run-next) (setq run-next (lambda (remaining) (if (null remaining) (funcall callback (nreverse outcomes)) (funcall (car remaining) (lambda (outcome) (push outcome outcomes) (funcall run-next (cdr remaining))))))) (funcall run-next thunks))) (defun pearl--save-summary-message (outcomes) "Return a one-line summary string for OUTCOMES, grouped by status. A status that carries a reason (skipped / conflict / failed) shows the first such reason next to its count." (let ((counts (make-hash-table :test 'eq)) (reasons (make-hash-table :test 'eq)) parts) (dolist (o outcomes) (let ((s (plist-get o :status))) (puthash s (1+ (gethash s counts 0)) counts) (when (and (plist-get o :reason) (not (gethash s reasons))) (puthash s (plist-get o :reason) reasons)))) (dolist (s '(pushed resolved-remote unchanged conflict skipped failed)) (let ((n (gethash s counts 0))) (when (> n 0) (push (if (gethash s reasons) (format "%d %s (%s)" n s (gethash s reasons)) (format "%d %s" n s)) parts)))) (if parts (string-join (nreverse parts) ", ") "nothing"))) (defun pearl--report-save-summary (outcomes buffer label) "Message a one-line summary of OUTCOMES under LABEL. Surface BUFFER when any field pushed. The shared close-out for `pearl-save-issue' and `pearl-save-all'." (let (pushed) (dolist (o outcomes) (when (memq (plist-get o :status) '(pushed resolved-remote)) (setq pushed t))) (message "%s: %s" label (pearl--save-summary-message outcomes)) (when pushed (pearl--surface-buffer buffer)))) (defun pearl--run-atomic-field-save (spec callback) "Save one atomic (enum/relation) field per SPEC, calling CALLBACK once. SPEC keys: :issue-id :identifier :field :marker :label; :live and :baseline \(comparison values -- a nil :baseline is a legacy file with no synced baseline); :equal (a comparator, default `equal'); :fetch-remote (FN CB; CB gets the remote comparison value or `:error'); :push (FN CB; pushes :live, CB gets a (:success BOOL) result); :commit-local (FN; advances the baseline to :live, already in the buffer); :commit-remote (FN VALUE; writes VALUE into the buffer and advances the baseline to it); :live-display (a prompt string) and :remote-display (FN VALUE -> string). The atomic three-way, the sibling of `pearl--run-field-save' for non-text fields: a missing baseline is `skipped'/`missing-property'; live equal to baseline is `unchanged'; otherwise the remote is fetched (`:error' -> `failed'/`fetch-failed') -- remote equal to live converges (advance baseline, `unchanged'), remote equal to baseline is a clean push, anything else runs `pearl--resolve-atomic-conflict'. No SHA hash and no smerge." (let* ((live (plist-get spec :live)) (baseline (plist-get spec :baseline)) (equal-fn (or (plist-get spec :equal) #'equal)) (marker (plist-get spec :marker)) (push-then-commit (lambda (cb) (funcall (plist-get spec :push) (lambda (r) ;; The push can land after the buffer was killed; only run ;; the buffer-touching commit when it's still live, but ;; still report the remote success either way. (when (and (plist-get r :success) (pearl--marker-live-p marker)) (funcall (plist-get spec :commit-local))) (funcall cb (plist-get r :success))))))) (cond ((null baseline) (funcall callback (pearl--save-outcome spec 'skipped 'missing-property))) ((funcall equal-fn live baseline) (funcall callback (pearl--save-outcome spec 'unchanged nil))) (t (funcall (plist-get spec :fetch-remote) (lambda (remote) (cond ((eq remote :error) (funcall callback (pearl--save-outcome spec 'failed 'fetch-failed))) ((funcall equal-fn remote live) (when (pearl--marker-live-p marker) (funcall (plist-get spec :commit-local))) (funcall callback (pearl--save-outcome spec 'unchanged nil))) ((funcall equal-fn remote baseline) (funcall push-then-commit (lambda (ok) (funcall callback (pearl--save-outcome spec (if ok 'pushed 'failed) (and (not ok) 'push-failed)))))) (t (pearl--resolve-atomic-conflict (plist-get spec :label) (plist-get spec :live-display) (funcall (plist-get spec :remote-display) remote) push-then-commit (lambda () (when (pearl--marker-live-p marker) (funcall (plist-get spec :commit-remote) remote))) (lambda (status reason) (funcall callback (pearl--save-outcome spec status reason)))))))))))) (defun pearl--node-assignee-id (node) "The assignee id of raw issue NODE, or \"\" when unassigned." (or (cdr (assoc 'id (cdr (assoc 'assignee node)))) "")) (defun pearl--node-assignee-name (node) "The assignee display name of raw issue NODE, or \"(unassigned)\"." (or (cdr (assoc 'name (cdr (assoc 'assignee node)))) "(unassigned)")) (defun pearl--save-assignee-field (marker callback) "Save the assignee of the issue subtree at MARKER, calling CALLBACK. Picker-authoritative: the live id is `LINEAR-ASSIGNEE-ID', diffed against `LINEAR-ASSIGNEE-ID-SYNCED'. A push sends `assigneeId' (`:null' unassigns)." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) (live (or (org-entry-get nil "LINEAR-ASSIGNEE-ID") "")) (remote-node nil) (spec (list :issue-id issue-id :identifier identifier :field 'assignee :marker marker :label (format "%s assignee" (or identifier issue-id)) :live live :baseline (org-entry-get nil "LINEAR-ASSIGNEE-ID-SYNCED") :equal #'string= :live-display (or (org-entry-get nil "LINEAR-ASSIGNEE-NAME") "(unassigned)") :remote-display (lambda (_id) (pearl--node-assignee-name remote-node)) :fetch-remote (lambda (cb) (pearl--fetch-issue-async issue-id (lambda (node) (if (memq node '(:error :missing)) (funcall cb :error) (setq remote-node node) (funcall cb (pearl--node-assignee-id node)))))) :push (lambda (cb) (pearl--update-issue-async issue-id (list (cons "assigneeId" (if (string-empty-p live) :null live))) cb)) :commit-local (lambda () (org-entry-put marker "LINEAR-ASSIGNEE-ID-SYNCED" live)) :commit-remote (lambda (remote-id) (org-entry-put marker "LINEAR-ASSIGNEE-ID" remote-id) (org-entry-put marker "LINEAR-ASSIGNEE-NAME" (pearl--node-assignee-name remote-node)) (org-entry-put marker "LINEAR-ASSIGNEE-ID-SYNCED" remote-id))))) (pearl--run-atomic-field-save spec callback)))) (defun pearl--node-priority (node) "The priority number (0-4) of raw issue NODE." (or (cdr (assoc 'priority node)) 0)) (defun pearl--node-state-id (node) "The state id of raw issue NODE, or \"\"." (or (cdr (assoc 'id (cdr (assoc 'state node)))) "")) (defun pearl--node-state-name (node) "The state name of raw issue NODE, or \"\"." (or (cdr (assoc 'name (cdr (assoc 'state node)))) "")) (defun pearl--node-label-ids (node) "The sorted label ids of raw issue NODE." (sort (mapcar (lambda (l) (or (cdr (assoc 'id l)) "")) (pearl--node-list (cdr (assoc 'labels node)))) #'string<)) (defun pearl--node-label-names (node) "The label display names of raw issue NODE, comma-separated." (mapconcat (lambda (l) (or (cdr (assoc 'name l)) "")) (pearl--node-list (cdr (assoc 'labels node))) ", ")) (defun pearl--save-priority-field (marker callback) "Save the priority of the issue subtree at MARKER, calling CALLBACK. The live value is the heading cookie's number, diffed against `LINEAR-PRIORITY'." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) (live (pearl--priority-number-at-point)) (base-str (org-entry-get nil "LINEAR-PRIORITY")) (spec (list :issue-id issue-id :identifier identifier :field 'priority :marker marker :label (format "%s priority" (or identifier issue-id)) :live live :baseline (and base-str (string-to-number base-str)) :equal #'eql :live-display (pearl--get-linear-priority-name live) :remote-display (lambda (n) (pearl--get-linear-priority-name n)) :fetch-remote (lambda (cb) (pearl--fetch-issue-async issue-id (lambda (node) (if (memq node '(:error :missing)) (funcall cb :error) (funcall cb (pearl--node-priority node)))))) :push (lambda (cb) (pearl--update-issue-async issue-id (list (cons "priority" live)) cb)) :commit-local (lambda () (org-entry-put marker "LINEAR-PRIORITY" (number-to-string live))) :commit-remote (lambda (n) (org-with-point-at marker (pearl--set-priority-cookie n)) (org-entry-put marker "LINEAR-PRIORITY" (number-to-string n)))))) (pearl--run-atomic-field-save spec callback)))) (defun pearl--save-state-field (marker callback) "Save the workflow state of the issue subtree at MARKER, calling CALLBACK. Two arms reach the live state id. Picker arm: the explicit `LINEAR-STATE-ID' moved off `LINEAR-STATE-ID-SYNCED', and that id is the live value. Keyword-cycle arm: the id is unmoved but the TODO keyword diverged from `LINEAR-STATE-NAME', so the keyword resolves to a team state id by slug match \(`pearl--resolve-keyword-to-state'). A keyword no team state matches can't be resolved, so the save is skipped. A push sends `stateId'." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) (label (format "%s state" (or identifier issue-id))) (explicit-id (or (org-entry-get nil "LINEAR-STATE-ID") "")) (synced (org-entry-get nil "LINEAR-STATE-ID-SYNCED")) (name (or (org-entry-get nil "LINEAR-STATE-NAME") "")) (picker-dirty (pearl--id-baseline-dirty-p "LINEAR-STATE-ID" "LINEAR-STATE-ID-SYNCED")) (cycled (and (not picker-dirty) (pearl--state-keyword-cycled-p))) (resolved (and cycled (pearl--resolve-keyword-to-state (org-get-todo-state) (org-entry-get nil "LINEAR-TEAM-ID")))) (live (if cycled (and resolved (plist-get resolved :id)) explicit-id)) (live-name (if cycled (and resolved (plist-get resolved :name)) name)) (remote-node nil)) (if (and cycled (not resolved)) ;; The keyword was cycled to one no team state slugifies to -- there's ;; no id to push. Report it skipped rather than guessing. (funcall callback (pearl--save-outcome (list :issue-id issue-id :identifier identifier :field 'state :label label) 'skipped 'unknown-keyword)) (let ((spec (list :issue-id issue-id :identifier identifier :field 'state :marker marker :label label :live live :baseline synced :equal #'string= :live-display live-name :remote-display (lambda (_id) (pearl--node-state-name remote-node)) :fetch-remote (lambda (cb) (pearl--fetch-issue-async issue-id (lambda (node) (if (memq node '(:error :missing)) (funcall cb :error) (setq remote-node node) (funcall cb (pearl--node-state-id node)))))) :push (lambda (cb) (pearl--update-issue-async issue-id (list (cons "stateId" live)) cb)) :commit-local (lambda () (org-with-point-at marker (pearl--set-heading-state live-name live)) (org-entry-put marker "LINEAR-STATE-ID-SYNCED" live)) :commit-remote (lambda (remote-id) (org-with-point-at marker (pearl--set-heading-state (pearl--node-state-name remote-node) remote-id)) (org-entry-put marker "LINEAR-STATE-ID-SYNCED" remote-id))))) (pearl--run-atomic-field-save spec callback)))))) (defun pearl--save-labels-field (marker callback) "Save the labels of the issue subtree at MARKER, calling CALLBACK. The live id set is `LINEAR-LABEL-IDS', diffed order-insensitively against `LINEAR-LABEL-IDS-SYNCED' (canonicalized to a sorted space-joined string). A push sends `labelIds'." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) (live-ids (sort (split-string (or (org-entry-get nil "LINEAR-LABEL-IDS") "") " " t) #'string<)) (live (string-join live-ids " ")) (base-str (org-entry-get nil "LINEAR-LABEL-IDS-SYNCED")) (remote-node nil) (spec (list :issue-id issue-id :identifier identifier :field 'labels :marker marker :label (format "%s labels" (or identifier issue-id)) :live live :baseline (and base-str (string-join (sort (split-string base-str " " t) #'string<) " ")) :equal #'string= :live-display (or (org-entry-get nil "LINEAR-LABELS") "[]") :remote-display (lambda (_) (format "[%s]" (pearl--node-label-names remote-node))) :fetch-remote (lambda (cb) (pearl--fetch-issue-async issue-id (lambda (node) (if (memq node '(:error :missing)) (funcall cb :error) (setq remote-node node) (funcall cb (string-join (pearl--node-label-ids node) " ")))))) :push (lambda (cb) (pearl--update-issue-async issue-id (list (cons "labelIds" (vconcat live-ids))) cb)) :commit-local (lambda () (org-entry-put marker "LINEAR-LABEL-IDS-SYNCED" live)) :commit-remote (lambda (remote-str) (org-entry-put marker "LINEAR-LABEL-IDS" remote-str) (org-entry-put marker "LINEAR-LABELS" (format "[%s]" (pearl--node-label-names remote-node))) (org-entry-put marker "LINEAR-LABEL-IDS-SYNCED" remote-str))))) (pearl--run-atomic-field-save spec callback)))) (defun pearl--issue-has-dirty-fields-p (dirty) "Non-nil if the DIRTY plist (from `pearl--issue-dirty-fields') has any change." (or (plist-get dirty :title) (plist-get dirty :description) (plist-get dirty :priority) (plist-get dirty :state) (plist-get dirty :assignee) (plist-get dirty :labels) (plist-get dirty :comment-candidates))) (defun pearl--save-field-thunks (marker dirty viewer-id) "Build the ordered save thunks for the DIRTY fields of the issue at MARKER. Title, then the structured fields (priority / state / assignee / labels), then description, then each changed comment candidate (VIEWER-ID gates ownership inside `pearl--save-comment-field')." (let (thunks) (when (plist-get dirty :title) (push (lambda (done) (pearl--save-title-field marker done)) thunks)) (when (plist-get dirty :priority) (push (lambda (done) (pearl--save-priority-field marker done)) thunks)) (when (plist-get dirty :state) (push (lambda (done) (pearl--save-state-field marker done)) thunks)) (when (plist-get dirty :assignee) (push (lambda (done) (pearl--save-assignee-field marker done)) thunks)) (when (plist-get dirty :labels) (push (lambda (done) (pearl--save-labels-field marker done)) thunks)) (when (plist-get dirty :description) (push (lambda (done) (pearl--save-description-field marker done)) thunks)) (dolist (c (plist-get dirty :comment-candidates)) (let ((cm (plist-get c :marker))) (push (lambda (done) (pearl--save-comment-field cm viewer-id done)) thunks))) (nreverse thunks))) (defun pearl--save-issue-at (marker buffer dirty viewer-id) "Queue and run the DIRTY field saves for the issue at MARKER, then summarize. VIEWER-ID is the resolved viewer id (or nil). BUFFER is surfaced if anything was pushed. The summary is labelled with the issue identifier." (let ((label (org-with-point-at marker (or (org-entry-get nil "LINEAR-IDENTIFIER") (org-entry-get nil "LINEAR-ID"))))) (pearl--run-save-queue (pearl--save-field-thunks marker dirty viewer-id) (lambda (outcomes) (pearl--report-save-summary outcomes buffer (format "Saved %s" label)))))) ;;;###autoload (defun pearl-save-issue () "Save every changed field of the Linear issue at point in one pass. Runs from anywhere inside an issue subtree. A local dirty scan (no network) picks which of the title, structured fields (priority / state / assignee / labels), description, and your own comments changed; the viewer is resolved once, and only if comments are dirty; then each dirty field is saved sequentially through its conflict gate and a single summary is reported. A clean issue does no network at all." (interactive) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((marker (point-marker)) (buffer (current-buffer)) (dirty (pearl--issue-dirty-fields))) (if (not (pearl--issue-has-dirty-fields-p dirty)) (message "Nothing to save for %s" (or (org-entry-get nil "LINEAR-IDENTIFIER") (org-entry-get nil "LINEAR-ID"))) (if (plist-get dirty :comment-candidates) (pearl--viewer-async (lambda (viewer) (pearl--save-issue-at marker buffer dirty (and viewer (plist-get viewer :id))))) (pearl--save-issue-at marker buffer dirty nil)))))) (defun pearl--scan-all-dirty () "Scan every issue subtree in the buffer; return ((MARKER . DIRTY) ...). One entry per issue with any locally-changed field, in buffer order. No network. This snapshots the work list at scan time -- edits made afterward wait for the next save (each field's content is still re-read at push)." (let (result) (dolist (cell (pearl--issue-subtree-markers)) (let* ((marker (cdr cell)) (dirty (org-with-point-at marker (pearl--issue-dirty-fields)))) (when (pearl--issue-has-dirty-fields-p dirty) (push (cons marker dirty) result)))) (nreverse result))) (defun pearl--save-all-counts (scan viewer-id &optional viewer-failed) "Tally the dirty fields in SCAN, classifying comments with VIEWER-ID. When VIEWER-FAILED is non-nil (the viewer lookup ran and failed), every comment candidate counts as `:viewer-unavailable' rather than being classified as own / read-only -- a nil VIEWER-ID then means \"couldn't tell\", not \"none are yours\". Returns a plist (:issues :titles :descriptions :priorities :states :assignees :labels :own-comments :read-only-comments :viewer-unavailable)." (let ((issues 0) (titles 0) (descriptions 0) (priorities 0) (states 0) (assignees 0) (labels 0) (own 0) (read-only 0) (viewer-unavailable 0)) (dolist (cell scan) (let ((dirty (cdr cell))) (setq issues (1+ issues)) (when (plist-get dirty :title) (setq titles (1+ titles))) (when (plist-get dirty :description) (setq descriptions (1+ descriptions))) (when (plist-get dirty :priority) (setq priorities (1+ priorities))) (when (plist-get dirty :state) (setq states (1+ states))) (when (plist-get dirty :assignee) (setq assignees (1+ assignees))) (when (plist-get dirty :labels) (setq labels (1+ labels))) (let ((cands (plist-get dirty :comment-candidates))) (if viewer-failed (setq viewer-unavailable (+ viewer-unavailable (length cands))) (let ((split (pearl--classify-comment-candidates cands viewer-id))) (setq own (+ own (length (plist-get split :own)))) (setq read-only (+ read-only (length (plist-get split :read-only))))))))) (list :issues issues :titles titles :descriptions descriptions :priorities priorities :states states :assignees assignees :labels labels :own-comments own :read-only-comments read-only :viewer-unavailable viewer-unavailable))) (defun pearl--save-all-prompt (counts) "Return the one-time confirmation prompt string for the dirty COUNTS plist." (let* ((titles (plist-get counts :titles)) (descriptions (plist-get counts :descriptions)) (priorities (or (plist-get counts :priorities) 0)) (states (or (plist-get counts :states) 0)) (assignees (or (plist-get counts :assignees) 0)) (labels (or (plist-get counts :labels) 0)) (own (plist-get counts :own-comments)) (read-only (plist-get counts :read-only-comments)) (viewer-unavailable (or (plist-get counts :viewer-unavailable) 0)) (fields (+ titles descriptions priorities states assignees labels own)) (issues (plist-get counts :issues)) parts skips) (when (> titles 0) (push (format "%d title%s" titles (if (= titles 1) "" "s")) parts)) (when (> descriptions 0) (push (format "%d description%s" descriptions (if (= descriptions 1) "" "s")) parts)) (when (> priorities 0) (push (format "%d priorit%s" priorities (if (= priorities 1) "y" "ies")) parts)) (when (> states 0) (push (format "%d state%s" states (if (= states 1) "" "s")) parts)) (when (> assignees 0) (push (format "%d assignee%s" assignees (if (= assignees 1) "" "s")) parts)) (when (> labels 0) (push (format "%d label%s" labels (if (= labels 1) "" "s")) parts)) (when (> own 0) (push (format "%d comment%s" own (if (= own 1) "" "s")) parts)) (when (> read-only 0) (push (format "%d read-only comment%s" read-only (if (= read-only 1) "" "s")) skips)) (when (> viewer-unavailable 0) (push (format "%d comment%s (viewer unavailable)" viewer-unavailable (if (= viewer-unavailable 1) "" "s")) skips)) (format "Save %d field%s across %d issue%s? (%s%s) " fields (if (= fields 1) "" "s") issues (if (= issues 1) "" "s") (if parts (string-join (nreverse parts) ", ") "0 fields") (if skips (concat "; " (string-join (nreverse skips) ", ") " skipped") "")))) (defun pearl--save-all-run (scan buffer viewer-id &optional viewer-failed) "Confirm SCAN once, then save all its dirty fields and report. VIEWER-ID gates comment ownership; VIEWER-FAILED marks a failed viewer lookup so the prompt counts comments as viewer-unavailable rather than read-only. BUFFER is surfaced if anything pushed. Declining the prompt mutates nothing. The queue continues past a per-field conflict, so one conflicted issue does not stop the rest." (if (not (y-or-n-p (pearl--save-all-prompt (pearl--save-all-counts scan viewer-id viewer-failed)))) (message "save-all cancelled; nothing saved") (let (thunks) (dolist (cell scan) (setq thunks (append thunks (pearl--save-field-thunks (car cell) (cdr cell) viewer-id)))) (pearl--run-save-queue thunks (lambda (outcomes) (pearl--report-save-summary outcomes buffer "Saved all")))))) ;;;###autoload (defun pearl-save-all () "Save every changed field across all Linear issues in the file, after one prompt. A local dirty scan (no network for title/description; comment changed-candidates found locally) builds the work list. When comment candidates exist and the viewer cache is cold, one read-only viewer lookup runs so read-only comments are counted -- no mutation before the prompt. A single confirmation names the field counts; declining mutates nothing. On confirm the dirty fields save sequentially, continuing past any per-field conflict, and one summary is reported. A clean file does nothing." (interactive) (let* ((buffer (current-buffer)) (scan (pearl--scan-all-dirty))) (if (null scan) (message "Nothing to save") (let ((has-comments nil)) (dolist (cell scan) (when (plist-get (cdr cell) :comment-candidates) (setq has-comments t))) (if (and has-comments (not pearl--cache-viewer)) (pearl--viewer-async (lambda (viewer) ;; A nil viewer here means the lookup failed (we only do it when ;; comments exist), so flag it -- those comments are ;; viewer-unavailable, not read-only. (pearl--save-all-run scan buffer (and viewer (plist-get viewer :id)) (null viewer)))) (pearl--save-all-run scan buffer (and pearl--cache-viewer (plist-get pearl--cache-viewer :id)))))))) (defun pearl--subtree-has-local-edits-p () "Non-nil if the issue subtree at point has any unpushed local edit. Broader than `pearl--subtree-dirty-p', which inspects only the description: this also covers a changed title, state, priority, assignee, labels, or comment. A merge refresh uses it so it keeps an issue you have touched in any field, not just ones whose description changed." (pearl--issue-has-dirty-fields-p (pearl--issue-dirty-fields))) (defun pearl--merge-issues-into-buffer (issues) "Merge normalized ISSUES into the current buffer by `LINEAR-ID'. Same-source refresh semantics: an existing issue still in ISSUES is re-rendered 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)." (let ((existing (pearl--issue-subtree-markers)) (fetched-ids (mapcar (lambda (i) (plist-get i :id)) issues)) (updated 0) (added 0) (dropped 0) (skipped 0)) ;; Existing issues still in the result: re-render in place, unless dirty. (dolist (issue issues) (let ((marker (cdr (assoc (plist-get issue :id) existing)))) (when marker (save-excursion (goto-char marker) (if (pearl--subtree-has-local-edits-p) (setq skipped (1+ skipped)) (pearl--replace-issue-subtree-at-point issue) (setq updated (1+ updated))))))) ;; Existing issues absent from the result: drop them, but keep dirty ones. (dolist (cell existing) (unless (member (car cell) fetched-ids) (save-excursion (goto-char (cdr cell)) (if (pearl--subtree-has-local-edits-p) (setq skipped (1+ skipped)) (org-back-to-heading t) (delete-region (point) (progn (org-end-of-subtree t t) (point))) (setq dropped (1+ dropped)))))) ;; Issues new to the result: append after the last one, in fetched order. (dolist (issue issues) (unless (assoc (plist-get issue :id) existing) (save-excursion (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert (pearl--format-issue-as-org-entry issue))) (setq added (1+ added)))) (list :updated updated :added added :dropped dropped :skipped skipped))) (defun pearl--update-source-header (issue-count truncated) "Refresh the active file's run-at, count, and truncation header lines. ISSUE-COUNT is the new issue total; TRUNCATED marks a page-cap hit. The `#+LINEAR-SOURCE:' descriptor is left untouched -- only the human-readable provenance advances on a refresh." (save-excursion (goto-char (point-min)) (when (re-search-forward "^#\\+LINEAR-RUN-AT: .*$" nil t) (replace-match (format "#+LINEAR-RUN-AT: %s" (format-time-string "%Y-%m-%d %H:%M")) t t)) (goto-char (point-min)) (when (re-search-forward "^#\\+LINEAR-COUNT: .*$" nil t) (replace-match (format "#+LINEAR-COUNT: %d" issue-count) t t)) (goto-char (point-min)) (when (re-search-forward "^#\\+LINEAR-TRUNCATED: .*$" nil t) (replace-match (format "#+LINEAR-TRUNCATED: %s" (if truncated "yes" "no")) t t)))) (defun pearl--update-derived-todo-header (states) "Rewrite the buffer's `#+TODO:' line from the final headings plus STATES. Scans every Linear issue heading (carrying `LINEAR-ID') for its TODO keyword and `:LINEAR-STATE-TYPE:' drawer, unions those with STATES (the fetched teams' states, see `pearl--gather-header-states'), and rewrites the line via `pearl--derive-todo-line'. Scanning the final buffer -- not just the fetched issue list -- keeps retained / skipped dirty subtrees declared. A heading with no state-type drawer (a legacy render) is classified by `org-done-keywords'. Creates the line after `#+STARTUP:' if it is absent." (save-excursion (let (scanned) (goto-char (point-min)) (while (re-search-forward "^\\*+ " nil t) (when (org-entry-get nil "LINEAR-ID") (let ((kw (org-get-todo-state)) (type (org-entry-get nil "LINEAR-STATE-TYPE"))) (when kw (push (list :name kw :type (cond ((and type (not (string-empty-p type))) type) ((member kw org-done-keywords) "completed") (t nil))) scanned))))) (let ((line (pearl--derive-todo-line (append states (nreverse scanned))))) (goto-char (point-min)) (if (re-search-forward "^#\\+TODO: .*$" nil t) (replace-match (format "#+TODO: %s" line) t t) (when (re-search-forward "^#\\+STARTUP: .*$" nil t) (end-of-line) (insert (format "\n#+TODO: %s" line)))))))) (defun pearl--merge-query-result (result source) "Merge a query RESULT into the current buffer by `LINEAR-ID', tagged with SOURCE. The same-source refresh counterpart to `pearl--render-query-result': rather than replacing the file, it updates issue subtrees in place, appends new matches, and drops issues no longer present (protecting unpushed edits per subtree), then refreshes the provenance header. An empty result leaves the buffer untouched rather than dropping every issue, mirroring the non-destructive empty handling of the replace path." (pcase (pearl--query-result-status result) ('ok (let* ((issues (pearl--sort-issues (mapcar (lambda (n) (pearl--cap-issue-list-comments (pearl--normalize-issue n))) (pearl--query-result-issues result)) (plist-get source :sort) (plist-get source :order))) (truncated (pearl--query-result-truncated-p result)) (counts (pearl--merge-issues-into-buffer issues))) (pearl--update-source-header (length issues) truncated) (pearl--update-derived-todo-header (pearl--gather-header-states issues)) (pearl-highlight-comments) (pearl--restore-page-visibility) (pearl--surface-buffer (current-buffer)) (message "Refreshed %s: %d updated, %d added, %d dropped%s" (pearl--source-name source) (plist-get counts :updated) (plist-get counts :added) (plist-get counts :dropped) (let ((s (plist-get counts :skipped))) (if (> s 0) (format ", %d kept (unpushed edits)" s) ""))))) ('empty (message "Linear: %s now matches no issues (file left unchanged)" (pearl--source-name source))) (_ (message "Linear: %s" (or (pearl--query-result-message result) "could not refresh issues"))))) ;;;###autoload (defun pearl-refresh-current-view () "Re-run the active source recorded in the current file's header and merge it in. Reads the `#+LINEAR-SOURCE:' descriptor, re-fetches it, and merges the result into this buffer by `LINEAR-ID' (see `pearl--merge-query-result'): existing issues update in place, new matches are appended, and issues no longer present are dropped, while any subtree with unpushed edits is kept. This is the same-source counterpart to the replace-on-switch behavior of the query and view commands. Errors if no source is recorded." (interactive) (let ((source (pearl--read-active-source)) (buffer (current-buffer))) (unless source (user-error "No Linear source recorded in this file; run a query or view first")) (let ((merge (lambda (result) (when (buffer-live-p buffer) (with-current-buffer buffer (pearl--merge-query-result result source)))))) (pcase (plist-get source :type) ('filter (pearl--progress "Refreshing %s..." (pearl--source-name source)) (pearl--query-issues-async (pearl--build-issue-filter (plist-get source :filter)) merge)) ('view (pearl--progress "Refreshing %s..." (pearl--source-name source)) (pearl--query-view-async (plist-get source :id) merge)) (_ (user-error "Unknown Linear source type: %s" (plist-get source :type))))))) ;;;###autoload (defun pearl-run-view (view-name) "Run a Linear Custom View by VIEW-NAME and render it into the active file. Interactively, completes over the workspace's Custom Views. The view's own filter runs server-side; the result replaces the active file (behind the dirty-buffer guard) and records the view as the active source." (interactive (list (completing-read "Custom view: " (mapcar (lambda (v) (cdr (assoc 'name v))) (pearl--custom-views)) nil t))) (let* ((view (seq-find (lambda (v) (string= (cdr (assoc 'name v)) view-name)) (pearl--custom-views))) (view-id (and view (cdr (assoc 'id view))))) (unless view-id (user-error "No Custom View named %s" view-name)) (let ((source (list :type 'view :name view-name :id view-id :url (cdr (assoc 'url view))))) (pearl--progress "Running view %s..." view-name) (pearl--query-view-async view-id (lambda (result) (pearl--render-query-result result source)))))) ;;;###autoload (defun pearl-open-current-view-in-linear () "Open the active view's source URL in the browser. Reads the recorded source from the file header; errors when the source is not a view or has no URL." (interactive) (let* ((source (pearl--read-active-source)) (url (plist-get source :url))) (unless (and url (not (string-empty-p url))) (user-error "The active source has no view URL to open")) (browse-url url))) ;;;###autoload (defun pearl--list-issues-source (project-id project-name) "Return (AUTHORING . SOURCE) for `pearl-list-issues' given PROJECT-ID/-NAME. Without PROJECT-ID this is \"my open issues\" (assignee=me). With PROJECT-ID this is the *whole* project (no assignee lock), named \"Project issues: NAME\" when PROJECT-NAME is known and \"Project issues\" otherwise." (let* ((authoring (if project-id (list :project project-id :open t) '(:assignee :me :open t))) (name (cond ((and project-id project-name) (format "Project issues: %s" project-name)) (project-id "Project issues") (t "My open issues")))) (cons authoring (list :type 'filter :name name :filter authoring)))) (defun pearl-list-issues (&optional project-id project-name) "Fetch open Linear issues into `pearl-org-file-path' and show them. Without PROJECT-ID, fetches *your* open issues (assignee=me). With PROJECT-ID, fetches every open issue in that project (no assignee scoping) -- the command named for a non-assignee dimension does not silently inject assignee=me. PROJECT-NAME, when known, is used in the source's display name. \"Open\" means any workflow state that is not completed, canceled, or duplicate. Inclusion is server-side via the issue filter; the state mapping only drives how each issue's state renders as a TODO keyword." (interactive) (pearl--log "Executing pearl-list-issues") (pearl--progress "Fetching issues from Linear...") (let* ((src (pearl--list-issues-source project-id project-name)) (authoring (car src)) (source (cdr src)) (_ (pearl--validate-issue-filter authoring)) (filter (pearl--build-issue-filter authoring))) (pearl--query-issues-async filter (lambda (result) (pearl--render-query-result result source))))) ;;;###autoload (defun pearl-list-issues-by-project () "List every open Linear issue in a chosen project (all assignees). Picks a team first (or uses `pearl-default-team-id'), then a project, then fetches via `pearl-list-issues' with no assignee scoping -- \"by project\" means the project, not your slice of it." (interactive) (let* ((team (if pearl-default-team-id (list (cons 'id pearl-default-team-id)) (pearl-select-team))) (team-id (cdr (assoc 'id team)))) (if team-id (let* ((project (pearl-select-project team-id)) (project-id (and project (cdr (assoc 'id project)))) (project-name (and project (cdr (assoc 'name project))))) (if project-id (progn (message "Fetching issues for project: %s" project-name) (pearl-list-issues project-id project-name)) (message "No project selected"))) (message "No team selected")))) ;;;###autoload (defun pearl--read-issue-label (team-id) "Prompt for an issue-type label in TEAM-ID, returning its label id (or nil). Labels are grouped by their \" - \" category prefix; the user picks a category \(or All), then a label, with a fuzzy match used directly when the typed text resolves to a single label." (let* ((issue-types (pearl-get-issue-types team-id)) (label-names (mapcar #'car issue-types)) ;; Group labels by category (e.g., "Docs", "Feature", etc.) (label-categories (let ((categories (make-hash-table :test 'equal))) (dolist (label label-names) (when-let* ((parts (split-string label " - " t)) (category (car parts))) (puthash category (cons label (gethash category categories nil)) categories))) categories)) (category-names (hash-table-keys label-categories)) ;; First select a category, then a specific label (selected-category (completing-read "Label category: " (append '("All") category-names) nil nil nil nil "All")) (filtered-labels (if (string= selected-category "All") label-names (gethash selected-category label-categories nil))) (label-prompt (completing-read (if (string= selected-category "All") "Label (type for fuzzy search): " (format "Label in %s category: " selected-category)) filtered-labels nil nil nil nil "")) (matching-labels (when (not (string-empty-p label-prompt)) (cl-remove-if-not (lambda (label-name) (string-match-p (regexp-quote label-prompt) label-name)) filtered-labels))) (selected-label-name (if (= (length matching-labels) 1) (car matching-labels) (when matching-labels (completing-read "Select specific label: " matching-labels nil t))))) (when (and selected-label-name (not (string-empty-p selected-label-name))) (cdr (assoc selected-label-name issue-types))))) (defun pearl-create-issue () "Create a new Linear issue with additional attributes." (interactive) ;; Select team first (needed for states, members, etc.) (let* ((team (if pearl-default-team-id (list (cons 'id pearl-default-team-id)) (pearl-select-team))) (team-id (cdr (assoc 'id team)))) (if team-id (let* ((title (read-string "Issue title: ")) (description (read-string "Description: ")) ;; Get workflow states (states (pearl-get-states team-id)) (state-options (when states (mapcar (lambda (state) (cons (cdr (assoc 'name state)) (cdr (assoc 'id state)))) states))) (selected-state (when state-options (cdr (assoc (completing-read "State: " state-options nil t) state-options)))) ;; Get priorities (priority-options (pearl-get-priorities)) (selected-priority (cdr (assoc (completing-read "Priority: " priority-options nil t) priority-options))) ;; Get team members for assignee (members (pearl-get-team-members team-id)) (assignee-prompt (completing-read "Assignee: " (mapcar #'car members) nil nil nil nil "")) (selected-assignee (unless (string-empty-p assignee-prompt) (cdr (assoc assignee-prompt members)))) ;; Estimate (points) (estimate (read-string "Estimate (points, leave empty for none): ")) (estimate-num (when (and estimate (not (string-empty-p estimate))) (string-to-number estimate))) ;; Issue type (label) (selected-type (pearl--read-issue-label team-id)) ;; Get project (selected-project (pearl-select-project team-id)) (selected-project-id (and selected-project (cdr (assoc 'id selected-project)))) ;; Prepare mutation (query "mutation CreateIssue($input: IssueCreateInput!) { issueCreate(input: $input) { success issue { id identifier title } } }") ;; Build input variables (input `(("title" . ,title) ("description" . ,description) ("teamId" . ,team-id) ,@(when selected-state `(("stateId" . ,selected-state))) ,@(when selected-priority `(("priority" . ,selected-priority))) ,@(when selected-assignee `(("assigneeId" . ,selected-assignee))) ,@(when estimate-num `(("estimate" . ,estimate-num))) ,@(when selected-type `(("labelIds" . [,selected-type]))) ,@(when selected-project-id `(("projectId" . ,selected-project-id))))) (response (pearl--graphql-request query `(("input" . ,input))))) (let ((issue (pearl--created-issue response))) (if issue (progn (message "Created issue %s: %s" (cdr (assoc 'identifier issue)) (cdr (assoc 'title issue))) issue) (message "Failed to create issue")))) (message "No team selected")))) ;;;###autoload (defun pearl-test-connection () "Test the connection to Linear API." (interactive) (pearl--log "Testing connection to Linear API") (pearl--progress "Testing Linear API connection...") (let* ((query "query { viewer { id name } }")) (pearl--graphql-request-async query nil (lambda (response) (if response (let ((viewer (assoc 'viewer (assoc 'data response)))) (message "Connected to Linear as: %s" (cdr (assoc 'name viewer)))) (message "Failed to connect to Linear API"))) (lambda (_error _response _data) (message "Failed to connect to Linear API"))))) ;;;###autoload (defun pearl-toggle-debug () "Toggle debug logging for Linear API requests." (interactive) (setq pearl-debug (not pearl-debug)) (message "Linear debug mode %s" (if pearl-debug "enabled" "disabled"))) ;;;###autoload (defun pearl-check-setup () "Check if Linear.el is properly set up." (interactive) (if pearl-api-key (progn (message "API key is set (length: %d). Testing connection..." (length pearl-api-key)) (pearl-test-connection)) (message "Linear API key is not set. Use M-x customize-variable RET pearl-api-key"))) ;;;###autoload (defun pearl-load-api-key-from-env () "Try to load Linear API key from environment variable." (interactive) (let ((env-key (getenv "LINEAR_API_KEY"))) (if env-key (progn (setq pearl-api-key env-key) (message "Loaded Linear API key from LINEAR_API_KEY environment variable")) (message "LINEAR_API_KEY environment variable not found or empty")))) ;;; Comment Editing (defface pearl-editable-comment '((t :inherit success)) "Face for comment headings the current user can edit." :group 'pearl) (defface pearl-readonly-comment '((((background dark)) :foreground "gray40") (((background light)) :foreground "gray60") (t :inherit shadow)) "Face for comments the current user cannot edit, dimmed to read as disabled. Darker than the stock `shadow' grey so a read-only comment clearly recedes." :group 'pearl) (defun pearl--comment-editable-p (author-id viewer-id) "Return non-nil when a comment by AUTHOR-ID is editable by VIEWER-ID. Editable only when both ids are present and equal; a nil or empty AUTHOR-ID \(bot or external comment) is never editable." (and author-id viewer-id (not (string-empty-p author-id)) (string= author-id viewer-id))) (defun pearl--viewer-async (callback) "Resolve the current Linear viewer and call CALLBACK with a plist (:id :name). Caches the result in `pearl--cache-viewer'; calls CALLBACK with nil on a transport or GraphQL failure." (if pearl--cache-viewer (funcall callback pearl--cache-viewer) (pearl--graphql-request-async "query { viewer { id name } }" nil (lambda (data) (let ((v (cdr (assoc 'viewer (assoc 'data data))))) (funcall callback (when v (setq pearl--cache-viewer (list :id (cdr (assoc 'id v)) :name (cdr (assoc 'name v)))))))) (lambda (_error _response _data) (funcall callback nil))))) (defun pearl--fetch-comment-body-async (comment-id callback) "Fetch COMMENT-ID's current body from Linear. CALLBACK is called with the markdown body string on success, or nil on error." (let ((query "query CommentBody($id: String!) { comment(id: $id) { body } }") (variables `(("id" . ,comment-id)))) (pearl--graphql-request-async query variables (lambda (data) (let ((comment (cdr (assoc 'comment (assoc 'data data))))) (funcall callback (when comment (or (cdr (assoc 'body comment)) ""))))) (lambda (_error _response _data) (funcall callback nil))))) (defun pearl--update-comment-async (comment-id body callback) "Push BODY as COMMENT-ID's text via commentUpdate. CALLBACK is called with a plist (:success BOOL)." (let ((query "mutation UpdateComment($id: String!, $body: String!) { commentUpdate(id: $id, input: {body: $body}) { success comment { id body } } }") (variables `(("id" . ,comment-id) ("body" . ,body)))) (pearl--graphql-request-async query variables (lambda (data) (let* ((payload (cdr (assoc 'commentUpdate (assoc 'data data)))) (success (eq t (cdr (assoc 'success payload))))) (funcall callback (list :success success)))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) (defun pearl--delete-comment-async (comment-id callback) "Delete COMMENT-ID on Linear via commentDelete. CALLBACK receives a plist (:success BOOL). Verified live (2026-05-25): `commentDelete' removes the comment immediately with no API restore path, so unlike `issueDelete' this is not a recoverable soft delete." (let ((query "mutation CommentDelete($id: String!) { commentDelete(id: $id) { success } }") (variables `(("id" . ,comment-id)))) (pearl--graphql-request-async query variables (lambda (data) (let ((payload (cdr (assoc 'commentDelete (assoc 'data data))))) (funcall callback (list :success (eq t (cdr (assoc 'success payload))))))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) (defun pearl--apply-comment-highlights (viewer-id) "Color every comment heading in the buffer by editability for VIEWER-ID. The viewer's own comments get `pearl-editable-comment' on the heading line; all others get `pearl-readonly-comment' over the whole comment subtree (heading and body) so a comment you cannot edit reads as disabled. Idempotent: clears prior highlights first." (save-excursion (remove-overlays (point-min) (point-max) 'pearl-comment t) (goto-char (point-min)) (while (re-search-forward "^\\*+ " nil t) ;; Point is now just past the leading stars + space. Start the overlay ;; here, not at the line beginning, so the stars (and the bullet a package ;; like org-superstar composes from them) keep org's own fontification ;; instead of being recolored by our face. (let ((text-start (point)) (comment-id (org-entry-get nil "LINEAR-COMMENT-ID"))) (when comment-id (let* ((editable (pearl--comment-editable-p (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID") viewer-id)) (face (if editable 'pearl-editable-comment 'pearl-readonly-comment)) ;; Editable: heading text only, so your own comment reads ;; normally. Read-only: through the whole subtree, dimming the ;; body too. (end (if editable (line-end-position) (save-excursion (org-end-of-subtree t t) (point)))) (ov (make-overlay text-start end))) (overlay-put ov 'pearl-comment t) (overlay-put ov 'face face))))))) ;;;###autoload (defun pearl-highlight-comments () "Color comment headings in the current buffer by who can edit them. The viewer's own comments render green (editable); others render greyed. Runs after a fetch/refresh, and is safe to invoke by hand." (interactive) (let ((buffer (current-buffer))) ;; Best-effort: highlighting is a display nicety and must never abort the ;; operation that triggered it (e.g. a missing API key errors in the ;; request layer), so a failure to resolve the viewer just skips coloring. (ignore-errors (pearl--viewer-async (lambda (viewer) (when (and viewer (buffer-live-p buffer)) (with-current-buffer buffer (pearl--apply-comment-highlights (plist-get viewer :id))))))))) ;;;###autoload (defun pearl-edit-current-comment () "Push an edit to the comment at point on Linear. Works from anywhere inside a comment's subtree. Only the current user's own comments are editable: a comment authored by anyone else (or by a bot or integration) is refused without a network call. The push is gated like the description sync -- unchanged since fetch sends nothing, a local edit against an unchanged remote pushes, and a both-sides-changed case is refused and reported (refresh to reconcile)." (interactive) (save-excursion (pearl--goto-heading-or-error "Not on a Linear comment") (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) (marker (point-marker)) (buf (current-buffer))) (unless comment-id (user-error "Not on a Linear comment")) ;; No-op fast path before resolving the viewer: an unchanged comment costs ;; no viewer lookup. The dirty check is Org-to-Org (see ;; `pearl--comment-dirty-p'), so a comment whose markdown does not survive ;; the round-trip is not falsely seen as edited. (if (not (pearl--comment-dirty-p)) (message "No comment changes to sync") (pearl--viewer-async (lambda (viewer) (pearl--save-comment-field marker (and viewer (plist-get viewer :id)) (lambda (outcome) (pearl--report-save-outcome outcome buf))))))))) ;;;###autoload (defun pearl-delete-current-comment () "Delete the comment at point on Linear after confirmation, removing its subtree. Works from anywhere inside a comment's subtree. Only your own comments are deletable: a comment authored by anyone else (or a bot/integration) is refused without a `commentDelete' call. The delete is permanent -- Linear's `commentDelete' has no API restore path -- so a locally edited comment, or one with no stored hash, gets a stronger discard-local-edits confirmation. On success the comment's Org subtree is removed; sibling comments and the issue body stay." (interactive) (save-excursion (pearl--goto-heading-or-error "Not on a Linear comment") (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) (author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) (stored (org-entry-get nil "LINEAR-COMMENT-SHA256")) (marker (point-marker)) (buf (current-buffer))) (unless comment-id (user-error "Not on a Linear comment")) (pearl--viewer-async (lambda (viewer) (cond ((null viewer) (message "Could not determine your Linear identity; not deleting")) ((not (pearl--comment-editable-p author-id (plist-get viewer :id))) (message "You can only delete your own comments")) (t ;; A clean comment (stored hash present and matching the rendered ;; body) gets the plain prompt; a locally edited body or a missing ;; hash (unknown provenance) gets the discard wording. The delete ;; proceeds either way (decision 2). (let* ((clean (and stored (string= (secure-hash 'sha256 (pearl--org-to-md (org-with-point-at marker (pearl--entry-body-at-point)))) stored))) (prompt (if clean "Delete this comment from Linear and remove it here? " "Delete this comment from Linear and discard your local edits here? "))) (when (yes-or-no-p prompt) (pearl--delete-comment-async comment-id (lambda (result) (if (plist-get result :success) (when (buffer-live-p buf) (org-with-point-at marker (org-back-to-heading t) (delete-region (point) (progn (org-end-of-subtree t t) (point)))) (message "Deleted comment from Linear") (pearl--surface-buffer buf)) (message "Failed to delete comment"))))))))))))) ;;; Transient Menu ;;;###autoload (autoload 'pearl-menu "pearl" nil t) (transient-define-prefix pearl-menu () "Dispatch menu for pearl commands." ;; Grouped to mirror the `pearl-prefix-map' categories (save / edit / new / ;; delete); fetch / view / setup are the operational groups with no keymap ;; equivalent. The org-sync commands (enable / disable / push-file) are ;; deliberately not surfaced -- they are plumbing (see the todo). ["Issue" ["Save" ("e" "save issue" pearl-save-issue) ("E" "save all" pearl-save-all)] ["Edit" ("D" "edit description" pearl-edit-description) ("M" "edit comment" pearl-edit-current-comment) ("s" "edit state" pearl-edit-state) ("a" "edit assignee" pearl-edit-assignee) ("L" "edit labels" pearl-edit-labels)] ["Create" ("n" "create issue" pearl-create-issue) ("c" "create comment" pearl-create-comment)] ["Delete" ("k" "delete issue" pearl-delete-current-issue) ("K" "delete comment" pearl-delete-current-comment)]] ["Workspace" ["Fetch" ("P" "pick source" pearl-pick-source) ("l" "my open issues" pearl-list-issues) ("p" "by project" pearl-list-issues-by-project) ("f" "build a filter" pearl-list-issues-filtered) ("v" "custom view" pearl-run-view) ("Q" "saved query" pearl-run-saved-query)] ["View" ("g" "refresh view" pearl-refresh-current-view) ("r" "refresh issue" pearl-refresh-current-issue) ("b" "open view in Linear" pearl-open-current-view-in-linear) ("o" "open issue in browser" pearl-open-current-issue)] ["Setup" ("T" "test connection" pearl-test-connection) ("C" "check setup" pearl-check-setup) ("!" "toggle debug" pearl-toggle-debug) ("x" "clear cache" pearl-clear-cache)]]) ;;; Prefix Keymap and minor mode ;; ;; A prefix keymap that makes the whole command surface reachable from the ;; keyboard. The hot-path commands sit directly under the prefix (one key); ;; the rest are grouped into category sub-maps (two keys). The most common ;; commands appear in both places -- e.g. edit-description is the direct `d' ;; and also `e d' under the edit group. ;; ;; Each binding is a (LABEL . COMMAND) menu item, so `which-key' shows the ;; verb-matched label without pearl depending on which-key. Lookups still ;; resolve straight to the command. ;; ;; `pearl-mode' (below) binds this map under `pearl-keymap-prefix' inside ;; Pearl-rendered buffers and turns on automatically, so the keys are live ;; without any global setup. To bind the map globally as well: ;; ;; (global-set-key (kbd "C-; L") pearl-prefix-map) ;; ;; Priority has no edit command -- it is edited org-natively via the heading ;; cookie (C-c , / S-up). State also cycles org-natively (C-c C-t); the ;; picker `pearl-edit-state' (e s) reaches any team state. (defvar pearl-fetch-map (let ((map (make-sparse-keymap))) (define-key map "s" (cons "pick source" #'pearl-pick-source)) (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 "v" (cons "custom view" #'pearl-run-view)) (define-key map "q" (cons "saved query" #'pearl-run-saved-query)) map) "Pearl fetch commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-edit-map (let ((map (make-sparse-keymap))) (define-key map "d" (cons "edit description" #'pearl-edit-description)) (define-key map "s" (cons "edit state" #'pearl-edit-state)) (define-key map "a" (cons "edit assignee" #'pearl-edit-assignee)) (define-key map "l" (cons "edit labels" #'pearl-edit-labels)) (define-key map "c" (cons "edit comment" #'pearl-edit-current-comment)) map) "Pearl edit commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-create-map (let ((map (make-sparse-keymap))) (define-key map "t" (cons "create issue" #'pearl-create-issue)) (define-key map "c" (cons "create comment" #'pearl-create-comment)) map) "Pearl create commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-delete-map (let ((map (make-sparse-keymap))) (define-key map "t" (cons "delete issue" #'pearl-delete-current-issue)) (define-key map "c" (cons "delete comment" #'pearl-delete-current-comment)) map) "Pearl delete commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-open-map (let ((map (make-sparse-keymap))) (define-key map "i" (cons "open issue in browser" #'pearl-open-current-issue)) (define-key map "v" (cons "open view in Linear" #'pearl-open-current-view-in-linear)) map) "Pearl open commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-copy-map (let ((map (make-sparse-keymap))) (define-key map "u" (cons "copy issue URL" #'pearl-copy-issue-url)) map) "Pearl copy commands; a sub-keymap of `pearl-prefix-map'.") (defvar pearl-prefix-map (let ((map (make-sparse-keymap))) ;; Hot path -- one key under the prefix. (define-key map "l" (cons "list my open issues" #'pearl-list-issues)) (define-key map "g" (cons "refresh view" #'pearl-refresh-current-view)) (define-key map "r" (cons "refresh issue" #'pearl-refresh-current-issue)) (define-key map "s" (cons "save issue" #'pearl-save-issue)) (define-key map "S" (cons "save all" #'pearl-save-all)) (define-key map "d" (cons "edit description" #'pearl-edit-description)) (define-key map "m" (cons "menu" #'pearl-menu)) ;; Category sub-maps -- two keys; each prefix names an action verb. (define-key map "f" (cons "+fetch" pearl-fetch-map)) (define-key map "e" (cons "+edit" pearl-edit-map)) (define-key map "c" (cons "+create" pearl-create-map)) (define-key map "k" (cons "+delete" pearl-delete-map)) (define-key map "o" (cons "+open" pearl-open-map)) (define-key map "y" (cons "+copy" pearl-copy-map)) map) "Pearl command prefix keymap. Hot-path commands are bound directly; the rest live under verb sub-maps \(fetch / edit / create / delete / open / copy). `pearl-mode' binds this under `pearl-keymap-prefix' inside Pearl buffers; you can also bind it globally \(see the Commentary above).") (defcustom pearl-keymap-prefix "C-; L" "Prefix key that `pearl-mode' binds to `pearl-prefix-map'. Inside a Pearl-rendered buffer this makes the whole command surface reachable without any global binding. Set to nil to bind nothing (then bind `pearl-prefix-map' yourself). Changing this through Customize updates `pearl-mode-map' immediately; setting it by hand needs `pearl-mode' re-enabled in already-open buffers." :type '(choice (key-sequence :tag "Prefix") (const :tag "None" nil)) :group 'pearl :set (lambda (sym val) (set-default sym val) (when (boundp 'pearl-mode-map) ;; Rebuild the mode map so a customized prefix takes effect. (setcdr pearl-mode-map nil) (when val (define-key pearl-mode-map (kbd val) pearl-prefix-map))))) (defvar pearl-mode-map (let ((map (make-sparse-keymap))) (when pearl-keymap-prefix (define-key map (kbd pearl-keymap-prefix) pearl-prefix-map)) map) "Keymap for `pearl-mode'.") ;;;###autoload (define-minor-mode pearl-mode "Minor mode for Pearl's Linear org buffers. Binds `pearl-prefix-map' under `pearl-keymap-prefix' so every Pearl command is reachable from the keyboard. Turns on automatically in any buffer Pearl rendered (one carrying a `#+LINEAR-SOURCE' header); see `pearl--maybe-enable-mode' on `org-mode-hook'." :lighter " Pearl" :keymap pearl-mode-map) (defun pearl--buffer-is-pearl-p () "Non-nil when the current buffer is a Pearl-rendered Linear file. Detected by the `#+LINEAR-SOURCE' header Pearl writes into every view; the search is bounded to the file preamble so it stays cheap on large buffers." (save-excursion (goto-char (point-min)) (let ((case-fold-search t)) (re-search-forward "^#\\+LINEAR-SOURCE:" 4000 t)))) (defun pearl--maybe-enable-mode () "Enable `pearl-mode' when the current org buffer is a Pearl Linear file. Hung on `org-mode-hook'; a no-op in any other org buffer." (when (and (derived-mode-p 'org-mode) (pearl--buffer-is-pearl-p)) (pearl-mode 1))) ;; Registered at load, not via an autoload cookie: an autoloaded hook would ;; fire before pearl is loaded (calling a void function) and would pull all of ;; pearl into every org buffer the user opens. Once any autoloaded pearl ;; command has loaded the package, this hook auto-enables the mode in Pearl ;; files; freshly fetched buffers are also enabled directly in the writer. (add-hook 'org-mode-hook #'pearl--maybe-enable-mode) (provide 'pearl) ;;; pearl.el ends here