Amr Gharbeia
41de20d3f1
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 11s
- Secret Exposure Gate + Privacy Filter (Bouncer) - Shell actuator safety harness (timeout, blocked patterns) - REPL-first enforcement (lisp validation gate, system-prompt-augment) - Engineering Standards lifecycle (two-track Org-first + REPL-first) - Literate Programming discipline (one function per block, reflect-back) - AGENTS.md: thin routing layer, skills are authoritative - SKILLS_DIR removed, ~/notes fallback eliminated - opencortex.sh: multi-distro (Debian+Fedora), configure, install service, backup, restore, help - infrastructure/opencortex.service (systemd user unit) - Docker: updated to debian:trixie, fixed build context - GitHub CI: lint + test workflows fixed, trigger on tags only - Gitea CI: deploy workflow paths fixed - README: one-line curl install, badges - USER_MANUAL: Deployment section (bare metal, Docker, backup) - .gitignore: skills/*.lisp and tests/*.lisp as generated artifacts - Prose/block refactor across all 35 org files - Test suite Tier 1: 43/45 pass (env-dependent failures isolated)
244 lines
9.2 KiB
Org Mode
244 lines
9.2 KiB
Org Mode
#+TITLE: SKILL: Utils Org (org-skill-utils-org.org)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :skill:utils:org:
|
|
#+PROPERTY: header-args:lisp :tangle org-skill-utils-org.lisp
|
|
|
|
* 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)
|
|
#+begin_src lisp
|
|
(defun utils-org-extract-filetags (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 utils-org-extract-filetags
|
|
(mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
|
|
(uiop:split-string tag-str :separator '(#\space #\tab))))))))
|
|
nil)
|
|
|
|
(defun utils-org-tag-matches-privacy-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" :opencortex))))
|
|
(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 utils-org-strip-tagged-subtrees (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 (utils-org-tag-matches-privacy-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 utils-org-read-file (filepath)
|
|
"Reads an Org file into a string, applying privacy filtering."
|
|
(let* ((raw (uiop:read-file-string filepath))
|
|
(filetags (utils-org-extract-filetags raw)))
|
|
(if (utils-org-tag-matches-privacy-p filetags)
|
|
(progn
|
|
(harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
|
|
nil)
|
|
(utils-org-strip-tagged-subtrees raw))))
|
|
#+end_src
|
|
|
|
** Writing Files
|
|
#+begin_src lisp
|
|
(defun utils-org-write-file (filepath content)
|
|
"Writes content to an Org file."
|
|
(uiop:with-output-file (s filepath :if-exists :supersede)
|
|
(format s "~a" content)))
|
|
#+end_src
|
|
|
|
** ID Generation
|
|
#+begin_src lisp
|
|
(defun utils-org-generate-id ()
|
|
"Generates a new UUID for an Org node."
|
|
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
|
|
#+end_src
|
|
|
|
** ID Formatting
|
|
#+begin_src lisp
|
|
(defun utils-org-id-format (id)
|
|
"Ensures the ID has the 'id:' prefix."
|
|
(if (uiop:string-prefix-p "id:" id)
|
|
id
|
|
(format nil "id:~a" id)))
|
|
#+end_src
|
|
|
|
** Setting Properties (Recursive)
|
|
#+begin_src lisp
|
|
(defun utils-org-set-property (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 utils-org-set-property t))
|
|
(dolist (child contents)
|
|
(when (listp child)
|
|
(when (utils-org-set-property child target-id property value)
|
|
(return-from utils-org-set-property t)))))
|
|
nil)
|
|
#+end_src
|
|
|
|
** Setting TODO Status
|
|
#+begin_src lisp
|
|
(defun utils-org-set-todo (ast target-id status)
|
|
"Sets the TODO status of a headline in the AST."
|
|
(utils-org-set-property ast target-id :TODO status))
|
|
#+end_src
|
|
|
|
** Adding Headlines
|
|
#+begin_src lisp
|
|
(defun utils-org-add-headline (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 (utils-org-id-format (utils-org-generate-id))
|
|
:TITLE title)
|
|
:contents nil)))
|
|
(setf (getf ast :contents) (append contents (list new-node)))
|
|
(return-from utils-org-add-headline t)))
|
|
(dolist (child contents)
|
|
(when (listp child)
|
|
(when (utils-org-add-headline child parent-id title)
|
|
(return-from utils-org-add-headline t)))))
|
|
nil)
|
|
#+end_src
|
|
|
|
** Searching Headlines (by ID)
|
|
#+begin_src lisp
|
|
(defun utils-org-find-headline-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 utils-org-find-headline-by-id ast))
|
|
(dolist (child (getf ast :contents))
|
|
(when (listp child)
|
|
(let ((found (utils-org-find-headline-by-id child id)))
|
|
(when found (return-from utils-org-find-headline-by-id found)))))
|
|
nil))
|
|
#+end_src
|
|
|
|
** Searching Headlines (by Title)
|
|
#+begin_src lisp
|
|
(defun utils-org-find-headline-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 utils-org-find-headline-by-title ast))
|
|
(dolist (child (getf ast :contents))
|
|
(when (listp child)
|
|
(let ((found (utils-org-find-headline-by-title child title)))
|
|
(when found (return-from utils-org-find-headline-by-title found)))))
|
|
nil))
|
|
#+end_src
|
|
|
|
** Placeholder for External Edits
|
|
#+begin_src lisp
|
|
(defun utils-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)
|
|
#+end_src
|
|
|
|
** Placeholder for AST to Org conversion
|
|
#+begin_src lisp
|
|
(defun utils-org-ast-to-org (ast)
|
|
"Minimal converter from AST back to Org text (Placeholder)."
|
|
(declare (ignore ast))
|
|
"* TITLE (Placeholder)")
|
|
#+end_src
|
|
|
|
** Skill Registration
|
|
#+begin_src lisp
|
|
(defskill :skill-utils-org
|
|
:priority 100
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
Verification of the structural manipulation for Org-mode files and their AST representation.
|
|
#+begin_src lisp :tangle ../tests/utils-org-tests.lisp
|
|
(defpackage :opencortex-utils-org-tests
|
|
(:use :cl :fiveam :opencortex)
|
|
(:export #:utils-org-suite))
|
|
|
|
(in-package :opencortex-utils-org-tests)
|
|
|
|
(def-suite utils-org-suite
|
|
:description "Tests for Utils Org skill.")
|
|
|
|
(in-suite utils-org-suite)
|
|
|
|
(test id-generation
|
|
(let ((id1 (utils-org-generate-id))
|
|
(id2 (utils-org-generate-id)))
|
|
(is (plusp (length id1)))
|
|
(is (not (string= id1 id2)))))
|
|
|
|
(test id-format
|
|
(let ((formatted (utils-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)))
|
|
(utils-org-set-property 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)))
|
|
(utils-org-set-todo ast "id:todo001" "DONE")
|
|
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
|
#+end_src
|