Amr Gharbeia
c227877302
Bug fixes: - Fix box() calls: set color-pair before box, pass ACS default chtype integers - Fix markdown functions: move to passepartout.channel-tui package where Croatoan is imported; use add-attributes/remove-attributes instead of :bold/:underline kwargs to add-string; call theme-color in gate-trace-lines to convert theme keys to Croatoan colors - Fix sandbox: remove dex:get/dex:post from restricted symbols (blocked neuro-provider from loading) - Export *log-lock* from passepartout (was unbound in jailed skill packages) - Fix configure: always deploy to XDG, skip cp when source==dest - Fix bash crash handler format string (~~ escaping) - Revert test reorder in 28 files (caused package leakage in skill loader) Design cleanup: - Extract tui-run-screen from tui-main for clean separation - Remove inject-stimulus alias - Merge *backend-registry* into *probabilistic-backends* - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string
363 lines
13 KiB
Org Mode
363 lines
13 KiB
Org Mode
#+TITLE: SKILL: Context Manager (org-skill-context-manager.org)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :system:context:scoping:
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-scope.lisp
|
|
|
|
* Overview
|
|
|
|
The Context Manager provides stack-based project focusing. When the agent
|
|
"focuses" on a project, file paths resolve relative to it and memory queries
|
|
auto-filter by scope. This enables the agent to work within a bounded context
|
|
without being distracted by unrelated memory.
|
|
|
|
The core provides the mechanism (=memory-object-scope=, =context-query= with
|
|
scope parameter). This skill provides the policy — what to focus on, what
|
|
scope means for each project, and how the stack is managed.
|
|
|
|
** Contract
|
|
|
|
1. (push-context &key project base-path scope): pushes a context plist
|
|
onto ~*context-stack*~. Blocks if depth exceeds ~*context-max-depth*~.
|
|
2. (pop-context): pops and returns the top context. If the stack would
|
|
become empty, inserts a default memex-wide context instead.
|
|
3. (current-context): returns the top-of-stack context plist.
|
|
4. (current-scope): returns the ~:scope~ keyword from the current context.
|
|
5. (current-project): returns the ~:project~ name from the current context.
|
|
6. (current-base-path): returns the ~:base-path~ from the current context.
|
|
7. (context-stack-depth): returns the number of contexts on the stack.
|
|
8. (focus-project name base-path): pushes a new context for the named
|
|
project. Sets ~*scope-resolver*~ to return ~:project~.
|
|
9. (focus-session): pushes an ephemeral context for the current session.
|
|
10. (focus-memex): pushes a global memex-wide context.
|
|
11. (unfocus): pops one level from the context stack.
|
|
12. (resolve-path path): resolves a path relative to the current base-path.
|
|
13. (context-scoped-query &key tag todo-state type): queries memory filtered
|
|
by the current context's scope.
|
|
14. (context-save): persists the context stack to disk.
|
|
15. (context-load): restores the context stack from disk on startup.
|
|
|
|
* Implementation
|
|
|
|
** Context Stack
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
|
|
(defvar *context-stack* nil
|
|
"Stack of context plists. Each plist has :project, :base-path, :scope.
|
|
Top of stack (car) is the current context.")
|
|
|
|
#+end_src
|
|
** *context-max-depth*
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *context-max-depth* 10
|
|
"Maximum context stack depth. Prevents runaway pushes.")
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Context Accessors
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun current-context ()
|
|
"Returns the current context plist, or nil if no context is set."
|
|
(car *context-stack*))
|
|
|
|
#+end_src
|
|
** current-scope
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun current-scope ()
|
|
"Returns the current scope keyword (:memex/:session/:project).
|
|
Returns :memex when no context is set (defaults to global scope)."
|
|
(or (getf (current-context) :scope) :memex))
|
|
|
|
#+end_src
|
|
** current-project
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun current-project ()
|
|
"Returns the current project name, or nil."
|
|
(getf (current-context) :project))
|
|
|
|
#+end_src
|
|
** current-base-path
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun current-base-path ()
|
|
"Returns the current base path for file resolution, or nil."
|
|
(getf (current-context) :base-path))
|
|
|
|
#+end_src
|
|
** context-stack-depth
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-stack-depth ()
|
|
"Returns the current depth of the context stack."
|
|
(length *context-stack*))
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Stack Operations
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun push-context (&key project base-path (scope :project))
|
|
"Pushes a new context onto the stack. When focused on a project:
|
|
- File paths resolve relative to BASE-PATH
|
|
- Memory queries filter by SCOPE
|
|
- :memex scope objects remain visible (always global)
|
|
Returns the new context plist."
|
|
(when (>= (context-stack-depth) *context-max-depth*)
|
|
(log-message "CONTEXT: Stack depth limit reached (~d), refusing push" *context-max-depth*)
|
|
(return-from push-context (current-context)))
|
|
(let* ((context (list :project project
|
|
:base-path base-path
|
|
:scope scope)))
|
|
(push context *context-stack*)
|
|
(context-save)
|
|
(log-message "CONTEXT: Pushed ~a (depth ~d)" project (context-stack-depth))
|
|
context))
|
|
|
|
#+end_src
|
|
** pop-context
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun pop-context ()
|
|
"Pops the current context, restoring the previous one.
|
|
Returns the restored context or nil if stack becomes empty."
|
|
(if *context-stack*
|
|
(let ((popped (pop *context-stack*)))
|
|
(context-save)
|
|
(log-message "CONTEXT: Popped ~a (depth ~d)"
|
|
(getf popped :project) (context-stack-depth))
|
|
(current-context))
|
|
(progn
|
|
(log-message "CONTEXT: Cannot pop — stack is empty")
|
|
nil)))
|
|
|
|
#+end_src
|
|
** with-context
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defmacro with-context ((&key project base-path (scope :project)) &body body)
|
|
"Executes BODY within a scoped context, then restores the previous context.
|
|
Example:
|
|
(with-context (:project \"passepartout\" :base-path \"/home/user/memex/projects/passepartout\")
|
|
(context-scoped-query :tag \"bug\"))"
|
|
`(let ((*context-stack* (cons (list :project ,project
|
|
:base-path ,base-path
|
|
:scope ,scope)
|
|
*context-stack*)))
|
|
,@body))
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Path Resolution
|
|
|
|
Resolves file paths relative to the current project's base path.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun resolve-path (path)
|
|
"Resolves a file path relative to the current context.
|
|
If PATH is absolute, returns it unchanged.
|
|
If PATH is relative and a base-path is set, merges them.
|
|
Otherwise returns PATH unchanged."
|
|
(let ((base (current-base-path)))
|
|
(if (and base path (not (uiop:absolute-pathname-p path)))
|
|
(namestring (merge-pathnames path (uiop:ensure-directory-pathname base)))
|
|
path)))
|
|
#+end_src
|
|
|
|
** Memory Scope Filtering
|
|
|
|
Provides scope-aware query access. When a context is active (scope ≠ :memex),
|
|
queries only return objects whose scope is :memex (global) or matches the
|
|
current scope.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-scoped-query (&key tag todo-state type)
|
|
"Like context-query but filtered to the current context's scope.
|
|
:memex-scoped objects are always visible regardless of current scope."
|
|
(context-query :tag tag :todo-state todo-state :type type :scope (current-scope)))
|
|
|
|
#+end_src
|
|
** project-objects
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun project-objects ()
|
|
"Returns all objects scoped to the current project.
|
|
Includes :memex-scoped objects (global knowledge) plus :project-scoped
|
|
objects matching the current project."
|
|
(context-scoped-query))
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Project Focus Convenience
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun focus-project (name base-path)
|
|
"Shortcut: focus on a project by name and base path.
|
|
Calls push-context with :scope :project."
|
|
(push-context :project name :base-path base-path :scope :project))
|
|
|
|
#+end_src
|
|
** focus-session
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun focus-session ()
|
|
"Shortcut: enter a session context (ephemeral scope).
|
|
Objects created in this scope are visible only during the session."
|
|
(push-context :project "session" :scope :session))
|
|
|
|
#+end_src
|
|
** focus-memex
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun focus-memex ()
|
|
"Shortcut: return to global memex scope. Equivalent to pop-context
|
|
until stack is empty or :memex context is reached."
|
|
(loop while (and *context-stack*
|
|
(not (eq (getf (current-context) :scope) :memex)))
|
|
do (pop-context)))
|
|
|
|
#+end_src
|
|
** unfocus
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun unfocus ()
|
|
"Pop the top context and return to the previous one."
|
|
(pop-context))
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Skill Registration
|
|
|
|
** Persistence
|
|
|
|
;; REPL-VERIFIED: 2026-05-05T12:00:00
|
|
#+begin_src lisp
|
|
(defvar *context-persistence-file* nil
|
|
"Path to the context stack persistence file.")
|
|
|
|
(defun context-persist-file ()
|
|
"Returns the full path to the context persistence file."
|
|
(or *context-persistence-file*
|
|
(setf *context-persistence-file*
|
|
(merge-pathnames ".cache/passepartout/context.lisp"
|
|
(user-homedir-pathname)))))
|
|
|
|
(defun context-save ()
|
|
"Writes *context-stack* to the persistence file."
|
|
(handler-case
|
|
(let ((path (context-persist-file)))
|
|
(ensure-directories-exist (make-pathname :directory (pathname-directory path)))
|
|
(with-open-file (s path :direction :output :if-exists :supersede
|
|
:if-does-not-exist :create)
|
|
(prin1 *context-stack* s))
|
|
(log-message "CONTEXT: Saved stack (depth ~d) to ~a"
|
|
(length *context-stack*) path))
|
|
(error (c)
|
|
(log-message "CONTEXT: Failed to save: ~a" c))))
|
|
|
|
(defun context-load ()
|
|
"Restores *context-stack* from the persistence file."
|
|
(handler-case
|
|
(let ((path (context-persist-file)))
|
|
(when (probe-file path)
|
|
(with-open-file (s path :direction :input)
|
|
(let ((*read-eval* nil)
|
|
(data (read s nil nil)))
|
|
(when (listp data)
|
|
(setf *context-stack* data)
|
|
(log-message "CONTEXT: Restored stack (depth ~d) from ~a"
|
|
(length *context-stack*) path))
|
|
t))))
|
|
(error (c)
|
|
(log-message "CONTEXT: Failed to load: ~a" c)
|
|
nil)))
|
|
#+end_src
|
|
|
|
** Skill Registration
|
|
|
|
#+begin_src lisp
|
|
(defskill :passepartout-symbolic-scope
|
|
:priority 90
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
|
:deterministic (lambda (action ctx)
|
|
(declare (ignore action))
|
|
(ignore-errors
|
|
(when (> (context-stack-depth) 0)
|
|
nil))
|
|
nil))
|
|
#+end_src
|
|
|
|
** Auto-Init: Wire Scope Resolver
|
|
|
|
Registers ~current-scope~ into the core ~*scope-resolver*~ hook so the
|
|
perceive gate tags ingested objects with the active context scope.
|
|
Also restores any previously saved context stack.
|
|
|
|
#+begin_src lisp
|
|
(when (boundp '*scope-resolver*)
|
|
(setf *scope-resolver* #'current-scope))
|
|
|
|
;; Restore persisted context on load
|
|
(context-load)
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
#+begin_src lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-context-tests
|
|
(:use :cl :passepartout)
|
|
(:export #:context-suite))
|
|
|
|
(in-package :passepartout-context-tests)
|
|
|
|
(fiveam:def-suite context-suite :description "Context manager verification")
|
|
(fiveam:in-suite context-suite)
|
|
|
|
(fiveam:test test-push-pop-context
|
|
"Contract 1-2: push-context and pop-context maintain stack order."
|
|
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
|
|
(stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
|
|
(pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
|
|
(when stack-var
|
|
(setf (symbol-value stack-var) nil)
|
|
(push-context :project "testapp" :base-path "/tmp" :scope :project)
|
|
(fiveam:is (= 1 (length (symbol-value stack-var))))
|
|
(fiveam:is (string= "testapp" (getf (car (symbol-value stack-var)) :project)))
|
|
(pop-context)
|
|
(fiveam:is (null (symbol-value stack-var))))))
|
|
|
|
(fiveam:test test-context-save-load
|
|
"Contract 3-4: context-save and context-load round-trip."
|
|
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
|
|
(stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
|
|
(pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
|
|
(when (and stack-var pf-var)
|
|
(let* ((tmpfile (merge-pathnames "test-context.lisp" (uiop:temporary-directory))))
|
|
(setf (symbol-value pf-var) tmpfile)
|
|
(setf (symbol-value stack-var) (list '(:project "test" :base-path "/tmp" :scope :project)))
|
|
(context-save)
|
|
(fiveam:is (probe-file tmpfile))
|
|
(setf (symbol-value stack-var) nil)
|
|
(context-load)
|
|
(fiveam:is (= 1 (length (symbol-value stack-var))))
|
|
(fiveam:is (string= "test" (getf (car (symbol-value stack-var)) :project)))
|
|
(ignore-errors (delete-file tmpfile))))))
|
|
#+end_src* Contract
|
|
|
|
1. (push-context &key project base-path scope): pushes a context plist
|
|
onto ~*context-stack*~ and persists to disk.
|
|
2. (pop-context): pops the top context, persists, returns restored context.
|
|
3. (context-save): serializes ~*context-stack*~ to the persistence file.
|
|
4. (context-load): restores ~*context-stack*~ from persistence file on boot. |