cleanup — remove dead markdown code, migrate theme to cl-tty, fix dialog navigation
Phases 1-3 of library/application boundary cleanup: Phase 1: Remove dead code (150 lines) - Delete local word-wrap (all callers already used cl-tty.box:word-wrap) - Delete parse-markdown-spans, render-styled, parse-markdown-blocks, syntax-highlight (all unused — view uses cl-tty.markdown directly) - Replace tests with cl-tty.markdown equivalents Phase 2: Migrate theme to cl-tty.theme (250 lines removed) - Replace *tui-theme*/*tui-theme-presets* with *theme* + define-preset - theme-switch/theme-save/theme-load delegate to cl-tty.theme - theme-color is now a 3-line wrapper - Added save-theme/load-theme to cl-tty.theme (38 lines added there) Phase 3: Fix dialog arrow navigation with select-handle-key - Replace broken manual key dispatch with cl-tty.dialog:select-handle-key - The old code had a dead (and ch (graphic-char-p ch)) — the and result was discarded, so every unhandled key ran (code-char key-code) against the filter unconditionally, inserting garbage on arrow keys
This commit is contained in:
@@ -373,12 +373,11 @@ Event handlers + daemon I/O + main loop.
|
||||
(add-msg :system "Ctrl+G Toggle gate trace"))
|
||||
;; /theme command
|
||||
((string-equal text "/theme")
|
||||
(add-msg :system (format nil "Theme: ~a — user-fg=~a agent-fg=~a system=~a input-fg=~a"
|
||||
*tui-theme-current-name*
|
||||
(getf *tui-theme* :user-fg)
|
||||
(getf *tui-theme* :agent-fg)
|
||||
(getf *tui-theme* :system)
|
||||
(getf *tui-theme* :input-fg)))
|
||||
(add-msg :system (format nil "Theme — user-fg=~a agent-fg=~a system=~a input-fg=~a"
|
||||
(theme-color :user-fg)
|
||||
(theme-color :agent-fg)
|
||||
(theme-color :system)
|
||||
(theme-color :input-fg)))
|
||||
(add-msg :system "Presets: /theme amber | gold | terracotta | sepia | nord-warm | monokai-warm | gruvbox-warm | light-amber | catppuccin | tokyonight | dracula | gemini | mono"))
|
||||
((and (>= (length text) 7)
|
||||
(string-equal (subseq text 0 7) "/theme "))
|
||||
@@ -765,37 +764,26 @@ supplied (e.g. \"/\"), pre-fill the select filter with it."
|
||||
((st :dialog-stack)
|
||||
(let* ((dlg (car (st :dialog-stack)))
|
||||
(sel (cl-tty.dialog:dialog-content dlg)))
|
||||
(cond
|
||||
((eq k :escape)
|
||||
(pop (st :dialog-stack))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((member k '(:up :down))
|
||||
(if (eq k :up)
|
||||
(cl-tty.dialog:select-prev sel)
|
||||
(cl-tty.dialog:select-next sel))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((eq k :enter)
|
||||
(let* ((filtered (cl-tty.dialog:select-filtered-options sel))
|
||||
(idx (cl-tty.dialog:select-selected-index sel))
|
||||
(item (when (< idx (length filtered))
|
||||
(third (nth idx filtered)))))
|
||||
(when item
|
||||
(let ((cb (cl-tty.dialog:select-on-select sel)))
|
||||
(when cb (funcall cb item))))
|
||||
(pop (st :dialog-stack))
|
||||
(setf (st :dirty) (list t t nil))))
|
||||
((let ((ch (code-char (cl-tty.input:key-event-code event))))
|
||||
(and ch (graphic-char-p ch))
|
||||
(setf (cl-tty.dialog:select-filter sel)
|
||||
(concatenate 'string
|
||||
(or (cl-tty.dialog:select-filter sel) "")
|
||||
(string ch)))))
|
||||
((eq k :backspace)
|
||||
(let* ((f (cl-tty.dialog:select-filter sel))
|
||||
(len (length (or f ""))))
|
||||
(when (> len 0)
|
||||
(setf (cl-tty.dialog:select-filter sel)
|
||||
(subseq f 0 (1- len)))))))))
|
||||
(if (cl-tty.dialog:select-handle-key sel event)
|
||||
;; select-handle-key handled nav or enter + fired callback
|
||||
(when (eql k :enter)
|
||||
(pop (st :dialog-stack)))
|
||||
;; not handled: escape, char input, backspace
|
||||
(cond
|
||||
((eql k :escape)
|
||||
(pop (st :dialog-stack)))
|
||||
((let ((ch (code-char (cl-tty.input:key-event-code event))))
|
||||
(and ch (graphic-char-p ch)
|
||||
(setf (cl-tty.dialog:select-filter sel)
|
||||
(concatenate 'string
|
||||
(or (cl-tty.dialog:select-filter sel) "")
|
||||
(string ch))))))
|
||||
((eql k :backspace)
|
||||
(let ((f (cl-tty.dialog:select-filter sel)))
|
||||
(when (> (length (or f "")) 0)
|
||||
(setf (cl-tty.dialog:select-filter sel)
|
||||
(subseq f 0 (1- (length f)))))))))
|
||||
(setf (st :dirty) (list t t nil))))
|
||||
((cl-tty.input:dispatch-key-event event)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((member k '(:enter :tab :escape :up :down))
|
||||
@@ -1273,11 +1261,11 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(fiveam:is (eq nil (st :busy))))
|
||||
|
||||
(fiveam:test test-theme
|
||||
"Contract view: *tui-theme* provides color mappings."
|
||||
(fiveam:is (string= "#fab283" (getf *tui-theme* :user-fg)))
|
||||
(fiveam:is (string= "#e8e8e8" (getf *tui-theme* :agent-fg)))
|
||||
(fiveam:is (string= "#808080" (getf *tui-theme* :system)))
|
||||
(fiveam:is (string= "#e8e8e8" (getf *tui-theme* :input-fg)))
|
||||
"Contract view: *theme* provides color mappings via theme-color."
|
||||
(fiveam:is (string= "#fab283" (theme-color :user-fg)))
|
||||
(fiveam:is (string= "#e8e8e8" (theme-color :agent-fg)))
|
||||
(fiveam:is (string= "#808080" (theme-color :system)))
|
||||
(fiveam:is (string= "#e8e8e8" (theme-color :input-fg)))
|
||||
(fiveam:is (string= "#FFFFFF" (theme-color :unknown-role))))
|
||||
|
||||
(fiveam:test test-on-key-ctrl-u-clears
|
||||
|
||||
@@ -26,282 +26,236 @@ All state mutation flows through event handlers in the controller.
|
||||
:input-panel-top
|
||||
:on-key :on-daemon-msg :send-daemon
|
||||
:connect-daemon :disconnect-daemon
|
||||
:*tui-theme* :theme-color))
|
||||
:*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))
|
||||
|
||||
@@ -19,7 +19,7 @@
|
||||
dispatches per dirty flags, fills global :bg first.
|
||||
5. ~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).
|
||||
Tab = 8. Used by cl-tty.box:word-wrap for accurate line counting.
|
||||
6. (sidebar-visible-p w): returns T if sidebar should show given width W
|
||||
and current :sidebar-mode (:auto >120, :visible always, :hidden never).
|
||||
|
||||
@@ -51,19 +51,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.
|
||||
@@ -351,142 +338,6 @@ Returns a list of strings, one per line."
|
||||
|
||||
#+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
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
||||
(in-package :passepartout)
|
||||
@@ -532,55 +383,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."
|
||||
@@ -645,17 +494,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
|
||||
|
||||
Reference in New Issue
Block a user