@@ -567,6 +567,38 @@ Optional CUSTOM-INSTRUCTIONS provide guidance for the compaction summary."
567567
568568; ;;; Fork
569569
570+ (defun pi-coding-agent--flatten-tree (nodes )
571+ " Flatten tree NODES into a hash table mapping id to node plist.
572+ NODES is a vector of tree node plists, each with `:children' vector.
573+ Returns a hash table for O(1) lookup by id."
574+ (let ((index (make-hash-table :test 'equal )))
575+ (cl-labels ((walk (ns)
576+ (seq-doseq (node ns)
577+ (puthash (plist-get node :id ) node index)
578+ (let ((children (plist-get node :children )))
579+ (when (and children (> (length children) 0 ))
580+ (walk children))))))
581+ (walk nodes))
582+ index))
583+
584+ (defun pi-coding-agent--active-branch-user-ids (index leaf-id )
585+ " Return chronological list of user message IDs on the active branch.
586+ INDEX is a hash table from `pi-coding-agent--flatten-tree' .
587+ LEAF-ID is the current leaf node ID. Walk from leaf to root via
588+ `:parentId' , collecting IDs of nodes with type \" message\" and role
589+ \" user\" . Returns list in root-to-leaf (chronological) order."
590+ (when leaf-id
591+ (let ((user-ids nil )
592+ (current-id leaf-id))
593+ (while current-id
594+ (let ((node (gethash current-id index)))
595+ (when (and node
596+ (equal (plist-get node :type ) " message" )
597+ (equal (plist-get node :role ) " user" ))
598+ (push (plist-get node :id ) user-ids))
599+ (setq current-id (and node (plist-get node :parentId )))))
600+ user-ids)))
601+
570602(defun pi-coding-agent--format-fork-message (msg &optional index )
571603 " Format MSG for display in fork selector.
572604MSG is a plist with :entryId and :text.
@@ -593,6 +625,87 @@ Shows a selector of user messages and creates a fork from the selected one."
593625 (pi-coding-agent--show-fork-selector proc messages)))
594626 (message " Pi: Failed to get fork messages " ))))))
595627
628+ (defun pi-coding-agent--resolve-fork-entry (response ordinal heading-count )
629+ " Resolve a fork entry ID from get_tree RESPONSE.
630+ ORDINAL is the 0-based user turn index. HEADING-COUNT is the number
631+ of visible You headings in the buffer. Returns (ENTRY-ID . PREVIEW)
632+ or nil if the ordinal could not be mapped."
633+ (when (plist-get response :success )
634+ (let* ((data (plist-get response :data ))
635+ (tree (plist-get data :tree ))
636+ (leaf-id (plist-get data :leafId ))
637+ (index (pi-coding-agent--flatten-tree tree))
638+ (all-user-ids (pi-coding-agent--active-branch-user-ids index leaf-id))
639+ ; ; Take last N to handle compaction (compacted-away
640+ ; ; user messages at start of path aren't rendered)
641+ (visible-ids (last all-user-ids heading-count))
642+ (entry-id (nth ordinal visible-ids))
643+ (node (and entry-id (gethash entry-id index))))
644+ (when entry-id
645+ (cons entry-id (plist-get node :preview ))))))
646+
647+ (defun pi-coding-agent-fork-at-point ()
648+ " Fork conversation from the user turn at point.
649+ Determines which user message point is in (or after), confirms with
650+ a preview, then forks. Only works when the session is idle."
651+ (interactive )
652+ (let ((chat-buf (pi-coding-agent--get-chat-buffer)))
653+ (unless chat-buf
654+ (user-error " Pi: No chat buffer" ))
655+ (with-current-buffer chat-buf
656+ (let* ((headings (pi-coding-agent--collect-you-headings))
657+ (ordinal (pi-coding-agent--user-turn-index-at-point headings)))
658+ (cond
659+ ((not (eq pi-coding-agent--status 'idle ))
660+ (message " Pi: Cannot fork while streaming " ))
661+ ((not ordinal)
662+ (message " Pi: No user message at point " ))
663+ (t
664+ (let ((heading-count (length headings))
665+ (proc (pi-coding-agent--get-process)))
666+ (unless proc
667+ (user-error " Pi: No active process" ))
668+ (pi-coding-agent--rpc-async proc '(:type " get_tree" )
669+ (lambda (response )
670+ (let ((result (pi-coding-agent--resolve-fork-entry
671+ response ordinal heading-count)))
672+ (cond
673+ ((not result)
674+ (message " Pi: Could not map turn to entry ID " ))
675+ ((with-current-buffer chat-buf
676+ (y-or-n-p (format " Fork from: %s ? " (or (cdr result) " ?" ))))
677+ (with-current-buffer chat-buf
678+ (pi-coding-agent--execute-fork proc (car result)))))))))))))))
679+
680+ (defun pi-coding-agent--execute-fork (proc entry-id )
681+ " Execute fork to ENTRY-ID via PROC.
682+ Sends the fork RPC, then on success: refreshes state, reloads history,
683+ and pre-fills the input buffer with the forked message text.
684+ Captures chat and input buffers at call time (before the async RPC)."
685+ (let ((chat-buf (pi-coding-agent--get-chat-buffer))
686+ (input-buf (pi-coding-agent--get-input-buffer)))
687+ (pi-coding-agent--rpc-async proc (list :type " fork" :entryId entry-id)
688+ (lambda (response )
689+ (if (plist-get response :success )
690+ (let* ((data (plist-get response :data ))
691+ (text (plist-get data :text )))
692+ ; ; Refresh state to get new session-file
693+ (pi-coding-agent--rpc-async proc '(:type " get_state" )
694+ (lambda (resp )
695+ (pi-coding-agent--apply-state-response chat-buf resp)))
696+ ; ; Reload and display the forked session
697+ (pi-coding-agent--load-session-history
698+ proc
699+ (lambda (count )
700+ (message " Pi: Branched to new session (%d messages) " count))
701+ chat-buf)
702+ ; ; Pre-fill input with the forked message text
703+ (when (buffer-live-p input-buf)
704+ (with-current-buffer input-buf
705+ (erase-buffer )
706+ (when text (insert text)))))
707+ (message " Pi: Branch failed " ))))))
708+
596709(defun pi-coding-agent--show-fork-selector (proc messages )
597710 " Show selector for MESSAGES and fork on selection.
598711PROC is the pi process.
@@ -613,34 +726,9 @@ MESSAGES is a vector of plists from get_fork_messages."
613726 '(metadata (display-sort-function . identity))
614727 (complete-with-action action choice-strings string pred)))
615728 nil t ))
616- (selected (cdr (assoc choice formatted)))
617- ; ; Capture buffers before async call (callback runs in arbitrary context)
618- (chat-buf (pi-coding-agent--get-chat-buffer))
619- (input-buf (pi-coding-agent--get-input-buffer)))
729+ (selected (cdr (assoc choice formatted))))
620730 (when selected
621- (let ((entry-id (plist-get selected :entryId )))
622- (pi-coding-agent--rpc-async proc (list :type " fork" :entryId entry-id)
623- (lambda (response )
624- (if (plist-get response :success )
625- (let* ((data (plist-get response :data ))
626- (text (plist-get data :text )))
627- ; ; Refresh state to get new session-file
628- (pi-coding-agent--rpc-async proc '(:type " get_state" )
629- (lambda (resp )
630- (pi-coding-agent--apply-state-response chat-buf resp)))
631- ; ; Reload and display the forked session
632- (pi-coding-agent--load-session-history
633- proc
634- (lambda (count )
635- (message " Pi: Branched to new session (%d messages) " count))
636- chat-buf)
637- ; ; Pre-fill input with the selected message text
638- (when (buffer-live-p input-buf)
639- (with-current-buffer input-buf
640- (erase-buffer )
641- ; ; text may be nil if RPC returns null
642- (when text (insert text)))))
643- (message " Pi: Branch failed " ))))))))
731+ (pi-coding-agent--execute-fork proc (plist-get selected :entryId )))))
644732
645733; ;;; Custom Commands
646734
0 commit comments