Amr Gharbeia
95d1ea3fed
- Add deepseek and nvidia entries to gateway-provider config - Add DEEPSEEK_API_KEY and NVIDIA_API_KEY to .env.example - Add deepseek and nvidia to doctor's LLM provider check - Fix remaining harness-log → log-message reference
9.0 KiB
9.0 KiB
SKILL: Utils Org (org-skill-utils-org.org)
Overview
Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with @personal (or any tag in bouncer-privacy-tags) and rejects files with matching #+FILETAGS:.
Implementation
Reading Files (with Privacy Filter)
(defun org-filetags-extract (content)
"Extracts the list of tags from a #+FILETAGS: line."
(let ((lines (uiop:split-string content :separator '(#\Newline))))
(dolist (line lines)
(when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
(let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
(return-from org-filetags-extract
(mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
(uiop:split-string tag-str :separator '(#\space #\tab))))))))
nil)
(defun org-privacy-tag-p (tags-list)
"Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
(let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
(when (and tags-list privacy-tags)
(some (lambda (tag)
(some (lambda (private-tag)
(string-equal (string-trim '(#\: #\space) tag)
(string-trim '(#\: #\space) private-tag))
privacy-tags))
tags-list)))))
(defun org-privacy-strip (content)
"Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
Returns the filtered content as a string."
(let* ((lines (uiop:split-string content :separator '(#\Newline)))
(result-lines nil)
(skip-depth nil)
(current-tags nil)
(in-properties nil))
(dolist (line lines)
(cond
(skip-depth
;; We're inside a skipped subtree
(when (and (uiop:string-prefix-p "*" (string-trim '(#\Space) line))
(<= (length (string-trim '(#\Space) line)) skip-depth))
(setf skip-depth nil)))
((uiop:string-prefix-p ":PROPERTIES:" (string-trim '(#\Space) line))
(setf in-properties t)
(push line result-lines))
((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
(setf in-properties nil)
(when current-tags
(when (org-privacy-tag-p (reverse current-tags))
(setf skip-depth
(length (car (last result-lines
(1+ (position-if
(lambda (l)
(uiop:string-prefix-p "*" (string-trim '(#\Space) l)))
(reverse result-lines))))))))
(setf current-tags nil))
(push line result-lines))
((and in-properties (uiop:string-prefix-p ":TAGS:" (string-trim '(#\Space) line)))
(let ((tag-val (string-trim '(#\Space) (subseq (string-trim '(#\Space) line) 6))))
(setf current-tags (uiop:split-string tag-val :separator '(#\space #\tab))))
(push line result-lines))
(t
(push line result-lines))))
(format nil "~{~a~%~}" (nreverse result-lines))))
(defun org-read-file (filepath)
"Reads an Org file into a string, applying privacy filtering."
(let* ((raw (uiop:read-file-string filepath))
(filetags (org-filetags-extract raw)))
(if (org-privacy-tag-p filetags)
(progn
(harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
nil)
(org-privacy-strip raw))))Writing Files
(defun org-write-file (filepath content)
"Writes content to an Org file."
(uiop:with-output-file (s filepath :if-exists :supersede)
(format s "~a" content)))ID Generation
(defun org-id-generate ()
"Generates a new UUID for an Org node."
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))ID Formatting
(defun org-id-format (id)
"Ensures the ID has the 'id:' prefix."
(if (uiop:string-prefix-p "id:" id)
id
(format nil "id:~a" id)))Setting Properties (Recursive)
(defun org-property-set (ast target-id property value)
"Recursively sets a property on a headline with a matching ID in the AST."
(let ((type (getf ast :type))
(props (getf ast :properties))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
(setf (getf (getf ast :properties) property) value)
(return-from org-property-set t))
(dolist (child contents)
(when (listp child)
(when (org-property-set child target-id property value)
(return-from org-property-set t)))))
nil)Setting TODO Status
(defun org-todo-set (ast target-id status)
"Sets the TODO status of a headline in the AST."
(org-property-set ast target-id :TODO status))Adding Headlines
(defun org-headline-add (ast parent-id title)
"Adds a new headline as a child of the parent-id in the AST."
(let* ((type (getf ast :type))
(props (getf ast :properties))
(id (getf props :ID))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= id parent-id))
(let ((new-node (list :type :HEADLINE
:properties (list :ID (org-id-format (org-id-generate))
:TITLE title)
:contents nil)))
(setf (getf ast :contents) (append contents (list new-node)))
(return-from org-headline-add t)))
(dolist (child contents)
(when (listp child)
(when (org-headline-add child parent-id title)
(return-from org-headline-add t)))))
nil)Searching Headlines (by ID)
(defun org-headline-find-by-id (ast id)
"Finds a headline by its ID in the AST."
(let ((props (getf ast :properties)))
(when (string= (getf props :ID) id)
(return-from org-headline-find-by-id ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (org-headline-find-by-id child id)))
(when found (return-from org-headline-find-by-id found)))))
nil))Searching Headlines (by Title)
(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)
(return-from org-headline-find-by-title ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (org-headline-find-by-title child title)))
(when found (return-from org-headline-find-by-title found)))))
nil))Placeholder for External Edits
(defun org-modify (filepath id changes)
"Placeholder for Emacs-driven modification of a specific node."
(declare (ignore changes))
(harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath)
t)Placeholder for AST to Org conversion
(defun org-ast-render (ast)
"Minimal converter from AST back to Org text (Placeholder)."
(declare (ignore ast))
"* TITLE (Placeholder)")Skill Registration
(defskill :passepartout-programming-org
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))Test Suite
Verification of the structural manipulation for Org-mode files and their AST representation.
(defpackage :passepartout-utils-org-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-org-suite))
(in-package :passepartout-utils-org-tests)
(def-suite utils-org-suite
:description "Tests for Utils Org skill.")
(in-suite utils-org-suite)
(test id-generation
(let ((id1 (org-id-generate))
(id2 (org-id-generate)))
(is (plusp (length id1)))
(is (not (string= id1 id2)))))
(test id-format
(let ((formatted (org-id-format "abc12345")))
(is (search "id:" formatted))))
(test property-setter
(let ((ast (list :type :HEADLINE
:properties (list :ID "id:test123" :TITLE "Test")
:contents nil)))
(org-property-set ast "id:test123" :STATUS "ACTIVE")
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
(test todo-setter
(let ((ast (list :type :HEADLINE
:properties (list :ID "id:todo001" :TITLE "Task")
:contents nil)))
(org-todo-set ast "id:todo001" "DONE")
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))