diff --git a/Makefile b/Makefile index abcd51a..729ad72 100644 --- a/Makefile +++ b/Makefile @@ -18,7 +18,7 @@ SELECTOR ?= # Example: make test VERBOSE=1 VERBOSE ?= -.PHONY: test test-unit test-core test-ui test-render test-input test-menu +.PHONY: test test-unit test-core test-ui test-render test-input test-menu test-browse .PHONY: test-integration test-integration-ci test-gui test-gui-ci test-all .PHONY: check check-parens compile lint lint-checkdoc lint-package clean clean-cache help .PHONY: ollama-start ollama-stop ollama-status setup-pi setup-models install-hooks @@ -61,6 +61,8 @@ help: --eval "(unless (package-installed-p 'markdown-mode) \ (package-install 'markdown-mode))" \ --eval "(package-install (cadr (assq 'transient package-archive-contents)))" \ + --eval "(unless (package-installed-p 'magit-section) \ + (package-install 'magit-section))" \ --eval "(message \"Dependencies installed\")" 2>&1 \ | grep -E "^Dependencies installed$$|^Error:" || true @touch $@ @@ -88,6 +90,7 @@ test: .deps-stamp -l pi-coding-agent-render-test \ -l pi-coding-agent-input-test \ -l pi-coding-agent-menu-test \ + -l pi-coding-agent-browse-test \ -l pi-coding-agent-test \ $(if $(SELECTOR),--eval '(ert-run-tests-batch-and-exit "$(SELECTOR)")',-f ert-run-tests-batch-and-exit) \ >$$OUTPUT 2>&1; \ @@ -117,6 +120,8 @@ test-input: .deps-stamp @$(BATCH_TEST) -l pi-coding-agent-input-test -f ert-run-tests-batch-and-exit test-menu: .deps-stamp @$(BATCH_TEST) -l pi-coding-agent-menu-test -f ert-run-tests-batch-and-exit +test-browse: .deps-stamp + @$(BATCH_TEST) -l pi-coding-agent-browse-test -f ert-run-tests-batch-and-exit test-unit: compile test @@ -229,7 +234,7 @@ ollama-status: check-parens: @echo "=== Check Parens ===" - @OUTPUT=$$($(BATCH) --eval '(condition-case err (dolist (f (list "pi-coding-agent-core.el" "pi-coding-agent-ui.el" "pi-coding-agent-render.el" "pi-coding-agent-input.el" "pi-coding-agent-menu.el" "pi-coding-agent.el")) (with-current-buffer (find-file-noselect f) (check-parens) (message "%s OK" f))) (user-error (message "FAIL: %s" (error-message-string err)) (kill-emacs 1)))' 2>&1); \ + @OUTPUT=$$($(BATCH) --eval '(condition-case err (dolist (f (list "pi-coding-agent-core.el" "pi-coding-agent-ui.el" "pi-coding-agent-render.el" "pi-coding-agent-input.el" "pi-coding-agent-menu.el" "pi-coding-agent-browse.el" "pi-coding-agent.el")) (with-current-buffer (find-file-noselect f) (check-parens) (message "%s OK" f))) (user-error (message "FAIL: %s" (error-message-string err)) (kill-emacs 1)))' 2>&1); \ echo "$$OUTPUT" | grep -E "OK$$|FAIL:"; \ echo "$$OUTPUT" | grep -q "FAIL:" && exit 1 || true @@ -241,7 +246,7 @@ compile: .deps-stamp --eval "(package-initialize)" \ $(LOCAL_LOAD_PATH) \ --eval "(setq byte-compile-error-on-warn t)" \ - -f batch-byte-compile pi-coding-agent-core.el pi-coding-agent-ui.el pi-coding-agent-render.el pi-coding-agent-input.el pi-coding-agent-menu.el pi-coding-agent.el + -f batch-byte-compile pi-coding-agent-core.el pi-coding-agent-ui.el pi-coding-agent-render.el pi-coding-agent-input.el pi-coding-agent-menu.el pi-coding-agent-browse.el pi-coding-agent.el lint: lint-checkdoc lint-package @@ -255,6 +260,7 @@ lint-checkdoc: --eval "(checkdoc-file \"pi-coding-agent-render.el\")" \ --eval "(checkdoc-file \"pi-coding-agent-input.el\")" \ --eval "(checkdoc-file \"pi-coding-agent-menu.el\")" \ + --eval "(checkdoc-file \"pi-coding-agent-browse.el\")" \ --eval "(checkdoc-file \"pi-coding-agent.el\")" 2>&1); \ WARNINGS=$$(echo "$$OUTPUT" | grep -A1 "^Warning" | grep -v "^Warning\|^--$$"); \ if [ -n "$$WARNINGS" ]; then echo "$$WARNINGS"; exit 1; else echo "OK"; fi @@ -270,7 +276,7 @@ lint-package: (package-install 'package-lint))" \ --eval "(require 'package-lint)" \ --eval "(setq package-lint-main-file \"pi-coding-agent.el\")" \ - -f package-lint-batch-and-exit pi-coding-agent.el pi-coding-agent-ui.el pi-coding-agent-render.el pi-coding-agent-input.el pi-coding-agent-menu.el pi-coding-agent-core.el + -f package-lint-batch-and-exit pi-coding-agent.el pi-coding-agent-ui.el pi-coding-agent-render.el pi-coding-agent-input.el pi-coding-agent-menu.el pi-coding-agent-browse.el pi-coding-agent-core.el check: compile lint test diff --git a/pi-coding-agent-browse.el b/pi-coding-agent-browse.el new file mode 100644 index 0000000..3908815 --- /dev/null +++ b/pi-coding-agent-browse.el @@ -0,0 +1,1585 @@ +;;; pi-coding-agent-browse.el --- Session and tree browser -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Daniel Nouri + +;; Author: Daniel Nouri +;; Maintainer: Daniel Nouri +;; URL: https://github.com/dnouri/pi-coding-agent + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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: + +;; Session and tree browsing for pi-coding-agent. +;; +;; Provides two read-only, refreshable, keyboard-driven buffers: +;; - Session Browser: find, filter, switch sessions (like TUI /resume) +;; - Tree Browser: navigate conversation tree, label, summarize (like TUI /tree) +;; +;; This module contains: +;; - RPC command builders for browsing commands +;; - Response parsers for list_sessions, get_tree, navigate_tree, set_label +;; - Tree helper functions (active path, flattening, filtering) +;; - Client-side search/filter logic +;; +;; Depends on: pi-coding-agent-core (RPC), pi-coding-agent-ui (shared state). +;; Does NOT depend on: pi-coding-agent-render or pi-coding-agent-input. + +;;; Code: + +(require 'pi-coding-agent-core) +(require 'pi-coding-agent-ui) +(require 'cl-lib) +(require 'magit-section) +(require 'transient) + +;; Forward declarations for functions in other modules (avoid circular deps) +(declare-function pi-coding-agent-set-session-name "pi-coding-agent-menu") +(declare-function pi-coding-agent--load-session-history "pi-coding-agent-menu") +(declare-function pi-coding-agent--update-session-name-from-file "pi-coding-agent-menu") + +;;;; RPC Command Builders + +(defun pi-coding-agent--build-list-sessions-command (scope) + "Build a `list_sessions' RPC command plist. +SCOPE is \"current\" or \"all\"." + (list :type "list_sessions" :scope scope)) + +(defun pi-coding-agent--build-get-tree-command () + "Build a `get_tree' RPC command plist." + (list :type "get_tree")) + +(defun pi-coding-agent--build-navigate-tree-command (target-id summarize custom-instructions) + "Build a `navigate_tree' RPC command plist. +TARGET-ID is the node to navigate to. +SUMMARIZE when non-nil triggers branch summarization. +CUSTOM-INSTRUCTIONS is an optional string for custom summary guidance." + (let ((cmd (list :type "navigate_tree" :targetId target-id))) + (when summarize + (setq cmd (plist-put cmd :summarize t))) + (when custom-instructions + (setq cmd (plist-put cmd :customInstructions custom-instructions))) + cmd)) + +(defun pi-coding-agent--build-set-label-command (entry-id label) + "Build a `set_label' RPC command plist. +ENTRY-ID is the node to label. +LABEL is the label string, or nil to clear." + (let ((cmd (list :type "set_label" :entryId entry-id))) + (when label + (setq cmd (plist-put cmd :label label))) + cmd)) + +(defun pi-coding-agent--build-abort-branch-summary-command () + "Build an `abort_branch_summary' RPC command plist." + (list :type "abort_branch_summary")) + +;;;; Response Parsers + +(defun pi-coding-agent--parse-session-list (response) + "Parse a `list_sessions' RESPONSE into a list of session plists. +Returns nil on failure or empty result." + (when (eq (plist-get response :success) t) + (let* ((data (plist-get response :data)) + (sessions-vec (plist-get data :sessions))) + (when (and sessions-vec (> (length sessions-vec) 0)) + (append sessions-vec nil))))) + +(defun pi-coding-agent--parse-tree (response) + "Parse a `get_tree' RESPONSE into a tree data plist. +Returns plist with :tree (vector) and :leafId (string), or nil on failure." + (when (eq (plist-get response :success) t) + (plist-get response :data))) + +(defun pi-coding-agent--parse-navigate-result (response) + "Parse a `navigate_tree' RESPONSE into a result plist. +Returns plist with :cancelled, :editorText, :summaryEntry, or nil on failure." + (when (eq (plist-get response :success) t) + (plist-get response :data))) + +;;;; Session Display Helpers + +(defun pi-coding-agent--collapse-whitespace (str) + "Collapse whitespace (including newlines) in STR to a single space." + (replace-regexp-in-string "[\n\r\t ]+" " " str)) + +(defun pi-coding-agent--first-nonempty-line (str) + "Return the first non-empty line from STR. +Skips leading blank lines. Returns empty string if STR is empty +or contains only whitespace." + (if (or (null str) (string-empty-p str)) + "" + (let ((lines (split-string str "\n"))) + (or (cl-find-if (lambda (l) (not (string-empty-p (string-trim l)))) lines) + "")))) + +(defun pi-coding-agent--session-display-name (session) + "Return display name for SESSION plist. +Prefers :name, falls back to :firstMessage, then \"[empty session]\". +Newlines and excess whitespace are collapsed to single spaces." + (let ((raw (or (pi-coding-agent--normalize-string-or-null + (plist-get session :name)) + (pi-coding-agent--normalize-string-or-null + (plist-get session :firstMessage))))) + (if raw + (pi-coding-agent--collapse-whitespace raw) + "[empty session]"))) + +;;;; Margin Rendering Infrastructure + +(defun pi-coding-agent--propertize-face (string face) + "Propertize STRING with both `face' and `font-lock-face' set to FACE. +This follows Magit's convention to survive fontification." + (propertize string 'face face 'font-lock-face face)) + +(defun pi-coding-agent--make-margin-overlay (string) + "Create a right-margin overlay on the current line displaying STRING. +The overlay uses `evaporate' so it auto-removes when the buffer text +is deleted (e.g., during erase-and-rewrite refresh). +STRING defaults to a single space if nil." + (save-excursion + (forward-line (if (bolp) -1 0)) + (let ((o (make-overlay (1+ (point)) (line-end-position) nil t))) + (overlay-put o 'evaporate t) + (overlay-put o 'before-string + (propertize "o" 'display + (list (list 'margin 'right-margin) + (or string " "))))))) + +(defconst pi-coding-agent--session-margin-width 20 + "Right margin width for the session browser. +Accommodates: count (4 digits + \" msgs \") + age (2 + 1 + 7) + padding. +4 + 5 + 10 = 19, plus 1 char left padding = 20.") + +(defconst pi-coding-agent--tree-margin-width 16 + "Right margin width for the tree browser. +Accommodates: \"[\" + 12-char label + \"]\" + padding = 16.") + +(defvar-local pi-coding-agent--browse-margin-width nil + "Right margin width for the current browse buffer. +Set by the derived mode; used by the window-configuration hook.") + +(defun pi-coding-agent--browse-set-window-margins (width &optional window) + "Set right margin to WIDTH on WINDOW (default: selected window). +Preserves any existing left margin." + (let ((win (or window (selected-window)))) + (when (window-live-p win) + (set-window-margins win (car (window-margins win)) width)))) + +(defun pi-coding-agent--browse-apply-margins () + "Re-apply right margins for the current browse buffer. +Reads width from `pi-coding-agent--browse-margin-width'. +Intended as a `window-configuration-change-hook' callback." + (when pi-coding-agent--browse-margin-width + (pi-coding-agent--browse-set-window-margins + pi-coding-agent--browse-margin-width))) + +;;;; Margin Age Formatting + +(defconst pi-coding-agent--age-spec + '(("year" 31557600) + ("month" 2629800) + ("week" 604800) + ("day" 86400) + ("hour" 3600) + ("minute" 60) + ("second" 1)) + "Time units and their durations in seconds. +Used for margin age display in browse buffers.") + +(defun pi-coding-agent--margin-age (seconds) + "Convert SECONDS to a (COUNT . UNIT) pair. +Returns the largest unit where COUNT >= 1, or (0 . \"second\") for zero." + (let ((result (cons 0 "second"))) + (cl-loop for (unit secs) in pi-coding-agent--age-spec + when (>= seconds secs) + do (setq result (cons (floor (/ (float seconds) secs)) unit)) + and return nil) + result)) + +(defconst pi-coding-agent--margin-age-unit-width + (apply #'max (mapcar (lambda (s) (length (concat (car s) "s"))) + pi-coding-agent--age-spec)) + "Width of the longest pluralized unit name (\"minutes\" = 7).") + +(defconst pi-coding-agent--margin-age-format + (format "%%2d %%-%ds" pi-coding-agent--margin-age-unit-width) + "Format string for margin age: \"%2d %-7s\".") + +(defun pi-coding-agent--format-margin-age (seconds) + "Format SECONDS as a magit-log–style aligned age string. +Format: \"%2d %-Ns\" where N is the longest pluralized unit width. +Example: \" 5 minutes\", \" 1 hour \", \"10 days \"." + (let* ((pair (pi-coding-agent--margin-age seconds)) + (count (car pair)) + (unit (cdr pair)) + (unit-str (if (= count 1) unit (concat unit "s")))) + (format pi-coding-agent--margin-age-format count unit-str))) + +(defun pi-coding-agent--format-margin-age-from-iso (iso-timestamp) + "Format ISO-TIMESTAMP as a margin age string. +Returns nil on invalid input." + (condition-case nil + (let* ((time (date-to-time iso-timestamp)) + (diff (floor (float-time (time-subtract (current-time) time))))) + (pi-coding-agent--format-margin-age (max 0 diff))) + (error nil))) + +;;;; Tree Helpers + +(defun pi-coding-agent--active-path-ids (tree leaf-id) + "Compute the set of node IDs on the active path. +TREE is the root vector from get_tree. +LEAF-ID is the current leaf node ID. +Returns a hash table mapping active node IDs to t." + (let ((result (make-hash-table :test 'equal))) + (when leaf-id + ;; Build parent-id lookup from tree + (let ((parent-map (make-hash-table :test 'equal)) + (stack (append tree nil))) + (while stack + (let* ((node (pop stack)) + (children (plist-get node :children))) + (when (vectorp children) + (dotimes (i (length children)) + (let ((child (aref children i))) + (puthash (plist-get child :id) + (plist-get node :id) + parent-map) + (push child stack)))))) + ;; Walk from leaf to root, marking the active path + (let ((current leaf-id)) + (while current + (puthash current t result) + (setq current (gethash current parent-map)))))) + result)) + +;;;; Tree Filter Predicates + +(defconst pi-coding-agent--empty-assistant-preview "(no content)" + "Preview string the RPC projection sets for assistant messages with no text. +Used as a heuristic to detect tool-dispatch-only assistant messages.") + +(defun pi-coding-agent--browse-node-empty-assistant-p (node) + "Return non-nil if NODE is an empty assistant message. +Empty assistants have no text content — typically tool-dispatch messages +containing only toolCall blocks. Detected via the preview string heuristic. +Aborted or errored messages are NOT considered empty." + (let ((type (plist-get node :type)) + (role (plist-get node :role))) + (and (equal type "message") + (equal role "assistant") + (let ((preview (or (plist-get node :preview) ""))) + (or (string-empty-p preview) + (equal preview pi-coding-agent--empty-assistant-preview))) + (not (equal (plist-get node :stopReason) "aborted")) + (not (plist-get node :errorMessage))))) + +(defun pi-coding-agent--browse-node-visible-p (node filter-mode) + "Return non-nil if NODE should be visible under FILTER-MODE. +FILTER-MODE is one of: \"default\", \"no-tools\", \"user-only\", +\"labeled-only\", \"all\". +NODE is a tree node plist. + +Filtering is two-phase (matching TUI tree-selector.ts:282-311): + Phase 1 — universal pre-filter: empty assistant messages are always + hidden regardless of mode (unless aborted or errored). + Phase 2 — mode-specific filter: each mode defines additional rules." + (if (pi-coding-agent--browse-node-empty-assistant-p node) + ;; Phase 1: universal pre-filter — empty assistants always hidden + nil + ;; Phase 2: mode-specific filter + (let ((type (plist-get node :type)) + (role (plist-get node :role))) + (pcase filter-mode + ("all" t) + ("labeled-only" + (and (plist-get node :label) t)) + ("user-only" + (and (equal type "message") (equal role "user"))) + ("no-tools" + (and (not (member type '("model_change" "thinking_level_change"))) + (not (equal type "tool_result")))) + (_ ;; "default" + (not (member type '("model_change" "thinking_level_change")))))))) + +;;;; Tree Flattening for Display + +(defun pi-coding-agent--flatten-tree-for-display (tree leaf-id filter-mode) + "Flatten TREE into a display-ordered list of (NODE INDENT PREFIX) lists. +LEAF-ID identifies the current leaf for active-branch-first ordering. +FILTER-MODE controls which nodes are visible. +Each entry is (NODE INDENT-LEVEL PREFIX-STRING) where PREFIX-STRING +contains tree connectors and gutter characters for visual structure." + (let ((active-ids (pi-coding-agent--active-path-ids tree leaf-id)) + (result nil)) + (pi-coding-agent--flatten-tree-walk + (append tree nil) 0 active-ids filter-mode + nil nil + (lambda (node indent prefix) (push (list node indent prefix) result))) + (nreverse result))) + +(defun pi-coding-agent--flatten-tree-walk (nodes indent active-ids filter-mode + gutter-stack is-branch-children + emit) + "Walk NODES at INDENT level, calling EMIT for visible nodes. +ACTIVE-IDS is the active path hash table. +FILTER-MODE controls visibility. +GUTTER-STACK is a list of strings (\"│ \" or \" \") for ancestor levels. +IS-BRANCH-CHILDREN is non-nil if NODES are siblings at a branch point. +EMIT is called with (node indent prefix) for each visible node. +Active-branch children are shown first at branch points. +Uses an explicit stack to avoid overflow on deep trees." + ;; Each stack frame: [siblings vis-count vis-index indent gutter is-branch] + (let* ((vis-count (cl-count-if + (lambda (n) + (pi-coding-agent--browse-node-visible-p n filter-mode)) + nodes)) + (stack (list (vector nodes vis-count 0 + indent gutter-stack is-branch-children)))) + (while stack + (let* ((frame (pop stack)) + (siblings (aref frame 0)) + (v-count (aref frame 1)) + (v-index (aref frame 2)) + (cur-indent (aref frame 3)) + (gutter (aref frame 4)) + (is-branch-ch (aref frame 5))) + (when siblings + (let* ((node (car siblings)) + (rest (cdr siblings)) + (is-visible (pi-coding-agent--browse-node-visible-p + node filter-mode)) + (children (plist-get node :children)) + (child-list (and (vectorp children) (append children nil))) + (is-branch (> (length child-list) 1)) + (child-indent (if is-branch (1+ cur-indent) cur-indent)) + ;; Compute gutter and child frame for this node + (child-gutter gutter) + (next-v-index v-index)) + ;; Push continuation for remaining siblings (goes UNDER children) + (when is-visible + (let* ((last-visible-p (= v-index (1- v-count))) + (connector (when is-branch-ch + (if last-visible-p "└─ " "├─ "))) + (prefix (concat (apply #'concat gutter) + (or connector ""))) + (new-gutter (when is-branch-ch + (if last-visible-p " " "│ ")))) + (funcall emit node cur-indent prefix) + (when new-gutter + (setq child-gutter (append gutter (list new-gutter)))) + (setq next-v-index (1+ v-index)))) + ;; Push remaining siblings (continuation) + (when rest + (push (vector rest v-count next-v-index + cur-indent gutter is-branch-ch) + stack)) + ;; Push children ON TOP (processed before remaining siblings) + (when child-list + (let* ((sorted (if is-branch + (pi-coding-agent--sort-active-first + child-list active-ids) + child-list)) + (child-v-count + (cl-count-if + (lambda (n) + (pi-coding-agent--browse-node-visible-p n filter-mode)) + sorted))) + (push (vector sorted child-v-count 0 + child-indent child-gutter is-branch) + stack))))))))) + + +(defun pi-coding-agent--sort-active-first (children active-ids) + "Sort CHILDREN so the subtree containing an active node comes first. +ACTIVE-IDS is the hash table of active path node IDs." + (let ((active nil) + (inactive nil)) + (dolist (child children) + (if (pi-coding-agent--subtree-contains-active-p child active-ids) + (push child active) + (push child inactive))) + (append (nreverse active) (nreverse inactive)))) + +(defun pi-coding-agent--subtree-contains-active-p (node active-ids) + "Return non-nil if NODE or any descendant is in ACTIVE-IDS. +Uses iterative DFS to avoid stack overflow on deep trees." + (let ((stack (list node))) + (cl-block found + (while stack + (let* ((n (pop stack)) + (children (plist-get n :children))) + (when (gethash (plist-get n :id) active-ids) + (cl-return-from found t)) + (when (vectorp children) + (dotimes (i (length children)) + (push (aref children i) stack))))) + nil))) + +;;;; Client-Side Search/Filter + +(defun pi-coding-agent--matches-filter-p (text tokens) + "Return non-nil if TEXT matches all regexp TOKENS. +Each whitespace-separated token is a regexp. +All tokens must match for the entry to be included." + (or (null tokens) + (cl-every (lambda (tok) (string-match-p tok text)) tokens))) + +;;;; Session Sort/Filter/Threading + +(defconst pi-coding-agent--session-sort-modes + '("threaded" "recent" "relevance") + "Available sort modes for the session browser.") + +(defun pi-coding-agent--session-sort-next (current) + "Return the sort mode after CURRENT in the cycle." + (let ((modes pi-coding-agent--session-sort-modes)) + (or (cadr (member current modes)) + (car modes)))) + +(defun pi-coding-agent--session-sort-items (items sort-mode) + "Sort session ITEMS by SORT-MODE. +\"recent\" sorts by modified time descending. +\"relevance\" sorts by message count descending. +\"threaded\" returns items as-is (threading is handled during rendering)." + (pcase sort-mode + ("recent" + (sort (copy-sequence items) + (lambda (a b) + (string> (plist-get a :modified) (plist-get b :modified))))) + ("relevance" + (sort (copy-sequence items) + (lambda (a b) + (> (or (plist-get a :messageCount) 0) + (or (plist-get b :messageCount) 0))))) + (_ items))) + +(defun pi-coding-agent--session-thread-items (items) + "Arrange ITEMS into a flat list with threading depth. +Returns a list of (session . depth) cons cells. +Top-level items have depth 0, children have depth 1+." + (let ((by-path (make-hash-table :test 'equal)) + (children-of (make-hash-table :test 'equal)) + (root-items nil)) + ;; Index by path + (dolist (item items) + (puthash (plist-get item :path) item by-path)) + ;; Group children under parents + (dolist (item items) + (let ((parent-path (plist-get item :parentSessionPath))) + (if (and parent-path (gethash parent-path by-path)) + (puthash parent-path + (append (gethash parent-path children-of) (list item)) + children-of) + (push item root-items)))) + ;; Build threaded list with depth (DFS) + (let ((result nil)) + (dolist (root (nreverse root-items)) + (setq result (pi-coding-agent--collect-threaded + root children-of 0 result))) + (nreverse result)))) + +(defun pi-coding-agent--collect-threaded (item children-of depth result) + "Collect ITEM and its children into RESULT at DEPTH. +CHILDREN-OF maps parent path to child items. +Returns the updated RESULT list." + (push (cons item depth) result) + (let ((kids (gethash (plist-get item :path) children-of))) + (dolist (kid kids) + (setq result (pi-coding-agent--collect-threaded + kid children-of (1+ depth) result)))) + result) + +(defun pi-coding-agent--session-filter-named (items) + "Filter ITEMS to only those with a name." + (cl-remove-if-not (lambda (item) + (pi-coding-agent--normalize-string-or-null + (plist-get item :name))) + items)) + +(defun pi-coding-agent--session-filter-search (items tokens) + "Filter ITEMS by search TOKENS. +Matches against session name, first message, and allMessagesText." + (if (null tokens) + items + (cl-remove-if-not + (lambda (item) + (let ((text (concat + (or (plist-get item :name) "") + " " + (or (plist-get item :firstMessage) "") + " " + (or (plist-get item :allMessagesText) "")))) + (pi-coding-agent--matches-filter-p text tokens))) + items))) + +;;;; Time-Based Section Headers + +(defun pi-coding-agent--session-time-group (iso-timestamp) + "Return time group label for ISO-TIMESTAMP. +Groups: \"Today\", \"Yesterday\", \"This Week\", \"Older\"." + (condition-case nil + (let* ((time (date-to-time iso-timestamp)) + (now (current-time)) + (diff-days (/ (float-time (time-subtract now time)) 86400.0))) + (cond + ((< diff-days 1) "Today") + ((< diff-days 2) "Yesterday") + ((< diff-days 7) "This Week") + (t "Older"))) + (error "Older"))) + +;;;; Section Classes + +(defclass pi-coding-agent-session-section (magit-section) + ((keymap :initform 'pi-coding-agent-session-section-map)) + "Section class for a session entry in the session browser.") + +(setf (alist-get 'session magit--section-type-alist) + 'pi-coding-agent-session-section) + +;;;; Keymaps + +(defvar pi-coding-agent-browse-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map magit-section-mode-map) + (define-key map (kbd "g") #'pi-coding-agent-browse-refresh) + (define-key map (kbd "q") #'quit-window) + map) + "Base keymap for pi-coding-agent browse modes.") + +(defvar pi-coding-agent-session-browser-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map pi-coding-agent-browse-mode-map) + (define-key map (kbd "s") #'pi-coding-agent-session-browser-cycle-sort) + (define-key map (kbd "f") #'pi-coding-agent-session-browser-toggle-named) + (define-key map (kbd "/") #'pi-coding-agent-session-browser-search) + (define-key map (kbd "t") #'pi-coding-agent-session-browser-toggle-scope) + (define-key map (kbd "r") #'pi-coding-agent-session-browser-rename) + (define-key map (kbd "RET") #'pi-coding-agent-session-browser-switch) + (define-key map (kbd "?") #'pi-coding-agent-session-browser-dispatch) + (define-key map (kbd "h") #'pi-coding-agent-session-browser-dispatch) + map) + "Keymap for the session browser.") + +(defvar pi-coding-agent-session-section-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'pi-coding-agent-session-browser-switch) + map) + "Keymap for session sections (text property on each session line).") + +;;;; Buffer-Local State + +(defvar-local pi-coding-agent--session-browser-scope "current" + "Scope for session listing: \"current\" or \"all\".") + +(defvar-local pi-coding-agent--session-browser-sort "threaded" + "Sort mode: \"threaded\", \"recent\", or \"relevance\".") + +(defvar-local pi-coding-agent--session-browser-named-only nil + "When non-nil, show only named sessions.") + +(defvar-local pi-coding-agent--session-browser-items nil + "Parsed session list from last `list_sessions' response.") + +(defvar-local pi-coding-agent--session-browser-search-query nil + "Current search query string, or nil.") + +(defvar-local pi-coding-agent--session-browser-search-tokens nil + "Parsed search tokens from `pi-coding-agent--session-browser-search-query'.") + +(defvar-local pi-coding-agent--session-browser-loading nil + "Non-nil while a fetch is in progress.") + +(defvar-local pi-coding-agent--session-browser-error nil + "Error message string from last fetch, or nil on success.") + +;;;; Session Browser Dispatch Transient + +(defun pi-coding-agent--session-dispatch-heading () + "Return heading string for the session browser dispatch transient. +Shows current sort mode, scope, and named-only state. +Sibling of `pi-coding-agent--session-browser-header-line' — both +format the same state variables for different contexts." + ;; Push-then-nreverse: initial list items appear first after nreverse, + ;; so list them in reverse of desired output order. + (let ((parts (list (format "scope:%s" pi-coding-agent--session-browser-scope) + (format "sort:%s" pi-coding-agent--session-browser-sort)))) + (when pi-coding-agent--session-browser-named-only + (push "named-only" parts)) + (mapconcat #'identity (nreverse parts) " │ "))) + +(transient-define-prefix pi-coding-agent-session-browser-dispatch () + "Session browser help." + [:description pi-coding-agent--session-dispatch-heading + ["Actions" + ("RET" "switch" pi-coding-agent-session-browser-switch) + ("r" "rename" pi-coding-agent-session-browser-rename) + ("g" "refresh" pi-coding-agent-browse-refresh) + ("q" "quit" quit-window)] + ["Filter & Sort" + ("s" "sort" pi-coding-agent-session-browser-cycle-sort) + ("f" "named only" pi-coding-agent-session-browser-toggle-named) + ("t" "scope" pi-coding-agent-session-browser-toggle-scope) + ("/" "search" pi-coding-agent-session-browser-search)]]) + +;;;; Faces + +(defface pi-coding-agent-session-name + '((t :weight bold)) + "Face for session names in the session browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-session-message-count + '((t :inherit shadow)) + "Face for message counts in the session browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-session-age + '((t :inherit shadow)) + "Face for relative age in the session browser margin." + :group 'pi-coding-agent) + +(defface pi-coding-agent-session-thread-connector + '((t :inherit shadow)) + "Face for threading connectors (├─, └─) in the session browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-session-group-header + '((t :inherit magit-section-heading)) + "Face for time-group headers (Today, Yesterday, etc.)." + :group 'pi-coding-agent) + +;;;; Major Modes + +(define-derived-mode pi-coding-agent-browse-mode magit-section-mode + "Pi-Browse" + "Base mode for pi-coding-agent browse buffers. +Inherits section navigation from `magit-section-mode'." + :group 'pi-coding-agent) + +(define-derived-mode pi-coding-agent-session-browser-mode + pi-coding-agent-browse-mode "Pi-Sessions" + "Major mode for browsing pi sessions. +\\{pi-coding-agent-session-browser-mode-map}" + :group 'pi-coding-agent + (setq-local header-line-format + '(:eval (pi-coding-agent--session-browser-header-line))) + (setq pi-coding-agent--browse-margin-width + pi-coding-agent--session-margin-width) + (setq-local right-margin-width pi-coding-agent--session-margin-width) + (add-hook 'window-configuration-change-hook + #'pi-coding-agent--browse-apply-margins nil t)) + +;;;; Buffer Management + +(defun pi-coding-agent--session-browser-buffer-name (dir) + "Return session browser buffer name for DIR." + (format "*pi-coding-agent-sessions:%s*" (abbreviate-file-name dir))) + +(defun pi-coding-agent--get-or-create-session-browser (dir) + "Get or create session browser buffer for DIR." + (let* ((name (pi-coding-agent--session-browser-buffer-name dir)) + (buf (get-buffer name))) + (or buf + (with-current-buffer (generate-new-buffer name) + (setq default-directory dir) + (pi-coding-agent-session-browser-mode) + (current-buffer))))) + +;;;; Rendering + +(defun pi-coding-agent--session-browser-render (buf) + "Render the session browser in BUF from its buffer-local state." + (with-current-buffer buf + (let* ((inhibit-read-only t) + (items (or pi-coding-agent--session-browser-items '())) + ;; Apply filters + (filtered (if pi-coding-agent--session-browser-named-only + (pi-coding-agent--session-filter-named items) + items)) + (filtered (pi-coding-agent--session-filter-search + filtered + pi-coding-agent--session-browser-search-tokens))) + (magit-insert-section (root) + (cond + (pi-coding-agent--session-browser-loading + (insert (pi-coding-agent--propertize-face + "Loading sessions..." + 'pi-coding-agent-activity-phase) + "\n")) + (pi-coding-agent--session-browser-error + (insert (pi-coding-agent--propertize-face + (format "Error: %s\n" pi-coding-agent--session-browser-error) + 'error))) + ((null items) + (insert "No sessions found.\n")) + ((null filtered) + (insert "No matching sessions.\n")) + ((equal pi-coding-agent--session-browser-sort "threaded") + (pi-coding-agent--session-browser-render-threaded filtered)) + ((equal pi-coding-agent--session-browser-sort "recent") + (pi-coding-agent--session-browser-render-recent filtered)) + (t + (let ((sorted (pi-coding-agent--session-sort-items + filtered pi-coding-agent--session-browser-sort))) + (pi-coding-agent--session-browser-render-flat sorted)))))))) + +(defun pi-coding-agent--session-browser-render-flat (items) + "Render ITEMS as a flat list." + (dolist (item items) + (pi-coding-agent--session-browser-insert-session item 0 nil))) + +(defun pi-coding-agent--session-browser-render-threaded (items) + "Render ITEMS in threaded view with connectors." + (let ((threaded (pi-coding-agent--session-thread-items items))) + (dolist (entry threaded) + (let ((item (car entry)) + (depth (cdr entry))) + (pi-coding-agent--session-browser-insert-session item depth t))))) + +(defun pi-coding-agent--session-browser-render-recent (items) + "Render ITEMS sorted by recency with time-group headers." + (let ((sorted (pi-coding-agent--session-sort-items items "recent")) + (last-group nil)) + (dolist (item sorted) + (let ((group (pi-coding-agent--session-time-group + (plist-get item :modified)))) + (unless (equal group last-group) + (magit-insert-section (time-group group) + (magit-insert-heading + (pi-coding-agent--propertize-face + group 'pi-coding-agent-session-group-header))) + (setq last-group group))) + (pi-coding-agent--session-browser-insert-session item 0 nil)))) + +(defun pi-coding-agent--session-browser-insert-session (session depth threaded) + "Insert SESSION as a magit-section at DEPTH. +When THREADED is non-nil, prepend threading connector at DEPTH. +In non-threaded modes, forked sessions get a \"fork:\" prefix. +Message count and age are rendered as a right-margin overlay." + (let* ((path (plist-get session :path)) + (name (pi-coding-agent--session-display-name session)) + (count (or (plist-get session :messageCount) 0)) + (modified (plist-get session :modified)) + (is-fork (plist-get session :parentSessionPath)) + (prefix (cond + ((and threaded (> depth 0)) + (concat (make-string (* 2 (1- depth)) ?\s) + (pi-coding-agent--propertize-face + "└─ " 'pi-coding-agent-session-thread-connector))) + ((and is-fork (not threaded)) + (pi-coding-agent--propertize-face + "fork: " 'pi-coding-agent-session-thread-connector)) + (t ""))) + (heading (concat prefix + (pi-coding-agent--propertize-face + name 'pi-coding-agent-session-name))) + (margin-str (concat + (pi-coding-agent--propertize-face + (format "%4d msgs " count) + 'pi-coding-agent-session-message-count) + (pi-coding-agent--propertize-face + (or (pi-coding-agent--format-margin-age-from-iso modified) + (format (format "%%%ds" + (+ 3 pi-coding-agent--margin-age-unit-width)) + "?")) + 'pi-coding-agent-session-age)))) + (magit-insert-section (session path) + (magit-insert-heading heading) + (pi-coding-agent--make-margin-overlay margin-str)))) + +;;;; Header-Line + +(defun pi-coding-agent--session-browser-header-line () + "Return header-line string for the session browser." + (let* ((scope pi-coding-agent--session-browser-scope) + (sort pi-coding-agent--session-browser-sort) + (named pi-coding-agent--session-browser-named-only) + (query pi-coding-agent--session-browser-search-query) + (count (length (or pi-coding-agent--session-browser-items '()))) + (parts (list (format "Sessions [%s]" scope) + (format "sort:%s" sort)))) + (when named (push "named-only" parts)) + (when query (push (format "/%s" query) parts)) + (push (format "(%d)" count) parts) + (push (pi-coding-agent--propertize-face "?:help" 'shadow) parts) + (mapconcat #'identity (nreverse parts) " │ "))) + +;;;; Session Browser Interactive Commands + +(defun pi-coding-agent-session-browser-cycle-sort () + "Cycle the session browser sort mode." + (interactive) + (setq pi-coding-agent--session-browser-sort + (pi-coding-agent--session-sort-next + pi-coding-agent--session-browser-sort)) + (pi-coding-agent--session-browser-rerender) + (message "Pi: Sort: %s" pi-coding-agent--session-browser-sort)) + +(defun pi-coding-agent-session-browser-toggle-named () + "Toggle named-only filter in the session browser." + (interactive) + (setq pi-coding-agent--session-browser-named-only + (not pi-coding-agent--session-browser-named-only)) + (pi-coding-agent--session-browser-rerender) + (message "Pi: Named-only: %s" + (if pi-coding-agent--session-browser-named-only "on" "off"))) + +(defun pi-coding-agent-session-browser-toggle-scope () + "Toggle scope between current and all projects." + (interactive) + (setq pi-coding-agent--session-browser-scope + (if (equal pi-coding-agent--session-browser-scope "current") + "all" "current")) + (pi-coding-agent--session-browser-fetch-and-render) + (message "Pi: Scope: %s" pi-coding-agent--session-browser-scope)) + +(defun pi-coding-agent-session-browser-search () + "Set or clear search filter in the session browser." + (interactive) + (let ((query (read-string "Filter (regexp tokens): " + pi-coding-agent--session-browser-search-query)) + (need-rerender t)) + (if (string-empty-p query) + (setq pi-coding-agent--session-browser-search-query nil + pi-coding-agent--session-browser-search-tokens nil) + ;; Validate regexp tokens + (condition-case err + (let ((tokens (split-string query))) + (dolist (tok tokens) + (string-match-p tok "")) + (setq pi-coding-agent--session-browser-search-query query + pi-coding-agent--session-browser-search-tokens tokens)) + (invalid-regexp + (message "Pi: Invalid regexp: %s" (error-message-string err)) + (setq need-rerender nil)))) + (when need-rerender + (pi-coding-agent--session-browser-rerender)))) + +(defun pi-coding-agent-session-browser-switch () + "Switch to the session at point. +On success, dismisses the browser window via `quit-window'." + (interactive) + (when-let* ((section (magit-current-section)) + (path (oref section value)) + (proc (pi-coding-agent--get-process)) + (chat-buf (pi-coding-agent--get-chat-buffer))) + (let ((win (selected-window))) + (pi-coding-agent--rpc-async proc + (list :type "switch_session" :sessionPath path) + (lambda (response) + (let* ((data (plist-get response :data)) + (cancelled (plist-get data :cancelled))) + (if (and (plist-get response :success) + (pi-coding-agent--json-false-p cancelled)) + (progn + ;; Refresh state + (pi-coding-agent--rpc-async proc '(:type "get_state") + (lambda (resp) + (pi-coding-agent--apply-state-response chat-buf resp))) + ;; Reload history + (pi-coding-agent--load-session-history + proc + (lambda (count) + (message "Pi: Switched session (%d messages)" count)) + chat-buf) + ;; Update session name + (when (buffer-live-p chat-buf) + (with-current-buffer chat-buf + (pi-coding-agent--update-session-name-from-file path))) + ;; Dismiss the browser + (when (window-live-p win) + (quit-window nil win))) + (message "Pi: Session switch cancelled")))))))) + +(defun pi-coding-agent-session-browser-rename () + "Rename the current session. +Only works for the currently active session." + (interactive) + (when-let* ((section (magit-current-section)) + (path (oref section value)) + (state (and (pi-coding-agent--get-chat-buffer) + (buffer-local-value 'pi-coding-agent--state + (pi-coding-agent--get-chat-buffer)))) + (current-file (plist-get state :session-file))) + (if (equal path current-file) + (call-interactively #'pi-coding-agent-set-session-name) + (message "Pi: Can only rename the current session (upstream limitation)")))) + +;;;; Fetch and Render + +(defun pi-coding-agent--session-browser-fetch-and-render () + "Fetch sessions from the server and re-render the buffer." + (let* ((buf (current-buffer)) + (proc (pi-coding-agent--get-process)) + (scope pi-coding-agent--session-browser-scope)) + (if (not proc) + (message "Pi: No active process") + (with-current-buffer buf + (setq pi-coding-agent--session-browser-loading t) + (pi-coding-agent--session-browser-rerender)) + (pi-coding-agent--rpc-async proc + (pi-coding-agent--build-list-sessions-command scope) + (lambda (response) + (when (buffer-live-p buf) + (with-current-buffer buf + (let ((success (eq (plist-get response :success) t))) + (setq pi-coding-agent--session-browser-loading nil + pi-coding-agent--session-browser-error + (unless success + (or (plist-get response :error) + "list_sessions not supported by this pi version")) + pi-coding-agent--session-browser-items + (when success + (pi-coding-agent--parse-session-list response)))) + (pi-coding-agent--session-browser-rerender)))))))) + +(defun pi-coding-agent--session-browser-rerender () + "Re-render the session browser from local state. +Preserves point using magit-section identity." + (let ((inhibit-read-only t)) + (erase-buffer) + (pi-coding-agent--session-browser-render (current-buffer)) + (goto-char (point-min)) + (magit-section-show (magit-current-section)) + (force-mode-line-update))) + +;;;; Tree Browser Section Classes and Keymaps + +(defclass pi-coding-agent-tree-node-section (magit-section) + ((keymap :initform 'pi-coding-agent-tree-node-section-map)) + "Section class for a tree node in the tree browser.") + +(setf (alist-get 'tree-node magit--section-type-alist) + 'pi-coding-agent-tree-node-section) + +(defvar pi-coding-agent-tree-browser-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map pi-coding-agent-browse-mode-map) + (define-key map (kbd "f") #'pi-coding-agent-tree-browser-cycle-filter) + (define-key map (kbd "l") #'pi-coding-agent-tree-browser-set-label) + (define-key map (kbd "/") #'pi-coding-agent-tree-browser-search) + (define-key map (kbd "RET") #'pi-coding-agent-tree-browser-navigate) + (define-key map (kbd "S") #'pi-coding-agent-tree-browser-summarize) + (define-key map (kbd "C-c C-k") #'pi-coding-agent-tree-browser-abort-summarization) + (define-key map (kbd "?") #'pi-coding-agent-tree-browser-dispatch) + (define-key map (kbd "h") #'pi-coding-agent-tree-browser-dispatch) + map) + "Keymap for the tree browser.") + +(defvar pi-coding-agent-tree-node-section-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'pi-coding-agent-tree-browser-navigate) + (define-key map (kbd "l") #'pi-coding-agent-tree-browser-set-label) + map) + "Keymap for tree node sections.") + +;;;; Tree Browser State + +(defvar-local pi-coding-agent--tree-browser-filter "no-tools" + "Filter mode: \"no-tools\", \"default\", \"user-only\", \"labeled-only\", \"all\".") + +(defvar-local pi-coding-agent--tree-browser-tree nil + "Parsed tree from last `get_tree' response (vector of root nodes).") + +(defvar-local pi-coding-agent--tree-browser-leaf-id nil + "Current leaf node ID from the tree response.") + +(defvar-local pi-coding-agent--tree-browser-visible-count 0 + "Count of visible entries from the last render. +Cached to avoid re-flattening the tree in the header-line.") + +(defvar-local pi-coding-agent--tree-browser-search-query nil + "Current search query string, or nil.") + +(defvar-local pi-coding-agent--tree-browser-search-tokens nil + "Parsed search tokens.") + +(defvar-local pi-coding-agent--tree-browser-loading nil + "Non-nil while a fetch is in progress.") + +(defvar-local pi-coding-agent--tree-browser-summarizing nil + "Non-nil while a branch summarization is in progress.") + +(defconst pi-coding-agent--tree-filter-modes + '("no-tools" "default" "user-only" "labeled-only" "all") + "Available filter modes for the tree browser.") + +;;;; Tree Browser Dispatch Transient + +(defun pi-coding-agent--tree-dispatch-heading () + "Return heading string for the tree browser dispatch transient. +Shows current filter mode. +Sibling of `pi-coding-agent--tree-browser-header-line' — both +format the same state variables for different contexts." + (format "filter:%s" pi-coding-agent--tree-browser-filter)) + +(transient-define-prefix pi-coding-agent-tree-browser-dispatch () + "Tree browser help." + [:description pi-coding-agent--tree-dispatch-heading + ["Actions" + ("RET" "navigate" pi-coding-agent-tree-browser-navigate) + ("S" "summarize" pi-coding-agent-tree-browser-summarize) + ("C-c C-k" "abort summary" pi-coding-agent-tree-browser-abort-summarization) + ("l" "label" pi-coding-agent-tree-browser-set-label) + ("g" "refresh" pi-coding-agent-browse-refresh) + ("q" "quit" quit-window)] + ["Filter" + ("f" "filter" pi-coding-agent-tree-browser-cycle-filter) + ("/" "search" pi-coding-agent-tree-browser-search)]]) + +;;;; Tree Browser Faces + +(defface pi-coding-agent-tree-user + '((t :inherit font-lock-keyword-face)) + "Face for user messages in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-assistant + '((t :inherit font-lock-string-face)) + "Face for assistant messages in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-tool + '((t :inherit shadow)) + "Face for tool results in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-compaction + '((t :inherit shadow :slant italic)) + "Face for compaction entries in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-summary + '((t :inherit warning)) + "Face for branch summaries in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-active + '((t :weight bold)) + "Face for active-path marker in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-label + '((t :inherit success :weight bold)) + "Face for node labels in the tree browser." + :group 'pi-coding-agent) + +(defface pi-coding-agent-tree-connector + '((t :inherit shadow)) + "Face for tree connectors (├─, └─, │) in the tree browser." + :group 'pi-coding-agent) + +;;;; Tree Browser Mode + +(define-derived-mode pi-coding-agent-tree-browser-mode + pi-coding-agent-browse-mode "Pi-Tree" + "Major mode for browsing pi conversation tree. +\\{pi-coding-agent-tree-browser-mode-map}" + :group 'pi-coding-agent + (setq-local header-line-format + '(:eval (pi-coding-agent--tree-browser-header-line))) + (setq pi-coding-agent--browse-margin-width + pi-coding-agent--tree-margin-width) + (setq-local right-margin-width pi-coding-agent--tree-margin-width) + (add-hook 'window-configuration-change-hook + #'pi-coding-agent--browse-apply-margins nil t)) + +;;;; Tree Browser Buffer Management + +(defun pi-coding-agent--tree-browser-buffer-name (dir) + "Return tree browser buffer name for DIR." + (format "*pi-coding-agent-tree:%s*" (abbreviate-file-name dir))) + +(defun pi-coding-agent--get-or-create-tree-browser (dir) + "Get or create tree browser buffer for DIR." + (let* ((name (pi-coding-agent--tree-browser-buffer-name dir)) + (buf (get-buffer name))) + (or buf + (with-current-buffer (generate-new-buffer name) + (setq default-directory dir) + (pi-coding-agent-tree-browser-mode) + (current-buffer))))) + +;;;; Tree Node Formatting + +(defun pi-coding-agent--tree-node-face (node) + "Return the face for NODE based on its type and role." + (let ((type (plist-get node :type)) + (role (plist-get node :role))) + (pcase type + ("message" + (pcase role + ("user" 'pi-coding-agent-tree-user) + ("assistant" 'pi-coding-agent-tree-assistant) + ("branchSummary" 'pi-coding-agent-tree-summary) + ("compactionSummary" 'pi-coding-agent-tree-compaction) + (_ 'default))) + ("tool_result" 'pi-coding-agent-tree-tool) + ("compaction" 'pi-coding-agent-tree-compaction) + ("branch_summary" 'pi-coding-agent-tree-summary) + ("model_change" 'shadow) + ("thinking_level_change" 'shadow) + (_ 'default)))) + +(defun pi-coding-agent--tree-node-type-label (node) + "Return a short type label for NODE." + (let ((type (plist-get node :type)) + (role (plist-get node :role))) + (pcase type + ("message" + (pcase role + ("user" "you") + ("assistant" "ast") + ("branchSummary" "sum") + ("compactionSummary" "cmp") + ("bashExecution" "sh") + (_ role))) + ("tool_result" + (or (plist-get node :toolName) "tool")) + ("compaction" "compact") + ("branch_summary" "summary") + ("model_change" "model") + ("thinking_level_change" "think") + (_ type)))) + +(defun pi-coding-agent--tree-strip-bracket-preview (node) + "Return preview text for NODE with bracket wrappers stripped. +The upstream `formatToolCall' wraps previews as `[name: args]'. Since +the type-label column already identifies the tool, the wrapper is +redundant. Prefers `formattedToolCall' over `preview'." + (let ((text (or (plist-get node :formattedToolCall) + (plist-get node :preview) + ""))) + (cond + ;; [name: content] → content + ((string-match "^\\[.+?: \\(.*\\)\\]$" text) + (match-string 1 text)) + ;; [name] (no args) → empty + ((string-match "^\\[.+\\]$" text) + "") + ;; Plain text → as-is + (t text)))) + +(defun pi-coding-agent--tree-node-preview (node) + "Return preview text for NODE." + (let ((type (plist-get node :type))) + (pcase type + ("compaction" + (format "compacted (%s tokens)" + (pi-coding-agent--format-tokens-compact + (or (plist-get node :tokensBefore) 0)))) + ("branch_summary" + (pi-coding-agent--first-nonempty-line + (or (plist-get node :summary) ""))) + ("model_change" + (format "%s/%s" (plist-get node :provider) (plist-get node :modelId))) + ("thinking_level_change" + (or (plist-get node :thinkingLevel) "")) + ("tool_result" + (pi-coding-agent--tree-strip-bracket-preview node)) + ("message" + (if (equal (plist-get node :role) "bashExecution") + (pi-coding-agent--tree-strip-bracket-preview node) + (or (plist-get node :preview) ""))) + (_ (or (plist-get node :preview) ""))))) + +(defun pi-coding-agent--tree-format-node-line (node is-active) + "Format a single NODE into a display string. +IS-ACTIVE is non-nil if the node is on the active path. +Labels are rendered separately as right-margin overlays." + (let* ((face (pi-coding-agent--tree-node-face node)) + (type-label (pi-coding-agent--tree-node-type-label node)) + (preview (pi-coding-agent--tree-node-preview node)) + (marker (if is-active + (pi-coding-agent--propertize-face + "• " 'pi-coding-agent-tree-active) + " ")) + (type-str (pi-coding-agent--propertize-face + (format "%-7s" type-label) face)) + (preview-str (pi-coding-agent--propertize-face preview face))) + (concat marker type-str " " preview-str))) + +;;;; Tree Browser Rendering + +(defun pi-coding-agent--tree-browser-render (buf) + "Render the tree browser in BUF from its buffer-local state." + (with-current-buffer buf + (let* ((inhibit-read-only t) + (tree pi-coding-agent--tree-browser-tree) + (leaf-id pi-coding-agent--tree-browser-leaf-id) + (filter pi-coding-agent--tree-browser-filter)) + (magit-insert-section (root) + (cond + (pi-coding-agent--tree-browser-loading + (insert (pi-coding-agent--propertize-face + "Loading tree..." + 'pi-coding-agent-activity-phase) + "\n")) + ((or (null tree) (= (length tree) 0)) + (insert "No conversation tree.\n")) + (t + (let* ((flat (pi-coding-agent--flatten-tree-for-display + tree leaf-id filter)) + (active-ids (pi-coding-agent--active-path-ids tree leaf-id)) + ;; Apply search filter if active + (visible (if pi-coding-agent--tree-browser-search-tokens + (cl-remove-if-not + (lambda (entry) + (pi-coding-agent--matches-filter-p + (pi-coding-agent--tree-node-preview + (nth 0 entry)) + pi-coding-agent--tree-browser-search-tokens)) + flat) + flat))) + (setq pi-coding-agent--tree-browser-visible-count + (length visible)) + (if (null visible) + (insert "No matching entries.\n") + (dolist (entry visible) + (let* ((node (nth 0 entry)) + (prefix (nth 2 entry)) + (node-id (plist-get node :id)) + (is-active (gethash node-id active-ids)) + (prefix-str (pi-coding-agent--propertize-face + prefix + 'pi-coding-agent-tree-connector)) + (line (pi-coding-agent--tree-format-node-line + node is-active))) + (magit-insert-section (tree-node node-id) + (magit-insert-heading + (concat prefix-str line)) + (when-let ((label (plist-get node :label))) + ;; 3 = "[" + "]" + 1 char padding + (let ((truncated + (pi-coding-agent--truncate-string + label + (- pi-coding-agent--tree-margin-width 3)))) + (pi-coding-agent--make-margin-overlay + (pi-coding-agent--propertize-face + (format "[%s]" truncated) + 'pi-coding-agent-tree-label))))))))))))))) + +;;;; Tree Browser Header-Line + +(defun pi-coding-agent--tree-browser-header-line () + "Return header-line string for the tree browser. +Uses cached visible count from the last render to avoid redundant +tree flattening on every redisplay cycle." + (let* ((filter pi-coding-agent--tree-browser-filter) + (query pi-coding-agent--tree-browser-search-query) + (total pi-coding-agent--tree-browser-visible-count) + (parts (list (format "Tree [%s]" filter) + (format "(%d)" total)))) + (when query (push (format "/%s" query) parts)) + (push (pi-coding-agent--propertize-face "?:help" 'shadow) parts) + (mapconcat #'identity (nreverse parts) " │ "))) + +;;;; Tree Browser Interactive Commands + +(defun pi-coding-agent-tree-browser-cycle-filter () + "Cycle the tree browser filter mode." + (interactive) + (let* ((modes pi-coding-agent--tree-filter-modes) + (current pi-coding-agent--tree-browser-filter) + (next (or (cadr (member current modes)) (car modes)))) + (setq pi-coding-agent--tree-browser-filter next) + (pi-coding-agent--tree-browser-rerender) + (message "Pi: Filter: %s" next))) + +(defun pi-coding-agent-tree-browser-search () + "Set or clear search filter in the tree browser." + (interactive) + (let ((query (read-string "Filter (regexp tokens): " + pi-coding-agent--tree-browser-search-query)) + (need-rerender t)) + (if (string-empty-p query) + (setq pi-coding-agent--tree-browser-search-query nil + pi-coding-agent--tree-browser-search-tokens nil) + (condition-case err + (let ((tokens (split-string query))) + (dolist (tok tokens) + (string-match-p tok "")) + (setq pi-coding-agent--tree-browser-search-query query + pi-coding-agent--tree-browser-search-tokens tokens)) + (invalid-regexp + (message "Pi: Invalid regexp: %s" (error-message-string err)) + (setq need-rerender nil)))) + (when need-rerender + (pi-coding-agent--tree-browser-rerender)))) + +(defun pi-coding-agent--tree-browser-with-node (action) + "Call ACTION with (proc node-id chat-buf tree-buf on-success). +Guards: verifies section, process, chat buffer, and not-at-leaf. +On success the tree browser window is dismissed via `quit-window'." + (when-let* ((section (magit-current-section)) + (node-id (oref section value)) + (proc (pi-coding-agent--get-process)) + (chat-buf (pi-coding-agent--get-chat-buffer))) + (if (equal node-id pi-coding-agent--tree-browser-leaf-id) + (message "Pi: Already at current position") + (let ((tree-buf (current-buffer)) + (win (selected-window))) + (funcall action proc node-id chat-buf tree-buf + (lambda () + (when (window-live-p win) + (quit-window nil win)))))))) + +(defun pi-coding-agent-tree-browser-navigate () + "Navigate to the tree node at point without summarization. +On success, dismisses the tree browser via `quit-window'." + (interactive) + (pi-coding-agent--tree-browser-with-node + (lambda (proc node-id chat-buf tree-buf on-success) + (pi-coding-agent--navigate-tree-async + proc node-id nil nil chat-buf tree-buf on-success)))) + +(defun pi-coding-agent-tree-browser-summarize () + "Navigate to the tree node at point with branch summarization. +Prompts for optional custom summary instructions. Empty input uses the +default summarization prompt. `C-g' at the prompt cancels. +On success, dismisses the tree browser via `quit-window'." + (interactive) + (pi-coding-agent--tree-browser-with-node + #'pi-coding-agent--tree-summarize-and-navigate)) + +(defun pi-coding-agent--tree-summarize-and-navigate + (proc node-id chat-buf tree-buf &optional on-success) + "Prompt for summary instructions, then navigate with summarization. +PROC is the pi process. NODE-ID is the target. +CHAT-BUF and TREE-BUF are refreshed on success. +ON-SUCCESS is an optional callback invoked after successful navigation. +`C-g' at the prompt cancels without sending any RPC." + (condition-case nil + (let* ((input (read-string "Summary instructions (RET for default): ")) + (custom-instructions (unless (string-empty-p input) input))) + (message "Pi: Summarizing...") + (pi-coding-agent--navigate-tree-async + proc node-id t custom-instructions chat-buf tree-buf on-success)) + (quit (message "Pi: Summarization cancelled")))) + +(defun pi-coding-agent-tree-browser-abort-summarization () + "Abort an in-progress branch summarization. +Sends `abort_branch_summary' to the pi process if a summarization +is currently in flight. Does nothing if no summarization is active." + (interactive) + (if (not pi-coding-agent--tree-browser-summarizing) + (message "Pi: No summarization in progress") + (setq pi-coding-agent--tree-browser-summarizing nil) + (when-let ((proc (pi-coding-agent--get-process))) + (pi-coding-agent--rpc-async proc + (pi-coding-agent--build-abort-branch-summary-command) + (lambda (_response) + (message "Pi: Summarization aborted")))))) + +(defun pi-coding-agent--navigate-tree-async + (proc node-id summarize custom-instructions chat-buf tree-buf + &optional on-success) + "Send navigate_tree RPC and handle the response. +PROC is the pi process. NODE-ID is the target. +SUMMARIZE and CUSTOM-INSTRUCTIONS control branch summary behavior. +CHAT-BUF and TREE-BUF are refreshed on success. +ON-SUCCESS is an optional callback invoked after successful navigation." + (when (and summarize tree-buf (buffer-live-p tree-buf)) + (with-current-buffer tree-buf + (setq pi-coding-agent--tree-browser-summarizing t))) + (pi-coding-agent--rpc-async proc + (pi-coding-agent--build-navigate-tree-command + node-id summarize custom-instructions) + (lambda (response) + (when (and tree-buf (buffer-live-p tree-buf)) + (with-current-buffer tree-buf + (setq pi-coding-agent--tree-browser-summarizing nil))) + (let ((result (pi-coding-agent--parse-navigate-result response))) + (cond + ;; Success (not cancelled, not aborted) + ((and result + (not (pi-coding-agent--normalize-boolean + (plist-get result :cancelled)))) + (pi-coding-agent--handle-navigate-success + proc result chat-buf tree-buf) + (when on-success (funcall on-success))) + ;; Aborted + ((and result (plist-get result :aborted)) + (message "Pi: Summarization aborted")) + ;; Cancelled or failed + (t + (message "Pi: Navigation cancelled"))))))) + +(defun pi-coding-agent--handle-navigate-success (proc result chat-buf tree-buf) + "Handle a successful navigate_tree RESULT. +PROC is used to refresh chat. CHAT-BUF and TREE-BUF are updated." + ;; Refresh chat + (pi-coding-agent--load-session-history + proc + (lambda (count) + (message "Pi: Navigated (%d messages)" count)) + chat-buf) + ;; Populate input if editorText present + (when-let ((text (plist-get result :editorText)) + (input-buf (and (buffer-live-p chat-buf) + (buffer-local-value + 'pi-coding-agent--input-buffer + chat-buf)))) + (when (buffer-live-p input-buf) + (with-current-buffer input-buf + (erase-buffer) + (insert text)))) + ;; Refresh tree + (when (buffer-live-p tree-buf) + (with-current-buffer tree-buf + (pi-coding-agent--tree-browser-fetch-and-render)))) + + +(defun pi-coding-agent-tree-browser-set-label () + "Set or clear a label on the tree node at point." + (interactive) + (when-let* ((section (magit-current-section)) + (node-id (oref section value)) + (proc (pi-coding-agent--get-process))) + (let* ((current-label nil) + ;; Find current label from tree data + (_ (when pi-coding-agent--tree-browser-tree + (setq current-label + (pi-coding-agent--tree-find-label + pi-coding-agent--tree-browser-tree node-id)))) + (new-label (read-string + (if current-label + (format "Label (current: %s, empty to clear): " current-label) + "Label: ") + current-label)) + (label (if (string-empty-p (string-trim new-label)) nil new-label)) + (tree-buf (current-buffer))) + (pi-coding-agent--rpc-async proc + (pi-coding-agent--build-set-label-command node-id label) + (lambda (response) + (if (eq (plist-get response :success) t) + (progn + (message "Pi: Label %s" (if label (format "set to \"%s\"" label) "cleared")) + (when (buffer-live-p tree-buf) + (with-current-buffer tree-buf + (pi-coding-agent--tree-browser-fetch-and-render)))) + (message "Pi: Failed to set label"))))))) + +(defun pi-coding-agent--tree-find-label (tree node-id) + "Find the label for NODE-ID in TREE. +Returns the label string or nil." + (let ((stack (append tree nil)) + (result nil)) + (while (and stack (not result)) + (let* ((node (pop stack)) + (children (plist-get node :children))) + (when (equal (plist-get node :id) node-id) + (setq result (plist-get node :label))) + (when (vectorp children) + (dotimes (i (length children)) + (push (aref children i) stack))))) + result)) + +;;;; Tree Browser Fetch and Render + +(defun pi-coding-agent--tree-browser-fetch-and-render () + "Fetch tree from the server and re-render." + (let ((buf (current-buffer)) + (proc (pi-coding-agent--get-process))) + (if (not proc) + (message "Pi: No active process") + (with-current-buffer buf + (setq pi-coding-agent--tree-browser-loading t) + (pi-coding-agent--tree-browser-rerender)) + (pi-coding-agent--rpc-async proc + (pi-coding-agent--build-get-tree-command) + (lambda (response) + (when (buffer-live-p buf) + (with-current-buffer buf + (let ((tree-data (pi-coding-agent--parse-tree response))) + (setq pi-coding-agent--tree-browser-loading nil + pi-coding-agent--tree-browser-tree + (plist-get tree-data :tree) + pi-coding-agent--tree-browser-leaf-id + (plist-get tree-data :leafId))) + (pi-coding-agent--tree-browser-rerender)))))))) + +(defun pi-coding-agent--tree-browser-rerender () + "Re-render the tree browser from local state." + (let ((inhibit-read-only t)) + (erase-buffer) + (pi-coding-agent--tree-browser-render (current-buffer)) + (goto-char (point-min)) + (when (magit-current-section) + (magit-section-show (magit-current-section))) + (force-mode-line-update))) + +;;;; Tree Browser Refresh Integration + +(defun pi-coding-agent-browse-refresh () + "Refresh the current browse buffer from the server." + (interactive) + (cond + ((derived-mode-p 'pi-coding-agent-session-browser-mode) + (pi-coding-agent--session-browser-fetch-and-render)) + ((derived-mode-p 'pi-coding-agent-tree-browser-mode) + (pi-coding-agent--tree-browser-fetch-and-render)) + (t (message "Pi: Not in a browse buffer")))) + +;;;; Entry Points + +;;;###autoload +(defun pi-coding-agent-session-browser () + "Open the session browser for the current project." + (interactive) + (let* ((dir (pi-coding-agent--session-directory)) + (new-p (not (get-buffer + (pi-coding-agent--session-browser-buffer-name dir)))) + (buf (pi-coding-agent--get-or-create-session-browser dir))) + ;; Link to chat session + (when-let ((chat-buf (pi-coding-agent--get-chat-buffer))) + (with-current-buffer buf + (setq pi-coding-agent--chat-buffer chat-buf + pi-coding-agent--process + (buffer-local-value 'pi-coding-agent--process chat-buf)))) + (pop-to-buffer buf) + (pi-coding-agent--browse-apply-margins) + (pi-coding-agent--session-browser-fetch-and-render) + (when new-p + (message "Press ? for available commands")))) + +;;;###autoload +(defun pi-coding-agent-tree-browser () + "Open the tree browser for the current session." + (interactive) + (let* ((dir (pi-coding-agent--session-directory)) + (new-p (not (get-buffer + (pi-coding-agent--tree-browser-buffer-name dir)))) + (buf (pi-coding-agent--get-or-create-tree-browser dir))) + ;; Link to chat session + (when-let ((chat-buf (pi-coding-agent--get-chat-buffer))) + (with-current-buffer buf + (setq pi-coding-agent--chat-buffer chat-buf + pi-coding-agent--process + (buffer-local-value 'pi-coding-agent--process chat-buf)))) + (pop-to-buffer buf) + (pi-coding-agent--browse-apply-margins) + (pi-coding-agent--tree-browser-fetch-and-render) + (when new-p + (message "Press ? for available commands")))) + +(provide 'pi-coding-agent-browse) +;;; pi-coding-agent-browse.el ends here diff --git a/pi-coding-agent-core.el b/pi-coding-agent-core.el index 810c279..ff4a3e6 100644 --- a/pi-coding-agent-core.el +++ b/pi-coding-agent-core.el @@ -285,10 +285,10 @@ JSON true (t) stays t, JSON false (:false) becomes nil." (if (pi-coding-agent--json-false-p value) nil value)) (defun pi-coding-agent--normalize-string-or-null (value) - "Return VALUE if it's a string, nil otherwise. + "Return VALUE if it's a non-empty string, nil otherwise. Use when reading JSON fields that may be null or string. -JSON null (:null) and non-strings become nil." - (and (stringp value) value)) +JSON null (:null), non-strings, and empty strings become nil." + (and (stringp value) (not (string-empty-p value)) value)) (defun pi-coding-agent--update-state-from-event (event) "Update status and state based on EVENT. diff --git a/pi-coding-agent-menu.el b/pi-coding-agent-menu.el index ea9b791..e738c4e 100644 --- a/pi-coding-agent-menu.el +++ b/pi-coding-agent-menu.el @@ -31,7 +31,6 @@ ;; Key entry points: ;; `pi-coding-agent-menu' Transient menu (C-c C-p) ;; `pi-coding-agent-new-session' Start fresh session -;; `pi-coding-agent-resume-session' Resume previous session ;; `pi-coding-agent-reload' Restart pi process ;; `pi-coding-agent-select-model' Choose model interactively ;; `pi-coding-agent-cycle-thinking' Cycle thinking levels @@ -114,15 +113,6 @@ from either chat or input buffer." (message "Pi: New session started")) (message "Pi: New session cancelled"))))))) -(defun pi-coding-agent--session-dir-name (dir) - "Convert DIR to session directory name. -Matches pi's encoding: --path-with-dashes--. -Note: Handles both Unix and Windows path separators." - (let* ((clean-dir (directory-file-name dir)) ; Remove trailing slash - (safe-path (replace-regexp-in-string "[/\\\\:]" "-" - (replace-regexp-in-string "^[/\\\\]" "" clean-dir)))) - (concat "--" safe-path "--"))) - (defun pi-coding-agent--session-metadata (path) "Extract metadata from session file PATH. Returns plist with :modified-time, :first-message, :message-count, and @@ -176,44 +166,6 @@ Call this from the chat buffer after switching or loading a session." (let ((metadata (pi-coding-agent--session-metadata session-file))) (setq pi-coding-agent--session-name (plist-get metadata :session-name))))) -(defun pi-coding-agent--list-sessions (dir) - "List available session files for project DIR. -Returns list of absolute paths to .jsonl files, sorted by modification -time with most recently used first." - (let* ((sessions-base (expand-file-name "~/.pi/agent/sessions/")) - (session-dir (expand-file-name (pi-coding-agent--session-dir-name dir) sessions-base))) - (when (file-directory-p session-dir) - ;; Sort by modification time descending (most recently used first) - (sort (directory-files session-dir t "\\.jsonl$") - (lambda (a b) - (time-less-p (file-attribute-modification-time (file-attributes b)) - (file-attribute-modification-time (file-attributes a)))))))) - -(defun pi-coding-agent--format-session-choice (path) - "Format session PATH for display in selector. -Returns (display-string . path) for `completing-read'. -Prefers session name over first message when available." - (let ((metadata (pi-coding-agent--session-metadata path))) - (if metadata - (let* ((modified-time (plist-get metadata :modified-time)) - (session-name (plist-get metadata :session-name)) - (first-msg (plist-get metadata :first-message)) - (msg-count (plist-get metadata :message-count)) - (relative-time (pi-coding-agent--format-relative-time modified-time)) - ;; Prefer session name, fall back to first message preview - (label (cond - (session-name (pi-coding-agent--truncate-string session-name 50)) - (first-msg (pi-coding-agent--truncate-string first-msg 50)) - (t nil))) - (display (if label - (format "%s · %s (%d msgs)" - label relative-time msg-count) - (format "[empty session] · %s" relative-time)))) - (cons display path)) - ;; Fallback to filename if metadata extraction fails - (let ((filename (file-name-nondirectory path))) - (cons filename path))))) - (defun pi-coding-agent--reset-session-state () "Reset all session-specific state for a new session. Call this when starting a new session to ensure no stale state persists." @@ -343,56 +295,11 @@ using the cached session file." (message "Pi: Failed to reload - %s" (or (plist-get response :error) "unknown error")))))))))))) -(defun pi-coding-agent-resume-session () - "Resume a previous pi session from the current project." - (interactive) - (when-let ((proc (pi-coding-agent--get-process)) - (dir (pi-coding-agent--session-directory))) - (let ((sessions (pi-coding-agent--list-sessions dir))) - (if (null sessions) - (message "Pi: No previous sessions found") - (let* ((choices (mapcar #'pi-coding-agent--format-session-choice sessions)) - (choice-strings (mapcar #'car choices)) - ;; Use completion table with metadata to preserve our sort order - ;; (completing-read normally re-sorts alphabetically) - (choice (completing-read "Resume session: " - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity)) - (complete-with-action action choice-strings string pred))) - nil t)) - (selected-path (cdr (assoc choice choices))) - ;; Capture chat buffer before async call - (chat-buf (pi-coding-agent--get-chat-buffer))) - (when selected-path - (pi-coding-agent--rpc-async proc (list :type "switch_session" - :sessionPath selected-path) - (lambda (response) - (let* ((data (plist-get response :data)) - (cancelled (plist-get data :cancelled))) - (if (and (plist-get response :success) - (pi-coding-agent--json-false-p cancelled)) - (progn - ;; Update session name cache - (when (buffer-live-p chat-buf) - (with-current-buffer chat-buf - (pi-coding-agent--update-session-name-from-file selected-path))) - ;; Refresh state to get new session-file - (pi-coding-agent--rpc-async proc '(:type "get_state") - (lambda (resp) - (pi-coding-agent--apply-state-response chat-buf resp))) - (pi-coding-agent--load-session-history - proc - (lambda (count) - (message "Pi: Resumed session (%d messages)" count)) - chat-buf)) - (message "Pi: Failed to resume session"))))))))))) - ;;;; Model and Thinking (defun pi-coding-agent-set-session-name (name) "Set the session NAME for the current session. -The name is displayed in the resume picker and header-line." +The name is displayed in the session browser and header-line." (interactive (let ((chat-buf (pi-coding-agent--get-chat-buffer))) (list (read-string "Session name: " @@ -633,48 +540,6 @@ Optional OUTPUT-PATH specifies where to save; nil uses pi's default." ;;;; Fork -(defun pi-coding-agent--flatten-tree (nodes) - "Flatten tree NODES into a hash table mapping id to node plist. -NODES is a vector of tree node plists, each with `:children' vector. -Returns a hash table for O(1) lookup by id. - -Uses iterative traversal to avoid `max-lisp-eval-depth' errors on deep -session trees." - (let ((index (make-hash-table :test 'equal)) - (stack nil)) - ;; Push roots in reverse so popping preserves original order. - (let ((i (1- (length nodes)))) - (while (>= i 0) - (push (aref nodes i) stack) - (setq i (1- i)))) - (while stack - (let* ((node (pop stack)) - (children (plist-get node :children))) - (puthash (plist-get node :id) node index) - (let ((i (1- (length children)))) - (while (>= i 0) - (push (aref children i) stack) - (setq i (1- i)))))) - index)) - -(defun pi-coding-agent--active-branch-user-ids (index leaf-id) - "Return chronological list of user message IDs on the active branch. -INDEX is a hash table from `pi-coding-agent--flatten-tree'. -LEAF-ID is the current leaf node ID. Walk from leaf to root via -`:parentId', collecting IDs of nodes with type \"message\" and role -\"user\". Returns list in root-to-leaf (chronological) order." - (when leaf-id - (let ((user-ids nil) - (current-id leaf-id)) - (while current-id - (let ((node (gethash current-id index))) - (when (and node - (equal (plist-get node :type) "message") - (equal (plist-get node :role) "user")) - (push (plist-get node :id) user-ids)) - (setq current-id (and node (plist-get node :parentId))))) - user-ids))) - (defun pi-coding-agent--format-fork-message (msg &optional index) "Format MSG for display in fork selector. MSG is a plist with :entryId and :text. @@ -849,14 +714,15 @@ Uses commands from pi's `get_commands' RPC." :class transient-row] [["Session" ("n" "new" pi-coding-agent-new-session) - ("r" "resume" pi-coding-agent-resume-session) + ("r" "sessions" pi-coding-agent-session-browser) ("R" "reload" pi-coding-agent-reload) ("N" "name" pi-coding-agent-set-session-name) ("e" "export" pi-coding-agent-export-html) ("Q" "quit" pi-coding-agent-quit)] ["Context" ("c" "compact" pi-coding-agent-compact) - ("f" "fork" pi-coding-agent-fork)]] + ("f" "fork" pi-coding-agent-fork) + ("w" "tree" pi-coding-agent-tree-browser)]] [["Model" ("m" "select" pi-coding-agent-select-model) ("t" "thinking" pi-coding-agent-cycle-thinking)] diff --git a/pi-coding-agent-render.el b/pi-coding-agent-render.el index 42e1b8f..4ece2f4 100644 --- a/pi-coding-agent-render.el +++ b/pi-coding-agent-render.el @@ -1901,6 +1901,16 @@ For example: '+ 7 code' or '-12 code'" (overlay-put line-ov 'priority pi-coding-agent--diff-line-priority) (overlay-put line-ov 'pi-coding-agent-diff-overlay t))))) +;;;; Branch Summary Display + +(defun pi-coding-agent--display-branch-summary (summary &optional timestamp) + "Display a branch summary block in the chat buffer. +SUMMARY is the branch summary text (markdown). +TIMESTAMP is optional time when the summary was created." + (pi-coding-agent--append-to-chat + (concat "\n" (pi-coding-agent--make-separator "Branch Summary" timestamp) "\n" + (or summary "") "\n"))) + ;;;; Compaction Display (defun pi-coding-agent--display-compaction-result (tokens-before summary &optional timestamp) @@ -2267,6 +2277,13 @@ Each text block is rendered independently for proper formatting." (timestamp (pi-coding-agent--ms-to-time (plist-get message :timestamp)))) (pi-coding-agent--display-compaction-result tokens-before summary timestamp)) (setq prev-role "compactionSummary")) + ("branchSummary" + (flush-tools) + (let* ((summary (plist-get message :summary)) + (timestamp (pi-coding-agent--ms-to-time + (plist-get message :timestamp)))) + (pi-coding-agent--display-branch-summary summary timestamp)) + (setq prev-role "branchSummary")) ("toolResult" nil)))) (flush-tools)))) @@ -2288,7 +2305,12 @@ Note: When called from async callbacks, pass CHAT-BUF explicitly." (unless (bolp) (insert "\n")) (pi-coding-agent--set-message-start-marker nil) (pi-coding-agent--set-streaming-marker nil) - (goto-char (point-max)))))) + (goto-char (point-max)) + ;; Update all windows showing this buffer so the latest content + ;; is visible — with-current-buffer only moves the buffer's own + ;; point, not window-point of non-selected windows. + (dolist (win (get-buffer-window-list chat-buf nil t)) + (set-window-point win (point-max))))))) (provide 'pi-coding-agent-render) diff --git a/pi-coding-agent-ui.el b/pi-coding-agent-ui.el index 914dbb6..c46c60f 100644 --- a/pi-coding-agent-ui.el +++ b/pi-coding-agent-ui.el @@ -68,11 +68,14 @@ ;; pi-coding-agent-menu.el (menu and session commands) (declare-function pi-coding-agent-menu "pi-coding-agent-menu") -(declare-function pi-coding-agent-resume-session "pi-coding-agent-menu") (declare-function pi-coding-agent-select-model "pi-coding-agent-menu") (declare-function pi-coding-agent-cycle-thinking "pi-coding-agent-menu") (declare-function pi-coding-agent-fork-at-point "pi-coding-agent-menu") +;; pi-coding-agent-browse.el (browse buffers) +(declare-function pi-coding-agent-session-browser "pi-coding-agent-browse") +(declare-function pi-coding-agent-tree-browser "pi-coding-agent-browse") + ;; Optional: phscroll for horizontal table scrolling (require 'phscroll nil t) (declare-function phscroll-mode "phscroll" (&optional arg)) @@ -563,7 +566,7 @@ removing the instructional header that would otherwise appear." (define-key map (kbd "TAB") #'pi-coding-agent-complete) (define-key map (kbd "C-c C-k") #'pi-coding-agent-abort) (define-key map (kbd "C-c C-p") #'pi-coding-agent-menu) - (define-key map (kbd "C-c C-r") #'pi-coding-agent-resume-session) + (define-key map (kbd "C-c C-r") #'pi-coding-agent-session-browser) (define-key map (kbd "M-p") #'pi-coding-agent-previous-input) (define-key map (kbd "M-n") #'pi-coding-agent-next-input) (define-key map (kbd "") #'pi-coding-agent-previous-input) @@ -1135,22 +1138,6 @@ turn markers as H1 while LLM ATX headings are leveled down to H2+." Returns nil if MS is nil." (and ms (seconds-to-time (/ ms 1000.0)))) -(defun pi-coding-agent--format-relative-time (time) - "Format TIME (Emacs time value) as relative time string." - (condition-case nil - (let* ((now (current-time)) - (diff (float-time (time-subtract now time))) - (minutes (/ diff 60)) - (hours (/ diff 3600)) - (days (/ diff 86400))) - (cond - ((< minutes 1) "just now") - ((< minutes 60) (format "%d min ago" (floor minutes))) - ((< hours 24) (format "%d hr ago" (floor hours))) - ((< days 7) (format "%d days ago" (floor days))) - (t (format-time-string "%b %d" time)))) - (error "Unknown time format"))) - (defun pi-coding-agent--format-message-timestamp (time) "Format TIME for message headers. Shows HH:MM if today, otherwise YYYY-MM-DD HH:MM." @@ -1282,7 +1269,7 @@ Stores the result in CHAT-BUF and emits a minibuffer notice when available." separator "\n" "C-c C-c send prompt\n" "C-c C-k abort\n" - "C-c C-r resume session\n" + "C-c C-r sessions\n" "C-c C-p menu\n"))) (defun pi-coding-agent--display-startup-header () diff --git a/pi-coding-agent.el b/pi-coding-agent.el index 4a1ccb5..94b290f 100644 --- a/pi-coding-agent.el +++ b/pi-coding-agent.el @@ -7,7 +7,7 @@ ;; URL: https://github.com/dnouri/pi-coding-agent ;; Keywords: ai llm ai-pair-programming tools ;; Version: 1.3.6 -;; Package-Requires: ((emacs "28.1") (markdown-mode "2.6") (transient "0.9.0")) +;; Package-Requires: ((emacs "28.1") (markdown-mode "2.6") (transient "0.9.0") (magit-section "4.0.0")) ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -53,7 +53,7 @@ ;; C-c C-s Queue steering (interrupts after current tool; busy only) ;; C-c C-k Abort streaming ;; C-c C-p Open menu -;; C-c C-r Resume session +;; C-c C-r Browse sessions ;; M-p / M-n History navigation ;; C-r Incremental history search (like readline) ;; TAB Path/file completion @@ -81,6 +81,7 @@ (require 'pi-coding-agent-menu) (require 'pi-coding-agent-input) +(require 'pi-coding-agent-browse) ;;;; Main Entry Point diff --git a/test/fixtures/browse-navigate.json b/test/fixtures/browse-navigate.json new file mode 100644 index 0000000..78c3e27 --- /dev/null +++ b/test/fixtures/browse-navigate.json @@ -0,0 +1,15 @@ +{ + "type": "response", + "id": "req_3", + "command": "navigate_tree", + "success": true, + "data": { + "cancelled": false, + "editorText": "Actually, let's try a different approach", + "summaryEntry": { + "id": "summary-1", + "summary": "Branch explored SQLAlchemy-based connection pooling with tests.", + "fromExtension": false + } + } +} diff --git a/test/fixtures/browse-sessions.json b/test/fixtures/browse-sessions.json new file mode 100644 index 0000000..6224081 --- /dev/null +++ b/test/fixtures/browse-sessions.json @@ -0,0 +1,58 @@ +{ + "type": "response", + "id": "req_1", + "command": "list_sessions", + "success": true, + "data": { + "sessions": [ + { + "path": "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-24_aaa.jsonl", + "id": "aaa-111", + "cwd": "/home/user/co/project", + "created": "2026-02-24T10:00:00.000Z", + "modified": "2026-02-24T12:30:00.000Z", + "messageCount": 42, + "firstMessage": "Fix the authentication bug in login.py" + }, + { + "path": "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-23_bbb.jsonl", + "id": "bbb-222", + "cwd": "/home/user/co/project", + "name": "Refactor DB Layer", + "created": "2026-02-23T09:00:00.000Z", + "modified": "2026-02-23T18:00:00.000Z", + "messageCount": 128, + "firstMessage": "Let's refactor the database layer to use connection pooling" + }, + { + "path": "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-23_ccc.jsonl", + "id": "ccc-333", + "cwd": "/home/user/co/project", + "parentSessionPath": "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-23_bbb.jsonl", + "created": "2026-02-23T15:00:00.000Z", + "modified": "2026-02-23T17:00:00.000Z", + "messageCount": 35, + "firstMessage": "Let's refactor the database layer to use connection pooling" + }, + { + "path": "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-22_ddd.jsonl", + "id": "ddd-444", + "cwd": "/home/user/co/project", + "name": "Setup CI/CD", + "created": "2026-02-22T08:00:00.000Z", + "modified": "2026-02-22T16:00:00.000Z", + "messageCount": 89, + "firstMessage": "Help me set up GitHub Actions for this project" + }, + { + "path": "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-20_eee.jsonl", + "id": "eee-555", + "cwd": "/home/user/co/project", + "created": "2026-02-20T14:00:00.000Z", + "modified": "2026-02-20T15:00:00.000Z", + "messageCount": 8, + "firstMessage": "Quick question: what's the best way to handle env vars?" + } + ] + } +} diff --git a/test/fixtures/browse-tree.json b/test/fixtures/browse-tree.json new file mode 100644 index 0000000..6264e6a --- /dev/null +++ b/test/fixtures/browse-tree.json @@ -0,0 +1,118 @@ +{ + "type": "response", + "id": "req_2", + "command": "get_tree", + "success": true, + "data": { + "tree": [ + { + "id": "node-1", + "parentId": null, + "type": "message", + "role": "user", + "timestamp": "2026-02-23T09:00:00.000Z", + "preview": "Let's refactor the database layer", + "children": [ + { + "id": "node-2", + "parentId": "node-1", + "type": "message", + "role": "assistant", + "timestamp": "2026-02-23T09:01:00.000Z", + "preview": "I'll help you refactor the database layer. Let me start by...", + "children": [ + { + "id": "node-3", + "parentId": "node-2", + "type": "tool_result", + "toolName": "Read", + "preview": "[Read: db/connection.py]", + "timestamp": "2026-02-23T09:02:00.000Z", + "children": [ + { + "id": "node-4", + "parentId": "node-3", + "type": "message", + "role": "user", + "timestamp": "2026-02-23T09:05:00.000Z", + "preview": "Actually, let's try a different approach", + "children": [ + { + "id": "node-5", + "parentId": "node-4", + "type": "message", + "role": "assistant", + "timestamp": "2026-02-23T09:06:00.000Z", + "preview": "Sure, let me explore the alternative using SQLAlchemy...", + "children": [ + { + "id": "node-6", + "parentId": "node-5", + "type": "tool_result", + "toolName": "Write", + "preview": "[Write: db/pool.py]", + "timestamp": "2026-02-23T09:07:00.000Z", + "children": [ + { + "id": "node-7", + "parentId": "node-6", + "type": "message", + "role": "user", + "timestamp": "2026-02-23T09:10:00.000Z", + "preview": "That looks good, now let's add tests", + "label": "checkpoint", + "children": [ + { + "id": "node-8", + "parentId": "node-7", + "type": "message", + "role": "assistant", + "timestamp": "2026-02-23T09:11:00.000Z", + "preview": "I'll write comprehensive tests for the connection pool...", + "children": [] + } + ] + } + ] + } + ] + }, + { + "id": "node-9", + "parentId": "node-4", + "type": "message", + "role": "assistant", + "timestamp": "2026-02-23T09:06:30.000Z", + "preview": "Another approach would be to use raw asyncpg...", + "stopReason": "aborted", + "children": [] + } + ] + } + ] + } + ] + } + ] + }, + { + "id": "node-10", + "parentId": null, + "type": "compaction", + "timestamp": "2026-02-23T08:00:00.000Z", + "tokensBefore": 50000, + "children": [ + { + "id": "node-11", + "parentId": "node-10", + "type": "branch_summary", + "timestamp": "2026-02-23T08:01:00.000Z", + "summary": "Earlier conversation about project setup and initial design decisions.", + "children": [] + } + ] + } + ], + "leafId": "node-8" + } +} diff --git a/test/pi-coding-agent-browse-test.el b/test/pi-coding-agent-browse-test.el new file mode 100644 index 0000000..243fa0f --- /dev/null +++ b/test/pi-coding-agent-browse-test.el @@ -0,0 +1,1688 @@ +;;; pi-coding-agent-browse-test.el --- Tests for browsing module -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Unit tests for pi-coding-agent-browse.el — session and tree browser +;; helper functions and response parsing. + +;;; Code: + +(require 'ert) +(require 'pi-coding-agent-browse) +(require 'pi-coding-agent-test-common) + +;;;; Test Fixtures + +(defvar pi-coding-agent-test--fixture-dir + (expand-file-name "test/fixtures/" + (or (and load-file-name + (file-name-directory + (directory-file-name + (file-name-directory load-file-name)))) + (locate-dominating-file default-directory "Makefile") + default-directory)) + "Directory containing JSON test fixtures.") + +(defun pi-coding-agent-test--read-json-fixture (filename) + "Read JSON fixture FILENAME from test/fixtures/ and return as plist." + (let ((path (expand-file-name filename pi-coding-agent-test--fixture-dir))) + (with-temp-buffer + (insert-file-contents path) + (json-parse-string (buffer-string) :object-type 'plist)))) + +;;;; Session Parsing + +(ert-deftest pi-coding-agent-test-parse-session-list () + "Parse list_sessions response into session items." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-sessions.json")) + (items (pi-coding-agent--parse-session-list response))) + (should (= (length items) 5)) + ;; First item fields + (let ((first (car items))) + (should (equal (plist-get first :id) "aaa-111")) + (should (equal (plist-get first :path) + "/home/user/.pi/agent/sessions/--home-user-co-project--/2026-02-24_aaa.jsonl")) + (should (= (plist-get first :messageCount) 42)) + (should (stringp (plist-get first :firstMessage)))))) + +(ert-deftest pi-coding-agent-test-parse-session-list-error () + "Return nil for failed list_sessions response." + (let ((response '(:type "response" :command "list_sessions" + :success :false :error "timeout"))) + (should (null (pi-coding-agent--parse-session-list response))))) + +(ert-deftest pi-coding-agent-test-parse-session-list-empty () + "Return empty list for response with no sessions." + (let ((response '(:type "response" :command "list_sessions" + :success t :data (:sessions [])))) + (should (equal (pi-coding-agent--parse-session-list response) nil)))) + +(ert-deftest pi-coding-agent-test-session-display-name () + "Session display name prefers name over firstMessage." + ;; Named session + (should (equal (pi-coding-agent--session-display-name + '(:name "My Session" :firstMessage "some prompt")) + "My Session")) + ;; Unnamed session + (should (equal (pi-coding-agent--session-display-name + '(:firstMessage "Fix the bug in login.py")) + "Fix the bug in login.py")) + ;; No name, no firstMessage + (should (equal (pi-coding-agent--session-display-name + '(:id "abc-123")) + "[empty session]")) + ;; Newlines in firstMessage collapsed to spaces + (should (equal (pi-coding-agent--session-display-name + '(:firstMessage "Fix the bug\nin login.py")) + "Fix the bug in login.py")) + ;; Multiple newlines and surrounding whitespace collapsed + (should (equal (pi-coding-agent--session-display-name + '(:firstMessage "First line\n\nSecond line\n Third")) + "First line Second line Third")) + ;; Newlines in name also collapsed + (should (equal (pi-coding-agent--session-display-name + '(:name "My\nSession" :firstMessage "prompt")) + "My Session"))) + +(ert-deftest pi-coding-agent-test-first-nonempty-line () + "Extract first non-empty line from a string." + ;; Single line + (should (equal (pi-coding-agent--first-nonempty-line "hello") "hello")) + ;; Multi-line returns first + (should (equal (pi-coding-agent--first-nonempty-line "first\nsecond") "first")) + ;; Skips leading blank lines + (should (equal (pi-coding-agent--first-nonempty-line "\n\nactual") "actual")) + ;; Nil returns empty string + (should (equal (pi-coding-agent--first-nonempty-line nil) "")) + ;; Empty string returns empty string + (should (equal (pi-coding-agent--first-nonempty-line "") "")) + ;; Only whitespace returns empty string + (should (equal (pi-coding-agent--first-nonempty-line "\n \n") ""))) + +;;;; Tree Parsing + +(ert-deftest pi-coding-agent-test-parse-tree () + "Parse get_tree response into tree data." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response))) + (should tree-data) + (should (equal (plist-get tree-data :leafId) "node-8")) + ;; Tree has two roots + (let ((roots (plist-get tree-data :tree))) + (should (= (length roots) 2)) + ;; First root is a user message + (let ((first (aref roots 0))) + (should (equal (plist-get first :type) "message")) + (should (equal (plist-get first :role) "user")))))) + +(ert-deftest pi-coding-agent-test-parse-tree-error () + "Return nil for failed get_tree response." + (let ((response '(:type "response" :command "get_tree" + :success :false :error "no session"))) + (should (null (pi-coding-agent--parse-tree response))))) + +;;;; Navigate Parsing + +(ert-deftest pi-coding-agent-test-parse-navigate-result () + "Parse navigate_tree response." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-navigate.json")) + (result (pi-coding-agent--parse-navigate-result response))) + (should result) + ;; JSON false parses as :false — use normalize-boolean + (should-not (pi-coding-agent--normalize-boolean (plist-get result :cancelled))) + (should (equal (plist-get result :editorText) + "Actually, let's try a different approach")) + (let ((summary (plist-get result :summaryEntry))) + (should summary) + (should (equal (plist-get summary :id) "summary-1")) + (should (stringp (plist-get summary :summary)))))) + +(ert-deftest pi-coding-agent-test-parse-navigate-cancelled () + "Parse cancelled navigate_tree response." + (let ((response '(:type "response" :command "navigate_tree" + :success t :data (:cancelled t)))) + (let ((result (pi-coding-agent--parse-navigate-result response))) + (should result) + (should (eq (plist-get result :cancelled) t))))) + +(ert-deftest pi-coding-agent-test-parse-navigate-error () + "Return nil for failed navigate_tree response." + (let ((response '(:type "response" :command "navigate_tree" + :success :false :error "bad target"))) + (should (null (pi-coding-agent--parse-navigate-result response))))) + +;;;; Margin Age Formatting + +(ert-deftest pi-coding-agent-test-margin-age-seconds () + "Margin age format for seconds." + (should (equal (pi-coding-agent--margin-age 1) '(1 . "second"))) + (should (equal (pi-coding-agent--margin-age 30) '(30 . "second"))) + (should (equal (pi-coding-agent--margin-age 59) '(59 . "second")))) + +(ert-deftest pi-coding-agent-test-margin-age-minutes () + "Margin age format for minutes." + (should (equal (pi-coding-agent--margin-age 60) '(1 . "minute"))) + (should (equal (pi-coding-agent--margin-age 120) '(2 . "minute"))) + (should (equal (pi-coding-agent--margin-age 3599) '(59 . "minute")))) + +(ert-deftest pi-coding-agent-test-margin-age-hours () + "Margin age format for hours." + (should (equal (pi-coding-agent--margin-age 3600) '(1 . "hour"))) + (should (equal (pi-coding-agent--margin-age 7200) '(2 . "hour"))) + (should (equal (pi-coding-agent--margin-age 86399) '(23 . "hour")))) + +(ert-deftest pi-coding-agent-test-margin-age-days () + "Margin age format for days." + (should (equal (pi-coding-agent--margin-age 86400) '(1 . "day"))) + (should (equal (pi-coding-agent--margin-age 604799) '(6 . "day")))) + +(ert-deftest pi-coding-agent-test-margin-age-weeks () + "Margin age format for weeks." + (should (equal (pi-coding-agent--margin-age 604800) '(1 . "week"))) + (should (equal (pi-coding-agent--margin-age 2629799) '(4 . "week")))) + +(ert-deftest pi-coding-agent-test-margin-age-months () + "Margin age format for months." + (should (equal (pi-coding-agent--margin-age 2629800) '(1 . "month"))) + (should (equal (pi-coding-agent--margin-age 31557599) '(11 . "month")))) + +(ert-deftest pi-coding-agent-test-margin-age-years () + "Margin age format for years." + (should (equal (pi-coding-agent--margin-age 31557600) '(1 . "year"))) + (should (equal (pi-coding-agent--margin-age 63115200) '(2 . "year")))) + +(ert-deftest pi-coding-agent-test-margin-age-zero () + "Margin age of zero seconds." + (should (equal (pi-coding-agent--margin-age 0) '(0 . "second")))) + +(ert-deftest pi-coding-agent-test-format-margin-age () + "Format margin age as aligned string." + ;; Singular: no trailing s + (should (equal (pi-coding-agent--format-margin-age 1) " 1 second ")) + ;; Plural: trailing s + (should (equal (pi-coding-agent--format-margin-age 120) " 2 minutes")) + ;; Right-justified count + (should (equal (pi-coding-agent--format-margin-age 3600) " 1 hour ")) + ;; Large count + (should (equal (pi-coding-agent--format-margin-age 86400) " 1 day ")) + ;; Multi-digit count (10 minutes) + (should (equal (pi-coding-agent--format-margin-age 600) "10 minutes")) + ;; Week boundary + (should (equal (pi-coding-agent--format-margin-age 604800) " 1 week "))) + +(ert-deftest pi-coding-agent-test-format-margin-age-from-iso () + "Format ISO timestamp as margin age string." + (cl-letf (((symbol-function 'current-time) + (lambda () (encode-time '(0 0 12 24 2 2026 nil nil 0))))) + ;; 5 minutes ago + (should (equal (pi-coding-agent--format-margin-age-from-iso + "2026-02-24T11:55:00.000Z") + " 5 minutes")) + ;; 2 hours ago + (should (equal (pi-coding-agent--format-margin-age-from-iso + "2026-02-24T10:00:00.000Z") + " 2 hours ")))) + +;;;; Margin Infrastructure + +(ert-deftest pi-coding-agent-test-propertize-face () + "Propertize-face sets both face and font-lock-face." + (let ((s (pi-coding-agent--propertize-face "hello" 'bold))) + (should (equal (get-text-property 0 'face s) 'bold)) + (should (equal (get-text-property 0 'font-lock-face s) 'bold)))) + +(ert-deftest pi-coding-agent-test-session-margin-width () + "Session margin width is computed from age spec." + ;; Width = count(4) + " msgs "(5) + age(2+1+max-unit-len) = 19 + ;; With 1 char padding = 20 + (should (integerp pi-coding-agent--session-margin-width)) + (should (>= pi-coding-agent--session-margin-width 19))) + +(ert-deftest pi-coding-agent-test-tree-margin-width () + "Tree margin width accommodates labels." + (should (integerp pi-coding-agent--tree-margin-width)) + (should (>= pi-coding-agent--tree-margin-width 14))) + +(ert-deftest pi-coding-agent-test-make-margin-overlay () + "Make-margin-overlay creates overlay with correct properties." + (with-temp-buffer + (insert "first line\n") + (insert "second line\n") + ;; Create overlay on the second line (point is after it) + (pi-coding-agent--make-margin-overlay "test margin") + (let* ((ovs (overlays-in (point-min) (point-max))) + (o (car ovs))) + (should o) + ;; Evaporate property set + (should (overlay-get o 'evaporate)) + ;; Before-string contains the display spec + (let* ((bs (overlay-get o 'before-string)) + (display (get-text-property 0 'display bs))) + (should display) + ;; Display spec is ((margin right-margin) STRING) + (should (equal (car display) '(margin right-margin))) + (should (equal (cadr display) "test margin")))))) + +(ert-deftest pi-coding-agent-test-make-margin-overlay-nil-string () + "Make-margin-overlay with nil uses a space." + (with-temp-buffer + (insert "a line\n") + (pi-coding-agent--make-margin-overlay nil) + (let* ((ovs (overlays-in (point-min) (point-max))) + (o (car ovs)) + (bs (overlay-get o 'before-string)) + (display (get-text-property 0 'display bs))) + (should (equal (cadr display) " "))))) + +(ert-deftest pi-coding-agent-test-browse-apply-margins () + "Apply-margins reads width from buffer-local variable." + (with-temp-buffer + (setq pi-coding-agent--browse-margin-width 20) + ;; Should not error; the function checks window-live-p + (pi-coding-agent--browse-apply-margins) + ;; Verify the variable was set correctly + (should (= pi-coding-agent--browse-margin-width 20)))) + +(ert-deftest pi-coding-agent-test-browse-mode-sets-right-margin-width () + "Browse mode sets buffer-local `right-margin-width'. +This ensures margins are cleaned up when `quit-window' switches to +another buffer — Emacs resets window margins from the new buffer's +`right-margin-width' during `set-window-buffer'." + (let ((tree-buf (generate-new-buffer " *test-tree*")) + (session-buf (generate-new-buffer " *test-sessions*"))) + (unwind-protect + (progn + (with-current-buffer tree-buf + (pi-coding-agent-tree-browser-mode) + (should (= right-margin-width + pi-coding-agent--tree-margin-width))) + (with-current-buffer session-buf + (pi-coding-agent-session-browser-mode) + (should (= right-margin-width + pi-coding-agent--session-margin-width)))) + (kill-buffer tree-buf) + (kill-buffer session-buf)))) + +(ert-deftest pi-coding-agent-test-browse-mode-no-margin-leak () + "Mode setup must not set margins on unrelated windows. +When the browse buffer is created via `with-current-buffer' (not yet +displayed), `--browse-apply-margins' must not touch `selected-window'." + (let ((other-buf (current-buffer)) + (browse-buf (generate-new-buffer " *test-tree-leak*"))) + (unwind-protect + (progn + ;; Record the current window's margins before mode setup + (set-window-margins (selected-window) nil nil) + (should-not (cdr (window-margins (selected-window)))) + ;; Create browse buffer in background (not displayed) + (with-current-buffer browse-buf + (pi-coding-agent-tree-browser-mode)) + ;; The selected window (showing other-buf) must NOT have margins + (should-not (cdr (window-margins (selected-window))))) + (kill-buffer browse-buf)))) + +;;;; Active Path Detection + +(ert-deftest pi-coding-agent-test-active-path-ids () + "Compute set of node IDs on the active path from root to leaf." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response)) + (active (pi-coding-agent--active-path-ids + (plist-get tree-data :tree) + (plist-get tree-data :leafId)))) + ;; The path from root to node-8: node-1 → node-2 → node-3 → node-4 → node-5 → node-6 → node-7 → node-8 + (should (gethash "node-1" active)) + (should (gethash "node-8" active)) + (should (gethash "node-4" active)) + ;; Abandoned branch node should NOT be on active path + (should-not (gethash "node-9" active)) + ;; Compaction root node-10 is not on active path + (should-not (gethash "node-10" active)))) + +;;;; Deep Tree Safety + +(defun pi-coding-agent-test--make-deep-tree (n) + "Create a single-chain tree of N nodes for depth testing." + (let ((node (list :id (format "node-%d" n) + :type "message" :role "user" + :preview (format "message %d" n) + :timestamp "2026-01-01T00:00:00Z" + :children (vector)))) + (cl-loop for i from (1- n) downto 1 + do (setq node (list :id (format "node-%d" i) + :type "message" + :role (if (= (mod i 2) 1) "user" "assistant") + :preview (format "message %d" i) + :timestamp "2026-01-01T00:00:00Z" + :children (vector node)))) + (vector node))) + +(ert-deftest pi-coding-agent-test-flatten-tree-deep-chain () + "Flatten a linear chain deeper than max-lisp-eval-depth." + (let* ((n 2000) + (tree (pi-coding-agent-test--make-deep-tree n)) + (leaf-id (format "node-%d" n)) + (flat (pi-coding-agent--flatten-tree-for-display + tree leaf-id "default"))) + (should (= (length flat) n)))) + +(ert-deftest pi-coding-agent-test-subtree-contains-active-deep () + "Subtree-contains-active-p works on chains deeper than max-lisp-eval-depth." + (let* ((n 2000) + (tree (pi-coding-agent-test--make-deep-tree n)) + (active-ids (make-hash-table :test 'equal))) + (puthash (format "node-%d" n) t active-ids) + (should (pi-coding-agent--subtree-contains-active-p + (aref tree 0) active-ids)))) + +;;;; Tree Flattening + +(ert-deftest pi-coding-agent-test-flatten-tree-for-display () + "Flatten tree into display-ordered list with indent levels and prefixes." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response)) + (flat (pi-coding-agent--flatten-tree-for-display + (plist-get tree-data :tree) + (plist-get tree-data :leafId) + "default"))) + ;; Should return a list of (node indent prefix) lists + (should (listp flat)) + (should (> (length flat) 0)) + ;; First item should be the first root + (let* ((first-entry (car flat)) + (node (nth 0 first-entry)) + (indent (nth 1 first-entry)) + (prefix (nth 2 first-entry))) + (should (equal (plist-get node :id) "node-1")) + (should (= indent 0)) + (should (stringp prefix))))) + +(ert-deftest pi-coding-agent-test-flatten-tree-connector-prefixes () + "Branch children get ├─/└─ connectors; chain nodes get gutter continuation." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response)) + (flat (pi-coding-agent--flatten-tree-for-display + (plist-get tree-data :tree) + (plist-get tree-data :leafId) + "default")) + ;; Build alist of (id . prefix) for easy lookup + (prefix-alist (mapcar (lambda (entry) + (cons (plist-get (nth 0 entry) :id) + (nth 2 entry))) + flat))) + ;; Root-level single-child chain: no prefix + (should (equal (alist-get "node-1" prefix-alist nil nil #'equal) "")) + (should (equal (alist-get "node-2" prefix-alist nil nil #'equal) "")) + (should (equal (alist-get "node-3" prefix-alist nil nil #'equal) "")) + (should (equal (alist-get "node-4" prefix-alist nil nil #'equal) "")) + ;; Branch point children: first gets ├─, last gets └─ + ;; node-5 is first (active branch), node-9 is last + (should (equal (alist-get "node-5" prefix-alist nil nil #'equal) "├─ ")) + (should (equal (alist-get "node-9" prefix-alist nil nil #'equal) "└─ ")) + ;; Descendants within active branch: gutter continuation + (should (equal (alist-get "node-6" prefix-alist nil nil #'equal) "│ ")) + (should (equal (alist-get "node-7" prefix-alist nil nil #'equal) "│ ")) + (should (equal (alist-get "node-8" prefix-alist nil nil #'equal) "│ ")) + ;; Second root and its child: no prefix (no top-level connectors) + (should (equal (alist-get "node-10" prefix-alist nil nil #'equal) "")) + (should (equal (alist-get "node-11" prefix-alist nil nil #'equal) "")))) + +(ert-deftest pi-coding-agent-test-flatten-tree-connectors-no-tools-filter () + "Connectors work when tool nodes are filtered out." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response)) + (flat (pi-coding-agent--flatten-tree-for-display + (plist-get tree-data :tree) + (plist-get tree-data :leafId) + "no-tools")) + (prefix-alist (mapcar (lambda (entry) + (cons (plist-get (nth 0 entry) :id) + (nth 2 entry))) + flat)) + (id-list (mapcar (lambda (entry) (plist-get (nth 0 entry) :id)) flat))) + ;; Tool nodes should be absent + (should-not (member "node-3" id-list)) + (should-not (member "node-6" id-list)) + ;; Branch connectors still correct (node-5 first, node-9 last) + (should (equal (alist-get "node-5" prefix-alist nil nil #'equal) "├─ ")) + (should (equal (alist-get "node-9" prefix-alist nil nil #'equal) "└─ ")) + ;; Chain descendant of active branch still gets gutter + (should (equal (alist-get "node-7" prefix-alist nil nil #'equal) "│ ")) + (should (equal (alist-get "node-8" prefix-alist nil nil #'equal) "│ ")))) + +(ert-deftest pi-coding-agent-test-flatten-tree-connectors-single-root () + "Single-root tree has no top-level connectors." + (let* ((tree (list '(:id "r1" :type "message" :role "user" + :children [(:id "c1" :type "message" :role "assistant" + :preview "hi" :children [])]))) + (flat (pi-coding-agent--flatten-tree-for-display tree "c1" "default")) + (prefixes (mapcar (lambda (e) (nth 2 e)) flat))) + ;; Both nodes at root level, single-child chain — no connectors + (should (equal prefixes '("" ""))))) + +(ert-deftest pi-coding-agent-test-flatten-tree-connectors-nested-branches () + "Nested branch points produce correct multi-level gutter stacks." + (let* ((tree (list + '(:id "root" :type "message" :role "user" :preview "root" + :children + [(:id "a1" :type "message" :role "assistant" :preview "a1" + :children + [(:id "u2" :type "message" :role "user" :preview "u2" + :children []) + (:id "u3" :type "message" :role "user" :preview "u3" + :children [])]) + (:id "a2" :type "message" :role "assistant" :preview "a2" + :children [])]))) + ;; leaf is u2 so a1 branch is active + (flat (pi-coding-agent--flatten-tree-for-display tree "u2" "default")) + (prefix-alist (mapcar (lambda (entry) + (cons (plist-get (nth 0 entry) :id) + (nth 2 entry))) + flat))) + ;; root: no prefix + (should (equal (alist-get "root" prefix-alist nil nil #'equal) "")) + ;; First branch children: a1 (active, first), a2 (last) + (should (equal (alist-get "a1" prefix-alist nil nil #'equal) "├─ ")) + (should (equal (alist-get "a2" prefix-alist nil nil #'equal) "└─ ")) + ;; Nested branch under a1: u2 (active, first), u3 (last) + ;; Gutter from outer branch (│) + inner connector + (should (equal (alist-get "u2" prefix-alist nil nil #'equal) "│ ├─ ")) + (should (equal (alist-get "u3" prefix-alist nil nil #'equal) "│ └─ ")))) + +(ert-deftest pi-coding-agent-test-flatten-tree-connectors-three-siblings () + "Three siblings at a branch point: ├─, ├─, └─." + (let* ((tree (list + '(:id "root" :type "message" :role "user" :preview "q" + :children + [(:id "c1" :type "message" :role "assistant" + :preview "first" :children []) + (:id "c2" :type "message" :role "assistant" + :preview "second" :children []) + (:id "c3" :type "message" :role "assistant" + :preview "third" :children [])]))) + (flat (pi-coding-agent--flatten-tree-for-display tree "c1" "default")) + (prefix-alist (mapcar (lambda (entry) + (cons (plist-get (nth 0 entry) :id) + (nth 2 entry))) + flat))) + (should (equal (alist-get "root" prefix-alist nil nil #'equal) "")) + ;; Active child first, then others in order + (should (equal (alist-get "c1" prefix-alist nil nil #'equal) "├─ ")) + (should (equal (alist-get "c2" prefix-alist nil nil #'equal) "├─ ")) + (should (equal (alist-get "c3" prefix-alist nil nil #'equal) "└─ ")))) + +;;;; Filter Predicates + +(ert-deftest pi-coding-agent-test-filter-default () + "Default filter shows messages, tool results, compaction, branch summary." + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "user") "default")) + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "assistant" :preview "hello") "default")) + (should (pi-coding-agent--browse-node-visible-p + '(:type "tool_result") "default")) + (should (pi-coding-agent--browse-node-visible-p + '(:type "compaction") "default")) + (should (pi-coding-agent--browse-node-visible-p + '(:type "branch_summary") "default")) + ;; Model change hidden in default + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "model_change") "default")) + ;; Thinking level change hidden in default + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "thinking_level_change") "default"))) + +(ert-deftest pi-coding-agent-test-filter-no-tools () + "No-tools filter hides tool_result entries." + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "user") "no-tools")) + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "tool_result") "no-tools"))) + +(ert-deftest pi-coding-agent-test-filter-user-only () + "User-only filter shows only user messages." + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "user") "user-only")) + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "assistant" :preview "hello") "user-only")) + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "tool_result") "user-only"))) + +(ert-deftest pi-coding-agent-test-filter-labeled-only () + "Labeled-only filter shows only entries with labels." + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "user" :label "checkpoint") "labeled-only")) + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "user") "labeled-only"))) + +(ert-deftest pi-coding-agent-test-filter-all () + "All filter shows settings entries that other modes hide." + (should (pi-coding-agent--browse-node-visible-p + '(:type "model_change") "all")) + (should (pi-coding-agent--browse-node-visible-p + '(:type "thinking_level_change") "all"))) + +(ert-deftest pi-coding-agent-test-filter-empty-assistant () + "Empty assistant messages are hidden (unless they are the leaf)." + ;; Empty assistant with no useful content + (should-not (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "assistant" :preview "") "default")) + ;; Aborted assistant is shown + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "assistant" :preview "" :stopReason "aborted") "default")) + ;; Assistant with error is shown + (should (pi-coding-agent--browse-node-visible-p + '(:type "message" :role "assistant" :preview "" :errorMessage "rate limit") "default"))) + +(ert-deftest pi-coding-agent-test-empty-assistant-hidden-in-all-modes () + "Empty assistant messages are hidden in ALL filter modes. +Per TUI tree-selector.ts:282-293 and PLAN-BROWSING.md line 560: +empty assistants are a universal pre-filter, not mode-specific." + (let ((empty-ast '(:type "message" :role "assistant" :preview "(no content)")) + (empty-ast-blank '(:type "message" :role "assistant" :preview ""))) + (dolist (mode '("default" "no-tools" "all")) + (should-not (pi-coding-agent--browse-node-visible-p empty-ast mode)) + (should-not (pi-coding-agent--browse-node-visible-p empty-ast-blank mode))))) + +(ert-deftest pi-coding-agent-test-empty-assistant-shown-when-aborted-all-modes () + "Aborted/error assistant messages are shown even if empty, in all modes." + (let ((aborted '(:type "message" :role "assistant" :preview "" + :stopReason "aborted")) + (errored '(:type "message" :role "assistant" :preview "" + :errorMessage "rate limit"))) + (dolist (mode '("default" "no-tools" "all")) + (should (pi-coding-agent--browse-node-visible-p aborted mode)) + (should (pi-coding-agent--browse-node-visible-p errored mode))))) + +;;;; Search/Filter + +(ert-deftest pi-coding-agent-test-matches-filter-p () + "Space-separated regexp token matching." + ;; Single token + (should (pi-coding-agent--matches-filter-p "Fix the login bug" '("login"))) + ;; Multiple tokens (AND) + (should (pi-coding-agent--matches-filter-p "Fix the login bug" '("login" "bug"))) + ;; Non-match + (should-not (pi-coding-agent--matches-filter-p "Fix the login bug" '("database"))) + ;; Regexp token + (should (pi-coding-agent--matches-filter-p "Fix the login bug" '("log.*bug"))) + ;; Empty tokens list matches everything + (should (pi-coding-agent--matches-filter-p "anything" nil))) + +;;;; RPC Command Builders + +(ert-deftest pi-coding-agent-test-build-list-sessions-command () + "Build list_sessions RPC command plist." + (let ((cmd (pi-coding-agent--build-list-sessions-command "current"))) + (should (equal (plist-get cmd :type) "list_sessions")) + (should (equal (plist-get cmd :scope) "current"))) + (let ((cmd (pi-coding-agent--build-list-sessions-command "all"))) + (should (equal (plist-get cmd :scope) "all")))) + +(ert-deftest pi-coding-agent-test-build-get-tree-command () + "Build get_tree RPC command plist." + (let ((cmd (pi-coding-agent--build-get-tree-command))) + (should (equal (plist-get cmd :type) "get_tree")))) + +(ert-deftest pi-coding-agent-test-build-navigate-tree-command () + "Build navigate_tree RPC command plist." + ;; Without summarize + (let ((cmd (pi-coding-agent--build-navigate-tree-command "node-4" nil nil))) + (should (equal (plist-get cmd :type) "navigate_tree")) + (should (equal (plist-get cmd :targetId) "node-4")) + (should-not (plist-get cmd :summarize))) + ;; With summarize + (let ((cmd (pi-coding-agent--build-navigate-tree-command "node-4" t nil))) + (should (eq (plist-get cmd :summarize) t))) + ;; With custom instructions + (let ((cmd (pi-coding-agent--build-navigate-tree-command "node-4" t "Focus on tests"))) + (should (eq (plist-get cmd :summarize) t)) + (should (equal (plist-get cmd :customInstructions) "Focus on tests")))) + +(ert-deftest pi-coding-agent-test-build-set-label-command () + "Build set_label RPC command plist." + ;; Set label + (let ((cmd (pi-coding-agent--build-set-label-command "node-7" "checkpoint"))) + (should (equal (plist-get cmd :type) "set_label")) + (should (equal (plist-get cmd :entryId) "node-7")) + (should (equal (plist-get cmd :label) "checkpoint"))) + ;; Clear label (nil) + (let ((cmd (pi-coding-agent--build-set-label-command "node-7" nil))) + (should (equal (plist-get cmd :entryId) "node-7")) + (should-not (plist-get cmd :label)))) + +(ert-deftest pi-coding-agent-test-build-abort-branch-summary-command () + "Build abort_branch_summary RPC command plist." + (let ((cmd (pi-coding-agent--build-abort-branch-summary-command))) + (should (equal (plist-get cmd :type) "abort_branch_summary")))) + +(ert-deftest pi-coding-agent-test-abort-summarization-sends-rpc () + "Aborting an in-flight summarization sends abort_branch_summary." + (let* ((sent-commands nil) + (fake-proc 'fake-process) + (buf (generate-new-buffer " *test-tree*"))) + (unwind-protect + (with-current-buffer buf + (pi-coding-agent-tree-browser-mode) + (setq pi-coding-agent--tree-browser-summarizing t) + (cl-letf (((symbol-function 'pi-coding-agent--get-process) + (lambda () fake-proc)) + ((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc cmd _cb) + (push (plist-get cmd :type) sent-commands)))) + (pi-coding-agent-tree-browser-abort-summarization) + (should (member "abort_branch_summary" sent-commands)) + (should-not pi-coding-agent--tree-browser-summarizing))) + (kill-buffer buf)))) + +(ert-deftest pi-coding-agent-test-abort-summarization-noop-when-idle () + "Aborting when no summarization is in progress does nothing." + (let* ((sent-commands nil) + (buf (generate-new-buffer " *test-tree*"))) + (unwind-protect + (with-current-buffer buf + (pi-coding-agent-tree-browser-mode) + (should-not pi-coding-agent--tree-browser-summarizing) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc cmd _cb) + (push (plist-get cmd :type) sent-commands)))) + (pi-coding-agent-tree-browser-abort-summarization) + (should-not sent-commands))) + (kill-buffer buf)))) + +(ert-deftest pi-coding-agent-test-navigate-tree-sets-summarizing-flag () + "Navigate with summarize sets the summarizing flag, callback clears it." + (let* ((captured-callback nil) + (fake-proc 'fake-process) + (tree-buf (generate-new-buffer " *test-tree*")) + (chat-buf (generate-new-buffer " *test-chat*"))) + (unwind-protect + (progn + (with-current-buffer tree-buf + (pi-coding-agent-tree-browser-mode)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd cb) + (setq captured-callback cb)))) + ;; Send navigate with summarize=t + (pi-coding-agent--navigate-tree-async + fake-proc "node-1" t nil chat-buf tree-buf) + ;; Flag should be set before callback fires + (with-current-buffer tree-buf + (should pi-coding-agent--tree-browser-summarizing)) + ;; Simulate aborted response + (funcall captured-callback + '(:type "response" :command "navigate_tree" + :success t :data (:cancelled t :aborted t))) + ;; Flag should be cleared after callback + (with-current-buffer tree-buf + (should-not pi-coding-agent--tree-browser-summarizing)))) + (kill-buffer tree-buf) + (kill-buffer chat-buf)))) + +(ert-deftest pi-coding-agent-test-navigate-tree-no-flag-without-summarize () + "Navigate without summarize does not set the summarizing flag." + (let* ((fake-proc 'fake-process) + (tree-buf (generate-new-buffer " *test-tree*")) + (chat-buf (generate-new-buffer " *test-chat*"))) + (unwind-protect + (progn + (with-current-buffer tree-buf + (pi-coding-agent-tree-browser-mode)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd _cb) nil))) + (pi-coding-agent--navigate-tree-async + fake-proc "node-1" nil nil chat-buf tree-buf) + (with-current-buffer tree-buf + (should-not pi-coding-agent--tree-browser-summarizing)))) + (kill-buffer tree-buf) + (kill-buffer chat-buf)))) + +;;;; Session Sorting + +(ert-deftest pi-coding-agent-test-session-sort-cycle () + "Sort mode cycles through threaded → recent → relevance." + (should (equal (pi-coding-agent--session-sort-next "threaded") "recent")) + (should (equal (pi-coding-agent--session-sort-next "recent") "relevance")) + (should (equal (pi-coding-agent--session-sort-next "relevance") "threaded"))) + +(ert-deftest pi-coding-agent-test-session-sort-recent () + "Sort by recent puts newest modified first." + (let ((items (list '(:modified "2026-02-20T10:00:00Z" :id "old") + '(:modified "2026-02-24T10:00:00Z" :id "new") + '(:modified "2026-02-22T10:00:00Z" :id "mid")))) + (let ((sorted (pi-coding-agent--session-sort-items items "recent"))) + (should (equal (plist-get (nth 0 sorted) :id) "new")) + (should (equal (plist-get (nth 1 sorted) :id) "mid")) + (should (equal (plist-get (nth 2 sorted) :id) "old"))))) + +(ert-deftest pi-coding-agent-test-session-sort-relevance () + "Sort by relevance puts highest message count first." + (let ((items (list '(:messageCount 10 :id "small") + '(:messageCount 500 :id "big") + '(:messageCount 100 :id "med")))) + (let ((sorted (pi-coding-agent--session-sort-items items "relevance"))) + (should (equal (plist-get (nth 0 sorted) :id) "big")) + (should (equal (plist-get (nth 1 sorted) :id) "med")) + (should (equal (plist-get (nth 2 sorted) :id) "small"))))) + +;;;; Session Threading + +(ert-deftest pi-coding-agent-test-session-threading () + "Thread items into parent-child structure." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-sessions.json")) + (items (pi-coding-agent--parse-session-list response)) + (threaded (pi-coding-agent--session-thread-items items))) + ;; Should have entries with depth + (should (> (length threaded) 0)) + ;; Root items have depth 0 + (let ((roots (cl-remove-if-not (lambda (e) (= (cdr e) 0)) threaded))) + (should (>= (length roots) 3))) + ;; Session ccc-333 is a child of bbb-222, should have depth 1 + (let ((child (cl-find-if (lambda (e) + (equal (plist-get (car e) :id) "ccc-333")) + threaded))) + (should child) + (should (= (cdr child) 1))))) + +;;;; Session Filter + +(ert-deftest pi-coding-agent-test-session-filter-named () + "Named filter keeps only sessions with a name." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-sessions.json")) + (items (pi-coding-agent--parse-session-list response)) + (named (pi-coding-agent--session-filter-named items))) + ;; Only bbb-222 and ddd-444 have names + (should (= (length named) 2)) + (should (cl-every (lambda (item) + (plist-get item :name)) + named)))) + +(ert-deftest pi-coding-agent-test-session-filter-search () + "Search filter matches against name and first message." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-sessions.json")) + (items (pi-coding-agent--parse-session-list response))) + ;; Search for "database" + (let ((found (pi-coding-agent--session-filter-search items '("database")))) + (should (= (length found) 2)) ; bbb-222 and ccc-333 mention database + ) + ;; Search for "CI" matches Setup CI/CD + (let ((found (pi-coding-agent--session-filter-search items '("CI")))) + (should (>= (length found) 1))))) + +;;;; Time Groups + +(ert-deftest pi-coding-agent-test-session-time-group () + "Time group labels for ISO timestamps." + ;; Now → Today + (let ((now (format-time-string "%Y-%m-%dT%H:%M:%S.000Z" (current-time) t))) + (should (equal (pi-coding-agent--session-time-group now) "Today"))) + ;; 2 days ago → Yesterday or This Week depending on time of day + ;; 30 days ago → Older + (let ((old (format-time-string "%Y-%m-%dT%H:%M:%S.000Z" + (time-subtract (current-time) (days-to-time 30)) + t))) + (should (equal (pi-coding-agent--session-time-group old) "Older")))) + +;;;; Session Browser Rendering + +(ert-deftest pi-coding-agent-test-session-browser-render-flat () + "Render sessions as flat list in a buffer." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/a.jsonl" :name "Session A" + :messageCount 42 :modified "2026-02-24T10:00:00Z") + '(:path "/test/b.jsonl" :firstMessage "Fix the bug" + :messageCount 10 :modified "2026-02-23T10:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "relevance") + (pi-coding-agent--session-browser-rerender) + ;; Buffer should contain session names + (should (string-match-p "Session A" (buffer-string))) + (should (string-match-p "Fix the bug" (buffer-string))) + ;; Session A has more messages, should come first in relevance sort + (let ((pos-a (string-match "Session A" (buffer-string))) + (pos-b (string-match "Fix the bug" (buffer-string)))) + (should (< pos-a pos-b))) + ;; Count and age should NOT be in buffer text (they're in margins) + (should-not (string-match-p "42 msgs" (buffer-string))) + (should-not (string-match-p "10 msgs" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-session-browser-render-threaded () + "Render sessions with threading connectors." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/parent.jsonl" :name "Parent Session" + :messageCount 100 :modified "2026-02-24T10:00:00Z") + '(:path "/test/child.jsonl" :firstMessage "Child branch" + :parentSessionPath "/test/parent.jsonl" + :messageCount 20 :modified "2026-02-24T11:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "threaded") + (pi-coding-agent--session-browser-rerender) + ;; Should contain threading connector + (should (string-match-p "└─" (buffer-string))) + ;; Parent before child + (let ((pos-p (string-match "Parent Session" (buffer-string))) + (pos-c (string-match "Child branch" (buffer-string)))) + (should (< pos-p pos-c))))) + +(ert-deftest pi-coding-agent-test-session-browser-fork-prefix-flat () + "Forked sessions show `fork:' prefix in non-threaded modes." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/parent.jsonl" :name "Parent Session" + :messageCount 100 :modified "2026-02-24T10:00:00Z") + '(:path "/test/child.jsonl" :firstMessage "Child branch" + :parentSessionPath "/test/parent.jsonl" + :messageCount 20 :modified "2026-02-24T11:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "relevance") + (pi-coding-agent--session-browser-rerender) + ;; Fork prefix should appear before child session + (should (string-match-p "fork:" (buffer-string))) + ;; But NOT before parent + (let ((text (buffer-string))) + (should-not (string-match-p "fork:.*Parent Session" text))))) + +(ert-deftest pi-coding-agent-test-session-browser-fork-prefix-threaded () + "Forked sessions do NOT show `fork:' prefix in threaded mode." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/parent.jsonl" :name "Parent Session" + :messageCount 100 :modified "2026-02-24T10:00:00Z") + '(:path "/test/child.jsonl" :firstMessage "Child branch" + :parentSessionPath "/test/parent.jsonl" + :messageCount 20 :modified "2026-02-24T11:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "threaded") + (pi-coding-agent--session-browser-rerender) + ;; Threading connector should appear, but NOT fork: prefix + (should (string-match-p "└─" (buffer-string))) + (should-not (string-match-p "fork:" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-session-browser-margin-overlays () + "Session entries have right-margin overlays with count and age." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/a.jsonl" :name "Session A" + :messageCount 42 :modified "2026-02-24T10:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "relevance") + (pi-coding-agent--session-browser-rerender) + ;; Should have at least one overlay + (let ((ovs (overlays-in (point-min) (point-max)))) + (should (> (length ovs) 0)) + ;; Find our margin overlay (has before-string with margin display) + (let* ((margin-ovs (cl-remove-if-not + (lambda (o) + (let ((bs (overlay-get o 'before-string))) + (and bs (get-text-property 0 'display bs)))) + ovs)) + (ov (car margin-ovs)) + (bs (overlay-get ov 'before-string)) + (display (get-text-property 0 'display bs)) + (content (cadr display))) + (should (equal (car display) '(margin right-margin))) + ;; Content should contain message count + (should (string-match-p "42 msgs" content)))))) + +(ert-deftest pi-coding-agent-test-session-browser-no-name-truncation () + "Session names are not truncated." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (let ((long-name (make-string 80 ?x))) + (setq pi-coding-agent--session-browser-items + (list (list :path "/test/a.jsonl" :name long-name + :messageCount 1 :modified "2026-02-24T10:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "relevance") + (pi-coding-agent--session-browser-rerender) + ;; Full name should appear, not truncated + (should (string-match-p long-name (buffer-string)))))) + +(ert-deftest pi-coding-agent-test-session-browser-render-loading () + "Render loading indicator." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-loading t) + (pi-coding-agent--session-browser-rerender) + (should (string-match-p "Loading" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-session-browser-render-empty () + "Render empty state when no sessions." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items nil) + (pi-coding-agent--session-browser-rerender) + (should (string-match-p "No sessions found" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-session-browser-header-line () + "Header-line shows scope, sort, and filter state." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-scope "current" + pi-coding-agent--session-browser-sort "threaded" + pi-coding-agent--session-browser-items '((:id "a") (:id "b"))) + (let ((header (pi-coding-agent--session-browser-header-line))) + (should (string-match-p "current" header)) + (should (string-match-p "threaded" header)) + (should (string-match-p "(2)" header))))) + +;;;; Tree Node Formatting + +(ert-deftest pi-coding-agent-test-tree-node-face () + "Correct face for each node type." + (should (eq (pi-coding-agent--tree-node-face + '(:type "message" :role "user")) + 'pi-coding-agent-tree-user)) + (should (eq (pi-coding-agent--tree-node-face + '(:type "message" :role "assistant")) + 'pi-coding-agent-tree-assistant)) + (should (eq (pi-coding-agent--tree-node-face + '(:type "tool_result")) + 'pi-coding-agent-tree-tool)) + (should (eq (pi-coding-agent--tree-node-face + '(:type "compaction")) + 'pi-coding-agent-tree-compaction)) + (should (eq (pi-coding-agent--tree-node-face + '(:type "branch_summary")) + 'pi-coding-agent-tree-summary))) + +(ert-deftest pi-coding-agent-test-tree-node-type-label () + "Short type labels for tree nodes." + (should (equal (pi-coding-agent--tree-node-type-label + '(:type "message" :role "user")) + "you")) + (should (equal (pi-coding-agent--tree-node-type-label + '(:type "message" :role "assistant")) + "ast")) + (should (equal (pi-coding-agent--tree-node-type-label + '(:type "tool_result" :toolName "Read")) + "Read")) + (should (equal (pi-coding-agent--tree-node-type-label + '(:type "compaction")) + "compact"))) + +;;;; Tool Preview Unpacking + +(ert-deftest pi-coding-agent-test-tree-strip-bracket-preview-formatted () + "Strip bracket wrapper from formattedToolCall." + (should (equal (pi-coding-agent--tree-strip-bracket-preview + '(:type "tool_result" :toolName "read" + :formattedToolCall "[read: ~/file.py:10-29]" + :preview "[read: ~/file.py:10-29]")) + "~/file.py:10-29"))) + +(ert-deftest pi-coding-agent-test-tree-strip-bracket-preview-read () + "Read tool strips wrapper, shows path." + (should (equal (pi-coding-agent--tree-strip-bracket-preview + '(:type "tool_result" :toolName "Read" + :preview "[Read: db/connection.py]")) + "db/connection.py"))) + +(ert-deftest pi-coding-agent-test-tree-strip-bracket-preview-bash () + "Bash tool strips wrapper, shows command." + (should (equal (pi-coding-agent--tree-strip-bracket-preview + '(:type "tool_result" :toolName "bash" + :formattedToolCall "[bash: git status]" + :preview "[bash: git status]")) + "git status"))) + +(ert-deftest pi-coding-agent-test-tree-strip-bracket-preview-no-args () + "Tool with no args returns empty string." + (should (equal (pi-coding-agent--tree-strip-bracket-preview + '(:type "tool_result" :toolName "unknown" + :preview "[unknown]")) + ""))) + +(ert-deftest pi-coding-agent-test-tree-strip-bracket-preview-plain-text () + "Preview without brackets returned as-is." + (should (equal (pi-coding-agent--tree-strip-bracket-preview + '(:type "tool_result" :toolName "custom" + :preview "some plain output")) + "some plain output"))) + +(ert-deftest pi-coding-agent-test-tree-strip-bracket-preview-in-node-line () + "Tool result in formatted node line shows unwrapped preview." + (let ((line (pi-coding-agent--tree-format-node-line + '(:type "tool_result" :toolName "Read" + :preview "[Read: db/connection.py]") + nil))) + ;; Should NOT have the bracketed format + (should-not (string-match-p "\\[Read:" line)) + ;; Should have the unwrapped path + (should (string-match-p "db/connection.py" line)))) + +(ert-deftest pi-coding-agent-test-tree-node-preview-message () + "Regular message nodes return preview as-is." + (should (equal (pi-coding-agent--tree-node-preview + '(:type "message" :role "user" :preview "hello world")) + "hello world")) + (should (equal (pi-coding-agent--tree-node-preview + '(:type "message" :role "assistant" :preview "sure thing")) + "sure thing")) + ;; Missing preview returns empty string + (should (equal (pi-coding-agent--tree-node-preview + '(:type "message" :role "user")) + ""))) + +(ert-deftest pi-coding-agent-test-tree-node-preview-branch-summary () + "Branch summary nodes return first line of summary, not full text." + ;; Multi-line summary returns only first line + (should (equal (pi-coding-agent--tree-node-preview + '(:type "branch_summary" + :summary "The user explored TDD.\n\n## Goal\nLearn testing.")) + "The user explored TDD.")) + ;; Single-line summary returned as-is + (should (equal (pi-coding-agent--tree-node-preview + '(:type "branch_summary" + :summary "Short summary")) + "Short summary")) + ;; Missing summary returns empty string + (should (equal (pi-coding-agent--tree-node-preview + '(:type "branch_summary")) + "")) + ;; Summary starting with blank lines skips to first non-empty line + (should (equal (pi-coding-agent--tree-node-preview + '(:type "branch_summary" + :summary "\n\nActual summary here\nMore text")) + "Actual summary here"))) + +(ert-deftest pi-coding-agent-test-tree-node-preview-bash-execution () + "Bash execution message strips bracket wrapper from preview. +Upstream changed format from `[bash]: cmd' to `[bash: cmd]'. +The type label already shows `sh', so brackets are redundant." + ;; tree-node-preview strips the wrapper + (should (equal (pi-coding-agent--tree-node-preview + '(:type "message" :role "bashExecution" + :preview "[bash: git status]")) + "git status")) + ;; Formatted node line shows stripped preview + (let ((line (pi-coding-agent--tree-format-node-line + '(:type "message" :role "bashExecution" + :preview "[bash: git log --oneline]") + nil))) + (should-not (string-match-p "\\[bash:" line)) + (should (string-match-p "git log --oneline" line)))) + +(ert-deftest pi-coding-agent-test-tree-format-node-active () + "Active path nodes get bullet marker." + (let ((line (pi-coding-agent--tree-format-node-line + '(:type "message" :role "user" :preview "hello") t))) + (should (string-match-p "•" line)) + (should (string-match-p "hello" line)))) + +(ert-deftest pi-coding-agent-test-tree-format-node-inactive () + "Inactive nodes get space instead of bullet." + (let ((line (pi-coding-agent--tree-format-node-line + '(:type "message" :role "user" :preview "hello") nil))) + (should-not (string-match-p "•" line)) + (should (string-match-p "hello" line)))) + +(ert-deftest pi-coding-agent-test-tree-format-node-with-label () + "Labeled nodes do NOT include label in the line text (labels go in margin)." + (let ((line (pi-coding-agent--tree-format-node-line + '(:type "message" :role "user" :preview "hello" + :label "checkpoint") + nil))) + ;; Label should not be in the main text + (should-not (string-match-p "\\[checkpoint\\]" line)) + ;; But preview should still appear + (should (string-match-p "hello" line)))) + +;;;; Tree Browser Rendering + +(ert-deftest pi-coding-agent-test-tree-browser-render () + "Render tree from fixture data." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response))) + (setq pi-coding-agent--tree-browser-tree (plist-get tree-data :tree) + pi-coding-agent--tree-browser-leaf-id (plist-get tree-data :leafId) + pi-coding-agent--tree-browser-filter "default") + (pi-coding-agent--tree-browser-rerender) + ;; Buffer should contain node content + (should (string-match-p "refactor" (buffer-string))) + ;; Active path nodes should have bullet marker + (should (string-match-p "•" (buffer-string))) + ;; Label should NOT be in buffer text (it's in margin overlay) + (should-not (string-match-p "\\[checkpoint\\]" (buffer-string)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-render-connectors () + "Tree connectors appear in rendered buffer at branch points." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response))) + (setq pi-coding-agent--tree-browser-tree (plist-get tree-data :tree) + pi-coding-agent--tree-browser-leaf-id (plist-get tree-data :leafId) + pi-coding-agent--tree-browser-filter "default") + (pi-coding-agent--tree-browser-rerender) + (let ((text (buffer-string))) + ;; Branch connectors should appear + (should (string-match-p "├─" text)) + (should (string-match-p "└─" text)) + ;; Gutter continuation should appear + (should (string-match-p "│" text)) + ;; Active branch child line: connector + bullet + (should (string-match-p "├─ •" text)) + ;; Last branch child: connector without bullet (inactive) + (should (string-match-p "└─ " text)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-label-in-margin () + "Labels appear as right-margin overlays, not inline text." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response))) + (setq pi-coding-agent--tree-browser-tree (plist-get tree-data :tree) + pi-coding-agent--tree-browser-leaf-id (plist-get tree-data :leafId) + pi-coding-agent--tree-browser-filter "default") + (pi-coding-agent--tree-browser-rerender) + ;; Find margin overlays + (let* ((ovs (overlays-in (point-min) (point-max))) + (margin-ovs (cl-remove-if-not + (lambda (o) + (let ((bs (overlay-get o 'before-string))) + (and bs (get-text-property 0 'display bs)))) + ovs))) + ;; Should have at least one margin overlay (for the labeled node) + (should (> (length margin-ovs) 0)) + ;; Find the one containing "checkpoint" + (should (cl-some + (lambda (o) + (let* ((bs (overlay-get o 'before-string)) + (display (get-text-property 0 'display bs)) + (content (cadr display))) + (string-match-p "checkpoint" content))) + margin-ovs)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-label-truncation () + "Long labels are truncated with ellipsis to fit the right margin." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let ((tree (vector (list :id "n1" :type "message" :role "user" + :preview "hello" :timestamp "2026-01-01T00:00:00Z" + :label "this-is-a-very-long-label-name" + :children (vector))))) + (setq pi-coding-agent--tree-browser-tree tree + pi-coding-agent--tree-browser-leaf-id "n1" + pi-coding-agent--tree-browser-filter "default") + (pi-coding-agent--tree-browser-rerender) + ;; Find the margin overlay + (let* ((ovs (overlays-in (point-min) (point-max))) + (margin-ovs (cl-remove-if-not + (lambda (o) + (let ((bs (overlay-get o 'before-string))) + (and bs (get-text-property 0 'display bs)))) + ovs)) + (content (when margin-ovs + (let* ((bs (overlay-get (car margin-ovs) 'before-string)) + (display (get-text-property 0 'display bs))) + (cadr display))))) + ;; Should exist and be truncated + (should content) + ;; Should contain ellipsis + (should (string-match-p "…" content)) + ;; Total formatted length should fit: [truncated…] ≤ margin width + (should (<= (length content) pi-coding-agent--tree-margin-width)) + ;; Should NOT contain the full label + (should-not (string-match-p "this-is-a-very-long-label-name" content)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-short-label-not-truncated () + "Short labels are not truncated." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let ((tree (vector (list :id "n1" :type "message" :role "user" + :preview "hello" :timestamp "2026-01-01T00:00:00Z" + :label "ok" + :children (vector))))) + (setq pi-coding-agent--tree-browser-tree tree + pi-coding-agent--tree-browser-leaf-id "n1" + pi-coding-agent--tree-browser-filter "default") + (pi-coding-agent--tree-browser-rerender) + (let* ((ovs (overlays-in (point-min) (point-max))) + (margin-ovs (cl-remove-if-not + (lambda (o) + (let ((bs (overlay-get o 'before-string))) + (and bs (get-text-property 0 'display bs)))) + ovs)) + (content (when margin-ovs + (let* ((bs (overlay-get (car margin-ovs) 'before-string)) + (display (get-text-property 0 'display bs))) + (cadr display))))) + ;; Should contain the full label + (should (string-match-p "\\[ok\\]" content)) + ;; Should NOT contain ellipsis + (should-not (string-match-p "…" content)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-render-empty () + "Render empty tree." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (setq pi-coding-agent--tree-browser-tree nil) + (pi-coding-agent--tree-browser-rerender) + (should (string-match-p "No conversation tree" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-tree-browser-render-user-filter () + "User-only filter shows only user messages." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response))) + (setq pi-coding-agent--tree-browser-tree (plist-get tree-data :tree) + pi-coding-agent--tree-browser-leaf-id (plist-get tree-data :leafId) + pi-coding-agent--tree-browser-filter "user-only") + (pi-coding-agent--tree-browser-rerender) + ;; Should have user nodes + (should (string-match-p "you" (buffer-string))) + ;; Should NOT have assistant nodes + (should-not (string-match-p "\\bast\\b" (buffer-string)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-initial-filter () + "Tree browser opens with no-tools filter." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (should (equal pi-coding-agent--tree-browser-filter "no-tools")))) + +(ert-deftest pi-coding-agent-test-tree-browser-header-line () + "Header-line shows filter mode and count." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree-data (pi-coding-agent--parse-tree response))) + (setq pi-coding-agent--tree-browser-tree (plist-get tree-data :tree) + pi-coding-agent--tree-browser-leaf-id (plist-get tree-data :leafId) + pi-coding-agent--tree-browser-filter "no-tools") + (let ((header (pi-coding-agent--tree-browser-header-line))) + (should (string-match-p "no-tools" header)) + (should (string-match-p "([0-9]+)" header)))))) + +;;;; RPC Error Handling + +(ert-deftest pi-coding-agent-test-session-browser-rpc-error () + "Session browser shows error when RPC fails." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-error + "list_sessions not supported by this pi version") + (pi-coding-agent--session-browser-rerender) + (should (string-match-p "Error:" (buffer-string))) + (should (string-match-p "not supported" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-session-browser-rpc-error-cleared-on-success () + "Error is cleared when a subsequent fetch succeeds." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + ;; Simulate error state + (setq pi-coding-agent--session-browser-error "some error") + ;; Simulate successful callback + (let ((response '(:success t :data (:sessions [])))) + (let ((success (eq (plist-get response :success) t))) + (setq pi-coding-agent--session-browser-error + (unless success "should not appear") + pi-coding-agent--session-browser-items nil))) + (pi-coding-agent--session-browser-rerender) + (should-not (string-match-p "Error:" (buffer-string))))) + +;;;; Summarize-and-Navigate + +(ert-deftest pi-coding-agent-test-summarize-navigate-default-instructions () + "S with empty input navigates with summarize=true, no custom instructions." + (let ((sent-cmd nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc cmd callback) + (setq sent-cmd cmd) + (funcall callback + '(:success t + :data (:cancelled :false))))) + ((symbol-function 'pi-coding-agent--handle-navigate-success) + #'ignore) + ((symbol-function 'read-string) + (lambda (_prompt) ""))) + (pi-coding-agent--tree-summarize-and-navigate + 'fake-proc "node-1" (current-buffer) (current-buffer)) + (should (equal (plist-get sent-cmd :summarize) t)) + (should (null (plist-get sent-cmd :customInstructions)))))) + +(ert-deftest pi-coding-agent-test-summarize-navigate-custom-instructions () + "S with custom text passes instructions to RPC." + (let ((sent-cmd nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc cmd callback) + (setq sent-cmd cmd) + (funcall callback + '(:success t + :data (:cancelled :false))))) + ((symbol-function 'pi-coding-agent--handle-navigate-success) + #'ignore) + ((symbol-function 'read-string) + (lambda (_prompt) "Focus on key decisions"))) + (pi-coding-agent--tree-summarize-and-navigate + 'fake-proc "node-1" (current-buffer) (current-buffer)) + (should (equal (plist-get sent-cmd :summarize) t)) + (should (equal (plist-get sent-cmd :customInstructions) + "Focus on key decisions"))))) + +(ert-deftest pi-coding-agent-test-summarize-navigate-quit-cancels () + "C-g at the read-string prompt cancels without sending RPC." + (let ((rpc-called nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd _callback) + (setq rpc-called t))) + ((symbol-function 'read-string) + (lambda (_prompt) (signal 'quit nil)))) + (pi-coding-agent--tree-summarize-and-navigate + 'fake-proc "node-1" (current-buffer) (current-buffer)) + (should-not rpc-called)))) + +(ert-deftest pi-coding-agent-test-navigate-tree-async-success () + "Navigate tree async calls handler on success." + (let ((navigated nil) + (chat-refreshed nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd callback) + (funcall callback + '(:success t + :data (:cancelled :false + :editorText "test text"))))) + ((symbol-function 'pi-coding-agent--handle-navigate-success) + (lambda (_proc result _chat _tree) + (setq navigated t + chat-refreshed (plist-get result :editorText))))) + (pi-coding-agent--navigate-tree-async + 'fake-proc "node-1" nil nil + (current-buffer) (current-buffer)) + (should navigated) + (should (equal chat-refreshed "test text"))))) + +(ert-deftest pi-coding-agent-test-navigate-tree-async-on-success-callback () + "On-success callback fires after successful navigation." + (let ((callback-called nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd callback) + (funcall callback + '(:success t + :data (:cancelled :false))))) + ((symbol-function 'pi-coding-agent--handle-navigate-success) + #'ignore)) + (pi-coding-agent--navigate-tree-async + 'fake-proc "node-1" nil nil + (current-buffer) (current-buffer) + (lambda () (setq callback-called t))) + (should callback-called)))) + +(ert-deftest pi-coding-agent-test-navigate-tree-async-no-callback-on-cancel () + "On-success callback does not fire when navigation is cancelled." + (let ((callback-called nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd callback) + (funcall callback + '(:success t + :data (:cancelled t)))))) + (pi-coding-agent--navigate-tree-async + 'fake-proc "node-1" nil nil + (current-buffer) (current-buffer) + (lambda () (setq callback-called t))) + (should-not callback-called)))) + +(ert-deftest pi-coding-agent-test-navigate-tree-async-cancelled () + "Navigate tree async shows message when cancelled." + (let ((messages nil)) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc _cmd callback) + (funcall callback + '(:success t + :data (:cancelled t))))) + ((symbol-function 'message) + (lambda (fmt &rest args) + (push (apply #'format fmt args) messages)))) + (pi-coding-agent--navigate-tree-async + 'fake-proc "node-1" nil nil + (current-buffer) (current-buffer)) + (should (cl-some (lambda (m) (string-match-p "cancelled" m)) + messages))))) + +;;;; Session Browser Switch + +(ert-deftest pi-coding-agent-test-session-browser-switch-quits-on-success () + "Successful session switch calls quit-window on the browser window." + (let ((quit-called nil) + (quit-kill-arg nil)) + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/a.jsonl" :name "Session A" + :messageCount 5 :modified "2026-02-24T10:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "relevance") + (pi-coding-agent--session-browser-rerender) + (goto-char (point-min)) + (let ((chat-buf (generate-new-buffer " *test-chat*"))) + (unwind-protect + (progn + ;; Set process on chat buffer (--get-process reads from it) + (with-current-buffer chat-buf + (setq pi-coding-agent--process 'fake-proc)) + (setq pi-coding-agent--chat-buffer chat-buf) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc cmd callback) + (when (equal (plist-get cmd :type) "switch_session") + (funcall callback + '(:success t + :data (:cancelled :false)))))) + ((symbol-function 'pi-coding-agent--load-session-history) + #'ignore) + ((symbol-function 'pi-coding-agent--apply-state-response) + #'ignore) + ((symbol-function 'pi-coding-agent--update-session-name-from-file) + #'ignore) + ((symbol-function 'quit-window) + (lambda (kill &optional _window) + (setq quit-called t + quit-kill-arg kill)))) + (pi-coding-agent-session-browser-switch))) + (kill-buffer chat-buf))) + (should quit-called) + ;; Should bury, not kill + (should (null quit-kill-arg))))) + +(ert-deftest pi-coding-agent-test-session-browser-switch-stays-on-cancel () + "Cancelled session switch does NOT call quit-window." + (let ((quit-called nil)) + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items + (list '(:path "/test/a.jsonl" :name "Session A" + :messageCount 5 :modified "2026-02-24T10:00:00Z"))) + (setq pi-coding-agent--session-browser-sort "relevance") + (pi-coding-agent--session-browser-rerender) + (goto-char (point-min)) + (let ((chat-buf (generate-new-buffer " *test-chat*"))) + (unwind-protect + (progn + (with-current-buffer chat-buf + (setq pi-coding-agent--process 'fake-proc)) + (setq pi-coding-agent--chat-buffer chat-buf) + (cl-letf (((symbol-function 'pi-coding-agent--rpc-async) + (lambda (_proc cmd callback) + (when (equal (plist-get cmd :type) "switch_session") + (funcall callback + '(:success t + :data (:cancelled t)))))) + ((symbol-function 'quit-window) + (lambda (&rest _) + (setq quit-called t))) + ((symbol-function 'message) #'ignore)) + (pi-coding-agent-session-browser-switch))) + (kill-buffer chat-buf))) + (should-not quit-called)))) + +;;;; Tree Find Label + +(ert-deftest pi-coding-agent-test-tree-find-label () + "Find label for a node ID in the tree." + (let* ((response (pi-coding-agent-test--read-json-fixture "browse-tree.json")) + (tree (plist-get (plist-get response :data) :tree))) + ;; node-7 has label "checkpoint" + (should (equal (pi-coding-agent--tree-find-label tree "node-7") + "checkpoint")) + ;; node-1 has no label + (should (null (pi-coding-agent--tree-find-label tree "node-1"))))) + +;;;; Session Browser Dispatch Transient + +(ert-deftest pi-coding-agent-test-session-browser-dispatch-binding () + "Session browser binds `?' and `h' to the dispatch transient." + (should (eq (lookup-key pi-coding-agent-session-browser-mode-map "?") + 'pi-coding-agent-session-browser-dispatch)) + (should (eq (lookup-key pi-coding-agent-session-browser-mode-map "h") + 'pi-coding-agent-session-browser-dispatch))) + +(ert-deftest pi-coding-agent-test-session-browser-dispatch-is-transient () + "Session browser dispatch is a transient prefix command." + (should (commandp 'pi-coding-agent-session-browser-dispatch)) + (should (get 'pi-coding-agent-session-browser-dispatch 'transient--prefix))) + +(ert-deftest pi-coding-agent-test-session-browser-dispatch-suffixes () + "Session browser dispatch wires all keys to the correct commands." + (let ((expected + '(("RET" . pi-coding-agent-session-browser-switch) + ("r" . pi-coding-agent-session-browser-rename) + ("s" . pi-coding-agent-session-browser-cycle-sort) + ("f" . pi-coding-agent-session-browser-toggle-named) + ("t" . pi-coding-agent-session-browser-toggle-scope) + ("/" . pi-coding-agent-session-browser-search) + ("g" . pi-coding-agent-browse-refresh) + ("q" . quit-window)))) + (dolist (pair expected) + (let* ((key (car pair)) + (cmd (cdr pair)) + (suffix (transient-get-suffix + 'pi-coding-agent-session-browser-dispatch key)) + (actual (plist-get (cdr suffix) :command))) + (should (eq actual cmd)))))) + +(ert-deftest pi-coding-agent-test-session-dispatch-heading () + "Session dispatch heading reflects buffer-local state." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + ;; Default state: sort before scope, no named-only + (should (equal (pi-coding-agent--session-dispatch-heading) + "sort:threaded │ scope:current")) + ;; All state active + (setq pi-coding-agent--session-browser-sort "recent" + pi-coding-agent--session-browser-scope "all" + pi-coding-agent--session-browser-named-only t) + (should (equal (pi-coding-agent--session-dispatch-heading) + "sort:recent │ scope:all │ named-only")))) + +;;;; Tree Browser Dispatch Transient + +(ert-deftest pi-coding-agent-test-tree-browser-summarize-binding () + "Tree browser binds `S' to the summarize command." + (should (eq (lookup-key pi-coding-agent-tree-browser-mode-map "S") + 'pi-coding-agent-tree-browser-summarize))) + +(ert-deftest pi-coding-agent-test-tree-browser-dispatch-binding () + "Tree browser binds `?' and `h' to the dispatch transient." + (should (eq (lookup-key pi-coding-agent-tree-browser-mode-map "?") + 'pi-coding-agent-tree-browser-dispatch)) + (should (eq (lookup-key pi-coding-agent-tree-browser-mode-map "h") + 'pi-coding-agent-tree-browser-dispatch))) + +(ert-deftest pi-coding-agent-test-tree-browser-dispatch-is-transient () + "Tree browser dispatch is a transient prefix command." + (should (commandp 'pi-coding-agent-tree-browser-dispatch)) + (should (get 'pi-coding-agent-tree-browser-dispatch 'transient--prefix))) + +(ert-deftest pi-coding-agent-test-tree-browser-dispatch-suffixes () + "Tree browser dispatch wires all keys to the correct commands." + (let ((expected + '(("RET" . pi-coding-agent-tree-browser-navigate) + ("S" . pi-coding-agent-tree-browser-summarize) + ("l" . pi-coding-agent-tree-browser-set-label) + ("f" . pi-coding-agent-tree-browser-cycle-filter) + ("/" . pi-coding-agent-tree-browser-search) + ("g" . pi-coding-agent-browse-refresh) + ("q" . quit-window)))) + (dolist (pair expected) + (let* ((key (car pair)) + (cmd (cdr pair)) + (suffix (transient-get-suffix + 'pi-coding-agent-tree-browser-dispatch key)) + (actual (plist-get (cdr suffix) :command))) + (should (eq actual cmd)))))) + +(ert-deftest pi-coding-agent-test-tree-dispatch-heading () + "Tree dispatch heading reflects buffer-local filter state." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + ;; Default state (initial filter is no-tools) + (let ((heading (pi-coding-agent--tree-dispatch-heading))) + (should (string-match-p "filter:no-tools" heading))) + ;; Change state + (setq pi-coding-agent--tree-browser-filter "user-only") + (let ((heading (pi-coding-agent--tree-dispatch-heading))) + (should (string-match-p "filter:user-only" heading))))) + +;;;; Header-Line Help Hint + +(ert-deftest pi-coding-agent-test-session-browser-header-line-help-hint () + "Session browser header-line includes `?:help' hint." + (with-temp-buffer + (pi-coding-agent-session-browser-mode) + (setq pi-coding-agent--session-browser-items '((:id "a"))) + (let ((header (pi-coding-agent--session-browser-header-line))) + (should (string-match-p "?:help" header))))) + +(ert-deftest pi-coding-agent-test-tree-browser-header-line-help-hint () + "Tree browser header-line includes `?:help' hint." + (with-temp-buffer + (pi-coding-agent-tree-browser-mode) + (let ((header (pi-coding-agent--tree-browser-header-line))) + (should (string-match-p "?:help" header))))) + +;;;; Startup Message + +(ert-deftest pi-coding-agent-test-session-browser-startup-message () + "Session browser shows help hint message on first creation." + (let ((messages nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (push (apply #'format fmt args) messages))) + ((symbol-function 'pi-coding-agent--session-browser-fetch-and-render) + #'ignore) + ((symbol-function 'pi-coding-agent--get-chat-buffer) + (lambda () nil)) + ((symbol-function 'pi-coding-agent--session-directory) + (lambda () "/tmp/pi-test/"))) + (pi-coding-agent-session-browser) + (unwind-protect + (should (member "Press ? for available commands" messages)) + (when-let ((buf (get-buffer + (pi-coding-agent--session-browser-buffer-name + "/tmp/pi-test/")))) + (kill-buffer buf)))))) + +(ert-deftest pi-coding-agent-test-tree-browser-startup-message () + "Tree browser shows help hint message on first creation." + (let ((messages nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (push (apply #'format fmt args) messages))) + ((symbol-function 'pi-coding-agent--tree-browser-fetch-and-render) + #'ignore) + ((symbol-function 'pi-coding-agent--get-chat-buffer) + (lambda () nil)) + ((symbol-function 'pi-coding-agent--session-directory) + (lambda () "/tmp/pi-test/"))) + (pi-coding-agent-tree-browser) + (unwind-protect + (should (member "Press ? for available commands" messages)) + (when-let ((buf (get-buffer + (pi-coding-agent--tree-browser-buffer-name + "/tmp/pi-test/")))) + (kill-buffer buf)))))) + +(provide 'pi-coding-agent-browse-test) +;;; pi-coding-agent-browse-test.el ends here diff --git a/test/pi-coding-agent-core-test.el b/test/pi-coding-agent-core-test.el index ed4e394..03df813 100644 --- a/test/pi-coding-agent-core-test.el +++ b/test/pi-coding-agent-core-test.el @@ -51,6 +51,24 @@ (let ((result (pi-coding-agent--parse-json-line "{\"msg\":\"Hello 世界 🌍\"}"))) (should (equal (plist-get result :msg) "Hello 世界 🌍")))) +;;;; Normalize String-or-Null + +(ert-deftest pi-coding-agent-test-normalize-string-or-null-string () + "Non-empty string is returned as-is." + (should (equal (pi-coding-agent--normalize-string-or-null "hello") "hello"))) + +(ert-deftest pi-coding-agent-test-normalize-string-or-null-empty () + "Empty string returns nil." + (should (null (pi-coding-agent--normalize-string-or-null "")))) + +(ert-deftest pi-coding-agent-test-normalize-string-or-null-nil () + "Nil returns nil." + (should (null (pi-coding-agent--normalize-string-or-null nil)))) + +(ert-deftest pi-coding-agent-test-normalize-string-or-null-keyword () + "JSON null keyword returns nil." + (should (null (pi-coding-agent--normalize-string-or-null :null)))) + ;;;; Line Accumulation Tests (ert-deftest pi-coding-agent-test-accumulate-complete-line () diff --git a/test/pi-coding-agent-input-test.el b/test/pi-coding-agent-input-test.el index 6872c13..f53b928 100644 --- a/test/pi-coding-agent-input-test.el +++ b/test/pi-coding-agent-input-test.el @@ -1413,48 +1413,6 @@ Aborted messages may have incomplete usage data." (when (buffer-live-p chat-buf) (kill-buffer chat-buf))))) -(ert-deftest pi-coding-agent-test-session-dir-name () - "Session directory name derived from project path." - (should (equal (pi-coding-agent--session-dir-name "/home/daniel/co/pi-coding-agent") - "--home-daniel-co-pi-coding-agent--")) - (should (equal (pi-coding-agent--session-dir-name "/tmp/test") - "--tmp-test--"))) - -(ert-deftest pi-coding-agent-test-list-sessions-sorted-by-mtime () - "Sessions are sorted by modification time, most recent first. -Regression test for #25: sessions were sorted by filename (creation time) -and then re-sorted alphabetically by completing-read." - (let* ((temp-base (make-temp-file "pi-coding-agent-sessions-" t)) - (session-dir (expand-file-name "--test-project--" temp-base)) - ;; Create files with names that would sort differently alphabetically - (old-file (expand-file-name "2024-01-01_10-00-00.jsonl" session-dir)) - (new-file (expand-file-name "2024-01-01_09-00-00.jsonl" session-dir))) - (unwind-protect - (progn - (make-directory session-dir t) - (let* ((now (current-time)) - (old-time (time-subtract now (seconds-to-time 10))) - (new-time (time-subtract now (seconds-to-time 5)))) - ;; Create "old" file first - (with-temp-file old-file (insert "{}")) - (set-file-times old-file old-time) - ;; Create "new" file second (more recent mtime despite earlier filename) - (with-temp-file new-file (insert "{}")) - (set-file-times new-file new-time)) - ;; Directly call directory-files and sort logic to test sorting - (let* ((files (directory-files session-dir t "\\.jsonl$")) - (sorted (sort files - (lambda (a b) - (time-less-p - (file-attribute-modification-time (file-attributes b)) - (file-attribute-modification-time (file-attributes a))))))) - ;; new-file should be first (most recent mtime) - ;; even though "09-00-00" < "10-00-00" alphabetically - (should (equal (length sorted) 2)) - (should (string-suffix-p "09-00-00.jsonl" (car sorted))))) - ;; Cleanup - (delete-directory temp-base t)))) - (ert-deftest pi-coding-agent-test-session-metadata-extracts-first-message () "pi-coding-agent--session-metadata extracts first user message text." (let ((temp-file (make-temp-file "pi-coding-agent-test-session" nil ".jsonl"))) @@ -1538,38 +1496,6 @@ and then re-sorted alphabetically by completing-read." (should (null (plist-get metadata :session-name))))) (delete-file temp-file)))) -(ert-deftest pi-coding-agent-test-format-session-choice-fallback-on-cleared-name () - "pi-coding-agent--format-session-choice falls back to message when name cleared." - (let ((temp-file (make-temp-file "pi-coding-agent-test-session" nil ".jsonl"))) - (unwind-protect - (progn - (with-temp-file temp-file - (insert "{\"type\":\"session\",\"id\":\"test\"}\n") - (insert "{\"type\":\"message\",\"id\":\"m1\",\"message\":{\"role\":\"user\",\"content\":[{\"type\":\"text\",\"text\":\"Hello world\"}]}}\n") - (insert "{\"type\":\"session_info\",\"id\":\"si1\",\"name\":\"My Project\"}\n") - ;; Name was cleared - (insert "{\"type\":\"session_info\",\"id\":\"si2\",\"name\":null}\n")) - (let ((choice (pi-coding-agent--format-session-choice temp-file))) - ;; Should fall back to first message, not crash - (should (string-match-p "Hello world" (car choice))) - (should-not (string-match-p "My Project" (car choice))))) - (delete-file temp-file)))) - -(ert-deftest pi-coding-agent-test-format-session-choice-prefers-name () - "pi-coding-agent--format-session-choice uses session name when available." - (let ((temp-file (make-temp-file "pi-coding-agent-test-session" nil ".jsonl"))) - (unwind-protect - (progn - (with-temp-file temp-file - (insert "{\"type\":\"session\",\"id\":\"test\"}\n") - (insert "{\"type\":\"message\",\"id\":\"m1\",\"message\":{\"role\":\"user\",\"content\":[{\"type\":\"text\",\"text\":\"Hello world\"}]}}\n") - (insert "{\"type\":\"session_info\",\"id\":\"si1\",\"name\":\"My Project\"}\n")) - (let ((choice (pi-coding-agent--format-session-choice temp-file))) - ;; Should show session name, not first message - (should (string-match-p "My Project" (car choice))) - (should-not (string-match-p "Hello world" (car choice))))) - (delete-file temp-file)))) - (ert-deftest pi-coding-agent-test-header-line-includes-session-name () "pi-coding-agent--header-line-string includes session name when set." (let ((chat-buf (get-buffer-create "*pi-test-header-session-name*"))) diff --git a/test/pi-coding-agent-integration-test.el b/test/pi-coding-agent-integration-test.el index 03170de..4fdcf4b 100644 --- a/test/pi-coding-agent-integration-test.el +++ b/test/pi-coding-agent-integration-test.el @@ -352,13 +352,12 @@ Verifies: ;;; Session Name Tests (ert-deftest pi-coding-agent-integration-session-name-persists-across-resume () - "Session name set via set-session-name persists and appears in resume picker. + "Session name set via set-session-name persists in session file. Verifies the full flow: 1. Start session, send a prompt to materialize the session file 2. Set a session name 3. Read file and verify session_info entry was written -4. Call session-metadata and verify name is extracted -5. Call format-session-choice and verify name appears in display" +4. Call session-metadata and verify name is extracted" (pi-coding-agent-integration-with-process ;; Send a prompt to create the session file (it's created lazily) (let ((got-agent-end nil)) @@ -404,10 +403,7 @@ Verifies the full flow: ;; Verify metadata extraction works (let ((metadata (pi-coding-agent--session-metadata session-file))) (should metadata) - (should (equal (plist-get metadata :session-name) "Integration Test Session"))) - ;; Verify format-session-choice uses the name - (let ((choice (pi-coding-agent--format-session-choice session-file))) - (should (string-match-p "Integration Test Session" (car choice))))) + (should (equal (plist-get metadata :session-name) "Integration Test Session")))) (kill-buffer chat-buf)))))) ;; Note: "clear session name" test removed - empty string now shows current name diff --git a/test/pi-coding-agent-menu-test.el b/test/pi-coding-agent-menu-test.el index 769edbe..a47fb29 100644 --- a/test/pi-coding-agent-menu-test.el +++ b/test/pi-coding-agent-menu-test.el @@ -935,26 +935,6 @@ Pi v0.51.3+ renamed SlashCommandSource from \"template\" to \"prompt\"." (let ((response '(:success nil :error "Network error"))) (should-not (pi-coding-agent--resolve-fork-entry response 0 3)))) -(defun pi-coding-agent-test--make-deep-linear-tree (depth) - "Return a single-branch tree vector with DEPTH nested nodes. -The tree is built iteratively to avoid recursion in test setup." - (let* ((leaf-id (1- depth)) - (node (list :id (format "n%d" leaf-id) - :type "message" - :role "user" - :preview (format "node %d" leaf-id) - :parentId (and (> leaf-id 0) (format "n%d" (1- leaf-id))) - :children []))) - (dotimes (i (1- depth)) - (let ((id (- depth i 2))) - (setq node (list :id (format "n%d" id) - :type "message" - :role "user" - :preview (format "node %d" id) - :parentId (and (> id 0) (format "n%d" (1- id))) - :children (vector node))))) - (vector node))) - (defun pi-coding-agent-test--make-deep-fork-messages (depth) "Return DEPTH chronological fork messages." (let ((messages (make-vector depth nil))) @@ -963,78 +943,6 @@ The tree is built iteratively to avoid recursion in test setup." :text (format "node %d" i)))) messages)) -(ert-deftest pi-coding-agent-test-flatten-tree-deep-linear-tree () - "flatten-tree handles deep linear trees without eval-depth overflow." - (let* ((depth pi-coding-agent-test--deep-tree-depth) - (tree (pi-coding-agent-test--make-deep-linear-tree depth)) - (index (pi-coding-agent--flatten-tree tree))) - (should (= (hash-table-count index) depth)))) - -;;; Active Branch Tree Walk - -(ert-deftest pi-coding-agent-test-active-branch-linear () - "Linear tree: u1 → a1 → u2 → a2 (leaf) returns both user IDs." - (let* ((data (pi-coding-agent-test--build-tree - '("u1" nil "message" :role "user" :preview "Hello") - '("a1" nil "message" :role "assistant" :preview "Hi") - '("u2" nil "message" :role "user" :preview "More") - '("a2" nil "message" :role "assistant" :preview "Sure"))) - (index (pi-coding-agent--flatten-tree (plist-get data :tree))) - (ids (pi-coding-agent--active-branch-user-ids index "a2"))) - (should (equal ids '("u1" "u2"))))) - -(ert-deftest pi-coding-agent-test-active-branch-branched () - "Branched tree: active branch u1 → a1 → u2 → a2, ignores u3 → a3." - (let* ((data (pi-coding-agent-test--build-tree - '("u1" nil "message" :role "user" :preview "Hello") - '("a1" nil "message" :role "assistant" :preview "Hi") - '("u2" nil "message" :role "user" :preview "Path A") - '("a2" nil "message" :role "assistant" :preview "Sure A") - '("u3" "a1" "message" :role "user" :preview "Path B") - '("a3" nil "message" :role "assistant" :preview "Sure B"))) - (index (pi-coding-agent--flatten-tree (plist-get data :tree))) - (ids (pi-coding-agent--active-branch-user-ids index "a2"))) - (should (equal ids '("u1" "u2"))))) - -(ert-deftest pi-coding-agent-test-active-branch-with-compaction () - "Tree with compaction node: u1 → a1 → compaction → u2 → a2." - (let* ((data (pi-coding-agent-test--build-tree - '("u1" nil "message" :role "user" :preview "First") - '("a1" nil "message" :role "assistant" :preview "Response") - '("c1" nil "compaction" :tokensBefore 5000) - '("u2" nil "message" :role "user" :preview "After compaction") - '("a2" nil "message" :role "assistant" :preview "Still here"))) - (index (pi-coding-agent--flatten-tree (plist-get data :tree))) - (ids (pi-coding-agent--active-branch-user-ids index "a2"))) - (should (equal ids '("u1" "u2"))))) - -(ert-deftest pi-coding-agent-test-active-branch-with-metadata () - "Tree with model_change and thinking nodes: only user IDs returned." - (let* ((data (pi-coding-agent-test--build-tree - '("u1" nil "message" :role "user" :preview "Hello") - '("a1" nil "message" :role "assistant" :preview "Hi") - '("m1" nil "model_change" :provider "anthropic" :modelId "claude-4") - '("t1" nil "thinking_level_change" :thinkingLevel "high") - '("u2" nil "message" :role "user" :preview "More") - '("a2" nil "message" :role "assistant" :preview "Sure"))) - (index (pi-coding-agent--flatten-tree (plist-get data :tree))) - (ids (pi-coding-agent--active-branch-user-ids index "a2"))) - (should (equal ids '("u1" "u2"))))) - -(ert-deftest pi-coding-agent-test-active-branch-empty-tree () - "Empty tree returns empty list." - (let* ((index (pi-coding-agent--flatten-tree [])) - (ids (pi-coding-agent--active-branch-user-ids index nil))) - (should (equal ids nil)))) - -(ert-deftest pi-coding-agent-test-active-branch-nil-leaf () - "Nil leafId returns empty list." - (let* ((data (pi-coding-agent-test--build-tree - '("u1" nil "message" :role "user" :preview "Hello"))) - (index (pi-coding-agent--flatten-tree (plist-get data :tree))) - (ids (pi-coding-agent--active-branch-user-ids index nil))) - (should (equal ids nil)))) - ;;;; State Reading from Input Buffer (ert-deftest pi-coding-agent-test-menu-model-description-from-input-buffer () diff --git a/test/pi-coding-agent-render-test.el b/test/pi-coding-agent-render-test.el index a971d94..5dd4e93 100644 --- a/test/pi-coding-agent-render-test.el +++ b/test/pi-coding-agent-render-test.el @@ -368,6 +368,54 @@ agent_end + next section's leading newline must not create triple newlines." ;; Should show summary text (should (string-match-p "Key points" (buffer-string))))) +(ert-deftest pi-coding-agent-test-history-displays-branch-summary () + "Branch summary messages display with header and full summary text." + (with-temp-buffer + (pi-coding-agent-chat-mode) + (let ((messages [(:role "branchSummary" + :summary "## Goal\nThe user was exploring TDD.\n\n## Progress\n- Learned basics" + :fromId "abc123" + :timestamp 1704067200000)])) + (pi-coding-agent--display-history-messages messages)) + ;; Should have Branch Summary header + (should (string-match-p "Branch Summary" (buffer-string))) + ;; Should show the full summary text + (should (string-match-p "Goal" (buffer-string))) + (should (string-match-p "exploring TDD" (buffer-string))) + (should (string-match-p "Learned basics" (buffer-string))))) + +(ert-deftest pi-coding-agent-test-history-branch-summary-among-messages () + "Branch summary renders correctly between user and assistant messages." + (with-temp-buffer + (pi-coding-agent-chat-mode) + (let ((messages [(:role "user" + :content [(:type "text" :text "Hello")] + :timestamp 1704067100000) + (:role "assistant" + :content [(:type "text" :text "Hi there")] + :timestamp 1704067150000) + (:role "branchSummary" + :summary "Summarized an abandoned branch." + :fromId "xyz" + :timestamp 1704067200000) + (:role "user" + :content [(:type "text" :text "Continue")] + :timestamp 1704067300000)])) + (pi-coding-agent--display-history-messages messages)) + (let ((text (buffer-string))) + ;; All four messages should appear in order + (should (string-match-p "Hello" text)) + (should (string-match-p "Hi there" text)) + (should (string-match-p "Branch Summary" text)) + (should (string-match-p "Summarized an abandoned branch" text)) + (should (string-match-p "Continue" text)) + ;; Branch Summary should come after Hi there and before Continue + (let ((summary-pos (string-match "Branch Summary" text)) + (hi-pos (string-match "Hi there" text)) + (continue-pos (string-match "Continue" text))) + (should (< hi-pos summary-pos)) + (should (< summary-pos continue-pos)))))) + ;;; Streaming Marker (ert-deftest pi-coding-agent-test-streaming-marker-created-on-agent-start ()