passepartout: v0.5.0 File Reorganization
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Extract non-core fragments using self-repair criterion:
- core-context -> symbolic-awareness (224 lines, fboundp guards in think())
- heartbeat generation -> symbolic-events (renamed events-start-heartbeat)
Rename 23 files for clarity and new naming scheme:
- 6 core: core-package, core-transport, core-pipeline,
core-perceive, core-reason, core-act
- 13 system: symbolic-*, neuro-*, embedding-*, channel-shell
- 4 gateway: channel-cli, channel-tui-*, channel-tui-state
Utility relocations:
- markdown-strip -> programming-markdown
- plist-keywords-normalize -> programming-lisp
- cognitive-tool-prompt -> programming-tools
- VAULT-MEMORY -> security-vault
- Merge *backend-registry* into *probabilistic-backends*
Split gateway-messaging into channel-telegram/channel-signal/
channel-discord/channel-slack (4 independent skills)
Delete dead system-model.lisp (16-line wrapper)
Document self-repair criterion in DESIGN_DECISIONS
Version bump: 0.4.3 -> 0.5.0
This commit is contained in:
181
org/channel-tui-state.org
Normal file
181
org/channel-tui-state.org
Normal file
@@ -0,0 +1,181 @@
|
||||
#+TITLE: Passepartout TUI — Model
|
||||
#+PROPERTY: header-args:lisp :tangle ../lisp/channel-tui-state.lisp
|
||||
|
||||
* Model
|
||||
|
||||
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
|
||||
All state mutation flows through event handlers in the controller.
|
||||
|
||||
** Contract
|
||||
|
||||
1. (init-state): returns a fresh state plist with ~:msgs~ list,
|
||||
~:input~ buffer, ~:dirty~ flag, ~:busy~ flag, and ~:connection~ status.
|
||||
2. (add-msg role content &key gate-trace): appends a message object
|
||||
to the ~:messages~ vector (v0.3.3), tagged with timestamp, role,
|
||||
and optional gate-trace from the daemon (v0.4.0).
|
||||
3. (queue-event ev): thread-safely enqueues an event for the
|
||||
reader loop. (drain-queue) returns and clears the queue.
|
||||
|
||||
** Package + State
|
||||
#+begin_src lisp
|
||||
(defpackage :passepartout.channel-tui
|
||||
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
|
||||
(:export :tui-main :st :add-msg :now :input-string
|
||||
:queue-event :drain-queue :init-state
|
||||
:view-status :view-chat :view-input :redraw
|
||||
:on-key :on-daemon-msg :send-daemon
|
||||
:connect-daemon :disconnect-daemon
|
||||
:*tui-theme* :theme-color))
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(defvar *state* nil)
|
||||
(defvar *event-queue* nil)
|
||||
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
|
||||
|
||||
(defvar *tui-theme*
|
||||
;; Roles
|
||||
'(:user :green :agent :white :system :yellow
|
||||
;; Content
|
||||
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
|
||||
;; Status
|
||||
:connected :green :disconnected :red :busy :magenta :idle :white
|
||||
;; Gate trace
|
||||
:gate-passed :green :gate-blocked :red :gate-approval :yellow
|
||||
;; Tools (future use)
|
||||
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
|
||||
;; Display
|
||||
:scroll-indicator :cyan :border :white :background :black
|
||||
;; Differentiator (v0.4.0)
|
||||
:rule-count :cyan :focus-map :yellow
|
||||
;; UI
|
||||
:dim :white :highlight :cyan :accent :green)
|
||||
"Color theme plist. 27 semantic keys → Croatoan color values.
|
||||
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
|
||||
(defvar *tui-theme-presets*
|
||||
'(:dark (:user :green :agent :white :system :yellow
|
||||
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
|
||||
:connected :green :disconnected :red :busy :magenta :idle :white
|
||||
:gate-passed :green :gate-blocked :red :gate-approval :yellow
|
||||
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
|
||||
:scroll-indicator :cyan :border :white :background :black
|
||||
:rule-count :cyan :focus-map :yellow
|
||||
:dim :white :highlight :cyan :accent :green)
|
||||
:light (:user :blue :agent :black :system :red
|
||||
:input :black :timestamp :yellow :help :blue :error :red :warning :yellow
|
||||
:connected :green :disconnected :red :busy :magenta :idle :black
|
||||
:gate-passed :green :gate-blocked :red :gate-approval :yellow
|
||||
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
|
||||
:scroll-indicator :blue :border :black :background :white
|
||||
:rule-count :blue :focus-map :red
|
||||
:dim :white :highlight :blue :accent :green)
|
||||
:gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
|
||||
:input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
|
||||
:connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
|
||||
:gate-passed "#b8bb26" :gate-blocked "#fb4934" :gate-approval "#fabd2f"
|
||||
:tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
|
||||
:scroll-indicator "#83a598" :border "#a89984" :background "#282828"
|
||||
:rule-count "#83a598" :focus-map "#fabd2f"
|
||||
:dim "#928374" :highlight "#83a598" :accent "#b8bb26")
|
||||
:solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
|
||||
:input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
|
||||
:connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
|
||||
:gate-passed "#859900" :gate-blocked "#dc322f" :gate-approval "#b58900"
|
||||
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
|
||||
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
|
||||
:rule-count "#2aa198" :focus-map "#b58900"
|
||||
:dim "#586e75" :highlight "#2aa198" :accent "#859900"))
|
||||
"Named theme presets. /theme <name> loads one into *tui-theme*.")
|
||||
|
||||
(defvar *tui-theme-current-name* :dark
|
||||
"Name of the currently active theme preset.")
|
||||
|
||||
(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))
|
||||
|
||||
(defun theme-load ()
|
||||
"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)))))
|
||||
|
||||
(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)))
|
||||
|
||||
(defun theme-color (role)
|
||||
"Returns the Croatoan color for a semantic role."
|
||||
(or (getf *tui-theme* role) :white))
|
||||
|
||||
(defun st (key) (getf *state* key))
|
||||
(defun (setf st) (val key) (setf (getf *state* key) val))
|
||||
|
||||
(defun init-state ()
|
||||
(setf *state*
|
||||
(list :running t :mode :chat :connected nil :stream nil
|
||||
:input-buffer nil :input-history nil :input-hpos 0
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:dirty (list nil nil nil))))
|
||||
#+end_src
|
||||
|
||||
** Helpers
|
||||
#+begin_src lisp
|
||||
(defun now ()
|
||||
(multiple-value-bind (s m h) (get-decoded-time)
|
||||
(declare (ignore s))
|
||||
(format nil "~2,'0d:~2,'0d" h m)))
|
||||
|
||||
(defun input-string ()
|
||||
(coerce (reverse (st :input-buffer)) 'string))
|
||||
|
||||
(defun input-insert-char (ch)
|
||||
"Insert character at cursor position into the input buffer."
|
||||
(let* ((buf (st :input-buffer))
|
||||
(pos (or (st :cursor-pos) 0))
|
||||
(s (coerce (reverse buf) 'string))
|
||||
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1+ pos))))
|
||||
|
||||
(defun input-delete-char ()
|
||||
"Delete character before cursor position (standard backspace)."
|
||||
(let* ((buf (st :input-buffer))
|
||||
(pos (or (st :cursor-pos) 0)))
|
||||
(when (and buf (> pos 0))
|
||||
(let* ((s (coerce (reverse buf) 'string))
|
||||
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1- pos))))))
|
||||
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
#+end_src
|
||||
|
||||
** Event Queue
|
||||
#+begin_src lisp
|
||||
(defun queue-event (ev)
|
||||
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
|
||||
|
||||
(defun drain-queue ()
|
||||
(bt:with-lock-held (*event-lock*)
|
||||
(let ((evs (nreverse *event-queue*)))
|
||||
(setf *event-queue* nil) evs)))
|
||||
#+end_src
|
||||
Reference in New Issue
Block a user