;;; 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://github.com/cjennings/pearl ;; 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-state-to-todo-mapping '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("In Review" . "IN-REVIEW") ("Backlog" . "BACKLOG") ("Blocked" . "BLOCKED") ("Done" . "DONE")) "Mapping between Linear state names and Org TODO keywords, for rendering. Each element is a cons cell (LINEAR-STATE . ORG-STATE). It controls how a Linear state renders as an Org TODO keyword and how an Org keyword maps back on sync. It no longer decides which issues appear: inclusion is now a server-side query concern (see `pearl-list-issues'). A Linear state not listed here renders with the default TODO keyword." :type '(alist :key-type string :value-type string) :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) (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) (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--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-all-drawers))) (defvar pearl-todo-states-pattern nil "Cached regex pattern for matching Org TODO states. This pattern is generated from `pearl-state-to-todo-mapping'. Use `pearl--get-todo-states-pattern' to get the pattern.") (defvar pearl--todo-states-pattern-source nil "Mapping the cached pattern was built from. Holds the `pearl-state-to-todo-mapping' value used to build `pearl-todo-states-pattern', so the cache can be invalidated when the mapping changes.") ;; Cache variables (defvar pearl--cache-issues nil "Cache for issues.") (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))) (setq pearl--active-requests (1+ pearl--active-requests)) (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))))))) (pearl--log "Request payload: %s" request-data) (request pearl-graphql-url :type "POST" :headers (pearl--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 :open :state :state-type :project :team :labels :priority :cycle :sort :order) "Keys recognized in an issue-filter authoring plist. `:sort' and `:order' steer result ordering, not the `IssueFilter' itself.") (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))) (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)) (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))) (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. (defconst pearl--issues-query "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 } comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } } pageInfo { hasNextPage endCursor } } }" "GraphQL query for a filtered, ordered page of issues. Pulls comments per issue so a populated list renders them, not just the single-issue refresh.") (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. Same field shape as `pearl--issues-query' (which now also pulls comments); this is the single-issue refresh path.") (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)))) (defconst pearl--view-issues-query "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 } comments { nodes { id body createdAt user { id name displayName } botActor { name } externalUser { name } } } } pageInfo { hasNextPage endCursor } } } }" "GraphQL query running a Custom View's own filter server-side, by view id. Pulls comments per issue so a view-populated list renders them.") (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 } } } }") (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, issues). Use after renaming things in Linear, or to force the next lookup to refetch." (interactive) (setq pearl--cache-issues nil 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)))))) (defun pearl--update-issue-state-async (issue-id state-name team-id) "Asynchronously update a Linear issue's state. ISSUE-ID is the Linear issue ID. STATE-NAME is the target state name to set. TEAM-ID is the team ID of the issue. Gives immediate feedback and performs the API update in the background." (pearl--log "Asynchronously 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) (message "Updating issue state to %s... (in background)" state-name) (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))) (success-handler (lambda (data) (let ((success (and (assoc 'data data) (assoc 'issueUpdate (assoc 'data data)) (cdr (assoc 'success (assoc 'issueUpdate (assoc 'data data))))))) (if success (message "Successfully updated issue %s state to %s" issue-id state-name) (pearl--log "Failed to update issue state asynchronously: %s" (prin1-to-string data)) (message "Failed to update issue %s state in Linear" issue-id))))) (error-handler (lambda (error-thrown _response _data) (message "Error updating issue %s state in Linear: %s" issue-id error-thrown)))) (pearl--graphql-request-async query variables success-handler error-handler))))) ;;; 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")))) (unless (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-org-hook-function () "Sync to Linear when the configured Linear org file is saved. Fires only for the buffer visiting `pearl-org-file-path', so a custom output path is honored instead of a hardcoded \"linear.org\" name." (when (and buffer-file-name pearl-org-file-path (string-equal (file-truename buffer-file-name) (file-truename pearl-org-file-path))) (pearl--log "Linear org file saved, syncing changes to Linear API") (pearl-sync-org-to-linear))) (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"))))) (defun pearl--process-heading-at-point () "Process the Linear issue at the current org heading." (let* ((props (pearl--extract-org-heading-properties)) (todo-state (plist-get props :todo-state)) (issue-id (plist-get props :issue-id)) (issue-identifier (plist-get props :issue-identifier)) (team-id (plist-get props :team-id))) ;; Only sync when this heading is a Linear issue (has id, identifier, team). (when (and issue-id issue-identifier team-id) (let ((linear-state (pearl--map-org-state-to-linear todo-state))) (when linear-state (pearl--update-issue-state-async issue-id linear-state team-id)))))) (defun pearl-sync-org-to-linear () "Syncs change from linear.org to Linear API." (interactive) ;; If called from org-after-todo-state-change-hook, just process the current heading (if (eq this-command 'org-todo) (pearl-sync-current-heading-to-linear) ;; Otherwise, scan the entire file (save-excursion (goto-char (point-min)) (let ((todo-states-pattern (pearl--get-todo-states-pattern))) (while (re-search-forward (format "^\\*+ \\(%s\\)" todo-states-pattern) nil t) ;; Process at the heading start, but keep the outer point at the end ;; of this match so the next search advances past it. Without the ;; save-excursion, `beginning-of-line' rewinds point and the search ;; re-matches the same heading forever. (save-excursion (beginning-of-line) (pearl--process-heading-at-point))))))) (defun pearl-sync-current-heading-to-linear () "Sync the current org heading's TODO state to the Linear API. Used when directly changing a TODO state in the org buffer." (save-excursion ;; Move up to the enclosing heading. `org-back-to-heading' signals ;; "before first heading" in the preamble; guard so the sync entry point ;; degrades to a no-op there instead of erroring. (when (ignore-errors (org-back-to-heading t) t) (pearl--process-heading-at-point)))) ;;; Mapping Functions (defun pearl--map-linear-state-to-org (state) "Map Linear STATE name to an Org TODO keyword string. STATE is the Linear state string." (or (cdr (assoc state pearl-state-to-todo-mapping)) "TODO")) ; Default fallback (defun pearl--map-org-state-to-linear (todo-state) "Map an Org TODO-STATE keyword to a Linear state name. TODO-STATE is the Org keyword string." (or (car (rassoc todo-state pearl-state-to-todo-mapping)) nil)) (defun pearl--get-todo-states-pattern () "Return the regex pattern matching the Org TODO states. Built from the org keywords in `pearl-state-to-todo-mapping' and cached in `pearl-todo-states-pattern'. The cache is rebuilt when the mapping changes, so a mid-session `setq' or customization takes effect." (unless (and pearl-todo-states-pattern (eq pearl--todo-states-pattern-source pearl-state-to-todo-mapping)) ;; Pattern like "TODO\\|IN-PROGRESS\\|IN-REVIEW\\|BACKLOG\\|BLOCKED\\|DONE". (setq pearl--todo-states-pattern-source pearl-state-to-todo-mapping pearl-todo-states-pattern (mapconcat #'regexp-quote (mapcar #'cdr pearl-state-to-todo-mapping) "\\|"))) pearl-todo-states-pattern) (defun pearl--map-linear-priority-to-org (priority-num) "Convert Linear PRIORITY-NUM to an Org priority cookie. PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." (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 "[#C]"))) ; Default -> C (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 "Medium"))) (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." (let ((s line)) ;; [text](url) -> [[url][text]] (before code/emphasis touch the brackets) (setq s (replace-regexp-in-string "\\[\\([^]]+\\)\\](\\([^) ]+\\))" "[[\\2][\\1]]" s)) ;; `code` -> ~code~ (setq s (replace-regexp-in-string "`\\([^`\n]+\\)`" "~\\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-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-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. Other text passes through unchanged. Italics are word-bounded so filesystem paths and URLs are left alone." (let ((s line)) ;; [[url][text]] -> [text](url) (before verbatim/emphasis touch brackets) (setq s (replace-regexp-in-string "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" "[\\2](\\1)" s)) ;; [[url]] -> url (setq s (replace-regexp-in-string "\\[\\[\\([^]]+\\)\\]\\]" "\\1" s)) ;; ~code~ -> `code` (setq s (replace-regexp-in-string "~\\([^~\n]+\\)~" "`\\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-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)) ":END:\n" (if (string-empty-p body) "" (concat body "\n"))))) (defun pearl--format-comments (comments) "Format COMMENTS (a list of normalized comment plists) as a Comments subtree. Comments render oldest-first under a level-3 `Comments' heading. Returns the empty string when COMMENTS is nil, so an issue with no comments renders no subtree." (if (null comments) "" (let ((sorted (sort (copy-sequence comments) (lambda (a b) (string< (or (plist-get a :created-at) "") (or (plist-get b :created-at) "")))))) (concat "*** Comments\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, bracket-stripped title)." (let* ((title (or (plist-get issue :title) "")) (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--map-linear-state-to-org (plist-get state :name))) (priority (pearl--map-linear-priority-to-org (plist-get issue :priority))) (sanitized-title (replace-regexp-in-string "\\[\\|\\]" "" title)) (label-names (mapconcat (lambda (l) (or (plist-get l :name) "")) (plist-get issue :labels) ", ")) (body-org (pearl--md-to-org description))) (concat (format "** %s %s %s\n" todo priority sanitized-title) ":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-STATE-ID: %s\n" (or (plist-get state :id) "")) (format ":LINEAR-STATE-NAME: %s\n" (or (plist-get state :name) "")) (format ":LINEAR-ASSIGNEE-ID: %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-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 sanitized-title)) ":END:\n" (if (string-empty-p body-org) "" (concat body-org "\n")) (pearl--format-comments (plist-get issue :comments))))) ;;; 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) "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' is the deferred smerge flow -- for now it stashes the local text and redirects, so nothing is lost." (pcase (pearl--read-conflict-resolution label) ('cancel (message "Left %s untouched (refresh to see Linear's version)" label)) ('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)) (message "Failed to push %s" label))))) ('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)) ('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)) (message "Failed to push merged %s" label))))))))) (defvar-local pearl--conflict-on-finish nil "Callback invoked with the reconciled text when a conflict buffer commits.") (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) "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." (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) (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))) (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." (interactive) (kill-buffer (current-buffer)) (message "Conflict resolution aborted; your text is on the kill ring and in %s" pearl--conflict-backup-buffer)) (defun pearl--issue-body-at-point () "Return the description body of the Linear issue subtree at point. The body is the text after the property drawer and before the first child heading (so a Comments subtree is excluded), trimmed of surrounding whitespace. Returns the empty string when the entry has no body." (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, leaving the bare title text (which is the bracket-stripped form the renderer wrote)." (save-excursion (org-back-to-heading t) (org-get-heading t t t t))) ;;;###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. The push is gated: if the body is unchanged since the last fetch nothing is sent; if it was edited and the remote is unchanged the edit is pushed and the provenance properties advance; if both the body and the remote changed since the last fetch the push is refused and the conflict reported (refresh to reconcile)." (interactive) (save-excursion (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (stored (org-entry-get nil "LINEAR-DESC-SHA256")) (marker (point-marker))) (unless issue-id (user-error "Not on a Linear issue heading")) (let* ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) (if (string= (secure-hash 'sha256 local-md) (or stored "")) (message "No description changes to sync for %s" issue-id) (pearl--progress "Checking Linear for remote changes...") (pearl--fetch-issue-description-async issue-id (lambda (remote) (if (null remote) (message "Could not fetch %s from Linear; not syncing" issue-id) (pcase (pearl--sync-decision local-md stored (plist-get remote :description)) (:noop (message "%s already matches Linear" issue-id)) (:conflict (pearl--resolve-conflict (format "%s description" issue-id) local-md (plist-get remote :description) marker "LINEAR-DESC-SHA256" (lambda (md) (org-with-point-at marker (pearl--set-entry-body-at-point (pearl--md-to-org md)))) (lambda (md cb) (pearl--update-issue-description-async issue-id md (lambda (r) (funcall cb (plist-get r :success))))))) (:push (pearl--update-issue-description-async issue-id local-md (lambda (result) (if (plist-get result :success) (progn (org-entry-put marker "LINEAR-DESC-SHA256" (secure-hash 'sha256 local-md)) (when (plist-get result :updated-at) (org-entry-put marker "LINEAR-DESC-UPDATED-AT" (plist-get result :updated-at))) (message "Synced description for %s to Linear" issue-id) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to sync description for %s" issue-id)))))))))))))) ;;;###autoload (defun pearl-sync-current-issue-title () "Push the title edited in the heading of the issue at point to Linear. A separate path from the description sync, sharing the same conflict gate and working from anywhere inside an issue subtree. Note the title is lossy: the renderer strips square brackets, so the heading holds the stripped form and a push sends that stripped title. Gated like the description sync: unchanged title sends nothing; a local edit against an unchanged remote pushes and advances the title provenance; both-changed refuses and reports the conflict." (interactive) (save-excursion (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (stored (org-entry-get nil "LINEAR-TITLE-SHA256")) (marker (point-marker))) (unless issue-id (user-error "Not on a Linear issue heading")) (let ((local-title (pearl--issue-title-at-point))) (if (string= (secure-hash 'sha256 local-title) (or stored "")) (message "No title changes to sync for %s" issue-id) (pearl--progress "Checking Linear for remote title changes...") (pearl--fetch-issue-title-async issue-id (lambda (remote) (if (null remote) (message "Could not fetch %s from Linear; not syncing" issue-id) (pcase (pearl--sync-decision local-title stored (plist-get remote :title)) (:noop (message "%s title already matches Linear" issue-id)) (:conflict (pearl--resolve-conflict (format "%s title" issue-id) local-title (plist-get remote :title) marker "LINEAR-TITLE-SHA256" (lambda (md) (org-with-point-at marker (org-back-to-heading t) (org-edit-headline md))) (lambda (md cb) (pearl--update-issue-title-async issue-id md (lambda (r) (funcall cb (plist-get r :success))))))) (:push (pearl--update-issue-title-async issue-id local-title (lambda (result) (if (plist-get result :success) (progn (org-entry-put marker "LINEAR-TITLE-SHA256" (secure-hash 'sha256 local-title)) (message "Synced title for %s to Linear" issue-id) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to sync title for %s" issue-id)))))))))))))) (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-all-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 (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (stored (org-entry-get nil "LINEAR-DESC-SHA256")) (marker (point-marker))) (unless issue-id (user-error "Not on a Linear issue heading")) (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) ;; Stash an unpushed edit before the overwrite rather than refusing, ;; so an explicit single-issue refresh always proceeds without data loss. (unless (string= (secure-hash 'sha256 local-md) (or stored "")) (pearl--stash-conflict-text (format "%s description (pre-refresh)" issue-id) local-md)) (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 (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))))))))) (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--append-comment-to-issue (comment) "Insert COMMENT (a normalized plist) under the issue subtree at point. Appends after any existing comments in the issue's `Comments' subtree, creating that 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 (when (re-search-forward "^\\*+ Comments[ \t]*$" issue-end t) (match-beginning 0))))) (if comments-pos (progn (goto-char comments-pos) (org-end-of-subtree t t) (insert (pearl--format-comment comment))) (goto-char issue-end) (insert "*** Comments\n" (pearl--format-comment comment)))))) ;;;###autoload (defun pearl-add-comment (body) "Add a comment with BODY to the Linear issue at point and insert it. Works from anywhere inside an issue subtree. The new comment is the viewer's own, so it renders editable; edit it later with `pearl-edit-current-comment'." (interactive "sComment: ") (save-excursion (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (marker (point-marker))) (unless issue-id (user-error "Not on a Linear issue heading")) (pearl--progress "Adding comment to %s..." issue-id) (pearl--create-comment-async issue-id body (lambda (comment) (if (null comment) (message "Failed to add comment to %s" issue-id) (save-excursion (goto-char marker) (pearl--append-comment-to-issue comment)) (pearl-highlight-comments) (pearl--surface-buffer (marker-buffer marker)) (message "Added comment to %s" issue-id))))))) ;;;###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 (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (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))) (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) (unless (save-excursion (ignore-errors (org-back-to-heading t) t)) (user-error "Not on a Linear issue heading")) (let* ((marker (save-excursion (org-back-to-heading t) (point-marker))) (issue-id (org-entry-get marker "LINEAR-ID")) (ident (or (org-entry-get marker "LINEAR-IDENTIFIER") "this issue"))) (unless issue-id (user-error "Not on a Linear issue heading")) (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)))))) (defconst pearl--priority-choices '(("None" . 0) ("Urgent" . 1) ("High" . 2) ("Medium" . 3) ("Low" . 4)) "Linear priority names mapped to their numeric API values.") (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)))))) ;;;###autoload (defun pearl-set-priority (priority-name) "Set the priority of the Linear issue at point to PRIORITY-NAME. Interactively, completes over None/Urgent/High/Medium/Low. Pushes the numeric priority to Linear and rewrites the heading cookie on success. Works from anywhere inside an issue subtree." (interactive (list (completing-read "Priority: " pearl--priority-choices nil t))) (save-excursion (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let ((issue-id (org-entry-get nil "LINEAR-ID")) (priority-num (cdr (assoc priority-name pearl--priority-choices))) (marker (point-marker))) (unless issue-id (user-error "Not on a Linear issue heading")) (unless priority-num (user-error "Unknown priority: %s" priority-name)) (pearl--update-issue-async issue-id `(("priority" . ,priority-num)) (lambda (result) (if (plist-get result :success) (progn (save-excursion (goto-char marker) (pearl--set-priority-cookie priority-num)) (message "Set %s priority to %s" issue-id priority-name) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to set priority for %s" issue-id))))))) (defun pearl--set-heading-state (state-name state-id) "Update the heading at point to STATE-NAME / STATE-ID. Rewrites the TODO keyword (mapped from STATE-NAME) and the LINEAR-STATE-NAME / LINEAR-STATE-ID drawer properties. The Linear org-todo sync hook is inhibited during the keyword change so updating the keyword here does not trigger a second push back to Linear." (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--map-linear-state-to-org state-name))))) ;;;###autoload (defun pearl-set-state (state-name) "Set the workflow state of the Linear issue at point to STATE-NAME. Interactively, completes over the issue team's workflow states. Pushes the resolved state id to Linear and updates the heading keyword and drawer on success. 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 "State: " (mapcar (lambda (s) (cdr (assoc 'name s))) (and team-id (pearl--team-states team-id))) nil t)))) (save-excursion (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (team-id (org-entry-get nil "LINEAR-TEAM-ID")) (marker (point-marker)) (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 issue-id (user-error "Not on a Linear issue heading")) (unless state-id (user-error "No workflow state named %s in this team" state-name)) (pearl--update-issue-async issue-id `(("stateId" . ,state-id)) (lambda (result) (if (plist-get result :success) (progn (save-excursion (goto-char marker) (pearl--set-heading-state state-name state-id)) (message "Set %s state to %s" issue-id state-name) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to set state for %s" issue-id))))))) (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-set-assignee (assignee-name) "Set the assignee of the Linear issue at point to ASSIGNEE-NAME. Interactively, completes over the issue team's members. Resolves the name to a user id, pushes it, and updates the assignee drawer on success. 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 (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (team-id (org-entry-get nil "LINEAR-TEAM-ID")) (marker (point-marker)) (assignee-id (and team-id (pearl--resolve-team-id 'members assignee-name team-id)))) (unless issue-id (user-error "Not on a Linear issue heading")) (unless assignee-id (user-error "No team member matching %s" assignee-name)) (pearl--update-issue-async issue-id `(("assigneeId" . ,assignee-id)) (lambda (result) (if (plist-get result :success) (progn (save-excursion (goto-char marker) (org-entry-put nil "LINEAR-ASSIGNEE-NAME" assignee-name) (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id)) (message "Set %s assignee to %s" issue-id assignee-name) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to set assignee for %s" issue-id))))))) ;;;###autoload (defun pearl-set-labels (label-names) "Set the labels of the Linear issue at point to LABEL-NAMES. Interactively, completes (multiple) over the issue team's labels; an empty selection clears the labels. Resolves each name to a label id, pushes the id list, and updates the labels drawer on success. 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 (unless (ignore-errors (org-back-to-heading t) t) (user-error "Not on a Linear issue heading")) (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (team-id (org-entry-get nil "LINEAR-TEAM-ID")) (marker (point-marker)) (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))) (unless issue-id (user-error "Not on a Linear issue heading")) (pearl--update-issue-async issue-id `(("labelIds" . ,label-ids)) (lambda (result) (if (plist-get result :success) (progn (save-excursion (goto-char marker) (org-entry-put nil "LINEAR-LABELS" (format "[%s]" (mapconcat #'identity label-names ", ")))) (message "Set %s labels to %s" issue-id (if label-names (mapconcat #'identity label-names ", ") "none")) (pearl--surface-buffer (marker-buffer marker))) (message "Failed to set labels for %s" issue-id))))))) ;;; 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--build-org-content (issues &optional source truncated) "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. 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 (insert (format "#+title: Linear — %s\n" name)) (insert "#+STARTUP: show3levels\n") (insert (format "#+TODO: %s\n" (if (bound-and-true-p org-todo-keywords) (let ((seq (car org-todo-keywords))) (mapconcat #'identity (cdr seq) " ")) "TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE"))) ;; 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-sync-current-issue to push.\n") (insert "# Comments subtree = the thread; add with M-x pearl-add-comment.\n") (insert "# Drawer fields change via M-x pearl-set-priority / -state / -assignee / -labels.\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--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: do not overwrite. Log and emit a message asking the user to save or revert before re-running. 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) (new-content (pearl--build-org-content issues source truncated)) (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--restore-page-visibility)) (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))) (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 -- defer, do not overwrite, but show it. (t (pearl--log "Linear refresh deferred: %s has unsaved changes (%d issues not written)" org-file-path (length issues)) (message "Linear refresh deferred: %s has unsaved changes. Save or revert, then re-run M-x pearl-list-issues." (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))) (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))))) (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)) (when assignee (list :assignee 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. 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))) (unless (string-empty-p p) p)))) (labels (and team-id (completing-read-multiple "Labels (comma-separated, empty for none): " (pearl--team-collection-names 'labels team-id)))) (assignee (pcase (completing-read "Assignee (me / any): " '("me" "any") nil t "any") ("me" :me) (_ nil)))) (pearl--assemble-filter (and (not (string-empty-p team-name)) team-name) 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 as a local query? ") (read-string "Query name: ")))) (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--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 #'pearl--normalize-issue (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--issue-body-at-point)) org-hash)) (let ((stored (org-entry-get nil "LINEAR-DESC-SHA256")) (local-md (pearl--org-to-md (pearl--issue-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))) (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 whose body has unpushed edits (see `pearl--subtree-dirty-p') 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-dirty-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-dirty-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--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 #'pearl--normalize-issue (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-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 (&optional project-id) "Fetch my open Linear issues into `pearl-org-file-path' and show them. With PROJECT-ID, narrow to that project. \"Open\" means any workflow state that is not completed, canceled, or duplicate. Runs asynchronously. 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* ((authoring `(:assignee :me :open t ,@(when project-id (list :project project-id)))) (source (list :type 'filter :name (if project-id "My open issues in project" "My open issues") :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 Linear issues filtered by a selected project. Uses async API for better performance." (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))))) (if project-id (progn (message "Fetching issues for project: %s" (cdr (assoc 'name project))) (pearl-list-issues project-id)) (message "No project selected"))) (message "No team selected")))) ;;;###autoload (defun pearl-new-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) (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)))) (selected-type (when (and selected-label-name (not (string-empty-p selected-label-name))) (cdr (assoc selected-label-name issue-types)))) ;; 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")))) ;;; Org Mode Sync Hooks ;;;###autoload (defun pearl-enable-org-sync () "Enable synchronization between org mode and Linear." (interactive) (add-hook 'after-save-hook #'pearl-org-hook-function nil t) (add-hook 'org-after-todo-state-change-hook #'pearl-sync-org-to-linear nil t) (pearl-highlight-comments) (message "Linear-org synchronization enabled")) ;;;###autoload (defun pearl-disable-org-sync () "Disable synchronization between org mode and Linear." (interactive) (remove-hook 'after-save-hook #'pearl-org-hook-function t) (remove-hook 'org-after-todo-state-change-hook #'pearl-sync-org-to-linear t) (message "Linear-org synchronization disabled")) ;;; Comment Editing (defface pearl-editable-comment '((t :inherit success)) "Face for comment headings the current user can edit." :group 'pearl) (defface pearl-readonly-comment '((t :inherit shadow)) "Face for comment headings the current user cannot edit." :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--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'; all others get `pearl-readonly-comment'. 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) (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID"))) (when comment-id (let* ((author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) (face (if (pearl--comment-editable-p author-id viewer-id) 'pearl-editable-comment 'pearl-readonly-comment)) (ov (make-overlay (line-beginning-position) (line-end-position)))) (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 from `pearl-enable-org-sync', 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 (unless (ignore-errors (org-back-to-heading t) t) (user-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))) (unless comment-id (user-error "Not on a Linear comment")) ;; `pearl--issue-body-at-point' reads the text after the drawer and before ;; the first child heading -- a comment subtree has that same shape, so the ;; description path's body reader serves the comment body unchanged. (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) (if (string= (secure-hash 'sha256 local-md) (or stored "")) (message "No comment changes to sync") (pearl--viewer-async (lambda (viewer) (cond ((null viewer) (message "Could not determine your Linear identity; not editing")) ((not (pearl--comment-editable-p author-id (plist-get viewer :id))) (message "You can only edit your own comments")) (t (pearl--progress "Checking Linear for remote changes...") (pearl--fetch-comment-body-async comment-id (lambda (remote-md) (if (null remote-md) (message "Could not fetch the comment from Linear; not syncing") (pcase (pearl--sync-decision local-md stored remote-md) (:noop (message "Comment already matches Linear")) (:conflict (pearl--resolve-conflict "comment" local-md remote-md marker "LINEAR-COMMENT-SHA256" (lambda (md) (org-with-point-at marker (pearl--set-entry-body-at-point (pearl--md-to-org md)))) (lambda (md cb) (pearl--update-comment-async comment-id md (lambda (r) (funcall cb (plist-get r :success))))))) (:push (pearl--update-comment-async comment-id local-md (lambda (result) (if (plist-get result :success) (progn (org-entry-put marker "LINEAR-COMMENT-SHA256" (secure-hash 'sha256 local-md)) (message "Synced comment to Linear") (pearl--surface-buffer (marker-buffer marker))) (message "Failed to sync comment")))))))))))))))))) ;;; Transient Menu ;;;###autoload (autoload 'pearl-menu "pearl" nil t) (transient-define-prefix pearl-menu () "Dispatch menu for pearl commands." ["Linear" ["Fetch" ("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)] ["Issue at point" ("e" "Edit desc -> push" pearl-sync-current-issue) ("t" "Edit title -> push" pearl-sync-current-issue-title) ("s" "Set state" pearl-set-state) ("a" "Set assignee" pearl-set-assignee) ("P" "Set priority" pearl-set-priority) ("L" "Set labels" pearl-set-labels) ("c" "Add comment" pearl-add-comment) ("M" "Edit comment" pearl-edit-current-comment) ("k" "Delete issue" pearl-delete-current-issue) ("o" "Open in browser" pearl-open-current-issue)] ["Create & org-sync" ("n" "New issue" pearl-new-issue) ("E" "Enable org-sync" pearl-enable-org-sync) ("X" "Disable org-sync" pearl-disable-org-sync) ("u" "Push file -> Linear" pearl-sync-org-to-linear)] ["Setup" ("T" "Test connection" pearl-test-connection) ("C" "Check setup" pearl-check-setup) ("!" "Toggle debug" pearl-toggle-debug) ("x" "Clear cache" pearl-clear-cache)]]) (provide 'pearl) ;;; pearl.el ends here