diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 05198b3..a211e3f 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -1181,7 +1181,7 @@ (recreate-windows (or (width scr) 80) (or (height scr) 24)) (redraw sw cw ch iw) (refresh scr)) - (t (on-key ch)))) + (t (ignore-errors (on-key ch))))) (redraw sw cw ch iw) (when sidebar-w (view-sidebar sidebar-w) diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index 7e5890c..5f21126 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -73,7 +73,7 @@ (search-highlight content (st :search-query)) content)) (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2))) + (wrapped (passepartout::word-wrap line-text (- w 2))) (nlines (length wrapped))) (if (<= nlines lines-remaining) (progn (decf lines-remaining nlines) (incf msg-count)) @@ -95,7 +95,7 @@ (search-highlight content (st :search-query)) content)) (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2)))) + (wrapped (passepartout::word-wrap line-text (- w 2)))) ;; HITL panel: render with colored border (when is-panel (setf color (if is-resolved @@ -160,6 +160,34 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." ((<= #xFE00 code #xFE0F) 0) (t 1)))) +(defun word-wrap (text max-width) + "Split TEXT into lines that fit within MAX-WIDTH columns. +Word-breaks at spaces when possible; breaks mid-word if necessary. +Respects CJK/emoji char widths via char-width." + (let ((lines nil) + (start 0) + (end (length text))) + (loop while (< start end) do + (let* ((col 0) + (pos start) + (last-break start)) + (loop while (< pos end) + for width = (char-width (char text pos)) do + (when (char= (char text pos) #\Space) + (setf last-break pos)) + (when (> (+ col width) max-width) + (return)) + (incf col width) + (incf pos) + (when (>= pos end) (return))) + (let ((line-end (if (> pos start) pos (1+ start)))) + (when (>= line-end end) (setf line-end end)) + (push (subseq text start line-end) lines) + (setf start (if (and (< line-end end) (char= (char text line-end) #\Space)) + (1+ line-end) + line-end))))) + (nreverse lines))) + (in-package :passepartout) (defun parse-markdown-spans (text) diff --git a/lisp/programming-lisp.lisp b/lisp/programming-lisp.lisp index b4c41b7..70edfca 100644 --- a/lisp/programming-lisp.lisp +++ b/lisp/programming-lisp.lisp @@ -149,20 +149,6 @@ :priority 400 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) -(defun plist-keywords-normalize (plist) - - (when (listp plist) - - (loop for (k v) on plist by #'cddr - - collect (if (and (symbolp k) (not (keywordp k))) - - (intern (string k) :keyword) - - k) - - collect v))) - (defun plist-keywords-normalize (plist) (when (listp plist) (loop for (k v) on plist by #'cddr diff --git a/lisp/programming-tools.lisp b/lisp/programming-tools.lisp index f16e9e5..ba37e70 100644 --- a/lisp/programming-tools.lisp +++ b/lisp/programming-tools.lisp @@ -257,203 +257,6 @@ :trigger (lambda (ctx) (declare (ignore ctx)) nil) :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)) -(defpackage :passepartout - (:use :cl) - (:export - #:frame-message - #:read-framed-message - #:PROTO-GET - #:proto-get - #:*VAULT-MEMORY* - #:make-hello-message - #:validate-communication-protocol-schema - #:start-daemon - #:log-message - #:main - #:diagnostics-run-all - #:diagnostics-main - #:diagnostics-dependencies-check - #:diagnostics-env-check - #:register-provider - #:provider-openai-request - #:provider-config - #:run-setup-wizard - #:ingest-ast - #:memory-object-get - #:*memory-store* - #:memory-object - #:make-memory-object - #:memory-object-id - #:memory-object-type - #:memory-object-attributes - #:memory-object-parent-id - #:memory-object-children - #:memory-object-version - #:memory-object-last-sync - #:memory-object-vector - #:memory-object-content - #:memory-object-hash - #:memory-object-scope - #:snapshot-memory - #:rollback-memory - #:context-get-system-logs - #:context-assemble-global-awareness - #:context-awareness-assemble - #:context-query - #:push-context - #:pop-context - #:current-context - #:current-scope - #:context-stack-depth - #:context-save - #:context-load - #:focus-project - #:focus-session - #:focus-memex - #:unfocus - #:process-signal - #:loop-process - #:perceive-gate - #:loop-gate-perceive - #:act-gate - #:loop-gate-act - #:reason-gate - #:loop-gate-reason - #:cognitive-verify - #:backend-cascade-call - #:json-alist-to-plist - #:inject-stimulus - #:stimulus-inject - #:hitl-create - #:hitl-approve - #:hitl-deny - #:hitl-handle-message - #:dispatcher-check-secret-path - #:dispatcher-check-shell-safety - #:dispatcher-check-privacy-tags - #:dispatcher-check-network-exfil - #:dispatcher-gate - #:wildcard-match - #:actuator-initialize - #:action-dispatch - #:register-actuator - #:load-skill-from-org - #:skill-initialize-all - #:lisp-syntax-validate - #:defskill - #:*skill-registry* - #:*scope-resolver* - #:*embedding-backend* - #:*embedding-queue* - #:*embedding-provider* - #:embed-queue-object - #:embed-object - #:embed-all-pending - #:embedding-backend-hashing - #:embedding-backend-native - #:embedding-native-load-model - #:embedding-native-unload - #:embedding-native-ensure-loaded - #:embedding-native-get-dim - #:embeddings-compute - #:mark-vector-stale - #:skill - #:skill-name - #:skill-priority - #:skill-dependencies - #:skill-trigger-fn - #:skill-probabilistic-prompt - #:skill-deterministic-fn - #:def-cognitive-tool - #:*cognitive-tool-registry* - #:org-read-file - #:org-write-file - #:org-headline-add - #:org-headline-find-by-id - #:literate-tangle-sync-check - #:archivist-create-note - #:gateway-start - #:org-property-set - #:org-todo-set - #:org-id-generate - #:org-id-format - #:org-modify - #:lisp-validate - #:lisp-structural-check - #:lisp-syntactic-check - #:lisp-semantic-check - #:lisp-eval - #:lisp-format - #:lisp-list-definitions - #:lisp-extract - #:lisp-inject - #:lisp-slurp - #:get-oc-config-dir - #:get-tool-permission - #:set-tool-permission - #:check-tool-permission-gate - #:permission-get - #:permission-set - #:cognitive-tool - #:cognitive-tool-name - #:cognitive-tool-description - #:cognitive-tool-parameters - #:cognitive-tool-guard - #:cognitive-tool-body - #:register-probabilistic-backend - #:*probabilistic-backends* - #:*provider-cascade* - #:vault-get - #:vault-set - #:vault-get-secret - #:vault-set-secret - #:memory-objects-by-attribute - #:channel-cli-input - #:repl-eval - #:repl-inspect - #:repl-list-vars - #:policy-compliance-check - #:validator-protocol-check - #:archivist-extract-headlines - #:archivist-headline-to-filename - #:literate-extract-lisp-blocks - #:literate-block-balance-check - #:gateway-registry-initialize - #:messaging-link - #:messaging-unlink - #:gateway-configured-p)) - -(in-package :passepartout) - -(defun plist-get (plist key) - "Robust plist accessor — checks both :KEY and :key variants." - (let* ((s (string key)) - (up (intern (string-upcase s) :keyword)) - (dn (intern (string-downcase s) :keyword))) - (or (getf plist up) (getf plist dn)))) - -(defvar *log-buffer* nil) -(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock")) -(defvar *log-limit* 100) - -(defvar *skill-registry* (make-hash-table :test 'equal) - "Global registry of all loaded skills.") - -(defvar *telemetry-table* (make-hash-table :test 'equal)) -(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock")) - -(defun telemetry-track (skill-name duration status) - "Updates performance metrics for a skill. STATUS is :success or :rejected." - (when skill-name - (bordeaux-threads:with-lock-held (*telemetry-lock*) - (let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0)))) - (incf (getf entry :executions)) - (incf (getf entry :total-time) duration) - (when (eq status :rejected) (incf (getf entry :failures))) - (setf (gethash skill-name *telemetry-table*) entry))))) - -(defvar *cognitive-tool-registry* (make-hash-table :test 'equal)) - (defvar *modified-files-this-turn* nil "List of plists recording file modifications in the current turn.") diff --git a/lisp/security-vault.lisp b/lisp/security-vault.lisp index 330584d..cc7df7d 100644 --- a/lisp/security-vault.lisp +++ b/lisp/security-vault.lisp @@ -34,8 +34,6 @@ :priority 600 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) -(defvar *VAULT-MEMORY* (make-hash-table :test 'equal)) - (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 0027acc..c1e5da0 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -1300,7 +1300,7 @@ if the user reopens it within the same session. State is per-session only (recreate-windows (or (width scr) 80) (or (height scr) 24)) (redraw sw cw ch iw) (refresh scr)) - (t (on-key ch)))) + (t (ignore-errors (on-key ch))))) (redraw sw cw ch iw) (when sidebar-w (view-sidebar sidebar-w) diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index 7c0471d..79a3b45 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -218,7 +218,7 @@ that the TUI actuator attaches to the response plist before transmission. (search-highlight content (st :search-query)) content)) (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2))) + (wrapped (passepartout::word-wrap line-text (- w 2))) (nlines (length wrapped))) (if (<= nlines lines-remaining) (progn (decf lines-remaining nlines) (incf msg-count)) @@ -240,7 +240,7 @@ that the TUI actuator attaches to the response plist before transmission. (search-highlight content (st :search-query)) content)) (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2)))) + (wrapped (passepartout::word-wrap line-text (- w 2)))) ;; HITL panel: render with colored border (when is-panel (setf color (if is-resolved @@ -313,6 +313,34 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8." ((<= #x20D0 code #x20FF) 0) ((<= #xFE00 code #xFE0F) 0) (t 1)))) + +(defun word-wrap (text max-width) + "Split TEXT into lines that fit within MAX-WIDTH columns. +Word-breaks at spaces when possible; breaks mid-word if necessary. +Respects CJK/emoji char widths via char-width." + (let ((lines nil) + (start 0) + (end (length text))) + (loop while (< start end) do + (let* ((col 0) + (pos start) + (last-break start)) + (loop while (< pos end) + for width = (char-width (char text pos)) do + (when (char= (char text pos) #\Space) + (setf last-break pos)) + (when (> (+ col width) max-width) + (return)) + (incf col width) + (incf pos) + (when (>= pos end) (return))) + (let ((line-end (if (> pos start) pos (1+ start)))) + (when (>= line-end end) (setf line-end end)) + (push (subseq text start line-end) lines) + (setf start (if (and (< line-end end) (char= (char text line-end) #\Space)) + (1+ line-end) + line-end))))) + (nreverse lines))) #+end_src * v0.7.1 — Markdown Rendering diff --git a/org/programming-lisp.org b/org/programming-lisp.org index 03e17e8..66ca78b 100644 --- a/org/programming-lisp.org +++ b/org/programming-lisp.org @@ -236,33 +236,6 @@ The skill has four layers: ** Plist Keywords Normalize (relocated from core-reason) - - -Lisp keywords are case-sensitive. The LLM might produce ~:payload~ or ~:PAYLOAD~ depending on the model. This function normalizes keyword keys to uppercase. - - - -#+begin_src lisp - -(defun plist-keywords-normalize (plist) - - (when (listp plist) - - (loop for (k v) on plist by #'cddr - - collect (if (and (symbolp k) (not (keywordp k))) - - (intern (string k) :keyword) - - k) - - collect v))) - -#+end_src - - -** Plist Keywords Normalize (relocated from core-reason) - Lisp keywords are case-sensitive. The LLM might produce :payload or :PAYLOAD depending on the model. This function normalizes keyword keys to uppercase. #+begin_src lisp diff --git a/org/programming-tools.org b/org/programming-tools.org index 0e864e1..1d3e3bb 100644 --- a/org/programming-tools.org +++ b/org/programming-tools.org @@ -382,7 +382,7 @@ Surgical text replacement in an Org file — matches exact text and replaces it. ** Package Definition and Export List The package definition. All public symbols are exported here. -#+begin_src lisp +#+begin_src lisp :tangle no (defpackage :passepartout (:use :cl) (:export @@ -555,7 +555,7 @@ The package implementation section defines the low-level utilities and global st *** Robust plist access (plist-get) Retrieves a value from a plist, checking both upper and lowercase keyword variants. This is needed because different components use different keyword conventions. -#+begin_src lisp +#+begin_src lisp :tangle no (in-package :passepartout) (defun plist-get (plist key) @@ -568,7 +568,7 @@ Retrieves a value from a plist, checking both upper and lowercase keyword varian *** Logging state The harness maintains a bounded ring buffer of log messages for inclusion in LLM context. Access is thread-safe via a lock. -#+begin_src lisp +#+begin_src lisp :tangle no (defvar *log-buffer* nil) (defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock")) (defvar *log-limit* 100) @@ -576,14 +576,14 @@ The harness maintains a bounded ring buffer of log messages for inclusion in LLM *** Skill registry The global registry of all loaded skills. This is the authoritative list that the deterministic engine iterates. -#+begin_src lisp +#+begin_src lisp :tangle no (defvar *skill-registry* (make-hash-table :test 'equal) "Global registry of all loaded skills.") #+end_src *** Skill telemetry Tracks execution metrics per skill (count, duration, failures) for diagnostics and performance analysis. -#+begin_src lisp +#+begin_src lisp :tangle no (defvar *telemetry-table* (make-hash-table :test 'equal)) (defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock")) @@ -600,7 +600,7 @@ Tracks execution metrics per skill (count, duration, failures) for diagnostics a *** Cognitive tool registry Tools that the LLM can invoke are registered here. Each tool has a name, description, parameters, optional guard, and implementation body. The ~def-cognitive-tool~ macro handles registration. ~cognitive-tool-prompt~ serialises the registry into the LLM's system prompt. -#+begin_src lisp +#+begin_src lisp :tangle no (defvar *cognitive-tool-registry* (make-hash-table :test 'equal)) #+end_src diff --git a/org/security-vault.org b/org/security-vault.org index 0e74ddb..b9d6257 100644 --- a/org/security-vault.org +++ b/org/security-vault.org @@ -103,13 +103,6 @@ Delegates to the existing =vault-get=/=vault-set= with ~:type :secret~. :trigger (lambda (ctx) (declare (ignore ctx)) nil)) #+end_src - -** Vault Memory (relocated from core-skills) - -#+begin_src lisp -(defvar *VAULT-MEMORY* (make-hash-table :test 'equal)) -#+end_src - * Test Suite #+begin_src lisp diff --git a/passepartout b/passepartout index bc8d607..9ff0a00 100755 --- a/passepartout +++ b/passepartout @@ -17,7 +17,7 @@ done export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" export PASSEPARTOUT_CONFIG_DIR="$(realpath -m "${XDG_CONFIG_HOME:-$HOME/.config}/passepartout")" -export PASSEPARTOUT_DATA_DIR="${PASSEPARTOUT_DATA_DIR:-$(realpath -m "${XDG_DATA_HOME:-$HOME/.local/share}/passepartout")}" +export PASSEPARTOUT_DATA_DIR="${PASSEPARTOUT_DATA_DIR:-$(if [ -d "$HOME/memex/projects/passepartout/lisp" ]; then realpath -m "$HOME/memex/projects/passepartout"; else realpath -m "${XDG_DATA_HOME:-$HOME/.local/share}/passepartout"; fi)}" export PASSEPARTOUT_STATE_DIR="$(realpath -m "${XDG_STATE_HOME:-$HOME/.local/state}/passepartout")" export PASSEPARTOUT_BIN_DIR="$(realpath -m "${XDG_BIN_HOME:-$HOME/.local/bin}")" export PASSEPARTOUT_MEMEX_DIR="${PASSEPARTOUT_MEMEX_DIR:-$HOME/memex}" @@ -347,19 +347,17 @@ case "$COMMAND" in --eval '(funcall (find-symbol "DIAGNOSTICS-MAIN" :passepartout))' fi ;; - daemon) - check_dependencies - # Use the script's directory as the data dir (development mode) - # In production, set PASSEPARTOUT_DATA_DIR to your deployment path - export PASSEPARTOUT_DATA_DIR="${PASSEPARTOUT_DATA_DIR:-$SCRIPT_DIR}" - export MEMEX_DIR="${PASSEPARTOUT_MEMEX_DIR:-$HOME/memex}" - echo "Starting daemon (data dir: $PASSEPARTOUT_DATA_DIR)..." + daemon) + check_dependencies + export PASSEPARTOUT_DATA_DIR="${PASSEPARTOUT_DATA_DIR:-$SCRIPT_DIR}" + export MEMEX_DIR="${PASSEPARTOUT_MEMEX_DIR:-$HOME/memex}" + echo "Starting daemon (data dir: $PASSEPARTOUT_DATA_DIR)..." nohup sbcl --non-interactive \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ - --eval "(ql:quickload :passepartout)" \ - --eval "(load (format nil \"~alisp/neuro-router.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \ - --eval "(load (format nil \"~alisp/embedding-backends.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \ - --eval "(load (format nil \"~alisp/neuro-explorer.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \ + --eval '(ql:quickload :passepartout)' \ + --eval "(handler-case (load (format nil \"~alisp/neuro-router.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\"))) (error () nil))" \ + --eval "(handler-case (load (format nil \"~alisp/embedding-backends.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\"))) (error () nil))" \ + --eval "(handler-case (load (format nil \"~alisp/neuro-explorer.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\"))) (error () nil))" \ --eval '(funcall (find-symbol "MAIN" :passepartout))' \ > "$PASSEPARTOUT_STATE_DIR/daemon.log" 2>&1 & echo "Waiting for port 9105..."