Compare commits
9 Commits
f783b45ac7
...
084abc0644
| Author | SHA1 | Date | |
|---|---|---|---|
| 084abc0644 | |||
| a64532bc96 | |||
| e763768122 | |||
| 0629f8c6d3 | |||
| 9492e00318 | |||
| ef36854822 | |||
| 8dd94f6d3c | |||
| 8eb866dee3 | |||
| b61191bec2 |
@@ -143,6 +143,52 @@ stabilization of the cl-tty TUI runtime.
|
||||
| Ctrl+Q | Quit |
|
||||
| ? | Help panel |
|
||||
|
||||
** v0.8.1: Hardening — Runtime Safety Fixes
|
||||
|
||||
:PROPERTIES:
|
||||
:ID: id-v081-hardening
|
||||
:CREATED: [2026-05-20 Wed]
|
||||
:END:
|
||||
|
||||
Three small fixes that protect the runtime while the TUI stabilizes. Each is a single-session change (minutes, not days).
|
||||
|
||||
*** Heartbeat error handling
|
||||
:PROPERTIES:
|
||||
:ID: id-v081-heartbeat
|
||||
:CREATED: [2026-05-20 Wed]
|
||||
:END:
|
||||
|
||||
The heartbeat loop in ~core-pipeline.org~ has no error handler. An unhandled condition in any tick kills the thread — auto-save, cron, and background maintenance die silently. The daemon keeps running but the user sees no evidence.
|
||||
|
||||
Wrap the loop body in ~handler-case~, log the error, continue. ~5 lines.
|
||||
|
||||
*** Atomic memory save
|
||||
:PROPERTIES:
|
||||
:ID: id-v081-atomic-save
|
||||
:CREATED: [2026-05-20 Wed]
|
||||
:END:
|
||||
|
||||
~save-memory-to-disk~ writes directly to the snapshot path. A crash or SIGINT mid-write truncates the file. Next boot reads garbage and starts with empty memory.
|
||||
|
||||
Write to ~path.tmp~, then ~rename-file~. ~3 lines.
|
||||
|
||||
*** Version string consistency
|
||||
:PROPERTIES:
|
||||
:ID: id-v081-versions
|
||||
:CREATED: [2026-05-20 Wed]
|
||||
:END:
|
||||
|
||||
~passepartout.asd~ says ~0.4.3~, ~core-transport.org~ handshake says ~0.7.2~, ~core-reason.org~ config prompt says ~v0.7.2~, README and CHANGELOG and tags all diverge. Bring all four to ~0.8.0~. Better yet, define ~*version*~ once and reference it.
|
||||
|
||||
| File | Line | Change |
|
||||
|------|------|--------|
|
||||
| ~passepartout.asd~ | 4 | ~:version "0.4.3"~ → ~"0.8.0"~ |
|
||||
| ~org/core-manifest.org~ | 25 | same |
|
||||
| ~org/core-transport.org~ | 157 | ~(make-hello-message "0.7.2")~ → ~"0.8.0"~ |
|
||||
| ~org/core-reason.org~ | 260 | ~"v0.7.2"~ in prompt string → ~"v0.8.0"~ |
|
||||
|
||||
~4 lines.
|
||||
|
||||
** v0.9.0: Eval Harness — Safety Net First
|
||||
|
||||
Every subsequent release ships with automated regression protection. The eval harness is the gate that makes self-modification safe — before any neurosymbolic component modifies the system, the harness verifies nothing broke.
|
||||
@@ -161,6 +207,33 @@ Every subsequent release ships with automated regression protection. The eval ha
|
||||
- Task suite grows with codebase: every bug fix adds a regression task
|
||||
~200 lines.
|
||||
|
||||
*** TODO Jailed-package sandbox hardening
|
||||
:PROPERTIES:
|
||||
:ID: id-v090-sandbox
|
||||
:CREATED: [2026-05-20 Wed]
|
||||
:END:
|
||||
|
||||
The skill loader's sandbox (~core-skills.org~) scans for ~"uiop:run-program"~ as text. This misses indirect calls:
|
||||
|
||||
#+begin_src lisp
|
||||
(eval (read-from-string "(uiop:run-program \"rm -rf /\")"))
|
||||
#+end_src
|
||||
|
||||
The jailed package ~:use~s ~:cl~ and ~:passepartout~, so ~eval~, ~find-symbol~, ~intern~, ~funcall~, ~read~ are all available. The post-eval ~symbol-function~ equality check is also bypassable by wrapping.
|
||||
|
||||
Fix: add ~eval~, ~funcall~, ~apply~, ~find-symbol~, ~intern~, ~read~, ~read-from-string~ to the text-level ~*skill-restricted-symbols*~ list, and shadow them in the jailed package at load time:
|
||||
|
||||
#+begin_src lisp
|
||||
(dolist (sym-name '("EVAL" "READ" "READ-FROM-STRING"
|
||||
"FIND-SYMBOL" "INTERN" "FUNCALL" "APPLY"))
|
||||
(let ((sym (find-symbol sym-name :cl)))
|
||||
(when sym (shadow sym jailed-pkg))))
|
||||
#+end_src
|
||||
|
||||
This makes the symbols unfindable in the jailed package without an explicit ~cl:eval~ prefix, which the text scan then catches. Text scan + shadowing is the combo that closes the bypass.
|
||||
|
||||
~20 lines across ~core-skills.org~. Ships with the eval harness so the harness itself tests the sandbox before use.
|
||||
|
||||
** v0.10.0: Emacs Development Environment — Secondary Client
|
||||
|
||||
cl-tty is the primary TUI (v0.8.0). The Emacs major mode is an optional secondary client for users who prefer Emacs-based workflows. Both clients communicate with the same daemon over the same TCP protocol — they are interchangeable frontends, not competing architectures.
|
||||
@@ -251,6 +324,10 @@ The Dispatcher gate stack currently prevents self-modification through pattern m
|
||||
5. Add ~dispatcher-check-self-termination~: scan shell commands for patterns targeting the Passepartout process (~kill -9 <pid>~, ~rm -rf ~/.cache/passepartout/~, ~sudo apt remove sbcl~). Return ~:reject-self-termination~ with a diagnostic message explaining which command matched and why it would destroy the agent. Human override is possible via HITL — the gate does not prevent the human from issuing the command in a terminal. It prevents the /LLM/ from issuing it accidentally. ~20 lines.
|
||||
6. Add ~integrity-verify-core-files~: on heartbeat, hash the eight core files against known-good values stored at daemon startup. On mismatch, inject an integrity alert into the signal queue. ~25 lines, uses existing SHA-256 infrastructure from v0.2.0 Merkle memory.
|
||||
|
||||
7. Add CI tangle verification: after checkout, tangle all ~.org~ files, then ~git diff --exit-code~. CI fails if committed ~.lisp~ files don't match canonical ~.org~ source. One CI step in ~.github/workflows/lint.yml~. Also stop ~.gitignore~-ing ~lisp/~ and commit tangled output — lets ~ql:quickload~ work on fresh clone without Emacs.
|
||||
|
||||
8. Add daemon connection thread limits: ~*max-client-connections*~ (default 32), ~*active-client-count*~ with lock, reject connections when at capacity. Add read timeout (~sb-ext:with-timeout~, default 300s) on ~read-framed-message~ to reap silent clients. ~25 lines in ~core-transport.org~.
|
||||
|
||||
*** Verification
|
||||
|
||||
Existing FiveAM gate tests continue to pass. New test: signal at type-level 5 targeting a gate at type-level 4 returns ~:reject-type-violation~ without evaluating the gate predicate. New test: signal at type-level 1 passing through a gate at type-level 3 proceeds to predicate evaluation. New test: ~kill -9 <pid>~ returns ~:reject-self-termination~. New test: modified core file is detected by integrity hash check.
|
||||
@@ -497,6 +574,12 @@ Inject a system message: "Memory critical (94% of 16GB). Unloading embedding-nat
|
||||
|
||||
Skill shed order is determined by a new ~:preservation-priority~ slot on ~defskill~ (default ~:normal~). Core safety skills carry ~:critical~ and are never shed. Heavy skills (embedding-native with its model in memory, channel gateways with connection pools) carry ~:low~.
|
||||
|
||||
**** Snapshot budget enforcement — extends ~core-memory.lisp~
|
||||
|
||||
The current ~snapshot-memory~ deep-copies the entire store. For stores exceeding ~MEMORY_SNAPSHOT_MAX_OBJECTS~ (default 50,000), skip full copies and switch to a journaling mode: record only the objects changed since the last snapshot. Implemented as a conditional branch in ~snapshot-memory~. ~20 lines.
|
||||
|
||||
Add this to the resource self-monitoring heartbeat: before each snapshot, check store size. If over threshold, use journaling path. Keeps the snapshot model viable for the claimed 10M-object use case without requiring 30GB of RAM for 20 snapshots.
|
||||
|
||||
**** External watchdog — extends ~passepartout~ bash entry point
|
||||
The bash script spawns a watchdog subprocess that polls the daemon port every ~WATCHDOG_TIMEOUT~ seconds (default 30). If the port stops responding, the watchdog snapshots the last known-good Merkle root, kills the stale process, and restarts the daemon with ~--snapshot <root-hash>~.
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -20,289 +20,242 @@ All state mutation flows through event handlers in the controller.
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
|
||||
(defpackage :passepartout.channel-tui
|
||||
(:use :cl :passepartout :usocket :bordeaux-threads)
|
||||
(:export :tui-main :st :add-msg :now :input-string
|
||||
(:export :tui-main :st :add-msg :now
|
||||
:queue-event :drain-queue :init-state
|
||||
:view-status :view-chat :view-input :redraw
|
||||
:position-cursor
|
||||
:input-panel-top
|
||||
:on-key :on-daemon-msg :send-daemon
|
||||
:connect-daemon :disconnect-daemon
|
||||
:*tui-theme* :theme-color))
|
||||
:on-key :process-key-event :input-text :on-daemon-msg :send-daemon
|
||||
:connect-daemon :disconnect-daemon
|
||||
:*theme* :theme-color :theme-switch))
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defvar *state* nil)
|
||||
(defvar *event-queue* nil)
|
||||
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
|
||||
|
||||
(defvar *tui-theme*
|
||||
'( :user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
|
||||
:agent-border "#c0a080" :agent-header "#d4956a" :agent-fg "#e8e8e8"
|
||||
:system "#808080"
|
||||
:input-prompt "#fab283" :input-fg "#e8e8e8"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#e8e8e8"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7fd88f" :dot-disconnected "#e06c75"
|
||||
:bg-input "#2e2e2e"
|
||||
:error "#e06c75"
|
||||
:tool-running "#fab283" :tool-done "#7fd88f" :tool-error "#e06c75"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#fab283" :dim "#606060")
|
||||
"Dark-neutral color theme with warm amber accent. Backgrounds are dark grays,
|
||||
semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
|
||||
:text-muted, :user-fg/bg/border, :agent-border/header/fg, :system,
|
||||
:input-prompt/fg, :hint, :status-bg/fg, :bg-input, :thinking-bg,
|
||||
:symbolic-border, :dot-connected/disconnected, :error, :tool-*,
|
||||
:separator, :accent, :dim.")
|
||||
(defvar *theme* (cl-tty.theme:make-theme)
|
||||
"The active theme instance. Populated by cl-tty.theme:load-preset.
|
||||
|
||||
(defvar *tui-theme-presets*
|
||||
'(:amber
|
||||
(:user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
|
||||
:agent-header "#d4956a" :agent-fg "#e8e8e8"
|
||||
:agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:system "#808080"
|
||||
:input-prompt "#fab283" :input-fg "#e8e8e8"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#e8e8e8"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7fd88f" :dot-disconnected "#e06c75"
|
||||
:error "#e06c75"
|
||||
:tool-running "#fab283" :tool-done "#7fd88f" :tool-error "#e06c75"
|
||||
:separator "#3c3c3c" :accent "#fab283" :dim "#606060")
|
||||
:gold
|
||||
(:user-fg "#ffd700" :user-bg "#1e1e1e" :user-border "#ffd700"
|
||||
:agent-header "#d4a574" :agent-fg "#e8e8e8"
|
||||
:agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:system "#808080"
|
||||
:input-prompt "#ffd700" :input-fg "#e8e8e8"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#ffd700"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7fd88f" :dot-disconnected "#e06c75"
|
||||
:error "#e06c75"
|
||||
:tool-running "#ffd700" :tool-done "#7fd88f" :tool-error "#e06c75"
|
||||
:separator "#3c3c3c" :accent "#ffd700" :dim "#606060")
|
||||
:terracotta
|
||||
(:user-fg "#e87a5d" :user-bg "#1e1e1e" :user-border "#e87a5d"
|
||||
:agent-header "#d4956a" :agent-fg "#e0c8b0"
|
||||
:agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:system "#808080"
|
||||
:input-prompt "#e87a5d" :input-fg "#e0c8b0"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#d4956a"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#6cb85c" :dot-disconnected "#d94a3a"
|
||||
:error "#d94a3a"
|
||||
:tool-running "#e87a5d" :tool-done "#6cb85c" :tool-error "#d94a3a"
|
||||
:separator "#3c3c3c" :accent "#e87a5d" :dim "#606060")
|
||||
:sepia
|
||||
(:user-fg "#c4a882" :user-bg "#1e1e1e" :user-border "#c4a882"
|
||||
:agent-header "#b89870" :agent-fg "#d4c4a8"
|
||||
:system "#808080"
|
||||
:input-prompt "#c4a882" :input-fg "#d4c4a8"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#b89870"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7aac5c" :dot-disconnected "#c84a3a"
|
||||
:error "#c84a3a"
|
||||
:tool-running "#c4a882" :tool-done "#7aac5c" :tool-error "#c84a3a"
|
||||
:separator "#3c3c3c" :accent "#c4a882" :dim "#606060")
|
||||
:nord-warm
|
||||
(:user-fg "#d4a574" :user-bg "#1e1e1e" :user-border "#d4a574"
|
||||
:agent-header "#c49870" :agent-fg "#e0d0c0"
|
||||
:system "#808080"
|
||||
:input-prompt "#d08770" :input-fg "#e0d0c0"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#c8a080"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7cb860" :dot-disconnected "#d06050"
|
||||
:error "#d06050"
|
||||
:tool-running "#d08770" :tool-done "#7cb860" :tool-error "#d06050"
|
||||
:separator "#3c3c3c" :accent "#d4a574" :dim "#606060")
|
||||
:monokai-warm
|
||||
(:user-fg "#e6b87d" :user-bg "#1e1e1e" :user-border "#e6b87d"
|
||||
:agent-header "#d4a06a" :agent-fg "#d8c8b0"
|
||||
:system "#808080"
|
||||
:input-prompt "#e6b87d" :input-fg "#d8c8b0"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#cc9966"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7ab85c" :dot-disconnected "#d94a3a"
|
||||
:error "#d94a3a"
|
||||
:tool-running "#e6b87d" :tool-done "#7ab85c" :tool-error "#d94a3a"
|
||||
:separator "#3c3c3c" :accent "#e6b87d" :dim "#606060")
|
||||
:gruvbox-warm
|
||||
(:user-fg "#d8a657" :user-bg "#1e1e1e" :user-border "#d8a657"
|
||||
:agent-header "#c8a070" :agent-fg "#e0c8a8"
|
||||
:system "#808080"
|
||||
:input-prompt "#d8a657" :input-fg "#e0c8a8"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#c8a070"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#7ab85c" :dot-disconnected "#d94a3a"
|
||||
:error "#d94a3a"
|
||||
:tool-running "#d8a657" :tool-done "#7ab85c" :tool-error "#d94a3a"
|
||||
:separator "#3c3c3c" :accent "#d8a657" :dim "#606060")
|
||||
:light-amber
|
||||
(:user-fg "#cc6600" :user-bg "#f5f5f5" :user-border "#cc6600"
|
||||
:agent-header "#8b6914" :agent-fg "#3a2a1a"
|
||||
:agent-border "#a08060" :thinking-bg "#d4d4d4" :symbolic-border "#b0b0b0"
|
||||
:system "#808080"
|
||||
:input-prompt "#cc6600" :input-fg "#3a2a1a"
|
||||
:hint "#a0a0a0"
|
||||
:status-bg "#ebebeb" :status-fg "#3a2a1a"
|
||||
:bg "#ffffff" :bg-panel "#f5f5f5" :bg-element "#ebebeb"
|
||||
:bg-input "#d4d4d4"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#2e8b57" :dot-disconnected "#cc3300"
|
||||
:error "#cc3300"
|
||||
:tool-running "#cc6600" :tool-done "#2e8b57" :tool-error "#cc3300"
|
||||
:separator "#d4d4d4" :accent "#cc6600" :dim "#a0a0a0")
|
||||
:catppuccin
|
||||
(:user-fg "#fab387" :user-bg "#1e1e2e" :user-border "#fab387"
|
||||
:agent-header "#cba6f7" :agent-fg "#cdd6f4"
|
||||
:agent-border "#a6adc8" :thinking-bg "#363650" :symbolic-border "#6c7086"
|
||||
:system "#808080"
|
||||
:input-prompt "#fab387" :input-fg "#cdd6f4"
|
||||
:hint "#6c7086"
|
||||
:status-bg "#181825" :status-fg "#a6adc8"
|
||||
:bg "#11111b" :bg-panel "#181825" :bg-element "#1e1e2e"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#6c7086"
|
||||
:dot-connected "#a6e3a1" :dot-disconnected "#f38ba8"
|
||||
:error "#f38ba8"
|
||||
:tool-running "#fab387" :tool-done "#a6e3a1" :tool-error "#f38ba8"
|
||||
:separator "#313244" :accent "#fab387" :dim "#585b70")
|
||||
:tokyonight
|
||||
(:user-fg "#ff9e64" :user-bg "#1a1b26" :user-border "#ff9e64"
|
||||
:agent-header "#7aa2f7" :agent-fg "#a9b1d6"
|
||||
:agent-border "#7982a8" :thinking-bg "#363b54" :symbolic-border "#565f89"
|
||||
:system "#808080"
|
||||
:input-prompt "#ff9e64" :input-fg "#a9b1d6"
|
||||
:hint "#565f89"
|
||||
:status-bg "#16161e" :status-fg "#9aa5ce"
|
||||
:bg "#0f0f18" :bg-panel "#16161e" :bg-element "#1a1b26"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#565f89"
|
||||
:dot-connected "#9ece6a" :dot-disconnected "#db4b4b"
|
||||
:error "#db4b4b"
|
||||
:tool-running "#ff9e64" :tool-done "#9ece6a" :tool-error "#db4b4b"
|
||||
:separator "#292e42" :accent "#ff9e64" :dim "#444b6a")
|
||||
:dracula
|
||||
(:user-fg "#ff9580" :user-bg "#1e1f2b" :user-border "#ff9580"
|
||||
:agent-header "#bd93f9" :agent-fg "#f8f8f2"
|
||||
:agent-border "#c0c0e0" :thinking-bg "#3a3b50" :symbolic-border "#6272a4"
|
||||
:system "#808080"
|
||||
:input-prompt "#ff9580" :input-fg "#f8f8f2"
|
||||
:hint "#6272a4"
|
||||
:status-bg "#191a24" :status-fg "#e0e0e0"
|
||||
:bg "#0f101a" :bg-panel "#191a24" :bg-element "#1e1f2b"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#6272a4"
|
||||
:dot-connected "#50fa7b" :dot-disconnected "#ff5555"
|
||||
:error "#ff5555"
|
||||
:tool-running "#ff9580" :tool-done "#50fa7b" :tool-error "#ff5555"
|
||||
:separator "#34354a" :accent "#ff9580" :dim "#5a5b7a")
|
||||
:gemini
|
||||
(:user-fg "#87afff" :user-bg "#1a1a1a" :user-border "#87afff"
|
||||
:agent-header "#d7afff" :agent-fg "#ffffff"
|
||||
:agent-border "#d0d0d0" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:system "#808080"
|
||||
:input-prompt "#87afff" :input-fg "#ffffff"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#afafaf"
|
||||
:bg "#000000" :bg-panel "#141414" :bg-element "#1a1a1a"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#d7ffd7" :dot-disconnected "#ff87af"
|
||||
:error "#ff87af"
|
||||
:tool-running "#87afff" :tool-done "#d7ffd7" :tool-error "#ff87af"
|
||||
:separator "#3a3a3a" :accent "#87afff" :dim "#5f5f5f")
|
||||
:mono
|
||||
(:user-fg "#e0e0e0" :user-bg "#1a1a1a" :user-border "#808080"
|
||||
:agent-header "#c0c0c0" :agent-fg "#d0d0d0"
|
||||
:agent-border "#a0a0a0" :thinking-bg "#3a3a3a" :symbolic-border "#808080"
|
||||
:system "#808080"
|
||||
:input-prompt "#ffffff" :input-fg "#d0d0d0"
|
||||
:hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#b0b0b0"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1a1a1a"
|
||||
:bg-input "#2e2e2e"
|
||||
:text-muted "#808080"
|
||||
:dot-connected "#a0a0a0" :dot-disconnected "#808080"
|
||||
:error "#808080"
|
||||
:tool-running "#e0e0e0" :tool-done "#a0a0a0" :tool-error "#808080"
|
||||
:separator "#303030" :accent "#ffffff" :dim "#505050"))
|
||||
"13 theme presets (amber, gold, terracotta, sepia, nord-warm,
|
||||
monokai-warm, gruvbox-warm, light-amber, catppuccin, tokyonight, dracula,
|
||||
gemini, mono). Keys: :bg/:bg-panel/:bg-element/:bg-input/:text-muted.")
|
||||
Semantic keys (all presets define these):
|
||||
:user-fg, :user-bg, :user-border, :agent-border, :agent-header, :agent-fg,
|
||||
:system, :input-prompt, :input-fg, :hint, :status-bg, :status-fg,
|
||||
:bg, :bg-panel, :bg-element, :bg-input, :text-muted,
|
||||
:dot-connected, :dot-disconnected, :error,
|
||||
:tool-running, :tool-done, :tool-error,
|
||||
:thinking-bg, :symbolic-border, :separator, :accent, :dim.")
|
||||
|
||||
(defvar *tui-theme-current-name* :amber
|
||||
"Name of the currently active theme preset.")
|
||||
(cl-tty.theme:define-preset :amber
|
||||
:dark (:user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
|
||||
:agent-border "#c0a080" :agent-header "#d4956a" :agent-fg "#e8e8e8"
|
||||
:system "#808080"
|
||||
:input-prompt "#fab283" :input-fg "#e8e8e8" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#e8e8e8"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#7fd88f" :dot-disconnected "#e06c75"
|
||||
:error "#e06c75"
|
||||
:tool-running "#fab283" :tool-done "#7fd88f" :tool-error "#e06c75"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#fab283" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :gold
|
||||
:dark (:user-fg "#ffd700" :user-bg "#1e1e1e" :user-border "#ffd700"
|
||||
:agent-border "#c0a080" :agent-header "#d4a574" :agent-fg "#e8e8e8"
|
||||
:system "#808080"
|
||||
:input-prompt "#ffd700" :input-fg "#e8e8e8" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#ffd700"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#7fd88f" :dot-disconnected "#e06c75"
|
||||
:error "#e06c75"
|
||||
:tool-running "#ffd700" :tool-done "#7fd88f" :tool-error "#e06c75"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#ffd700" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :terracotta
|
||||
:dark (:user-fg "#e87a5d" :user-bg "#1e1e1e" :user-border "#e87a5d"
|
||||
:agent-border "#c0a080" :agent-header "#d4956a" :agent-fg "#e0c8b0"
|
||||
:system "#808080"
|
||||
:input-prompt "#e87a5d" :input-fg "#e0c8b0" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#d4956a"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#6cb85c" :dot-disconnected "#d94a3a"
|
||||
:error "#d94a3a"
|
||||
:tool-running "#e87a5d" :tool-done "#6cb85c" :tool-error "#d94a3a"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#e87a5d" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :sepia
|
||||
:dark (:user-fg "#c4a882" :user-bg "#1e1e1e" :user-border "#c4a882"
|
||||
:agent-border "#c0a080" :agent-header "#b89870" :agent-fg "#d4c4a8"
|
||||
:system "#808080"
|
||||
:input-prompt "#c4a882" :input-fg "#d4c4a8" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#b89870"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#7aac5c" :dot-disconnected "#c84a3a"
|
||||
:error "#c84a3a"
|
||||
:tool-running "#c4a882" :tool-done "#7aac5c" :tool-error "#c84a3a"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#c4a882" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :nord-warm
|
||||
:dark (:user-fg "#d4a574" :user-bg "#1e1e1e" :user-border "#d4a574"
|
||||
:agent-border "#c0a080" :agent-header "#c49870" :agent-fg "#e0d0c0"
|
||||
:system "#808080"
|
||||
:input-prompt "#d08770" :input-fg "#e0d0c0" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#c8a080"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#7cb860" :dot-disconnected "#d06050"
|
||||
:error "#d06050"
|
||||
:tool-running "#d08770" :tool-done "#7cb860" :tool-error "#d06050"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#d4a574" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :monokai-warm
|
||||
:dark (:user-fg "#e6b87d" :user-bg "#1e1e1e" :user-border "#e6b87d"
|
||||
:agent-border "#c0a080" :agent-header "#d4a06a" :agent-fg "#d8c8b0"
|
||||
:system "#808080"
|
||||
:input-prompt "#e6b87d" :input-fg "#d8c8b0" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#cc9966"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#7ab85c" :dot-disconnected "#d94a3a"
|
||||
:error "#d94a3a"
|
||||
:tool-running "#e6b87d" :tool-done "#7ab85c" :tool-error "#d94a3a"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#e6b87d" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :gruvbox-warm
|
||||
:dark (:user-fg "#d8a657" :user-bg "#1e1e1e" :user-border "#d8a657"
|
||||
:agent-border "#c0a080" :agent-header "#c8a070" :agent-fg "#e0c8a8"
|
||||
:system "#808080"
|
||||
:input-prompt "#d8a657" :input-fg "#e0c8a8" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#c8a070"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1e1e1e"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#7ab85c" :dot-disconnected "#d94a3a"
|
||||
:error "#d94a3a"
|
||||
:tool-running "#d8a657" :tool-done "#7ab85c" :tool-error "#d94a3a"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3c3c3c" :accent "#d8a657" :dim "#606060")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :light-amber
|
||||
:dark (:user-fg "#d4a574" :user-bg "#f5f0eb" :user-border "#c4956a"
|
||||
:agent-border "#c0a090" :agent-header "#b88050" :agent-fg "#3a3a3a"
|
||||
:system "#606060"
|
||||
:input-prompt "#c4956a" :input-fg "#3a3a3a" :hint "#a0a0a0"
|
||||
:status-bg "#e8e0d8" :status-fg "#5a5a5a"
|
||||
:bg "#f5f0eb" :bg-panel "#e8e0d8" :bg-element "#f0ebe5"
|
||||
:bg-input "#ffffff" :text-muted "#909090"
|
||||
:dot-connected "#6cb85c" :dot-disconnected "#c84a3a"
|
||||
:error "#c84a3a"
|
||||
:tool-running "#c4956a" :tool-done "#6cb85c" :tool-error "#c84a3a"
|
||||
:thinking-bg "#e8e0d8" :symbolic-border "#a09080"
|
||||
:separator "#d0c8c0" :accent "#b88050" :dim "#a0a0a0")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :catppuccin
|
||||
:dark (:user-fg "#fab387" :user-bg "#1e1e2e" :user-border "#fab387"
|
||||
:agent-border "#a6adc8" :agent-header "#cba6f7" :agent-fg "#cdd6f4"
|
||||
:system "#808080"
|
||||
:input-prompt "#fab387" :input-fg "#cdd6f4" :hint "#6c7086"
|
||||
:status-bg "#181825" :status-fg "#bac2de"
|
||||
:bg "#11111b" :bg-panel "#181825" :bg-element "#1e1e2e"
|
||||
:bg-input "#2e2e2e" :text-muted "#6c7086"
|
||||
:dot-connected "#a6e3a1" :dot-disconnected "#f38ba8"
|
||||
:error "#f38ba8"
|
||||
:tool-running "#fab387" :tool-done "#a6e3a1" :tool-error "#f38ba8"
|
||||
:thinking-bg "#363a4f" :symbolic-border "#6c7086"
|
||||
:separator "#313244" :accent "#fab387" :dim "#585b70")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :tokyonight
|
||||
:dark (:user-fg "#ff9e64" :user-bg "#1a1b26" :user-border "#ff9e64"
|
||||
:agent-border "#7982a8" :agent-header "#7aa2f7" :agent-fg "#a9b1d6"
|
||||
:system "#808080"
|
||||
:input-prompt "#ff9e64" :input-fg "#a9b1d6" :hint "#565f89"
|
||||
:status-bg "#16161e" :status-fg "#9aa5ce"
|
||||
:bg "#0f0f18" :bg-panel "#16161e" :bg-element "#1a1b26"
|
||||
:bg-input "#2e2e2e" :text-muted "#565f89"
|
||||
:dot-connected "#9ece6a" :dot-disconnected "#db4b4b"
|
||||
:error "#db4b4b"
|
||||
:tool-running "#ff9e64" :tool-done "#9ece6a" :tool-error "#db4b4b"
|
||||
:thinking-bg "#363b54" :symbolic-border "#565f89"
|
||||
:separator "#292e42" :accent "#ff9e64" :dim "#444b6a")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :dracula
|
||||
:dark (:user-fg "#ff9580" :user-bg "#1e1f2b" :user-border "#ff9580"
|
||||
:agent-border "#c0c0e0" :agent-header "#bd93f9" :agent-fg "#f8f8f2"
|
||||
:system "#808080"
|
||||
:input-prompt "#ff9580" :input-fg "#f8f8f2" :hint "#6272a4"
|
||||
:status-bg "#191a24" :status-fg "#e0e0e0"
|
||||
:bg "#0f101a" :bg-panel "#191a24" :bg-element "#1e1f2b"
|
||||
:bg-input "#2e2e2e" :text-muted "#6272a4"
|
||||
:dot-connected "#50fa7b" :dot-disconnected "#ff5555"
|
||||
:error "#ff5555"
|
||||
:tool-running "#ff9580" :tool-done "#50fa7b" :tool-error "#ff5555"
|
||||
:thinking-bg "#3a3b50" :symbolic-border "#6272a4"
|
||||
:separator "#34354a" :accent "#ff9580" :dim "#5a5b7a")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :gemini
|
||||
:dark (:user-fg "#87afff" :user-bg "#1a1a1a" :user-border "#87afff"
|
||||
:agent-border "#d0d0d0" :agent-header "#d7afff" :agent-fg "#ffffff"
|
||||
:system "#808080"
|
||||
:input-prompt "#87afff" :input-fg "#ffffff" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#afafaf"
|
||||
:bg "#000000" :bg-panel "#141414" :bg-element "#1a1a1a"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#d7ffd7" :dot-disconnected "#ff87af"
|
||||
:error "#ff87af"
|
||||
:tool-running "#87afff" :tool-done "#d7ffd7" :tool-error "#ff87af"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
|
||||
:separator "#3a3a3a" :accent "#87afff" :dim "#5f5f5f")
|
||||
:light nil)
|
||||
(cl-tty.theme:define-preset :mono
|
||||
:dark (:user-fg "#e0e0e0" :user-bg "#1a1a1a" :user-border "#808080"
|
||||
:agent-border "#a0a0a0" :agent-header "#c0c0c0" :agent-fg "#d0d0d0"
|
||||
:system "#808080"
|
||||
:input-prompt "#ffffff" :input-fg "#d0d0d0" :hint "#606060"
|
||||
:status-bg "#141414" :status-fg "#b0b0b0"
|
||||
:bg "#0a0a0a" :bg-panel "#141414" :bg-element "#1a1a1a"
|
||||
:bg-input "#2e2e2e" :text-muted "#808080"
|
||||
:dot-connected "#a0a0a0" :dot-disconnected "#808080"
|
||||
:error "#808080"
|
||||
:tool-running "#e0e0e0" :tool-done "#a0a0a0" :tool-error "#808080"
|
||||
:thinking-bg "#3a3a3a" :symbolic-border "#808080"
|
||||
:separator "#303030" :accent "#ffffff" :dim "#505050")
|
||||
:light nil)
|
||||
|
||||
;; Load default theme at startup
|
||||
(cl-tty.theme:load-preset *theme* :amber)
|
||||
|
||||
(defun theme-save ()
|
||||
"Persist current theme to disk."
|
||||
(let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list path))
|
||||
(with-open-file (out path :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(format out ";; Passepartout TUI theme — auto-generated~%")
|
||||
(format out "(setf passepartout.channel-tui::*tui-theme* '~s)~%" *tui-theme*)
|
||||
(format out "(setf passepartout.channel-tui::*tui-theme-current-name* ~s)~%" *tui-theme-current-name*))
|
||||
t))
|
||||
(ensure-directories-exist path)
|
||||
(cl-tty.theme:save-theme *theme* path)))
|
||||
|
||||
(defun theme-load ()
|
||||
"Load persisted theme from disk. Called at startup.
|
||||
Adds any missing keys with defaults to handle saved themes from older versions."
|
||||
"Load persisted theme from disk. Called at startup."
|
||||
(let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (uiop:file-exists-p path)
|
||||
(ignore-errors (load path)))
|
||||
;; Fill in any missing keys from the default preset
|
||||
(let ((defaults (getf *tui-theme-presets* *tui-theme-current-name*)))
|
||||
(when defaults
|
||||
(dolist (key '(:bg-input :bg-element :text-muted :agent-border :thinking-bg :symbolic-border))
|
||||
(unless (getf *tui-theme* key)
|
||||
(let ((val (getf defaults key)))
|
||||
(when val (setf (getf *tui-theme* key) val)))))))))
|
||||
(unless (cl-tty.theme:load-theme *theme* path)
|
||||
(cl-tty.theme:load-preset *theme* :amber))))
|
||||
|
||||
(defun theme-switch (name)
|
||||
"Switch to a named theme preset. Returns the preset name or nil if not found."
|
||||
(let* ((key (intern (string-upcase (string name)) :keyword))
|
||||
(preset (getf *tui-theme-presets* key)))
|
||||
(when preset
|
||||
(setf *tui-theme* (copy-list preset)
|
||||
*tui-theme-current-name* key)
|
||||
(theme-save)
|
||||
(setf (st :dirty) (list t t t))
|
||||
key)))
|
||||
(let ((key (intern (string-upcase (string name)) :keyword)))
|
||||
(cl-tty.theme:load-preset *theme* key)
|
||||
(theme-save)
|
||||
(setf (st :dirty) (list t t t))
|
||||
key))
|
||||
|
||||
(defun theme-color (role)
|
||||
"Returns a hex color string for a semantic role, suitable for cl-tty."
|
||||
(let ((val (or (getf *tui-theme* role) :white)))
|
||||
(cond
|
||||
((stringp val) val)
|
||||
(t (case val
|
||||
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
|
||||
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
|
||||
(:white "#FFFFFF") (:black "#000000")
|
||||
(:bright-black "#666666") (:bright-yellow "#FFD700")
|
||||
(t "#FFFFFF"))))))
|
||||
"Returns a hex color string for a semantic role via cl-tty.theme."
|
||||
(or (cl-tty.theme:theme-color *theme* role)
|
||||
"#FFFFFF"))
|
||||
|
||||
(defun st (key) (getf *state* key))
|
||||
(defun (setf st) (val key) (setf (getf *state* key) val))
|
||||
@@ -310,11 +263,14 @@ Adds any missing keys with defaults to handle saved themes from older versions."
|
||||
(defun init-state ()
|
||||
(setf *state*
|
||||
(list :running t :mode :chat :connected nil :stream nil
|
||||
:input-buffer nil :input-history nil :input-hpos 0
|
||||
:text-input (cl-tty.input:make-text-input)
|
||||
:input-history nil :input-hpos 0
|
||||
:text-input (cl-tty.input:make-text-input
|
||||
:on-submit #'handle-submit
|
||||
:on-cancel #'handle-cancel
|
||||
:on-tab #'handle-tab
|
||||
:on-history #'handle-history)
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:cursor-line 0 :cursor-col 0
|
||||
:scroll-offset 0 :busy nil
|
||||
:pending-ctrl-x nil
|
||||
:scroll-at-bottom t :scroll-notify nil
|
||||
:streaming-text nil :url-buffer nil ; v0.7.1
|
||||
@@ -342,15 +298,6 @@ Adds any missing keys with defaults to handle saved themes from older versions."
|
||||
(declare (ignore s))
|
||||
(format nil "~2,'0d:~2,'0d" h m)))
|
||||
|
||||
(defun input-string ()
|
||||
(cl-tty.input:text-input-value (st :text-input)))
|
||||
|
||||
(defun input-insert-char (ch)
|
||||
(cl-tty.input:text-input-insert (st :text-input) ch))
|
||||
|
||||
(defun input-delete-char ()
|
||||
(cl-tty.input:text-input-backspace (st :text-input)))
|
||||
|
||||
(defun add-msg (role content &key gate-trace panel)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages))
|
||||
;; v0.7.0: notify when scrolled up and new msg arrives
|
||||
@@ -362,51 +309,48 @@ Adds any missing keys with defaults to handle saved themes from older versions."
|
||||
** Slash Commands
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
|
||||
(defvar *slash-commands*
|
||||
'((:title "/eval <expr> — Evaluate Lisp" :value "/eval" :category :session)
|
||||
(:title "/undo — Undo last operation" :value "/undo" :category :session)
|
||||
(:title "/redo — Redo last operation" :value "/redo" :category :session)
|
||||
(:title "/reconnect — Re-establish daemon" :value "/reconnect" :category :session)
|
||||
(:title "/quit — Save history and exit" :value "/quit" :category :session)
|
||||
(:title "/q — Quick quit" :value "/q" :category :session)
|
||||
(:title "/why — Show last gate trace" :value "/why" :category :memory)
|
||||
(:title "/identity — Edit IDENTITY.org" :value "/identity" :category :memory)
|
||||
(:title "/tags — List tag severities" :value "/tags" :category :memory)
|
||||
(:title "/audit <id> — Inspect memory" :value "/audit" :category :memory)
|
||||
(:title "/audit verify — Memory integrity" :value "/audit verify" :category :memory)
|
||||
(:title "/rewind <n> — Rewind to snapshot" :value "/rewind" :category :memory)
|
||||
(:title "/sessions — Show memory snapshots" :value "/sessions" :category :memory)
|
||||
(:title "/resume <n> — Resume from snapshot" :value "/resume" :category :memory)
|
||||
(:title "/focus <project> — Set context" :value "/focus" :category :system)
|
||||
(:title "/scope <scope> — Change scope" :value "/scope" :category :system)
|
||||
(:title "/unfocus — Pop context" :value "/unfocus" :category :system)
|
||||
(:title "/theme [name] — Show/switch theme" :value "/theme" :category :system)
|
||||
(:title "/context — Show context summary" :value "/context" :category :system)
|
||||
(:title "/context why <id> — Debug memory" :value "/context why" :category :system)
|
||||
(:title "/context dropped — Estimate pruned" :value "/context dropped" :category :system)
|
||||
(:title "/search <query> — Search messages" :value "/search" :category :navigation)
|
||||
(:title "/help — Show commands" :value "/help" :category :help)
|
||||
(:title "/help <topic> — Search manual" :value "/help <topic>" :category :help))
|
||||
'((:title "/eval <expr> — Evaluate Lisp" :value "/eval")
|
||||
(:title "/undo — Undo last operation" :value "/undo")
|
||||
(:title "/redo — Redo last operation" :value "/redo")
|
||||
(:title "/reconnect — Re-establish daemon" :value "/reconnect")
|
||||
(:title "/quit — Save history and exit" :value "/quit")
|
||||
(:title "/q — Quick quit" :value "/q")
|
||||
(:title "/why — Show last gate trace" :value "/why")
|
||||
(:title "/tags — List tag severities" :value "/tags")
|
||||
(:title "/audit <id> — Inspect memory" :value "/audit")
|
||||
(:title "/audit verify — Memory integrity" :value "/audit verify")
|
||||
(:title "/rewind <n> — Rewind to snapshot" :value "/rewind")
|
||||
(:title "/sessions — Show memory snapshots" :value "/sessions")
|
||||
(:title "/resume <n> — Resume from snapshot" :value "/resume")
|
||||
(:title "/theme [name] — Show/switch theme" :value "/theme")
|
||||
(:title "/context — Show context summary" :value "/context")
|
||||
(:title "/search <query> — Search messages" :value "/search")
|
||||
(:title "/help — Show commands" :value "/help")
|
||||
(:title "/help <topic> — Search manual" :value "/help "))
|
||||
"Slash commands for minibuffer select-dialog.")
|
||||
#+END_SRC
|
||||
|
||||
** Daemon Commands
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-state.lisp
|
||||
(defvar *daemon-commands*
|
||||
'((:title "Status — Daemon health info" :value (:action :status) :category :session)
|
||||
(:title "Stats — Daemon statistics" :value (:action :stats) :category :session)
|
||||
(:title "Ping — Daemon reachability" :value (:action :ping) :category :session)
|
||||
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot) :category :memory)
|
||||
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild) :category :memory)
|
||||
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact) :category :memory)
|
||||
(:title "Reload Config — Reload configuration" :value (:action :reload-config) :category :system)
|
||||
(:title "Reload Identity — Reload identity file" :value (:action :reload-identity) :category :system)
|
||||
(:title "List Skills — Available skills" :value (:action :list-skills) :category :system)
|
||||
(:title "Help — Show daemon help" :value (:action :help) :category :help))
|
||||
'((:title "Status — Daemon health info" :value (:action :status))
|
||||
(:title "Stats — Daemon statistics" :value (:action :stats))
|
||||
(:title "Ping — Daemon reachability" :value (:action :ping))
|
||||
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot))
|
||||
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild))
|
||||
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact))
|
||||
(:title "Reload Config — Reload configuration" :value (:action :reload-config))
|
||||
(:title "Reload Identity — Reload identity file" :value (:action :reload-identity))
|
||||
(:title "List Skills — Available skills" :value (:action :list-skills))
|
||||
(:title "Help — Show daemon help" :value (:action :help)))
|
||||
"Daemon commands for the command palette (Ctrl+P).")
|
||||
|
||||
(defun all-commands ()
|
||||
"Merge slash commands and daemon commands into one unified list."
|
||||
(append *slash-commands* *daemon-commands*))
|
||||
"Merge slash commands, daemon commands, and menu entries into one unified list."
|
||||
(append *menu-entries* *slash-commands* *daemon-commands*))
|
||||
|
||||
(defvar *menu-entries*
|
||||
'((:title "/config — LLM providers, cascade, network, folders, identity"
|
||||
:value :config-menu
|
||||
:action passepartout.channel-tui::show-config-main-menu))
|
||||
"Special menu entries with actions (open submenus).")
|
||||
#+END_SRC
|
||||
|
||||
** Event Queue
|
||||
|
||||
@@ -13,15 +13,22 @@
|
||||
get amber left border (│), agent messages no border, streaming
|
||||
agent gets grey left border. Gate traces/tool calls use ╎ prefix.
|
||||
3. (view-input fb w h): renders expanding light grey input box,
|
||||
multi-line word-wrapped prompt, Emacs-style reverse-video cursor,
|
||||
right-aligned lowercase hint at h-2.
|
||||
4. (redraw fb w h): wraps view-status/chat/input in begin-sync/end-sync,
|
||||
multi-line word-wrapped prompt, hint bar at h-2. Text and cursor
|
||||
rendered by cl-tty.input text-input's render method.
|
||||
4. (view-sidebar fb w h): renders sidebar panels using ~sidebar-lines~.
|
||||
5. (sidebar-lines): builds a flat list of (text . color-key) pairs for
|
||||
the sidebar: gate trace, rules, cost, files, version.
|
||||
6. (msg->pairs msg index bordered-w unbordered-w is-search): converts
|
||||
a message to renderable ~(border border-color text text-color &optional bg)~
|
||||
lines. Handles markdown, gate trace, tool calls, search highlight.
|
||||
7. (render-pair fb hpad y pair): draws one message line pair.
|
||||
8. (redraw fb w h): wraps view-status/chat/input in begin-sync/end-sync,
|
||||
dispatches per dirty flags, fills global :bg first.
|
||||
5. ~cl-tty.box:char-width~ for terminal column width.
|
||||
9. ~cl-tty.box:char-width~ for terminal column width.
|
||||
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0.
|
||||
Tab = 8. Used by word-wrap for accurate line counting (v0.7.0).
|
||||
6. (sidebar-visible-p w): returns T if sidebar should show given width W
|
||||
and current :sidebar-mode (:auto >120, :visible always, :hidden never).
|
||||
Tab = 8. Used by cl-tty.box:word-wrap for accurate line counting.
|
||||
10. (sidebar-visible-p w): returns T if sidebar should show given width W
|
||||
and current :sidebar-mode (:auto >120, :visible always, :hidden never).
|
||||
|
||||
** Status Bar
|
||||
|
||||
@@ -51,19 +58,6 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
(or (eq mode :visible)
|
||||
(and (eq mode :auto) (> w 120)))))
|
||||
|
||||
(defun word-wrap (text width)
|
||||
"Wrap TEXT to at most WIDTH columns. Splits on word boundaries.
|
||||
Returns a list of strings, one per line."
|
||||
(let ((lines nil))
|
||||
(loop while (> (length text) width)
|
||||
do (let ((break (or (position #\Space text :end width :from-end t)
|
||||
width)))
|
||||
(push (subseq text 0 break) lines)
|
||||
(setf text (string-left-trim '(#\Space)
|
||||
(subseq text break)))))
|
||||
(push text lines)
|
||||
(nreverse lines)))
|
||||
|
||||
(defun view-status (fb w h)
|
||||
(declare (ignore fb w h))
|
||||
;; Status bar is now a clean black line — blends with global :bg.
|
||||
@@ -71,33 +65,106 @@ Returns a list of strings, one per line."
|
||||
)
|
||||
|
||||
(defun input-panel-top (chat-w h)
|
||||
"Compute the top row of the input panel based on current input buffer."
|
||||
"Compute the top row of the input panel based on current input text."
|
||||
(let* ((hpad 2)
|
||||
(inner-w (- chat-w (* 2 hpad)))
|
||||
(prompt-w (- inner-w 2))
|
||||
(text (input-string))
|
||||
(lines (word-wrap text prompt-w))
|
||||
(text (cl-tty.input:text-input-value (st :text-input)))
|
||||
(lines (cl-tty.box:word-wrap text prompt-w))
|
||||
(n-lines (max 1 (length lines)))
|
||||
(panel-rows (max 4 (+ n-lines 2))))
|
||||
(- h 4 panel-rows -1)))
|
||||
|
||||
#+end_src
|
||||
|
||||
;; Build simple tab-like blocks
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defun msg->pairs (msg index bordered-w unbordered-w is-search)
|
||||
"Convert a message to a list of (border-str border-color text-str text-color &optional bg) lines."
|
||||
(let* ((role (getf msg :role))
|
||||
(content (getf msg :content))
|
||||
(cs (if is-search (cl-tty.markdown:search-highlight content (st :search-query)) content))
|
||||
(pairs nil)
|
||||
(think-bg (theme-color :thinking-bg))
|
||||
(sym-bdr (theme-color :symbolic-border))
|
||||
(agent-bdr (theme-color :agent-border))
|
||||
(user-bdr (theme-color :user-border))
|
||||
(user-fg (theme-color :user-fg))
|
||||
(agent-fg (theme-color :agent-fg))
|
||||
(system-fg (theme-color :system)))
|
||||
(case role
|
||||
(:user
|
||||
(dolist (l (cl-tty.box:word-wrap cs bordered-w))
|
||||
(push (list "│" user-bdr l user-fg) pairs)))
|
||||
(:agent
|
||||
(let* ((streaming (getf msg :streaming))
|
||||
(think-rect (if streaming think-bg nil))
|
||||
(bdr (if streaming nil agent-bdr))
|
||||
(bstr (if streaming nil "│"))
|
||||
(wrap-w (if streaming unbordered-w bordered-w))
|
||||
(nodes (cl-tty.markdown:parse-blocks cs))
|
||||
(raw-body (or (and nodes (cl-tty.markdown:render-md nodes)) (list "")))
|
||||
(body (mapcan (lambda (l) (cl-tty.box:word-wrap l wrap-w)) raw-body)))
|
||||
(dolist (l body)
|
||||
(push (list bstr bdr l agent-fg think-rect) pairs))))
|
||||
(t (dolist (l (cl-tty.box:word-wrap cs unbordered-w))
|
||||
(push (list nil nil l system-fg) pairs))))
|
||||
;; Gate trace
|
||||
(let ((gt (getf msg :gate-trace)))
|
||||
(when (and gt (eq role :agent))
|
||||
(if (member index (st :collapsed-gates))
|
||||
(push (list "│" sym-bdr (format nil "Gate trace: ~a gates" (length gt)) sym-bdr) pairs)
|
||||
(dolist (entry (passepartout::gate-trace-lines gt))
|
||||
(let ((ec (theme-color (getf (cdr entry) :fgcolor))))
|
||||
(dolist (l (cl-tty.box:word-wrap (car entry) bordered-w))
|
||||
(push (list "│" sym-bdr l ec) pairs)))))))
|
||||
;; Tool calls
|
||||
(let ((tc (getf msg :tool-calls)))
|
||||
(when tc
|
||||
(if (member index (st :collapsed-tools))
|
||||
(let* ((n (or (getf (first tc) :name) "tool"))
|
||||
(d (or (getf (first tc) :duration) 0.0)))
|
||||
(push (list "│" (theme-color :tool-done) (format nil "~a … ~,1fs" n d) (theme-color :tool-done)) pairs))
|
||||
(dolist (call tc)
|
||||
(let* ((name (or (getf call :name) "tool"))
|
||||
(dur (or (getf call :duration) 0.0))
|
||||
(st (getf call :status))
|
||||
(out (getf call :output))
|
||||
(bc (theme-color
|
||||
(cond ((eq st :running) :tool-running)
|
||||
((eq st :error) :tool-error)
|
||||
(t :tool-done))))
|
||||
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
|
||||
(ol (when out (cl-tty.box:word-wrap out bordered-w))))
|
||||
(push (list "│" bc (format nil "~a ~a ~,1fs" pfx name dur) bc) pairs)
|
||||
(dolist (l ol)
|
||||
(push (list "│" bc l bc) pairs)))))))
|
||||
(nreverse pairs)))
|
||||
|
||||
(defun render-pair (fb hpad y pair)
|
||||
"Draw a single (border-str border-color text-str text-color &optional bg) line."
|
||||
(destructuring-bind (bstr bcolor tstr tcolor &optional rect-bg) pair
|
||||
(when rect-bg
|
||||
(cl-tty.backend:draw-rect fb 0 y 1 1 :bg rect-bg))
|
||||
(let ((has-border (and bstr (> (length bstr) 0))))
|
||||
(when has-border
|
||||
(cl-tty.backend:draw-text fb hpad y bstr bcolor (theme-color :bg)))
|
||||
(cl-tty.backend:draw-text fb (+ hpad (if has-border 2 0)) y tstr tcolor (theme-color :bg)))))
|
||||
|
||||
(defun view-chat (fb w h)
|
||||
(let* ((w (or (and (numberp w) (> w 0) w) 80))
|
||||
(h (or (and (numberp h) (> h 0) h) 24))
|
||||
(hpad 2)
|
||||
(sidebar-w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
|
||||
(chat-w (- w sidebar-w))
|
||||
(msgs (st :messages)) (total (length msgs))
|
||||
(panel-top (input-panel-top chat-w h))
|
||||
(max-lines (max 0 panel-top)) (is-search (st :search-mode))
|
||||
(bordered-w (- chat-w (* 2 hpad) 2))
|
||||
(unbordered-w (- chat-w (* 2 hpad)))
|
||||
(y 0))
|
||||
(hpad 2)
|
||||
(sidebar-w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
|
||||
(chat-w (- w sidebar-w))
|
||||
(msgs (st :messages)) (total (length msgs))
|
||||
(panel-top (input-panel-top chat-w h))
|
||||
(max-lines (max 0 panel-top)) (is-search (st :search-mode))
|
||||
(bordered-w (- chat-w (* 2 hpad) 2))
|
||||
(unbordered-w (- chat-w (* 2 hpad)))
|
||||
(y 0))
|
||||
;; Search header
|
||||
(when is-search
|
||||
(let* ((matches (st :search-matches)) (idx (st :search-match-idx))
|
||||
(query (st :search-query))
|
||||
@@ -105,93 +172,27 @@ Returns a list of strings, one per line."
|
||||
(length matches) query (1+ idx) (length matches))))
|
||||
(cl-tty.backend:draw-text fb hpad y hdr (theme-color :accent) nil)
|
||||
(incf y) (decf max-lines)))
|
||||
(let ((msg-lines (make-array total)) (msg-heights (make-array total)))
|
||||
(dotimes (i total)
|
||||
(let* ((msg (aref msgs i)) (role (getf msg :role))
|
||||
(content (getf msg :content))
|
||||
(cs (if is-search (cl-tty.markdown:search-highlight content (st :search-query)) content))
|
||||
(pairs nil)
|
||||
(think-bg (theme-color :thinking-bg))
|
||||
(sym-bdr (theme-color :symbolic-border))
|
||||
(agent-bdr (theme-color :agent-border))
|
||||
(user-bdr (theme-color :user-border))
|
||||
(user-fg (theme-color :user-fg))
|
||||
(agent-fg (theme-color :agent-fg))
|
||||
(system-fg (theme-color :system)))
|
||||
(case role
|
||||
(:user
|
||||
(dolist (l (cl-tty.box:word-wrap cs bordered-w))
|
||||
(push (list "│" user-bdr l user-fg) pairs)))
|
||||
( :agent
|
||||
(let* ((streaming (getf msg :streaming))
|
||||
(think-rect (if streaming think-bg nil))
|
||||
(bdr (if streaming nil agent-bdr))
|
||||
(bstr (if streaming nil "│"))
|
||||
(wrap-w (if streaming unbordered-w bordered-w))
|
||||
(nodes (cl-tty.markdown:parse-blocks cs))
|
||||
(raw-body (or (and nodes (cl-tty.markdown:render-md nodes)) (list "")))
|
||||
(body (mapcan (lambda (l) (cl-tty.box:word-wrap l wrap-w)) raw-body)))
|
||||
(dolist (l body)
|
||||
(push (list bstr bdr l agent-fg think-rect) pairs))))
|
||||
(t (dolist (l (cl-tty.box:word-wrap cs unbordered-w))
|
||||
(push (list nil nil l system-fg) pairs))))
|
||||
;; Gate trace
|
||||
(let ((gt (getf msg :gate-trace)))
|
||||
(when (and gt (eq role :agent))
|
||||
(if (member i (st :collapsed-gates))
|
||||
(push (list "│" sym-bdr (format nil "Gate trace: ~a gates" (length gt)) sym-bdr) pairs)
|
||||
(dolist (entry (passepartout::gate-trace-lines gt))
|
||||
(let ((ec (theme-color (getf (cdr entry) :fgcolor))))
|
||||
(dolist (l (cl-tty.box:word-wrap (car entry) bordered-w))
|
||||
(push (list "│" sym-bdr l ec) pairs)))))))
|
||||
;; Tool calls
|
||||
(let ((tc (getf msg :tool-calls)))
|
||||
(when tc
|
||||
(if (member i (st :collapsed-tools))
|
||||
(let* ((n (or (getf (first tc) :name) "tool"))
|
||||
(d (or (getf (first tc) :duration) 0.0)))
|
||||
(push (list "│" (theme-color :tool-done) (format nil "~a … ~,1fs" n d) (theme-color :tool-done)) pairs))
|
||||
(dolist (call tc)
|
||||
(let* ((name (or (getf call :name) "tool"))
|
||||
(dur (or (getf call :duration) 0.0))
|
||||
(st (getf call :status))
|
||||
(out (getf call :output))
|
||||
(bc (theme-color
|
||||
(cond ((eq st :running) :tool-running)
|
||||
((eq st :error) :tool-error)
|
||||
(t :tool-done))))
|
||||
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
|
||||
(ol (when out (cl-tty.box:word-wrap out bordered-w))))
|
||||
(push (list "│" bc (format nil "~a ~a ~,1fs" pfx name dur) bc) pairs)
|
||||
(dolist (l ol)
|
||||
(push (list "│" bc l bc) pairs)))))))
|
||||
(setf (aref msg-lines i) (nreverse pairs))
|
||||
(setf (aref msg-heights i) (length pairs))))
|
||||
(let ((msg-count 0) (lines-remaining max-lines))
|
||||
(loop for i from (1- total) downto 0
|
||||
while (> lines-remaining 0)
|
||||
do (let ((mh (aref msg-heights i))
|
||||
(spacer (if (< i (1- total)) 1 0)))
|
||||
(if (<= (+ mh spacer) lines-remaining)
|
||||
(progn (decf lines-remaining (+ mh spacer)) (incf msg-count))
|
||||
(setf lines-remaining 0))))
|
||||
(let* ((scroll-skip (st :scroll-offset))
|
||||
(start (max 0 (- total msg-count scroll-skip))))
|
||||
(loop for i from start below total while (< y panel-top)
|
||||
do (let ((pairs (aref msg-lines i)))
|
||||
(dolist (pair pairs)
|
||||
(when (>= y panel-top) (return))
|
||||
(destructuring-bind (bstr bcolor tstr tcolor &optional rect-bg) pair
|
||||
(when rect-bg
|
||||
(cl-tty.backend:draw-rect fb 0 y 1 1 :bg rect-bg))
|
||||
(let ((has-border (and bstr (> (length bstr) 0))))
|
||||
(when has-border
|
||||
(cl-tty.backend:draw-text fb hpad y bstr bcolor nil))
|
||||
(cl-tty.backend:draw-text fb (+ hpad (if has-border 2 0)) y tstr tcolor nil)))
|
||||
(incf y))
|
||||
;; spacer between message blocks
|
||||
(when (< i (1- total))
|
||||
(incf y)))))))))
|
||||
;; Build all message lines once
|
||||
(let* ((msg-lines (map 'vector
|
||||
(lambda (msg i) (msg->pairs msg i bordered-w unbordered-w is-search))
|
||||
msgs
|
||||
(make-array total :initial-contents (loop for i below total collect i))))
|
||||
(heights (map 'vector #'length msg-lines))
|
||||
(scroll-skip (st :scroll-offset))
|
||||
(i 0))
|
||||
;; Forward scan: skip messages scrolled past, then render visible ones
|
||||
(loop while (< i total)
|
||||
do (let ((hgt (aref heights i)))
|
||||
(if (> scroll-skip 0)
|
||||
(decf scroll-skip hgt)
|
||||
(let ((msg-y y))
|
||||
(dolist (pair (aref msg-lines i))
|
||||
(when (>= msg-y panel-top) (return))
|
||||
(render-pair fb hpad msg-y pair)
|
||||
(incf msg-y))
|
||||
(setf y (1+ msg-y)) ;; +1 spacer between messages
|
||||
(when (>= y panel-top) (return)))))
|
||||
(incf i)))))
|
||||
#+END_SRC
|
||||
|
||||
** Input Line
|
||||
@@ -204,33 +205,25 @@ Returns a list of strings, one per line."
|
||||
(chat-w (- w sidebar-w))
|
||||
(inner-w (- chat-w (* 2 hpad)))
|
||||
(prompt-w (- inner-w 2))
|
||||
(text (input-string))
|
||||
(pos (or (st :cursor-pos) 0))
|
||||
(lines (word-wrap text prompt-w))
|
||||
(n-lines (max 1 (length lines)))
|
||||
(input (st :text-input))
|
||||
(n-lines (max 1 (length (cl-tty.box:word-wrap (cl-tty.input:text-input-value input) prompt-w))))
|
||||
(panel-rows (max 4 (+ n-lines 2)))
|
||||
(panel-top (input-panel-top chat-w h))
|
||||
(bg-i (theme-color :bg-input))
|
||||
(input-fg (theme-color :input-fg))
|
||||
(hint-fg (theme-color :hint)))
|
||||
;; Fill input panel: panel-top to h-4, indented by hpad
|
||||
;; Fill input panel
|
||||
(cl-tty.backend:draw-rect fb hpad panel-top inner-w panel-rows :bg bg-i)
|
||||
;; Speaker lines for all input rows
|
||||
(dotimes (r panel-rows)
|
||||
(cl-tty.backend:draw-text fb hpad (+ panel-top r) "│" (theme-color :input-prompt) nil))
|
||||
;; Draw each wrapped input line
|
||||
(let ((accum 0) (cursor-line 0) (cursor-col 0))
|
||||
(dotimes (i n-lines)
|
||||
(let* ((line (nth i lines))
|
||||
(row (+ panel-top 1 i))
|
||||
(len (length line)))
|
||||
(when (>= row (- h 4)) (return))
|
||||
(cl-tty.backend:draw-text fb (+ hpad 2) row line input-fg nil)
|
||||
(when (and (>= pos accum) (<= pos (+ accum len)))
|
||||
(setf cursor-line i
|
||||
cursor-col (- pos accum)))
|
||||
(incf accum (1+ len))))
|
||||
;; Hint bar at h-2: F:/MCP: on left, token gauge + keybindings on right
|
||||
;; Render text-input widget (word-wrap + cursor)
|
||||
(let ((ln (cl-tty.layout:make-layout-node)))
|
||||
(setf (cl-tty.layout:layout-node-x ln) (+ hpad 2)
|
||||
(cl-tty.layout:layout-node-y ln) (1+ panel-top)
|
||||
(cl-tty.layout:layout-node-width ln) prompt-w)
|
||||
(setf (cl-tty.input:text-input-layout-node input) ln)
|
||||
(cl-tty.box:render input fb))
|
||||
;; Hint bar at h-2
|
||||
(let* ((focal (or (st :foveal-id) "-"))
|
||||
(focal-str (format nil "F:~a" focal))
|
||||
(mcp-str (format nil "MCP:~d" (or (st :mcp-count) 0)))
|
||||
@@ -251,78 +244,84 @@ Returns a list of strings, one per line."
|
||||
(ctx-x (- hint-x 1 (length ctx-str))))
|
||||
(cl-tty.backend:draw-text fb hpad (- h 2) left-str hint-fg (theme-color :bg))
|
||||
(cl-tty.backend:draw-text fb ctx-x (- h 2) ctx-str ctx-fg (theme-color :bg))
|
||||
(cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg))))))
|
||||
(cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg)))))
|
||||
#+end_src
|
||||
|
||||
** Sidebar
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
||||
(defun sidebar-lines ()
|
||||
"Collect all sidebar lines as (text . color-key) pairs."
|
||||
(let* ((msgs (st :messages))
|
||||
(last-gt (loop for i from (1- (length msgs)) downto 0
|
||||
for m = (aref msgs i)
|
||||
when (getf m :gate-trace)
|
||||
return (getf m :gate-trace)))
|
||||
(blocked (loop for i below (length msgs)
|
||||
for m = (aref msgs i)
|
||||
sum (loop for g in (getf m :gate-trace)
|
||||
count (eq (getf g :result) :blocked))))
|
||||
(ver (or (st :daemon-version) ""))
|
||||
(ver-label (if (> (length ver) 0) (format nil "passepartout ~a" ver) "passepartout"))
|
||||
(dot (if (st :connected) "●" "○"))
|
||||
(dot-color (if (st :connected) :dot-connected :dot-disconnected)))
|
||||
(append
|
||||
;; Gate Trace
|
||||
(list (cons "GATE TRACE" :accent))
|
||||
(if last-gt
|
||||
(mapcan (lambda (g)
|
||||
(let* ((name (getf g :gate))
|
||||
(result (getf g :result))
|
||||
(reason (getf g :reason))
|
||||
(glyph (case result (:passed "✓") (:blocked "✗") (:approval "→") (t "?")))
|
||||
(color (case result
|
||||
(:passed :tool-done)
|
||||
(:blocked :error)
|
||||
(:approval :input-prompt)
|
||||
(t :dim))))
|
||||
(if reason
|
||||
(list (cons (format nil " ~a ~a" glyph name) color)
|
||||
(cons (format nil " ~a" reason) :dim))
|
||||
(list (cons (format nil " ~a ~a" glyph name) color)))))
|
||||
last-gt)
|
||||
(list (cons " (none)" :dim)))
|
||||
;; Rules
|
||||
(list (cons "" nil))
|
||||
(list (cons "RULES" :accent))
|
||||
(list (cons (format nil " ~d active" (or (st :rule-count) 0)) :agent-fg))
|
||||
(list (cons (format nil " ~d blocked" blocked)
|
||||
(if (> blocked 0) :error :dim)))
|
||||
;; Cost
|
||||
(list (cons "" nil))
|
||||
(list (cons "COST" :accent))
|
||||
(list (cons (format nil " $~,2f" (or (st :session-cost) 0.0)) :status-fg))
|
||||
;; Files
|
||||
(list (cons "" nil))
|
||||
(list (cons "FILES" :accent))
|
||||
(list (cons " (not yet)" :dim))
|
||||
;; spacer
|
||||
(list (cons "" nil))
|
||||
;; Version footer — rendered at h-2, not in the loop
|
||||
(list (cons (format nil "~a ~a" dot ver-label) dot-color)))))
|
||||
|
||||
(defun view-sidebar (fb w h)
|
||||
(let* ((w (or (and (numberp w) (> w 0) w) 80))
|
||||
(h (or (and (numberp h) (> h 0) h) 24))
|
||||
(x (- w (or (st :sidebar-width) 42)))
|
||||
(bg-panel (theme-color :bg-panel))
|
||||
(y 0))
|
||||
(cl-tty.backend:draw-rect fb x 0 (- w x) (1- h) :bg bg-panel)
|
||||
(cl-tty.backend:draw-text fb x (1- h) (make-string (- w x) :initial-element #\Space) nil bg-panel)
|
||||
;; Gate Trace — from latest agent message
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "GATE TRACE" (theme-color :accent) bg-panel)
|
||||
(incf y)
|
||||
(let* ((msgs (st :messages))
|
||||
(last-gt (loop for i from (1- (length msgs)) downto 0
|
||||
for m = (aref msgs i)
|
||||
when (getf m :gate-trace)
|
||||
return (getf m :gate-trace))))
|
||||
(if last-gt
|
||||
(dolist (g last-gt)
|
||||
(let* ((name (getf g :gate))
|
||||
(result (getf g :result))
|
||||
(reason (getf g :reason))
|
||||
(glyph (case result (:passed "✓") (:blocked "✗") (:approval "→") (t "?")))
|
||||
(color (case result
|
||||
(:passed (theme-color :tool-done))
|
||||
(:blocked (theme-color :error))
|
||||
(:approval (theme-color :input-prompt))
|
||||
(t (theme-color :dim)))))
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) (format nil " ~a ~a" glyph name) color bg-panel)
|
||||
(when reason
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (+ x 4) (incf y) reason (theme-color :dim) bg-panel))))
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) " (none)" (theme-color :dim) bg-panel))
|
||||
(incf y 2))
|
||||
;; Rules + Block Count
|
||||
(let ((blocked (loop for i below (length (st :messages))
|
||||
for m = (aref (st :messages) i)
|
||||
sum (loop for g in (getf m :gate-trace)
|
||||
count (eq (getf g :result) :blocked)))))
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "RULES" (theme-color :accent) bg-panel)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y)
|
||||
(format nil " ~d active" (or (st :rule-count) 0))
|
||||
(theme-color :agent-fg) bg-panel)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y)
|
||||
(format nil " ~d blocked" blocked)
|
||||
(if (> blocked 0) (theme-color :error) (theme-color :dim)) bg-panel)
|
||||
(incf y 2))
|
||||
;; Cost
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "COST" (theme-color :accent) bg-panel)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y)
|
||||
(format nil " $~,2f" (or (st :session-cost) 0.0))
|
||||
(theme-color :status-fg) bg-panel)
|
||||
(incf y 2)
|
||||
;; Files (stub)
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "FILES" (theme-color :accent) bg-panel)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (incf y) " (not yet)" (theme-color :dim) bg-panel)
|
||||
(incf y 2)
|
||||
;; Version footer
|
||||
(let* ((ver (or (st :daemon-version) ""))
|
||||
(ver-label (if (> (length ver) 0) (format nil "passepartout ~a" ver) "passepartout"))
|
||||
(dot (if (st :connected) "●" "○"))
|
||||
(dot-color (if (st :connected) (theme-color :dot-connected) (theme-color :dot-disconnected))))
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (- h 2) dot dot-color bg-panel)
|
||||
(cl-tty.backend:draw-text fb (+ x 4) (- h 2) ver-label (theme-color :text-muted) bg-panel))))
|
||||
(lines (sidebar-lines))
|
||||
(content-lines (butlast lines))
|
||||
(footer-line (car (last lines))))
|
||||
(cl-tty.backend:draw-rect fb x 0 (- w x) (1- h) :bg (theme-color :bg-panel))
|
||||
(loop for (text . color-key) in content-lines
|
||||
for y from 0
|
||||
when text
|
||||
do (cl-tty.backend:draw-text fb (+ x 2) y text
|
||||
(if color-key (theme-color color-key) (theme-color :dim))
|
||||
(theme-color :bg-panel)))
|
||||
;; Version footer at h-2
|
||||
(when footer-line
|
||||
(cl-tty.backend:draw-text fb (+ x 2) (- h 2) (car footer-line)
|
||||
(theme-color (cdr footer-line))
|
||||
(theme-color :bg-panel)))))
|
||||
#+END_SRC
|
||||
|
||||
** Redraw (dirty-flag dispatch)
|
||||
@@ -331,175 +330,19 @@ Returns a list of strings, one per line."
|
||||
(setq w (or (and (numberp w) (> w 0) w) 80)
|
||||
h (or (and (numberp h) (> h 0) h) 24))
|
||||
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
|
||||
(cl-tty.backend:begin-sync fb)
|
||||
(cl-tty.backend:draw-rect fb 0 0 w h :bg (theme-color :bg))
|
||||
(view-status fb w h)
|
||||
(view-chat fb w h)
|
||||
(view-input fb w h)
|
||||
(when (sidebar-visible-p w)
|
||||
(view-sidebar fb w h))
|
||||
(cl-tty.backend:end-sync fb)
|
||||
(setf (st :dirty) (list nil nil nil))))
|
||||
(handler-case
|
||||
(progn
|
||||
(cl-tty.backend:with-frame (fb)
|
||||
(cl-tty.backend:draw-rect fb 0 0 w h :bg (theme-color :bg))
|
||||
(view-status fb w h)
|
||||
(view-chat fb w h)
|
||||
(view-input fb w h)
|
||||
(when (sidebar-visible-p w)
|
||||
(view-sidebar fb w h)))
|
||||
(setf (st :dirty) (list nil nil nil)))
|
||||
(error (c)
|
||||
(add-msg :system (format nil "* Render error: ~a *" c))))))
|
||||
|
||||
(defun position-cursor (fb w h)
|
||||
"Draw cursor at the input insertion point using reverse video (Emacs-style).
|
||||
|
||||
The character under the cursor is redrawn with foreground and background
|
||||
swapped. If the cursor is past the end of the input string, a reversed
|
||||
space is drawn."
|
||||
(let* ((sw (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
|
||||
(cw (- w sw))
|
||||
(hpad 2)
|
||||
(text (input-string))
|
||||
(text-len (length text))
|
||||
(pos (or (st :cursor-pos) 0))
|
||||
(prompt-w (- cw (* 2 hpad) 2))
|
||||
(display-start (max 0 (- pos (1- prompt-w))))
|
||||
(cx (+ hpad 2 (- pos display-start)))
|
||||
(cy (- h 6))
|
||||
(bg-i (theme-color :bg-input))
|
||||
(input-fg (theme-color :input-fg)))
|
||||
(if (< pos text-len)
|
||||
(let ((ch (char text pos)))
|
||||
(cl-tty.backend:draw-text fb cx cy (string ch) bg-i input-fg))
|
||||
(cl-tty.backend:draw-text fb cx cy " " bg-i input-fg))
|
||||
(finish-output (cl-tty.backend::backend-output-stream fb))))
|
||||
#+END_SRC
|
||||
|
||||
* Implementation — v0.7.0 additions
|
||||
* v0.7.1 — Markdown Rendering
|
||||
|
||||
~render-styled~ accepts a ~(text . plist)~ segment list from the span
|
||||
parser and emits ~draw-text~ calls. The ~w~ parameter is ignored (layout
|
||||
is line-at-a-time, not fixed-width); ~theme-color~ is fully qualified
|
||||
as ~passepartout.channel-tui:theme-color~ since this function lives in
|
||||
the ~passepartout~ package but the theme API is in ~passepartout.channel-tui~.
|
||||
|
||||
The inline span parser (~parse-markdown-spans~) delegates punctuation
|
||||
delimiters (**bold**, `code`, *italic*) to a local ~pick~ helper.
|
||||
URLs are handled directly via ~url-end~ rather than through ~pick~,
|
||||
so the ~:url~ clause was removed from ~pick~'s ~case~ form to avoid
|
||||
dead code.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun parse-markdown-spans (text)
|
||||
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
|
||||
(let ((results nil) (pos 0) (len (length text)))
|
||||
(labels ((earliest (a b) (cond ((and a (or (null b) (< a b))) a) (b b))))
|
||||
(loop
|
||||
(when (>= pos len) (return))
|
||||
(let* ((bold (search "**" text :start2 pos))
|
||||
(code (search "`" text :start2 pos))
|
||||
(italic (search "*" text :start2 pos))
|
||||
(http (search "http://" text :start2 pos))
|
||||
(https (search "https://" text :start2 pos))
|
||||
(url-s (or https http)))
|
||||
(flet ((pick (tag delim)
|
||||
(let ((end (search delim text :start2 (+ pos (length delim)))))
|
||||
(when end
|
||||
(push (cons (subseq text (+ pos (length delim)) end)
|
||||
(case tag (:bold '(:bold t))
|
||||
(:code '(:code t :bgcolor :dim))
|
||||
(:underline '(:underline t))))
|
||||
results)
|
||||
(setf pos (+ end (length delim)))
|
||||
t)))
|
||||
(url-end (start)
|
||||
(or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
|
||||
text :start start)
|
||||
len)))
|
||||
(let ((next (earliest (earliest (earliest bold code) italic) url-s)))
|
||||
(cond ((and bold (eql bold next)) (unless (pick :bold "**") (incf pos 2)))
|
||||
((and code (eql code next)) (unless (pick :code "`") (incf pos)))
|
||||
((and italic (eql italic next)) (unless (pick :underline "*") (incf pos)))
|
||||
((and url-s (eql url-s next))
|
||||
(let ((ue (url-end url-s)))
|
||||
(push (cons (subseq text url-s ue) '(:url t)) results)
|
||||
(setf pos ue)))
|
||||
(t (push (cons (subseq text pos) nil) results) (return))))))))
|
||||
(nreverse results)))
|
||||
|
||||
(defun render-styled (fb segments y x w)
|
||||
"Render markdown segments to cl-tty backend. Returns next y."
|
||||
(declare (ignore w))
|
||||
(dolist (seg segments)
|
||||
(let* ((text (or (car seg) ""))
|
||||
(attrs (cdr seg))
|
||||
(bold (getf attrs :bold))
|
||||
(code (getf attrs :code))
|
||||
(url (getf attrs :url)))
|
||||
(declare (ignore code))
|
||||
(cl-tty.backend:draw-text fb x y text
|
||||
(cond (url (passepartout.channel-tui:theme-color :accent))
|
||||
(t (passepartout.channel-tui:theme-color (or (getf attrs :role) :agent-fg))))
|
||||
(passepartout.channel-tui:theme-color :bg)
|
||||
:bold bold)
|
||||
(incf x (length text))))
|
||||
y)
|
||||
|
||||
(defun parse-markdown-blocks (text)
|
||||
"Split text at ``` code block boundaries."
|
||||
(let ((r nil) (p 0) (l (length text)))
|
||||
(loop
|
||||
(when (>= p l) (return))
|
||||
(let ((bs (search "```" text :start2 p)))
|
||||
(unless bs
|
||||
(push (cons (subseq text p) nil) r)
|
||||
(return))
|
||||
(when (> bs p)
|
||||
(push (cons (subseq text p bs) nil) r))
|
||||
(let* ((ao (+ bs 3))
|
||||
(le (or (position #\Newline text :start ao) l))
|
||||
(lang (string-trim " \r\n\t" (if (< le l) (subseq text ao le) "")))
|
||||
(cs (if (< le l) (1+ le) l))
|
||||
(cp (search "```" text :start2 cs))
|
||||
(ce (or cp l))
|
||||
(content (string-trim "\r\n" (subseq text cs ce))))
|
||||
(push (list :code-block t :lang lang :content content) r)
|
||||
(setf p (if cp (+ cp 3) l)))))
|
||||
(nreverse r)))
|
||||
|
||||
(defun syntax-highlight (code lang)
|
||||
"Highlight Lisp code: strings, comments, keywords, function calls."
|
||||
(declare (ignore lang))
|
||||
(let* ((r nil) (p 0) (l (length code))
|
||||
(kw '("defun" "defvar" "defparameter" "let" "let*" "lambda" "if" "when" "unless"
|
||||
"cond" "loop" "dolist" "dotimes" "progn" "prog1" "return"
|
||||
"setf" "setq" "format" "and" "or" "not" "list" "cons"
|
||||
"quote" "function" "declare" "ignore" "t" "nil")))
|
||||
(flet ((wordp (c) (or (alphanumericp c) (find c "-*+/?!_=<>"))))
|
||||
(loop
|
||||
(when (>= p l) (return))
|
||||
(let* ((ss (position #\" code :start p))
|
||||
(sc (position #\; code :start p))
|
||||
(sp (position #\( code :start p))
|
||||
(next (min (or ss l) (or sc l) (or sp l))))
|
||||
(when (> next p)
|
||||
(push (cons (subseq code p next) nil) r)
|
||||
(setf p next))
|
||||
(when (>= p l) (return))
|
||||
(cond
|
||||
((eql p ss)
|
||||
(let ((e (or (position #\" code :start (1+ p)) l)))
|
||||
(push (cons (subseq code p (min (1+ e) l)) '(:fgcolor :string)) r)
|
||||
(setf p (min (1+ e) l))))
|
||||
((eql p sc)
|
||||
(let ((e (or (position #\Newline code :start p) l)))
|
||||
(push (cons (subseq code p e) '(:fgcolor :comment)) r)
|
||||
(setf p e)))
|
||||
((eql p sp)
|
||||
(push (cons "(" nil) r)
|
||||
(incf p)
|
||||
(let ((fe (loop for i from p below l for c = (char code i)
|
||||
while (wordp c) finally (return i))))
|
||||
(when (> fe p)
|
||||
(let ((fs (subseq code p fe)))
|
||||
(push (cons fs (list :fgcolor (if (member fs kw :test #'string=)
|
||||
:keyword :function))) r)
|
||||
(setf p fe)))))))))
|
||||
(nreverse r)))
|
||||
#+END_SRC
|
||||
|
||||
* v0.7.2 — Gate Trace
|
||||
@@ -547,55 +390,53 @@ dead code.
|
||||
(in-suite tui-view-suite)
|
||||
|
||||
(test test-markdown-bold
|
||||
"Contract 7: parse-markdown-spans detects **bold**."
|
||||
(let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
|
||||
(is (= 3 (length segments)))))
|
||||
"parse-inline detects **bold**."
|
||||
(let ((nodes (cl-tty.markdown:parse-inline "hello **world**!")))
|
||||
(is (= 3 (length nodes)))
|
||||
(is (eq :bold (getf (second nodes) :type)))))
|
||||
|
||||
(test test-markdown-plain
|
||||
"Contract 7: plain text returns single segment."
|
||||
(let ((segments (passepartout::parse-markdown-spans "plain")))
|
||||
(is (= 1 (length segments)))
|
||||
(is (string= "plain" (caar segments)))))
|
||||
"parse-inline returns text node for plain input."
|
||||
(let ((nodes (cl-tty.markdown:parse-inline "plain")))
|
||||
(is (= 1 (length nodes)))
|
||||
(is (eq :text (getf (first nodes) :type)))))
|
||||
|
||||
(test test-markdown-url
|
||||
"Contract 7: parse-markdown-spans detects URLs."
|
||||
(let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
|
||||
(is (>= (length segments) 2))
|
||||
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
|
||||
"parse-inline returns text nodes including URLs (no built-in auto-link)."
|
||||
(let ((nodes (cl-tty.markdown:parse-inline "see https://example.com for more")))
|
||||
(is (>= (length nodes) 1))))
|
||||
|
||||
(test test-markdown-blocks
|
||||
"Contract 8: parse-markdown-blocks detects code blocks."
|
||||
"parse-blocks detects code blocks."
|
||||
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
|
||||
(segs (passepartout::parse-markdown-blocks text)))
|
||||
(is (= 3 (length segs)))
|
||||
(let ((code (second segs)))
|
||||
(is (eq t (getf code :code-block)))
|
||||
(is (string= "lisp" (getf code :lang)))
|
||||
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
|
||||
(nodes (cl-tty.markdown:parse-blocks text)))
|
||||
(is (= 3 (length nodes)))
|
||||
(is (eq :code-block (getf (second nodes) :type)))
|
||||
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline)
|
||||
(getf (second nodes) :content))))))
|
||||
|
||||
(test test-markdown-blocks-no-close
|
||||
"Contract 8: unclosed code block returns content."
|
||||
(let* ((text (format nil "```~%unclosed code"))
|
||||
(segs (passepartout::parse-markdown-blocks text)))
|
||||
(is (= 1 (length segs)))
|
||||
(is (eq t (getf (first segs) :code-block)))))
|
||||
"parse-blocks returns code-block even when unclosed."
|
||||
(let* ((text "```~%unclosed code")
|
||||
(nodes (cl-tty.markdown:parse-blocks text)))
|
||||
(is (eq :code-block (getf (first nodes) :type)))))
|
||||
|
||||
(test test-syntax-highlight
|
||||
"Contract 9: syntax-highlight colors Lisp code."
|
||||
(let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
|
||||
(is (>= (length segs) 3))))
|
||||
"highlight-code returns segment pairs for Lisp code."
|
||||
(let ((result (cl-tty.markdown:highlight-code "(defun foo (x) (+ x 1))" "lisp")))
|
||||
(is (listp result))
|
||||
(is (> (length result) 0))))
|
||||
|
||||
(test test-syntax-highlight-keyword
|
||||
"Contract 9: syntax-highlight colors keywords."
|
||||
(let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
|
||||
(is (>= (length segs) 2))
|
||||
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
|
||||
"highlight-code classifies keywords."
|
||||
(let ((result (cl-tty.markdown:highlight-code "(let ((x 1)) (+ x 2))" "lisp")))
|
||||
(is (find :keyword result :key #'cdr))))
|
||||
|
||||
(test test-syntax-highlight-function
|
||||
"Contract 9: syntax-highlight colors function calls."
|
||||
(let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
|
||||
(is (>= (length segs) 2))
|
||||
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
|
||||
"highlight-code classifies function calls."
|
||||
(let ((result (cl-tty.markdown:highlight-code "(+ 1 2)" "lisp")))
|
||||
(is (listp result))
|
||||
(is (> (length result) 0))))
|
||||
|
||||
(test test-gate-trace-lines-passed
|
||||
"Contract 9: gate-trace-lines for passed gate."
|
||||
@@ -660,17 +501,17 @@ and current sidebar mode."
|
||||
|
||||
(test test-status-bar-tokens
|
||||
"v0.9.0: status bar uses :status-fg and :status-bg theme tokens."
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :status-fg))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :status-bg)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :status-fg)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :status-bg))))
|
||||
|
||||
(test test-new-theme-keys
|
||||
"v0.10.0: theme has all zone keys."
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :bg))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :bg-panel))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :bg-element))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :bg-input))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :agent-border))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :thinking-bg))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :symbolic-border))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :text-muted)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :bg)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :bg-panel)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :bg-element)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :bg-input)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :agent-border)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :thinking-bg)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :symbolic-border)))
|
||||
(is (stringp (passepartout.channel-tui:theme-color :text-muted))))
|
||||
#+END_SRC
|
||||
|
||||
@@ -395,14 +395,14 @@ case "$COMMAND" in
|
||||
stty -icanon -echo -ixon 2>/dev/null || true
|
||||
# Ensure COLORTERM is set for modern backend detection
|
||||
export COLORTERM="${COLORTERM:-truecolor}"
|
||||
# Clear stale cache
|
||||
find ~/.cache/common-lisp -name "*.fasl" -path "*passepartout*" -o -name "*.fasl" -path "*cl-tty*" -delete 2>/dev/null
|
||||
sbcl --noinform \
|
||||
sbcl --noinform --disable-debugger \
|
||||
--load "$HOME/quicklisp/setup.lisp" \
|
||||
--eval '(push (truename "'"$PASSEPARTOUT_DATA_DIR"'/") asdf:*central-registry*)' \
|
||||
--eval '(setf *debugger-hook* nil uiop:*compile-file-failure-behaviour* :warn)' \
|
||||
--eval '(ql:quickload :passepartout/tui)' \
|
||||
--eval '(in-package :passepartout)' \
|
||||
--eval '(passepartout.channel-tui:tui-main)'
|
||||
--eval '(passepartout.channel-tui:tui-main)' \
|
||||
--eval '(uiop:quit 0)'
|
||||
rc=$?
|
||||
stty icanon echo ixon 2>/dev/null
|
||||
exit $rc
|
||||
|
||||
Reference in New Issue
Block a user