-
Notifications
You must be signed in to change notification settings - Fork 14
Expand file tree
/
Copy pathpi-coding-agent-ui.el
More file actions
1492 lines (1293 loc) · 61.4 KB
/
pi-coding-agent-ui.el
File metadata and controls
1492 lines (1293 loc) · 61.4 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; pi-coding-agent-ui.el --- Shared state, faces, and UI primitives -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Daniel Nouri
;; Author: Daniel Nouri <daniel.nouri@gmail.com>
;; Maintainer: Daniel Nouri <daniel.nouri@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Foundation module for pi-coding-agent: shared state, faces, customization,
;; buffer management, display primitives, header-line, and major modes.
;;
;; This is the base layer that all other pi-coding-agent modules require.
;; It provides:
;; - Customization options and face definitions
;; - Buffer-local session variables (the shared mutable state)
;; - Buffer creation, naming, and navigation
;; - Display primitives (append-to-chat, scroll preservation, separators)
;; - Header-line formatting and activity phases
;; - Sending infrastructure (send-prompt, abort-send)
;; - Major mode definitions (chat-mode, input-mode)
;;; Code:
(require 'pi-coding-agent-core)
(require 'cl-lib)
(require 'project)
(require 'md-ts-mode)
(require 'pi-coding-agent-grammars)
(require 'color)
;; Forward declarations: keymaps bind functions defined in other modules.
;; Grouped by target module for easy cross-referencing.
;; pi-coding-agent-render.el (chat buffer commands)
(declare-function pi-coding-agent-toggle-tool-section "pi-coding-agent-render")
(declare-function pi-coding-agent-visit-file "pi-coding-agent-render")
(declare-function pi-coding-agent--cleanup-on-kill "pi-coding-agent-render")
(declare-function pi-coding-agent--restore-tool-properties "pi-coding-agent-render")
(declare-function pi-coding-agent--maybe-refresh-hot-tail-tables "pi-coding-agent-table")
;; pi-coding-agent-input.el (input buffer commands)
(declare-function pi-coding-agent-quit "pi-coding-agent-input")
(declare-function pi-coding-agent-send "pi-coding-agent-input")
(declare-function pi-coding-agent-abort "pi-coding-agent-input")
(declare-function pi-coding-agent-previous-input "pi-coding-agent-input")
(declare-function pi-coding-agent-next-input "pi-coding-agent-input")
(declare-function pi-coding-agent-history-isearch-backward "pi-coding-agent-input")
(declare-function pi-coding-agent-queue-steering "pi-coding-agent-input")
(declare-function pi-coding-agent-input-mode "pi-coding-agent-input")
;; 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")
;;;; Customization Group
(defgroup pi-coding-agent nil
"Emacs frontend for pi coding agent."
:group 'tools
:prefix "pi-coding-agent-")
;;;; Customization
(defcustom pi-coding-agent-executable '("pi")
"Command to invoke the pi binary, as a list of strings.
The first element is the program; remaining elements are passed
before \"--mode rpc\" and `pi-coding-agent-extra-args'.
For npx users:
(setq pi-coding-agent-executable \\='(\"npx\" \"pi\"))"
:type '(repeat string)
:group 'pi-coding-agent)
(defcustom pi-coding-agent-rpc-timeout 30
"Default timeout in seconds for synchronous RPC calls.
Some operations like model loading may need more time."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-input-window-height 10
"Height of the input window in lines."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-separator-width 72
"Total width of section separators in chat buffer."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-tool-preview-lines 10
"Maximum visual lines to show before collapsing tool output."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-bash-preview-lines 5
"Maximum visual lines to show for bash output before collapsing.
Bash output is typically more verbose, so fewer lines are shown."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-preview-max-bytes 51200
"Maximum bytes for tool output preview (50KB default).
Prevents huge single-line outputs from blowing up the chat buffer."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-context-warning-threshold 70
"Context usage percentage at which to show warning color."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-context-error-threshold 90
"Context usage percentage at which to show error color."
:type 'natnum
:group 'pi-coding-agent)
(defcustom pi-coding-agent-visit-file-other-window t
"Whether to open files in other window when visiting from tool blocks.
When non-nil, RET on a line in tool output opens in other window.
When nil, RET opens in the same window.
Prefix arg toggles the behavior."
:type 'boolean
:group 'pi-coding-agent)
(defcustom pi-coding-agent-input-markdown-highlighting nil
"Whether to enable markdown syntax highlighting in the input buffer.
When non-nil, the input buffer gets tree-sitter markdown highlighting
\(bold, italic, code spans, fenced blocks). When nil, the input buffer
uses plain `text-mode'.
Takes effect for new sessions; existing input buffers keep their mode."
:type 'boolean
:group 'pi-coding-agent)
(defcustom pi-coding-agent-copy-raw-markdown nil
"Whether to copy raw markdown from the chat buffer.
When non-nil, copy commands (`kill-ring-save', `kill-region') preserve
raw markdown — bold markers (**), backticks, code fences, and setext
underlines are kept. Useful for pasting into docs or other markdown-aware
contexts.
When nil (the default), only the visible text is copied."
:type 'boolean
:group 'pi-coding-agent)
(defcustom pi-coding-agent-hot-tail-turn-count 3
"How many recent headed chat turns stay hot for redisplay refreshes.
The hot tail is the suffix of the chat buffer beginning at the Nth newest
`You' or `Assistant' setext heading. Resize-sensitive features refresh only
inside that suffix; older history stays frozen until explicitly rebuilt."
:type 'natnum
:group 'pi-coding-agent)
;;;; Faces
(defface pi-coding-agent-timestamp
'((t :inherit shadow))
"Face for timestamps in message headers."
:group 'pi-coding-agent)
(defface pi-coding-agent-tool-name
'((t :inherit font-lock-function-name-face :weight bold :slant italic))
"Face for tool names (BASH, READ, etc.) in pi chat."
:group 'pi-coding-agent)
(defface pi-coding-agent-tool-command
'((t :inherit font-lock-function-name-face :slant italic))
"Face for tool commands and arguments."
:group 'pi-coding-agent)
(defface pi-coding-agent-tool-output
'((t :inherit shadow))
"Face for tool output text."
:group 'pi-coding-agent)
(defface pi-coding-agent-tool-block
'((t :extend t))
"Face for tool blocks.
Subtle blue-tinted background derived from the current theme."
:group 'pi-coding-agent)
(defface pi-coding-agent-tool-block-error
'((t :inherit diff-removed :extend t))
"Face for tool blocks after failed completion."
:group 'pi-coding-agent)
(defface pi-coding-agent-collapsed-indicator
'((t :inherit font-lock-comment-face :slant italic))
"Face for collapsed content indicators."
:group 'pi-coding-agent)
(defface pi-coding-agent-model-name
'((t :inherit font-lock-type-face))
"Face for model name in header line."
:group 'pi-coding-agent)
(defface pi-coding-agent-activity-phase
'((t :inherit shadow))
"Face for activity phase label in header line."
:group 'pi-coding-agent)
(defface pi-coding-agent-retry-notice
'((t :inherit warning :slant italic))
"Face for retry notifications (rate limit, overloaded, etc.)."
:group 'pi-coding-agent)
(defface pi-coding-agent-error-notice
'((t :inherit error))
"Face for error notifications from the server."
:group 'pi-coding-agent)
;;;; Dynamic Face Computation
(defun pi-coding-agent--blend-color (base target amount)
"Blend BASE color toward TARGET by AMOUNT (0.0–1.0).
Returns a hex color string. AMOUNT of 0.0 returns BASE unchanged;
1.0 returns TARGET."
(apply #'color-rgb-to-hex
(cl-mapcar (lambda (b tgt)
(+ (* (- 1.0 amount) b) (* amount tgt)))
(color-name-to-rgb base)
(color-name-to-rgb target))))
(defun pi-coding-agent--update-tool-block-face (&rest _)
"Set `pi-coding-agent-tool-block' background from theme.
Blends the default background slightly toward blue, producing a
subtle tint that works with any theme. Called from mode setup and
on theme changes."
(condition-case nil
(let ((bg (face-background 'default nil t)))
(when (and bg (color-defined-p bg))
(let* ((dark-p (< (nth 2 (apply #'color-rgb-to-hsl
(color-name-to-rgb bg)))
0.5))
(tint (if dark-p "#5555cc" "#3333aa"))
(amount (if dark-p 0.12 0.08)))
(set-face-attribute
'pi-coding-agent-tool-block nil
:background
(pi-coding-agent--blend-color bg tint amount)))))
(error nil)))
;; Recompute when theme changes (Emacs 29+)
(when (boundp 'enable-theme-functions)
(add-hook 'enable-theme-functions
#'pi-coding-agent--update-tool-block-face))
;;;; Language Detection
(defconst pi-coding-agent--extension-language-alist
'(("ts" . "typescript") ("tsx" . "typescript")
("js" . "javascript") ("jsx" . "javascript") ("mjs" . "javascript")
("py" . "python") ("pyw" . "python")
("rb" . "ruby") ("rake" . "ruby")
("rs" . "rust")
("go" . "go")
("el" . "emacs-lisp") ("lisp" . "lisp") ("cl" . "lisp")
("sh" . "bash") ("bash" . "bash") ("zsh" . "zsh")
("c" . "c") ("h" . "c")
("cpp" . "cpp") ("cc" . "cpp") ("cxx" . "cpp") ("hpp" . "cpp")
("java" . "java")
("kt" . "kotlin") ("kts" . "kotlin")
("swift" . "swift")
("cs" . "csharp")
("php" . "php")
("json" . "json")
("yaml" . "yaml") ("yml" . "yaml")
("toml" . "toml")
("xml" . "xml")
("html" . "html") ("htm" . "html")
("css" . "css") ("scss" . "scss") ("sass" . "sass")
("sql" . "sql")
("md" . "markdown")
("org" . "org")
("lua" . "lua")
("r" . "r") ("R" . "r")
("pl" . "perl") ("pm" . "perl")
("hs" . "haskell")
("ml" . "ocaml") ("mli" . "ocaml")
("ex" . "elixir") ("exs" . "elixir")
("erl" . "erlang")
("clj" . "clojure") ("cljs" . "clojure")
("scala" . "scala")
("vim" . "vim")
("dockerfile" . "dockerfile")
("makefile" . "makefile") ("mk" . "makefile"))
"Alist mapping file extensions to language names for syntax highlighting.")
(defsubst pi-coding-agent--tool-path (args)
"Extract file path from tool ARGS.
Checks both :path and :file_path keys for compatibility."
(or (plist-get args :path)
(plist-get args :file_path)))
(defun pi-coding-agent--path-to-language (path)
"Return language name for PATH based on file extension.
Returns \"text\" for unrecognized extensions to ensure consistent fencing."
(when path
(let ((ext (downcase (or (file-name-extension path) ""))))
(or (cdr (assoc ext pi-coding-agent--extension-language-alist))
"text"))))
;;;; Major Modes
(defvar pi-coding-agent-chat-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") #'pi-coding-agent-quit)
(define-key map (kbd "C-c C-p") #'pi-coding-agent-menu)
(define-key map (kbd "n") #'pi-coding-agent-next-message)
(define-key map (kbd "p") #'pi-coding-agent-previous-message)
(define-key map (kbd "f") #'pi-coding-agent-fork-at-point)
(define-key map (kbd "TAB") #'pi-coding-agent-toggle-tool-section)
(define-key map (kbd "<tab>") #'pi-coding-agent-toggle-tool-section)
(define-key map (kbd "RET") #'pi-coding-agent-visit-file)
(define-key map (kbd "<return>") #'pi-coding-agent-visit-file)
map)
"Keymap for `pi-coding-agent-chat-mode'.")
;;;; You Heading Detection
(defconst pi-coding-agent--you-heading-re
"^You\\( · .*\\)?$"
"Regex matching the first line of a user turn setext heading.
Matches `You' at line start, optionally followed by ` · <timestamp>'.
Must be verified with `pi-coding-agent--at-you-heading-p' to confirm
the next line is a setext underline (===), avoiding false matches on
user message text starting with \"You\".")
(defun pi-coding-agent--at-you-heading-p ()
"Return non-nil if current line is a You setext heading.
Checks that the current line matches `pi-coding-agent--you-heading-re'
and the next line is a setext underline (three or more `=' characters)."
(and (save-excursion
(beginning-of-line)
(looking-at pi-coding-agent--you-heading-re))
(save-excursion
(forward-line 1)
(looking-at "^=\\{3,\\}$"))))
(defvar-local pi-coding-agent--hot-tail-start nil
"Marker at the start of the recent hot-tail suffix.
Tables and future redisplay-sensitive subsystems refresh only at or after
this boundary.")
(defconst pi-coding-agent--turn-heading-re
"^\\(?:You\\(?: · .*\\)?\\|Assistant\\)$"
"Regex matching headed chat turns that define the hot-tail boundary.")
(defun pi-coding-agent--at-turn-heading-p ()
"Return non-nil if current line is a hot-tail turn heading.
A turn heading is a `You' or `Assistant' setext heading whose next line is
an underline of three or more `=' characters."
(and (save-excursion
(beginning-of-line)
(looking-at pi-coding-agent--turn-heading-re))
(save-excursion
(forward-line 1)
(looking-at "^=\\{3,\\}$"))))
;;;; Turn Detection
(defun pi-coding-agent--collect-you-headings ()
"Return list of buffer positions of all You setext headings.
Scans from `point-min', returns positions in chronological order."
(let (headings)
(save-excursion
(goto-char (point-min))
(while (re-search-forward pi-coding-agent--you-heading-re nil t)
(let ((pos (match-beginning 0)))
(save-excursion
(goto-char pos)
(when (pi-coding-agent--at-you-heading-p)
(push pos headings))))))
(nreverse headings)))
(defun pi-coding-agent--user-turn-index-at-point (&optional headings)
"Return 0-based index of the user turn at or before point.
HEADINGS is an optional pre-computed list from
`pi-coding-agent--collect-you-headings'; when nil, the buffer is scanned.
Returns nil if point is before the first You heading."
(let ((headings (or headings (pi-coding-agent--collect-you-headings)))
(limit (point))
(index 0)
(result nil))
(dolist (h headings)
(when (<= h limit)
(setq result index))
(setq index (1+ index)))
result))
(defun pi-coding-agent--update-hot-tail-boundary ()
"Move `pi-coding-agent--hot-tail-start' to the recent headed-turn suffix.
The marker lands on the Nth newest `You' or `Assistant' heading, where N is
`pi-coding-agent-hot-tail-turn-count'. If there are at most N headed turns,
all content stays hot and the marker moves to `point-min'. A count of 0
makes the hot region empty by moving the marker to `point-max'."
(let ((headings nil)
(count pi-coding-agent-hot-tail-turn-count))
(save-excursion
(goto-char (point-min))
(while (re-search-forward pi-coding-agent--turn-heading-re nil t)
(let ((candidate (match-beginning 0)))
(save-excursion
(goto-char candidate)
(when (pi-coding-agent--at-turn-heading-p)
(push candidate headings))))))
(setq headings (nreverse headings))
(move-marker
pi-coding-agent--hot-tail-start
(cond
((zerop count) (point-max))
((<= (length headings) count) (point-min))
(t (nth (- (length headings) count) headings)))
(current-buffer))))
(defun pi-coding-agent--in-hot-tail-p (pos)
"Return non-nil when POS is inside the hot tail."
(>= pos (marker-position pi-coding-agent--hot-tail-start)))
;;;; Chat Navigation
(defun pi-coding-agent--find-you-heading (search-fn)
"Find the next You setext heading using SEARCH-FN.
SEARCH-FN is `re-search-forward' or `re-search-backward'.
Returns the position of the heading line start, or nil if not found."
(save-excursion
(let ((found nil))
(while (and (not found)
(funcall search-fn pi-coding-agent--you-heading-re nil t))
(let ((candidate (match-beginning 0)))
(save-excursion
(goto-char candidate)
(when (pi-coding-agent--at-you-heading-p)
(setq found candidate)))))
found)))
(defun pi-coding-agent-next-message ()
"Move to the next user message in the chat buffer."
(interactive)
(let ((pos (save-excursion
(forward-line 1)
(pi-coding-agent--find-you-heading #'re-search-forward))))
(if pos
(progn
(goto-char pos)
(when (get-buffer-window) (recenter 0)))
(message "No more messages"))))
(defun pi-coding-agent-previous-message ()
"Move to the previous user message in the chat buffer."
(interactive)
(let ((pos (save-excursion
(beginning-of-line)
(pi-coding-agent--find-you-heading #'re-search-backward))))
(if pos
(progn
(goto-char pos)
(when (get-buffer-window) (recenter 0)))
(message "No previous message"))))
;;;; Copy Visible Text
(defun pi-coding-agent--visible-text (beg end)
"Return visible text between BEG and END, preserving text properties.
Skips characters with `invisible' property matching `buffer-invisibility-spec'
and characters with `display' property equal to the empty string.
The returned string carries face properties from font-lock, which
display overlay strings render faithfully (bold, italic, code, etc.)."
(let ((result nil)
(pos beg))
(while (< pos end)
(let* ((inv (get-text-property pos 'invisible))
(disp (get-text-property pos 'display))
(next (min (next-single-char-property-change pos 'invisible nil end)
(next-single-char-property-change pos 'display nil end))))
(cond
((and inv (invisible-p inv)) nil)
((equal disp "") nil)
(t (push (buffer-substring pos next) result)))
(setq pos next)))
(apply #'concat (nreverse result))))
(defun pi-coding-agent--filter-buffer-substring (beg end &optional delete)
"Filter function for `filter-buffer-substring-function' in chat buffers.
When `pi-coding-agent-copy-raw-markdown' is nil, returns only visible
text between BEG and END. If DELETE is non-nil, also removes the region.
Otherwise delegates to the default filter."
(if pi-coding-agent-copy-raw-markdown
(buffer-substring--filter beg end delete)
(prog1 (substring-no-properties (pi-coding-agent--visible-text beg end))
(when delete (delete-region beg end)))))
(define-derived-mode pi-coding-agent-chat-mode md-ts-mode "Pi-Chat"
"Major mode for displaying pi conversation.
Derives from `md-ts-mode' for tree-sitter syntax highlighting.
This is a read-only buffer showing the conversation history."
:group 'pi-coding-agent
(setq-local buffer-read-only t)
(setq-local truncate-lines nil)
(setq-local word-wrap t)
;; Hide markdown markup (**, `, ```) for cleaner display
(setq-local md-ts-hide-markup t)
(md-ts--set-hide-markup t)
;; Strip hidden markup from copy operations (M-w, C-w)
(setq-local filter-buffer-substring-function
#'pi-coding-agent--filter-buffer-substring)
(setq-local pi-coding-agent--tool-args-cache (make-hash-table :test 'equal))
;; Disable hl-line-mode: its post-command-hook overlay update causes
;; scroll oscillation in buffers with invisible text + variable heights.
(setq-local global-hl-line-mode nil)
(hl-line-mode -1)
;; Make window-point follow inserted text (like comint does).
;; This is key for natural scroll behavior during streaming.
(setq-local window-point-insertion-type t)
;; Recent content is hot by default in a fresh chat buffer.
(setq-local pi-coding-agent--hot-tail-start (copy-marker (point-min) nil))
;; Run after font-lock to undo markdown damage in tool overlays.
(jit-lock-register #'pi-coding-agent--restore-tool-properties)
;; Compute tool-block face from current theme
(pi-coding-agent--update-tool-block-face)
(add-hook 'window-configuration-change-hook
#'pi-coding-agent--maybe-refresh-hot-tail-tables nil t)
(add-hook 'kill-buffer-hook #'pi-coding-agent--cleanup-on-kill nil t))
(defun pi-coding-agent-complete ()
"Complete at point, suppressing help text in the *Completions* buffer.
This wraps `completion-at-point' with `completion-show-help' bound to nil,
removing the instructional header that would otherwise appear."
(interactive)
(let ((completion-show-help nil))
(completion-at-point)))
(defvar pi-coding-agent-input-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'pi-coding-agent-send)
(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 "M-p") #'pi-coding-agent-previous-input)
(define-key map (kbd "M-n") #'pi-coding-agent-next-input)
(define-key map (kbd "<C-up>") #'pi-coding-agent-previous-input)
(define-key map (kbd "<C-down>") #'pi-coding-agent-next-input)
(define-key map (kbd "C-r") #'pi-coding-agent-history-isearch-backward)
;; Message queuing (steering only - follow-up handled by C-c C-c)
(define-key map (kbd "C-c C-s") #'pi-coding-agent-queue-steering)
map)
"Keymap for `pi-coding-agent-input-mode'.")
;;;; Session Directory Detection
(defun pi-coding-agent--session-directory ()
"Determine directory for pi session.
Uses project root if available, otherwise `default-directory'.
Always returns an expanded absolute path (no ~ abbreviation)."
(expand-file-name
(or (when-let* ((proj (project-current)))
(project-root proj))
default-directory)))
;;;; Buffer Naming & Creation
(defun pi-coding-agent--buffer-name (type dir &optional session)
"Generate buffer name for TYPE (:chat or :input) in DIR.
Optional SESSION name creates a named session.
Uses abbreviated directory for readability in buffer lists."
(let ((type-str (pcase type
(:chat "chat")
(:input "input")))
(abbrev-dir (abbreviate-file-name dir)))
(if (and session (not (string-empty-p session)))
(format "*pi-coding-agent-%s:%s<%s>*" type-str abbrev-dir session)
(format "*pi-coding-agent-%s:%s*" type-str abbrev-dir))))
(defun pi-coding-agent--find-session (dir &optional session)
"Find existing chat buffer for DIR and SESSION.
Returns the chat buffer or nil if not found."
(get-buffer (pi-coding-agent--buffer-name :chat dir session)))
(defun pi-coding-agent--get-or-create-buffer (type dir &optional session)
"Get or create buffer of TYPE for DIR and optional SESSION.
TYPE is :chat or :input. Returns the buffer."
(let* ((name (pi-coding-agent--buffer-name type dir session))
(existing (get-buffer name)))
(if existing
existing
(let ((buf (generate-new-buffer name)))
(with-current-buffer buf
;; Keep canonical session directory for exact matching.
(setq default-directory dir)
(pcase type
(:chat (pi-coding-agent-chat-mode))
(:input (pi-coding-agent-input-mode))))
buf))))
;;;; Project Buffer Discovery
(defun pi-coding-agent--normalize-directory (dir)
"Normalize DIR for exact path comparisons.
Returns an expanded absolute path with a trailing slash."
(file-name-as-directory (expand-file-name dir)))
(defun pi-coding-agent-project-buffers ()
"Return pi chat buffers for the current project directory.
Matches buffers by exact `default-directory', not by `buffer-name' prefix.
Returns a list ordered by `buffer-list' recency (most recent first)."
(let ((target-dir (pi-coding-agent--normalize-directory
(pi-coding-agent--session-directory))))
(cl-remove-if-not
(lambda (buf)
(and (buffer-live-p buf)
(with-current-buffer buf
(and (derived-mode-p 'pi-coding-agent-chat-mode)
(stringp default-directory)
(string=
(pi-coding-agent--normalize-directory default-directory)
target-dir)))))
(buffer-list))))
;;;; Window Hiding
(defun pi-coding-agent--hide-session-windows ()
"Hide the current pi session in the selected frame.
Preserves this frame's window layout by deleting input windows (the
child splits created by `pi-coding-agent--display-buffers') and
replacing chat windows with their previous buffers via `bury-buffer'.
Must be called from a pi chat or input buffer. Only affects windows
of the current session in the selected frame."
(let ((chat-buf (pi-coding-agent--get-chat-buffer))
(input-buf (pi-coding-agent--get-input-buffer)))
(when (buffer-live-p input-buf)
(dolist (win (get-buffer-window-list input-buf nil))
(ignore-errors (delete-window win))))
(when (buffer-live-p chat-buf)
(dolist (win (get-buffer-window-list chat-buf nil))
(with-selected-window win
(bury-buffer))))))
;;;; Buffer-Local Session Variables
(defvar-local pi-coding-agent--process nil
"The pi RPC subprocess for this session.")
(defvar-local pi-coding-agent--process-version nil
"Detected pi CLI version for the current process.")
(defun pi-coding-agent--set-process (process)
"Set the pi RPC subprocess PROCESS for this session.
Resets cached process version and starts a delayed version probe for
new live processes in interactive sessions."
(setq pi-coding-agent--process process
pi-coding-agent--process-version nil)
(when (and (processp process)
(process-live-p process)
(not noninteractive))
(pi-coding-agent--probe-process-version-async (current-buffer))))
(defvar-local pi-coding-agent--chat-buffer nil
"Reference to the chat buffer for this session.")
(defun pi-coding-agent--set-chat-buffer (buffer)
"Set the chat BUFFER reference for this session."
(setq pi-coding-agent--chat-buffer buffer))
(defvar-local pi-coding-agent--input-buffer nil
"Reference to the input buffer for this session.")
(defun pi-coding-agent--set-input-buffer (buffer)
"Set the input BUFFER reference for this session."
(setq pi-coding-agent--input-buffer buffer))
(defvar-local pi-coding-agent--streaming-marker nil
"Marker for current streaming insertion point.")
(defun pi-coding-agent--set-streaming-marker (marker)
"Set the streaming insertion point MARKER."
(setq pi-coding-agent--streaming-marker marker))
(defvar-local pi-coding-agent--in-code-block nil
"Non-nil when streaming inside a fenced code block.
Used to suppress ATX heading transforms inside code.")
(defvar-local pi-coding-agent--in-thinking-block nil
"Non-nil while processing a thinking block for the current message.
Used for lifecycle resets when new messages or turns begin.")
(defvar-local pi-coding-agent--thinking-marker nil
"Marker for insertion point inside the current thinking block.
Unlike `pi-coding-agent--streaming-marker', this marker stays anchored
in thinking text when other content blocks (for example, tool headers)
interleave during streaming.")
(defvar-local pi-coding-agent--thinking-start-marker nil
"Marker for the start of the current thinking block.
Used to rewrite thinking content in place after whitespace normalization.")
(defvar-local pi-coding-agent--thinking-raw nil
"Accumulated raw thinking deltas for the current thinking block.
Normalized and re-rendered incrementally to avoid excess whitespace.")
(defvar-local pi-coding-agent--thinking-prev-rendered nil
"Previously rendered blockquote text for the current thinking block.
Used for incremental rendering: when the new rendered text extends the
previous text, only the suffix is inserted instead of replacing the
entire region. Reset by `pi-coding-agent--reset-thinking-state'.")
(defvar-local pi-coding-agent--line-parse-state 'line-start
"Parsing state for current line during streaming.
Values:
`line-start' - at beginning of line, ready for heading or fence
`fence-1' - seen one backtick at line start
`fence-2' - seen two backticks at line start
`mid-line' - somewhere in middle of line
Starts as `line-start' because content begins after separator newline.")
;; pi-coding-agent--status is defined in pi-coding-agent-core.el as the single source of truth
;; for session activity state (idle, sending, streaming, compacting)
(defvar-local pi-coding-agent--activity-phase "idle"
"Fine-grained activity phase for header-line display.
One of \"thinking\", \"replying\", \"running\",
\"compact\", or \"idle\".
Always populated and rendered in a fixed-width slot.")
(defun pi-coding-agent--set-activity-phase (phase)
"Set activity PHASE for header-line display in current chat buffer.
PHASE should be one of \"thinking\", \"replying\",
\"running\", \"compact\", \"idle\".
Returns non-nil when the phase changed."
(unless (equal pi-coding-agent--activity-phase phase)
(setq pi-coding-agent--activity-phase phase)
(force-mode-line-update t)
t))
(defvar-local pi-coding-agent--cached-stats nil
"Cached session statistics for header-line display.
Updated after each agent turn completes.")
(defvar-local pi-coding-agent--last-usage nil
"Usage from last assistant message for context percentage.
This is the per-turn usage, not cumulative - used to calculate
how much of the context window was used in the last turn.")
(defun pi-coding-agent--set-last-usage (usage)
"Set the last assistant message USAGE for context percentage."
(setq pi-coding-agent--last-usage usage))
(defun pi-coding-agent--extract-last-usage (messages)
"Extract usage from the last non-aborted assistant message in MESSAGES.
MESSAGES is a vector of message plists from get_messages RPC.
Returns the usage plist, or nil if no valid assistant message found.
Skips aborted messages as they may have incomplete usage data."
(when (vectorp messages)
(let ((i (1- (length messages)))
(result nil))
(while (and (>= i 0) (not result))
(let ((msg (aref messages i)))
(when (and (equal (plist-get msg :role) "assistant")
(not (equal (plist-get msg :stopReason) "aborted"))
(plist-get msg :usage))
(setq result (plist-get msg :usage))))
(setq i (1- i)))
result)))
(defvar-local pi-coding-agent--aborted nil
"Non-nil if the current/last request was aborted.")
(defun pi-coding-agent--set-aborted (value)
"Set the aborted flag to VALUE."
(setq pi-coding-agent--aborted value))
(defvar-local pi-coding-agent--message-start-marker nil
"Marker for start of current message content.
Used to replace raw markdown with rendered Org on message completion.")
(defun pi-coding-agent--set-message-start-marker (marker)
"Set the message start MARKER."
(setq pi-coding-agent--message-start-marker marker))
(defvar-local pi-coding-agent--tool-args-cache nil
"Hash table mapping toolCallId to args.
Needed because tool_execution_end events don't include args.")
(defvar-local pi-coding-agent--pending-tool-overlay nil
"Overlay for tool block currently being executed.
Set by display-tool-start, used by display-tool-end.")
(defvar-local pi-coding-agent--streaming-tool-id nil
"Tool call ID of overlay created via toolcall_start during LLM streaming.
Enables dedup guard in tool_execution_start to skip overlay creation
when the overlay was already created by the streaming event path.
Set at toolcall_start, consumed and cleared at tool_execution_start.")
(defvar-local pi-coding-agent--assistant-header-shown nil
"Non-nil if Assistant header has been shown for current prompt.
Used to avoid duplicate headers during retry sequences.")
(defvar-local pi-coding-agent--followup-queue nil
"List of follow-up messages queued while agent is busy.
Messages are added when user sends while streaming.
On agent_end, the first message is popped and sent as a normal prompt.
This is simpler than using pi's RPC follow_up command.")
(defun pi-coding-agent--push-followup (message)
"Push MESSAGE onto the follow-up queue."
(push message pi-coding-agent--followup-queue))
(defun pi-coding-agent--dequeue-followup ()
"Dequeue and return the oldest follow-up message, or nil if empty.
Follow-ups are processed in FIFO order: first pushed, first sent."
(when pi-coding-agent--followup-queue
(let ((text (car (last pi-coding-agent--followup-queue))))
(setq pi-coding-agent--followup-queue
(butlast pi-coding-agent--followup-queue))
text)))
(defun pi-coding-agent--clear-followup-queue ()
"Clear all pending follow-up messages."
(setq pi-coding-agent--followup-queue nil))
(defvar-local pi-coding-agent--local-user-message nil
"Text of user message we displayed locally, awaiting pi's echo.
Set when displaying a user message (normal send, follow-up).
Cleared when we receive message_start role=user from pi.
When nil and we receive message_start role=user, we display it.
When set but different from pi's message, we display pi's version
\(e.g., expanded template).")
(defvar-local pi-coding-agent--extension-status nil
"Alist of extension status messages for header-line display.
Keys are extension identifiers (strings), values are status text.")
(defvar-local pi-coding-agent--working-message nil
"Transient extension working message for header-line display.")
(defvar-local pi-coding-agent--session-name nil
"Cached session name for header-line display.
Extracted from session_info entries when session is loaded or switched.")
(defvar-local pi-coding-agent--commands nil
"List of available commands from pi.
Each entry is a plist with :name, :description, :source.
Source is \"prompt\", \"extension\", or \"skill\".")
(defvar pi-coding-agent--builtin-commands
'(("compact" :handler pi-coding-agent-compact :args optional)
("new" :handler pi-coding-agent-new-session)
("model" :handler pi-coding-agent-select-model :args optional)
("session" :handler pi-coding-agent-session-stats)
("name" :handler pi-coding-agent-set-session-name :args required)
("fork" :handler pi-coding-agent-fork)
("resume" :handler pi-coding-agent-resume-session)
("reload" :handler pi-coding-agent-reload)
("export" :handler pi-coding-agent-export-html :args optional)
("copy" :handler pi-coding-agent-copy-last-message)
("quit" :handler pi-coding-agent-quit))
"Built-in slash commands dispatched client-side.
Each entry is (NAME . PLIST) where PLIST has:
:handler Function to call (symbol)
:args nil (no args), `optional', or `required'
Commands with :args `optional' pass the trailing text (or nil) to the
handler. Commands with :args `required' prompt interactively when no
argument is given (the handler's `interactive' spec handles this).
Descriptions come from the handler's docstring.")
(defun pi-coding-agent--set-commands (commands)
"Set COMMANDS in current buffer and propagate to sibling session buffers.
COMMANDS is a list of plists with :name, :description, :source.
Both chat and input buffers share the same commands list, so this
setter updates all of them to keep them in sync."
(setq pi-coding-agent--commands commands)
(let ((chat-buf (pi-coding-agent--get-chat-buffer))
(input-buf (pi-coding-agent--get-input-buffer)))
(dolist (buf (list chat-buf input-buf))
(when (and (buffer-live-p buf)
(not (eq buf (current-buffer))))
(with-current-buffer buf
(setq pi-coding-agent--commands commands))))))
;;;; Buffer Navigation
(defun pi-coding-agent--get-chat-buffer ()
"Get the chat buffer for the current session.
Works from either chat or input buffer."
(if (derived-mode-p 'pi-coding-agent-chat-mode)
(current-buffer)
pi-coding-agent--chat-buffer))
(defun pi-coding-agent--get-input-buffer ()
"Get the input buffer for the current session.
Works from either chat or input buffer."
(if (derived-mode-p 'pi-coding-agent-input-mode)
(current-buffer)
pi-coding-agent--input-buffer))
(defun pi-coding-agent--get-process ()
"Get the pi process for the current session.
Works from either chat or input buffer."
(if (derived-mode-p 'pi-coding-agent-chat-mode)
pi-coding-agent--process
(and pi-coding-agent--chat-buffer
(buffer-local-value 'pi-coding-agent--process pi-coding-agent--chat-buffer))))
;;;; Display
(defun pi-coding-agent--window-can-split-for-input-p (window)
"Return non-nil if WINDOW can be split into chat and input windows."
(>= (window-total-height window)
(* 2 window-min-height)))
(defun pi-coding-agent--input-height-for-window (window)
"Return input pane height to use when splitting WINDOW.
Clamps `pi-coding-agent-input-window-height' to the maximum that still
leaves at least `window-min-height' lines for chat."
(let* ((window-height (window-total-height window))
(max-input-height (- window-height window-min-height)))
(max window-min-height
(min pi-coding-agent-input-window-height
max-input-height))))
(defun pi-coding-agent--windows-by-height (&optional windows)
"Return live WINDOWS sorted by descending height.
If WINDOWS is nil, use all non-minibuffer windows in the selected frame."
(sort (cl-remove-if-not #'window-live-p
(copy-sequence (or windows (window-list nil 'no-mini))))
(lambda (a b)
(> (window-total-height a)
(window-total-height b)))))
(defun pi-coding-agent--window-with-most-height (&optional windows)
"Return the tallest window from WINDOWS.
If WINDOWS is nil, use all non-minibuffer windows in the selected frame."
(car (pi-coding-agent--windows-by-height windows)))
(defun pi-coding-agent--best-display-window (&optional preferred)
"Return best window for displaying chat+input.
Use PREFERRED when it can be split, else pick the tallest splittable
window in the frame. Falls back to PREFERRED or selected window."
(or (and preferred
(window-live-p preferred)
(pi-coding-agent--window-can-split-for-input-p preferred)
preferred)
(cl-find-if #'pi-coding-agent--window-can-split-for-input-p
(pi-coding-agent--windows-by-height))
preferred
(selected-window)))
(defun pi-coding-agent--preferred-display-window (chat-wins input-wins selected)
"Return preferred base window for displaying chat+input.
CHAT-WINS and INPUT-WINS are existing session windows. SELECTED is the
currently selected window."
(cond
;; Input-only visible: prefer selected non-input window so we can
;; replace it cleanly and avoid duplicate input windows.
((and input-wins (not chat-wins)
(not (memq selected input-wins))
(pi-coding-agent--window-can-split-for-input-p selected))
selected)
(chat-wins (pi-coding-agent--window-with-most-height chat-wins))
(input-wins (pi-coding-agent--window-with-most-height input-wins))
(t selected)))
(defun pi-coding-agent--delete-extra-input-windows (input-wins target)
"Delete windows in INPUT-WINS except TARGET."
(dolist (win input-wins)
(unless (eq win target)
(ignore-errors (delete-window win)))))
(defun pi-coding-agent--paired-input-window (chat-win input-buf)
"Return input window below CHAT-WIN showing INPUT-BUF, or nil."