diff --git a/CHANGELOG.md b/CHANGELOG.md index e0bec4d..98dbb28 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ ## Unreleased +- `eca-workspaces-new-chat` (`+`) now always asks which workspace to start the chat in, defaulting to the one at point, and no longer requires a match: any other existing directory starts a session there. Typing a path inside a running workspace reuses its session instead of starting a second server. +- Bugfix: a tool call awaiting approval whose expanded body is taller than the window no longer gets its label and Accept/Reject buttons scrolled above the window (#308). The window is anchored on the tool call with point on its Accept button (RET accepts), and once it resolves the view moves on to the next pending approval or back to the prompt. - Bugfix: markdown tables in the chat could stay misaligned (#319): tables after the first one in a turn were skipped once aligning the earlier ones grew the buffer, code spans opened by two or more backticks swallowed the rest of the row and appended empty cells on every pass, and with markdown-mode 2.9 rows containing hidden markup or emoji had their pipes off the header column. Alignment also no longer relies on the caller binding `inhibit-read-only`. - Bugfix: on Doom, killing a workspace (`+workspace/kill`) replaced the chat shown in the workspace switched to with the fallback `*doom*` buffer when the chat window was the selected one, since Doom considered chat buffers "unreal". Chat buffers are now Doom real buffers, so they also show up in the workspace buffer list and get attached to the workspace they are displayed in. - Add `eca-doom-stop-session-on-workspace-kill` (default `t`): on Doom with the `:ui workspaces` module, killing a workspace also stops the ECA session related to it when no other workspace refers to that session. diff --git a/README.md b/README.md index 4aa1cf3..ad0eafa 100644 --- a/README.md +++ b/README.md @@ -65,10 +65,10 @@ Server / process refreshed automatically as chats change state. Each chat shows its status (⏳ running, 🚧 pending approval, ❓ waiting answer), elapsed time, cost and model. Press `?` for all actions: open (`RET`), fold - (`TAB`), new chat (`+`), delete chat/workspace (`d`/`DEL`), rename - (`r`), fork (`f`), compact (`C`), model/variant (`m`/`v`), - accept/reject tool calls (`a`/`A`/`x`), stop prompt (`s`), resume a - closed chat (`R`), refresh (`g`) and quit (`q`). When + (`TAB`), new chat in any workspace (`+`), delete chat/workspace + (`d`/`DEL`), rename (`r`), fork (`f`), compact (`C`), model/variant + (`m`/`v`), accept/reject tool calls (`a`/`A`/`x`), stop prompt (`s`), + resume a closed chat (`R`), refresh (`g`) and quit (`q`). When `eca-buttons-allow-mouse` is enabled, clicking the workspace text folds/unfolds it and clicking a chat switches to it - `eca-settings`: Open the centralized settings panel (MCP servers, and more in the future) diff --git a/eca-util.el b/eca-util.el index 5bec906..6566be8 100644 --- a/eca-util.el +++ b/eca-util.el @@ -310,6 +310,15 @@ time a buffer under it is visited." (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) diff --git a/eca-workspaces.el b/eca-workspaces.el index 449b0b1..8f24390 100644 --- a/eca-workspaces.el +++ b/eca-workspaces.el @@ -21,6 +21,7 @@ (require 'eca-chat) (declare-function eca-stop-session "eca") +(declare-function eca-start-session "eca") (defface eca-workspaces-tree-chat-idle-face '((t :underline t)) @@ -513,18 +514,81 @@ With prefix COUNT, repeat that many times." nil t))) (cdr (assoc choice candidates)))))))) +(defconst eca-workspaces--other-directory "Other directory..." + "Completion candidate that asks for a workspace directory to start.") + +(defun eca-workspaces--workspace-label (session) + "Return the completion label of SESSION." + (format "%s %s" + (eca--session-project-name session) + (string-join (-map #'abbreviate-file-name + (eca--session-workspace-folders session)) + ", "))) + +(defun eca-workspaces--workspace-candidates () + "Return an alist of (LABEL . SESSION), the session at point first." + (let ((at-point (eca-workspaces--session-at-point))) + (--map (cons (eca-workspaces--workspace-label it) it) + (append (when at-point (list at-point)) + (remq at-point (eca-workspaces--sorted-sessions)))))) + +(defun eca-workspaces--workspace-directory (path) + "Return PATH as a workspace root, or signal a `user-error'." + (let ((directory (directory-file-name (expand-file-name path)))) + (unless (file-directory-p directory) + (user-error "Not a directory: %s" directory)) + directory)) + +(defun eca-workspaces--read-workspace () + "Read a workspace, returning its session or its root directory. +Completion lists the running workspaces, defaulting to the one at +point, and requires no match: any other input is taken as the +directory of a workspace to start." + (let* ((candidates (eca-workspaces--workspace-candidates)) + (labels (append (-map #'car candidates) + (list eca-workspaces--other-directory))) + (choice (completing-read + "Workspace: " + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . eca-workspace) + (display-sort-function . identity)) + (complete-with-action action labels string pred))) + nil nil nil nil (car labels)))) + (if (equal choice eca-workspaces--other-directory) + (eca-workspaces--workspace-directory + (read-directory-name "Workspace directory: " nil nil t)) + (if-let* ((match (assoc choice candidates))) + (cdr match) + (eca-workspaces--workspace-directory choice))))) + +(defun eca-workspaces--send-initial-prompt (session prompt) + "Send PROMPT in the last chat of SESSION, unless PROMPT is empty." + (let ((chat-buffer (eca--session-last-chat-buffer session))) + (when (and (not (string-empty-p prompt)) + (buffer-live-p chat-buffer)) + (with-current-buffer chat-buffer + (eca-chat--send-prompt session prompt))))) + (defun eca-workspaces-new-chat () - "Start a new chat in the workspace at point. -Asks for an optional initial prompt which is sent right away." + "Start a new chat in a workspace. +Completion offers the running workspaces, defaulting to the one at +point, and accepts any other existing directory, starting a +session for it. Asks for an optional initial prompt which is sent +right away." (interactive) - (let* ((session (eca-workspaces--read-session)) + (let* ((workspace (eca-workspaces--read-workspace)) + (session (if (eca--session-p workspace) + workspace + (eca-session-for-root workspace))) (prompt (string-trim (read-string "Initial prompt (optional): ")))) - (eca-chat--new-chat session) - (let ((chat-buffer (eca--session-last-chat-buffer session))) - (when (and (buffer-live-p chat-buffer) - (not (string-empty-p prompt))) - (with-current-buffer chat-buffer - (eca-chat--send-prompt session prompt)))))) + (if session + (progn (eca-chat--new-chat session) + (eca-workspaces--send-initial-prompt session prompt)) + (eca-start-session + (eca-create-session (list workspace)) + (lambda (started) + (eca-workspaces--send-initial-prompt started prompt)))))) (defun eca-workspaces-delete () "Delete the chat or stop the workspace at point, with confirmation." diff --git a/eca.el b/eca.el index 0bbb7f2..f5a0cef 100644 --- a/eca.el +++ b/eca.el @@ -303,8 +303,11 @@ backtrace. On older Emacs, runs BODY without capture." (eca--log-error session err "handle-message" backtrace) (signal (car err) (cdr err))))))) -(defun eca--initialize (session) - "Send the initialize request for SESSION." +(defun eca--initialize (session &optional on-ready) + "Send the initialize request for SESSION. +ON-READY is called with SESSION once the server answered and the +first chat is open, for callers that must act on a session which +is only usable asynchronously." (run-hooks 'eca-before-initialize-hook) (setf (eca--session-status session) 'starting) (eca-api-request-async @@ -333,7 +336,8 @@ backtrace. On older Emacs, runs BODY without capture." (eca-api-notify session :method "initialized") (eca-info "Started with workspaces: %s" (string-join (eca--session-workspace-folders session) ",")) (eca-chat-open session) - (run-hooks 'eca-after-initialize-hook)) + (run-hooks 'eca-after-initialize-hook) + (when on-ready (funcall on-ready session))) :error-callback (lambda (e) (eca-error e)))) (defun eca--discover-workspaces () @@ -408,6 +412,20 @@ chat buffer. See `eca-chat--doctor-section'." (special-mode))) (pop-to-buffer out-buf))) +(defun eca-start-session (session &optional on-ready) + "Start SESSION, opening its chat when the server is ready. +Already started sessions just get their chat opened. ON-READY is +called with SESSION once it is usable, see `eca--initialize'." + (pcase (eca--session-status session) + ('stopped (eca-process-start session + (lambda () + (eca--initialize session on-ready)) + (-partial #'eca--handle-message session))) + ('started (eca-chat-open session) + (when on-ready (funcall on-ready session))) + ('starting (eca-info "eca server is already starting"))) + session) + ;;;###autoload (defun eca (&optional arg) "Start or switch to a eca session. @@ -418,13 +436,7 @@ When ARG is current prefix, ask for workspace roots to use." (list (funcall eca-find-root-for-buffer-function)))) (session (or (eca-session) (eca-create-session workspaces)))) - (pcase (eca--session-status session) - ('stopped (eca-process-start session - (lambda () - (eca--initialize session)) - (-partial #'eca--handle-message session))) - ('started (eca-chat-open session)) - ('starting (eca-info "eca server is already starting"))))) + (eca-start-session session))) (defun eca-stop-session (session) "Stop SESSION if running." diff --git a/test/eca-workspaces-test.el b/test/eca-workspaces-test.el index 43f8a5f..821a184 100644 --- a/test/eca-workspaces-test.el +++ b/test/eca-workspaces-test.el @@ -428,6 +428,179 @@ CHATS is a list of chat buffers ordered oldest-first." (eca-workspaces-delete) (expect (eca--session-id stopped) :to-equal 1)))))) +;; --------------------------------------------------------------------------- +;; new chat +;; --------------------------------------------------------------------------- + +(defvar eca-workspaces-test--directories '() + "Directories created by the tests, deleted on cleanup.") + +(defun eca-workspaces-test--directory () + "Create and return an existing directory usable as a workspace root." + (let ((directory (make-temp-file "eca-workspaces-test" t))) + (push directory eca-workspaces-test--directories) + (directory-file-name directory))) + +(defun eca-workspaces-test--new-chat-cleanup () + "Reset the state touched by the new chat tests." + (when (timerp eca-workspaces--refresh-timer) + (cancel-timer eca-workspaces--refresh-timer)) + (setq eca-workspaces--refresh-timer nil) + (dolist (directory eca-workspaces-test--directories) + (when (file-directory-p directory) + (delete-directory directory t))) + (setq eca-workspaces-test--directories '()) + (eca-workspaces-test--cleanup)) + +(describe "eca-workspaces--read-workspace" + + (after-each (eca-workspaces-test--new-chat-cleanup)) + + (it "offers the running workspaces, the one at point first" + (eca-workspaces-test--make-session 1 "/tmp/alpha" '()) + (eca-workspaces-test--make-session 2 "/tmp/zeta" '()) + (let ((offered nil)) + (with-current-buffer (eca-workspaces-test--render) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt table &rest _) + (setq offered (all-completions "" table)) + (car offered)))) + (eca-workspaces-test--goto "zeta") + (eca-workspaces--read-workspace))) + (expect (car offered) :to-match "zeta") + (expect (nth 1 offered) :to-match "alpha") + (expect (car (last offered)) + :to-equal eca-workspaces--other-directory))) + + (it "defaults to the workspace at point" + (eca-workspaces-test--make-session 1 "/tmp/alpha" '()) + (eca-workspaces-test--make-session 2 "/tmp/zeta" '()) + (with-current-buffer (eca-workspaces-test--render) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _table &rest args) (nth 4 args)))) + (eca-workspaces-test--goto "zeta") + (expect (eca--session-id (eca-workspaces--read-workspace)) + :to-equal 2)))) + + (it "returns the root of a directory typed instead of a workspace" + (let ((directory (eca-workspaces-test--directory))) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) directory))) + (expect (eca-workspaces--read-workspace) :to-equal directory)))) + + (it "expands a directory typed with a tilde" + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "~"))) + (expect (eca-workspaces--read-workspace) + :to-equal (directory-file-name (expand-file-name "~"))))) + + (it "signals when the typed directory does not exist" + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "/eca-no-such-directory"))) + (expect (eca-workspaces--read-workspace) :to-throw 'user-error))) + + (it "asks for a directory when picking the other directory entry" + (let ((directory (eca-workspaces-test--directory))) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) eca-workspaces--other-directory)) + ((symbol-function 'read-directory-name) + (lambda (&rest _) directory))) + (expect (eca-workspaces--read-workspace) :to-equal directory))))) + +(describe "eca-workspaces-new-chat" + + (after-each (eca-workspaces-test--new-chat-cleanup)) + + (it "creates a chat in the picked running workspace" + (let ((session (eca-workspaces-test--make-session 1 "/tmp/proj" '())) + (created nil) + (started nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _table &rest args) (nth 4 args))) + ((symbol-function 'read-string) (lambda (&rest _) "")) + ((symbol-function 'eca-chat--new-chat) + (lambda (s) (setq created s))) + ((symbol-function 'eca-start-session) + (lambda (&rest _) (setq started t)))) + (eca-workspaces-new-chat) + (expect created :to-be session) + (expect started :to-be nil)))) + + (it "starts a session for a directory without one" + (let ((directory (eca-workspaces-test--directory)) + (started nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) directory)) + ((symbol-function 'read-string) (lambda (&rest _) "")) + ((symbol-function 'eca-start-session) + (lambda (session &rest _) (setq started session)))) + (eca-workspaces-new-chat) + (expect (eca--session-workspace-folders started) + :to-equal (list directory))))) + + (it "reuses the running session owning the typed directory" + (let* ((directory (eca-workspaces-test--directory)) + (session (eca-workspaces-test--make-session 1 directory '())) + (created nil) + (started nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) (expand-file-name "sub" directory))) + ((symbol-function 'read-string) (lambda (&rest _) "")) + ((symbol-function 'eca-chat--new-chat) + (lambda (s) (setq created s))) + ((symbol-function 'eca-start-session) + (lambda (&rest _) (setq started t)))) + (make-directory (expand-file-name "sub" directory)) + (eca-workspaces-new-chat) + (expect created :to-be session) + (expect started :to-be nil)))) + + (it "sends the initial prompt in the chat of the picked workspace" + (let* ((chat (eca-workspaces-test--make-chat :title "Chat A")) + (session (eca-workspaces-test--make-session 1 "/tmp/proj" '())) + (sent nil)) + (setf (eca--session-last-chat-buffer session) chat) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _table &rest args) (nth 4 args))) + ((symbol-function 'read-string) (lambda (&rest _) " hi ")) + ((symbol-function 'eca-chat--new-chat) #'ignore) + ((symbol-function 'eca-chat--send-prompt) + (lambda (_session prompt) + (setq sent (cons prompt (current-buffer)))))) + (eca-workspaces-new-chat) + (expect sent :to-equal (cons "hi" chat))))) + + (it "sends no prompt when the initial prompt is empty" + (let* ((chat (eca-workspaces-test--make-chat :title "Chat A")) + (session (eca-workspaces-test--make-session 1 "/tmp/proj" '())) + (sent nil)) + (setf (eca--session-last-chat-buffer session) chat) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _table &rest args) (nth 4 args))) + ((symbol-function 'read-string) (lambda (&rest _) " ")) + ((symbol-function 'eca-chat--new-chat) #'ignore) + ((symbol-function 'eca-chat--send-prompt) + (lambda (&rest _) (setq sent t)))) + (eca-workspaces-new-chat) + (expect sent :to-be nil)))) + + (it "sends the initial prompt once the started session is ready" + (let ((directory (eca-workspaces-test--directory)) + (chat (eca-workspaces-test--make-chat :title "Chat A")) + (sent nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) directory)) + ((symbol-function 'read-string) (lambda (&rest _) "hi")) + ((symbol-function 'eca-start-session) + (lambda (session on-ready) + (setf (eca--session-last-chat-buffer session) chat) + (funcall on-ready session))) + ((symbol-function 'eca-chat--send-prompt) + (lambda (_session prompt) + (setq sent (cons prompt (current-buffer)))))) + (eca-workspaces-new-chat) + (expect sent :to-equal (cons "hi" chat)))))) + ;; --------------------------------------------------------------------------- ;; live updates ;; ---------------------------------------------------------------------------