passepartout: v0.5.0 hotfix 2 — daemon stable
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s

- Restore (in-package :passepartout) to core-reason
- Move *VAULT-MEMORY* back to core-skills
- Fix ASDF and defstruct/defpackage ordering
- Increase daemon timeout to 120s
- Handshake: 0.5.0

Verified: daemon processes messages, TUI clean, gate trace works
This commit is contained in:
2026-05-07 20:14:51 -04:00
parent da160b71e3
commit 924bf8f479
71 changed files with 2976 additions and 3888 deletions

View File

@@ -136,7 +136,7 @@ Returns the filtered content as a string."
(defun org-headline-find-by-title (ast title)
"Finds a headline by its title in the AST."
(let ((props (getf ast :properties)))
(when (string-equal (getf props :TITLE) title)
(when (string-equal (getf props :TITLE) title)
(return-from org-headline-find-by-title ast))
(dolist (child (getf ast :contents))
(when (listp child)
@@ -144,6 +144,22 @@ Returns the filtered content as a string."
(when found (return-from org-headline-find-by-title found)))))
nil))
(defun org-id-get-create (ast target-id)
"If the headline at TARGET-ID has an :ID property, return it.
If not, generate a new UUID, set it as the :ID property, and return it.
TARGET-ID can be a headline's :ID or :TITLE in the AST.
Returns nil if the headline is not found."
(let ((headline (or (org-headline-find-by-id ast target-id)
(org-headline-find-by-title ast target-id))))
(when headline
(let* ((props (getf headline :properties))
(id (getf props :ID)))
(if id
id
(let ((new-id (org-id-format (org-id-generate))))
(setf (getf props :ID) new-id)
new-id))))))
(defun org-subtree-extract (org-content heading-name)
"Extracts a subtree by heading name from Org text. Returns the subtree
content as a string (headline + body + children), or nil if not found."
@@ -310,3 +326,32 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
(is (string= "Child 2" (getf (getf found :properties) :TITLE))))
(let ((missing (org-headline-find-by-id ast "nonexistent")))
(is (null missing) "Missing ID should return nil"))))
(test test-org-id-get-create
"Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
;; Case 1: headline already has an ID
(let* ((ast (list :type :HEADLINE
:properties (list :ID "id:existing" :TITLE "Has ID")
:contents nil)))
(is (string= "id:existing" (org-id-get-create ast "id:existing"))))
;; Case 2: headline exists by title but has no ID — one should be created
(let* ((ast (list :type :HEADLINE
:properties (list :TITLE "No ID")
:contents nil)))
(let ((new-id (org-id-get-create ast "No ID")))
(is (stringp new-id))
(is (uiop:string-prefix-p "id:" new-id))
;; Verify the ID was set on the headline
(is (string= new-id (getf (getf ast :properties) :ID)))))
;; Case 3: idempotent — calling again returns same ID
(let* ((ast (list :type :HEADLINE
:properties (list :TITLE "Idempotent")
:contents nil)))
(let ((id1 (org-id-get-create ast "Idempotent"))
(id2 (org-id-get-create ast "Idempotent")))
(is (string= id1 id2))))
;; Case 4: headline not found returns nil
(let* ((ast (list :type :HEADLINE
:properties (list :ID "root" :TITLE "Root")
:contents nil)))
(is (null (org-id-get-create ast "nonexistent")))))