eca-util.el

;;; eca-util.el --- ECA (Editor Code Assistant) util -*- lexical-binding: t; -*-
;; Copyright (C) 2025 Eric Dallo
;;
;; SPDX-License-Identifier: Apache-2.0
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;;  The ECA (Editor Code Assistant) utils.
;;
;;; Code:

(require 'cl-lib)
(require 'dash)
(require 'f)
(require 'transient nil t)

(declare-function eca-api-notify "eca-api")

(defcustom eca-buttons-allow-mouse nil
  "Whether to allow mouse clicks on ECA buttons."
  :type 'boolean
  :group 'eca)

(defcustom eca-find-root-for-buffer-function #'eca-find-root-for-buffer
  "Function for getting the ECA's session root."
  :type 'function
  :group 'eca)

(defcustom eca-worktree-mode 'merged
  "How ECA handles git worktrees of the same repository.

- `merged': all worktrees share one ECA session and chat history.
  New worktrees are dynamically added to the running session when
  a file inside them is visited.  This is the default since 0.110.0
  and is efficient when you want a unified AI context across branches.

- `isolated': each worktree gets its own independent ECA session,
  chat history, and cache.  Toggle-window, resume, and agent context
  all scope to the individual worktree.  This matches the behaviour
  prior to 0.110.0 and is preferred for parallel worktree workflows."
  :type '(choice (const :tag "Merged (shared session per repo)" merged)
          (const :tag "Isolated (independent session per worktree)" isolated))
  :group 'eca)

(defun eca-uuid ()
  "Return a fresh v4-style UUID string.

Uses Emacs's pseudo-random generator reseeded from system entropy
on every call so consecutive ids inside the same Emacs session do
not repeat across, e.g., quickly-clicked \"+ new chat\" tabs.  Used
for client-generated `chatId' values sent to the eca server."
  (random t)
  (format "%04x%04x-%04x-4%03x-%01x%03x-%04x%04x%04x"
          (random 65536) (random 65536)
          (random 65536)
          (logand (random 65536) #x0fff)
          (logior #x8 (logand (random 16) #x3))
          (logand (random 65536) #x0fff)
          (random 65536) (random 65536) (random 65536)))

(defun eca-assoc (map key val)
  "Return a new MAP with KEY associated to flat plist VAL, replacing any existing."
  (cons (cons key val)
        (cl-remove-if (lambda (pair) (equal (car pair) key)) map)))

(defun eca-dissoc (map key)
  "Return a new MAP with KEY removed."
  (cl-remove-if (lambda (pair) (equal (car pair) key)) map))

(defun eca-get (map key)
  "Return the plist value associated with KEY in MAP, or nil."
  (let ((pair (cl-find key map :key #'car :test #'equal)))
    (when pair (cdr pair))))

(defun eca-vals (map)
  "Return the plist values from MAP."
  (-map #'cdr map))

(defun eca-plist-equal (plist1 plist2)
  "Check if PLIST1 is equal to PLIST2."
  (and (= (length plist1) (length plist2))
       (cl-loop for (key val) on plist1 by #'cddr
                always (equal val (plist-get plist2 key)))))

(defun eca--property-run-bounds (pos prop)
  "Return (START . END) of the run of text property PROP at POS, or nil.
The run is the text around POS whose PROP value is `eq' to the one
at POS, so two adjacent items propertized separately are two runs."
  (when-let* ((value (and pos (get-text-property pos prop))))
    (cons (if (and (> pos (point-min))
                   (eq value (get-text-property (1- pos) prop)))
              (previous-single-property-change pos prop nil (point-min))
            pos)
          (next-single-property-change pos prop nil (point-max)))))

(defvar-local eca--session-id-cache nil)

(defvar eca--sessions '())
(defvar eca--session-ids 0)

(defvar eca-session-deleting-functions nil
  "Functions called before an ECA session is deleted.
Each function receives the session being deleted.")

(defvar eca-sessions-updated-hook nil
  "Normal hook run after a ECA session is created or deleted.")

(cl-defstruct eca--session
  ;; id to manage multiple eca sessions
  (id nil)

  ;; The status of this session
  (status 'stopped)

  ;; The eca <process>
  (process nil)

  ;; the chat buffers
  (chats '())

  (last-chat-buffer nil)

  ;; The chat currently being hydrated by a chat/open request.
  (opening-chat-id nil)

  ;; A list of workspace folders of this session
  (workspace-folders '())

  ;; A plist of request method names (strings) -> handlers used when
  ;; receiving requests from server.
  (request-handlers '())

  ;; A plist of client request ids -> handlers for pending requests used when
  ;; receiving responses from server.
  (response-handlers '())

  ;; The suported models by the server.
  (models '())

  ;; The servers and their status.
  (tool-servers '())

  ;; The supported chat agents by the server.
  (chat-agents nil)

  ;; The available variants for the current model.
  (chat-variants '())

  ;; Selection defaults inherited by new chats in this session.
  (chat-default-model nil)
  (chat-default-agent nil)
  (chat-default-variant nil)
  (chat-default-trust nil)

  ;; The welcome message for new chats.
  (chat-welcome-message "")

  ;; The global config file path the server reads, from `initialize'.
  (global-config-path nil)

  ;; Init progress tasks alist: (taskId . plist) where plist has :title :type
  (init-tasks nil)

  ;; Provider status list from providers/list response.
  (providers nil)

  ;; Background jobs list from jobs/list and jobs/updated.
  (jobs nil))

(defun eca-find-root-for-buffer ()
  "Return the path that first matches the following:
- Buffer is within an existent eca session workspace-folder.
- Use `project` to return the project root if available.
- Otherwise return buffer file or `default-directory`."
  (let* ((default-path (or (when buffer-file-name (file-name-directory buffer-file-name))
                           default-directory))
         (existing-sessions-folders (-keep (lambda (session)
                                             (--first (or (f-same? it default-path)
                                                          (f-ancestor-of? it default-path))
                                                      (eca--session-workspace-folders session)))
                                           (eca-vals eca--sessions))))
    (or (when existing-sessions-folders
          (-max-by (lambda (a b)
                     (> (length (expand-file-name a))
                        (length (expand-file-name b))))
                   existing-sessions-folders))
        (when (fboundp 'project-current)
          (when-let* ((project (project-current)))
            (if (fboundp 'project-root)
                (project-root project)
              (car (with-no-warnings
                     (project-roots project))))))
        default-path)))

(defvar eca--git-common-dir-cache (make-hash-table :test 'equal)
  "Cache of expanded dir -> git common dir (or `:none') lookups.
Avoids spawning a git process on every `eca-session' resolution;
cleared whenever a session is created or deleted.")

(defun eca--git-common-dir (dir)
  "Return the absolute git common dir for DIR, or nil if not in a git repo.
Uses `git rev-parse --git-common-dir` to find the shared git
directory, which is the same for all worktrees of a repository.
Results are cached in `eca--git-common-dir-cache' since this can
be called repeatedly (e.g. resolving sessions from timers) and
spawning git each time causes visible lag (#275)."
  (let* ((dir (expand-file-name dir))
         (cached (gethash dir eca--git-common-dir-cache)))
    (if cached
        (unless (eq cached :none) cached)
      (let* ((default-directory dir)
             (output (ignore-errors
                       (string-trim
                        (with-output-to-string
                          (with-current-buffer standard-output
                            ;; TRAMP-aware, no intermediate shell,
                            ;; stderr discarded.
                            (process-file "git" nil '(t nil) nil
                                          "rev-parse" "--git-common-dir"))))))
             (result (when (and output
                                (not (string-empty-p output))
                                ;; Git < 2.5 echoes the flag back literally
                                (not (string= output "--git-common-dir")))
                       (expand-file-name output default-directory))))
        (puthash dir (or result :none) eca--git-common-dir-cache)
        result))))

(defun eca--paths-nested-p (a b)
  "Return non-nil when paths A and B are equal or nested.
Two paths are nested when one is an ancestor directory of the
other.  Both paths are normalized via `file-truename' and
compared with a trailing slash to avoid prefix false-positives
\(e.g. \"/foo\" matching \"/foobar\")."
  (let ((a (file-name-as-directory (file-truename (expand-file-name a))))
        (b (file-name-as-directory (file-truename (expand-file-name b)))))
    (or (string= a b)
        (string-prefix-p a b)
        (string-prefix-p b a))))

(defun eca--session-for-worktree (root)
  "Find a session whose workspace shares the same git repo as ROOT.
Returns the session if ROOT is a git worktree (or regular repo) that
shares the same `git-common-dir' as one of an existing session's
workspace folders AND is not in an ancestor/descendant relationship
with that folder.  True git worktrees are always sibling directories,
never nested, so a match where one path contains the other indicates
ROOT is merely a sub- or super-directory of an existing folder rather
than a separate worktree (typical case: $HOME is a dotfiles git repo
and the user starts ECA on a subdirectory, or vice versa).  Returns
nil otherwise."
  (when-let* ((root-common-dir (eca--git-common-dir root)))
    (-first (lambda (session)
              (--first (when-let* ((folder-common-dir (eca--git-common-dir it)))
                         (and (string= (file-truename root-common-dir)
                                       (file-truename folder-common-dir))
                              (not (eca--paths-nested-p root it))))
                       (eca--session-workspace-folders session)))
            (eca-vals eca--sessions))))

(defun eca--session-add-workspace-folder (session folder)
  "Add FOLDER to SESSION's workspace-folders and notify the server."
  (let ((folder (directory-file-name (expand-file-name folder))))
    (unless (--first (string= it folder)
                     (eca--session-workspace-folders session))
      (setf (eca--session-workspace-folders session)
            (append (eca--session-workspace-folders session) (list folder)))
      (eca-api-notify
       session
       :method "workspace/didChangeWorkspaceFolders"
       :params (list :event
                     (list :added (vector
                                   (list :uri (eca--path-to-uri folder)
                                         :name (file-name-nondirectory (directory-file-name folder))))
                           :removed [])))
      (eca-info "Added workspace folder: %s" folder))))

(defun eca--session-remove-workspace-folder (session folder)
  "Remove FOLDER from SESSION's workspace-folders and notify the server.
Refuses to remove the last remaining folder, since the Emacs client
resolves buffers to sessions by matching against workspace-folders and
an empty list would make the session unreachable.  In `merged' worktree
mode, a removed folder whose git-common-dir still matches another
folder in the session can be auto-re-added by `eca-session' the next
time a buffer under it is visited."
  (let* ((folder (directory-file-name (expand-file-name folder)))
         (folders (eca--session-workspace-folders session)))
    (cond
     ((not (--first (string= it folder) folders))
      (eca-warn "Workspace folder not found: %s" folder))
     ((<= (length folders) 1)
      (user-error "Cannot remove the last workspace folder"))
     (t
      (setf (eca--session-workspace-folders session)
            (cl-remove-if (lambda (it) (string= it folder)) folders))
      (eca-api-notify
       session
       :method "workspace/didChangeWorkspaceFolders"
       :params (list :event
                     (list :added []
                           :removed (vector
                                     (list :uri (eca--path-to-uri folder)
                                           :name (file-name-nondirectory (directory-file-name folder)))))))
      (eca-info "Removed workspace folder: %s" folder)))))

(defun eca-session ()
  "Return the session related to root of current buffer otherwise nil."
  (or (eca-get eca--sessions eca--session-id-cache)
      (let* ((root (directory-file-name
                    (expand-file-name (funcall eca-find-root-for-buffer-function))))
             (session (or (-first (lambda (session)
                                    (--first (string= it root)
                                             (eca--session-workspace-folders session)))
                                  (eca-vals eca--sessions))
                          ;; Worktree fallback: only in merged mode, find a session
                          ;; sharing the same git repo and add this worktree to it.
                          ;; In isolated mode each worktree gets its own session.
                          (when (eq eca-worktree-mode 'merged)
                            (when-let* ((worktree-session (eca--session-for-worktree root)))
                              (eca--session-add-workspace-folder worktree-session root)
                              worktree-session)))))
        (when session
          (setq-local eca--session-id-cache (eca--session-id session)))
        session)))

(defun eca-session-for-root (root)
  "Return the running session owning ROOT."
  (let ((root (directory-file-name (expand-file-name root))))
    (-first (lambda (session)
              (--first (or (f-same? it root)
                           (f-ancestor-of? it root))
                       (eca--session-workspace-folders session)))
            (eca-vals eca--sessions))))

(defun eca-create-session (workspace-roots)
  "Create a new ECA session for WORKSPACE-ROOTS."
  (clrhash eca--git-common-dir-cache)
  (let ((session (make-eca--session))
        (id (cl-incf eca--session-ids)))
    (setf (eca--session-id session) id)
    (setf (eca--session-workspace-folders session)
          (-distinct (--map (directory-file-name (expand-file-name it)) workspace-roots)))
    (setf (eca--session-chat-default-trust session)
          (and (boundp 'eca-chat-trust-enable)
               (symbol-value 'eca-chat-trust-enable)))
    (setq eca--sessions (eca-assoc eca--sessions id session))
    (run-hooks 'eca-sessions-updated-hook)
    session))

(defun eca--session-project-name (session)
  "Return the project name for SESSION.
Extracts the last directory component from the first
workspace folder. Falls back to \"unknown\"."
  (if-let* ((roots (eca--session-workspace-folders session))
            (root (car roots)))
      (file-name-nondirectory (directory-file-name root))
    "unknown"))

(defun eca-delete-session (session)
  "Delete SESSION from existing sessions."
  (when session
    (with-demoted-errors "eca-session-deleting-functions: %S"
      (run-hook-with-args 'eca-session-deleting-functions session))
    (clrhash eca--git-common-dir-cache)
    (setq eca--sessions
          (eca-dissoc eca--sessions (eca--session-id session)))
    (run-hooks 'eca-sessions-updated-hook)))

(defun eca-assert-session-running (session)
  "Assert that a eca SESSION is running."
  (unless session
    (user-error "ECA must be running, no session found, start with `eca` command")))

(defvar eca--uri-file-prefix (pcase system-type
                               (`windows-nt "file:///")
                               (_ "file://"))
  "Prefix for a file-uri.")

(defun eca--path-to-uri (path)
  "Convert a PATH to a uri."
  (concat eca--uri-file-prefix
          (--> path
               (expand-file-name it)
               (or (file-remote-p it 'localname) it)
               (eca--path-local-to-remote it))))

(defun eca--uri-to-path (uri)
  "Convert a file URI to a file path."
  (let ((path (cond
               ((string-prefix-p "file:///" uri)
                (url-unhex-string
                 (substring uri (if (eq system-type 'windows-nt) 8 7))))

               ((string-prefix-p "file://" uri)
                (url-unhex-string (substring uri 6)))

               (t uri))))
    (eca--path-remote-to-local path)))

(defcustom eca-local-to-remote-prefix-map nil
  "Alist of (LOCAL-PATH . REMOTE-PATH) for Docker or remote servers.
The longest matching prefix wins.

  \\='((\"/Users/me/dev\" . \"/workspace\")
    (\"/Users/me/dev/special\" . \"/custom\"))
  ;; /Users/me/dev/project → /workspace/project
  ;; /Users/me/dev/special → /custom"
  :type '(alist :key-type string :value-type string)
  :group 'eca)

(defvar eca--path-session nil
  "Session used to derive TRAMP path mappings.
Bound dynamically while handling server messages so path
translation uses the session owning the message instead of
resolving one from the current buffer.")

(defun eca--path-mappings ()
  "Return merged path mappings for translation.
Combines explicit `eca-local-to-remote-prefix-map' entries with
implicit mappings derived from TRAMP workspace folders.  Each
TRAMP folder like \"/docker:container:/workspace/project\" yields
a mapping (\"/docker:container:/workspace/project\" . \"/workspace/project\").
Folders come from `eca--path-session' when bound, otherwise from
the current buffer's session."
  (append
   eca-local-to-remote-prefix-map
   (when-let* ((session (or eca--path-session
                            (ignore-errors (eca-session))))
               (folders (eca--session-workspace-folders session)))
     (delq nil
           (mapcar
            (lambda (folder)
              (when (file-remote-p folder)
                (cons folder (file-local-name folder))))
            folders)))))

(defun eca--path--translate (path from-fn to-fn expand-from-p)
  "Translate PATH using explicit and TRAMP-derived path mappings.
FROM-FN extracts the side of each mapping to match against PATH;
TO-FN extracts the side to substitute in.  If EXPAND-FROM-P is
non-nil, expand the from-side path.  The longest matching prefix
wins; explicit user mappings take priority over TRAMP-derived ones
for equal-length prefixes."
  (let* ((ensure-slash (lambda (s) (if (string-suffix-p "/" s) s (concat s "/"))))
         (strip-slash (lambda (s) (if (string-suffix-p "/" s) (substring s 0 -1) s)))
         (sorted (sort (copy-sequence (eca--path-mappings))
                       (lambda (a b)
                         (let ((la (length (funcall from-fn a)))
                               (lb (length (funcall from-fn b))))
                           (if (= la lb)
                               (let ((explicit-a (member a eca-local-to-remote-prefix-map))
                                     (explicit-b (member b eca-local-to-remote-prefix-map)))
                                 (cond
                                  ((and explicit-a (not explicit-b)) t)
                                  ((and (not explicit-a) explicit-b) nil)
                                  (t (> (length (funcall to-fn a))
                                        (length (funcall to-fn b))))))
                             (> la lb)))))))
    (or (seq-some
         (lambda (m)
           (let* ((from-raw (funcall from-fn m))
                  (to-raw (funcall to-fn m))
                  (from (funcall ensure-slash
                                 (if (and expand-from-p (not (file-remote-p from-raw)))
                                     (expand-file-name from-raw)
                                   from-raw)))
                  (to-expanded (if (and (not expand-from-p) (not (file-remote-p to-raw)))
                                   (expand-file-name to-raw)
                                 to-raw)))
             (cond
              ((string= path (funcall strip-slash from))
               (funcall strip-slash to-expanded))
              ((string-prefix-p from path)
               (concat (funcall ensure-slash to-expanded) (substring path (length from)))))))
         sorted)
        path)))

(defun eca--path-local-to-remote (path)
  "Translate a local Emacs PATH to a remote path.
First strips any TRAMP prefix from PATH, then applies path
mappings (explicit `eca-local-to-remote-prefix-map' plus TRAMP
workspace folder mappings).  The longest matching prefix wins."
  (let ((local-path (or (file-remote-p path 'localname) path)))
    (eca--path--translate (expand-file-name local-path) #'car #'cdr t)))

(defun eca--path-remote-to-local (path)
  "Translate a remote server PATH to a local Emacs path.
Applies path mappings (explicit `eca-local-to-remote-prefix-map'
plus TRAMP workspace folder mappings).  The longest matching prefix
wins; explicit user mappings take priority over TRAMP-derived ones."
  (eca--path--translate path #'cdr #'car nil))

(defun eca-info (format &rest args)
  "Display eca info message with FORMAT with ARGS."
  (message "%s :: %s" (propertize "ECA" 'face 'success) (apply #'format format args)))

(defun eca-warn (format &rest args)
  "Display eca warn message with FORMAT with ARGS."
  (message "%s :: %s" (propertize "ECA" 'face 'warning) (apply #'format format args)))

(defun eca-error (format &rest args)
  "Display eca error message with FORMAT with ARGS."
  (message "%s :: %s" (propertize "ECA" 'face 'error) (apply #'format format args)))

(defun eca-safe-face-background (face &optional frame inherit)
  "Return background of FACE on FRAME, treating TTY sentinels as nil.
INHERIT is passed through to `face-background'.  On non-graphic
frames `face-background' returns the literal strings
\"unspecified-bg\" / \"unspecified-fg\" instead of nil, which
breaks callers that feed the result to `color-name-to-rgb' (e.g.
`color-lighten-name', `color-darken-name').  This wrapper maps
those sentinels back to nil so callers can short-circuit with
`when-let*' and friends."
  (let ((bg (face-background face frame inherit)))
    (unless (member bg '("unspecified-bg" "unspecified-fg"))
      bg)))

(defun eca-buttonize (base-map text callback)
  "Create a actionable TEXT that call CALLBACK when actioned.
Inheirits BASE-MAP."
  (let ((km (make-composed-keymap (make-sparse-keymap) base-map))
        (callback-int (lambda (&rest _)
                        (interactive)
                        (funcall callback))))
    (when eca-buttons-allow-mouse
      (define-key km (kbd "<mouse-1>") callback-int))
    (define-key km (kbd "<return>") callback-int)
    (define-key km (kbd "RET") callback-int)
    (propertize text
                'eca-button-on-action callback
                'pointer 'hand
                'help-echo text
                'local-map km
                'keymap km)))

(with-eval-after-load 'transient
  (transient-define-prefix eca--transient-menu-prefix ()
    "ECA transient menu."
    [["Chat"
      ("n" "New" eca-chat-new)
      ("e" "Resume" eca-chat-resume)
      ("f" "Select" eca-chat-select)
      ("c" "Clear" eca-chat-clear)
      ("r" "Reset" eca-chat-reset)
      ("k" "Delete" eca-chat-delete)
      ("R" "Rename" eca-chat-rename)
      ("t" "Talk" eca-chat-talk)
      ("i" "Compose prompt in buffer" eca-chat-compose)
      ("I" "Inline prompt at point" eca-chat-inline-prompt)
      ("T" "Toggle inline overlays" eca-chat-inline-toggle-overlays)
      ("p" "Repeat prompt" eca-chat-repeat-prompt)
      ("C" "Clear prompt" eca-chat-clear-prompt)
      ("m" "Select model" eca-chat-select-model)
      ("M" "Toggle MCP server" eca-mcp-toggle-server)
      ("v" "Select variant" eca-chat-select-variant)
      ("b" "Change agent" eca-chat-select-agent)
      ("o" "Open/close chat window" eca-chat-toggle-window)
      ("a" "Accept all pending tool calls" eca-chat-tool-call-accept-all)
      ("!" "Accept all pending tool calls and remember" eca-chat-tool-call-accept-all-and-remember)
      ("s" "Add to system prompt" eca-chat-add-context-to-system-prompt)
      ("u" "Add to user prompt" eca-chat-add-context-to-user-prompt)
      ("d" "Drop from system prompt" eca-chat-drop-context-from-system-prompt)
      ("A" "Accept next pending tool call" eca-chat-tool-call-accept-next)]

     ["Navigation"
      ("N h" "Message history" eca-chat-timeline)
      ("N c" "Chat" eca)
      ("N s" "Settings" eca-settings)
      ("N m" "MCP details" eca-mcp-details)
      ("N e" "Show stderr (logs)" eca-show-stderr)
      ("N E" "Show emacs errors" eca-show-errors)]

     ["Server"
      ("S r" "Restart" eca-restart)
      ("S s" "Stop" eca-stop)]

     ["Workspace"
      ("W a" "Add folder" eca-chat-add-workspace-root)
      ("W r" "Remove folder" eca-chat-remove-workspace-root)]]))

(defun eca-transient-menu ()
  "Open the ECA transient menu.
Requires the `transient' package."
  (interactive)
  (unless (featurep 'transient)
    (user-error "Install the `transient' package to use the ECA menu"))
  (condition-case err
      (transient-setup 'eca--transient-menu-prefix)
    (error
     (user-error
      "ECA menu failed: %s. Try: M-x package-reinstall RET transient"
      (error-message-string err)))))

(provide 'eca-util)
;;; eca-util.el ends here