Amr Gharbeia
6d57abad11
- Add vector search exports (get-embedding, cosine-similarity, semantic-search) - Add tool permissions exports to package.lisp - Add tool-permissions-tests to asdf test system - Tangled org-skill-emacs-edit.org and org-skill-lisp-utils.org - Fixed emacs-edit-tests.lisp (was missing closing paren) - Now 77/77 tests passing
282 lines
11 KiB
Common Lisp
282 lines
11 KiB
Common Lisp
(in-package :opencortex)
|
|
|
|
(defun emacs-edit-generate-id ()
|
|
"Generates a unique ID for org-mode headlines.
|
|
Format: 8-char hex + timestamp for uniqueness."
|
|
(let* ((data (format nil "~a-~a" (get-universal-time) (random 999999)))
|
|
(digest (ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array data)))
|
|
(uuid (ironclad:byte-array-to-hex-string digest)))
|
|
(subseq uuid 0 8)))
|
|
|
|
(defun emacs-edit-id-format (id)
|
|
"Formats ID for org-mode (e.g., 'abc12345')."
|
|
(if (search "id:" id)
|
|
id
|
|
(format nil "id:~a" id)))
|
|
|
|
(defun emacs-edit-print-headline (ast &key indent-level)
|
|
"Converts a HEADLINE AST node to org text.
|
|
INDENT-LEVEL is number of leading asterisks."
|
|
(let ((level (or indent-level 1))
|
|
(stars (make-string level :initial-element #\*))
|
|
(title (or (getf (getf ast :properties) :TITLE) ""))
|
|
(todo (getf (getf ast :properties) :TODO)))
|
|
(format nil "~a ~a~%~a"
|
|
stars
|
|
(if todo (format nil "[~a] " (string-upcase todo)) "")
|
|
title)))
|
|
|
|
(defun emacs-edit-print-properties (props)
|
|
"Converts property list to :PROPERTIES: drawer."
|
|
(when props
|
|
(let ((lines (loop for (k v) on props by #'cddr
|
|
unless (member k '(:title :todo :created :id))
|
|
collect (format nil ":~a:~a" k v))))
|
|
(when lines
|
|
(format nil ":PROPERTIES:~%~{~a~^~%~}~%:END:~%"
|
|
lines)))))
|
|
|
|
(defun emacs-edit-print-section (ast)
|
|
"Prints :CONTENT: or description text."
|
|
(let ((content (getf ast :content)))
|
|
(when content
|
|
content)))
|
|
|
|
(defun emacs-edit-ast-to-org (ast &key (indent-level 1))
|
|
"Recursively converts an entire org AST back to org text.
|
|
Preserves structure including #+begin_src blocks."
|
|
(let ((type (getf ast :type))
|
|
(props (getf ast :properties))
|
|
(contents (getf ast :contents))
|
|
(elements (getf ast :elements)))
|
|
|
|
(cond
|
|
;; Headline
|
|
((eq type :headline)
|
|
(format nil "~%~a~a~%~a~{~a~}"
|
|
(emacs-edit-print-headline ast :indent-level indent-level)
|
|
(emacs-edit-print-properties props)
|
|
(emacs-edit-print-section ast)
|
|
(mapcar (lambda (child)
|
|
(emacs-edit-ast-to-org child :indent-level (1+ indent-level)))
|
|
(or contents elements))))
|
|
|
|
;; Section (body text)
|
|
((eq type :section)
|
|
(emacs-edit-print-section ast))
|
|
|
|
;; Plain text / paragraph
|
|
((or (eq type :paragraph) (stringp ast))
|
|
(format nil "~a~%" (if (stringp ast) ast (getf ast :raw-content))))
|
|
|
|
;; Code block (preserve exactly)
|
|
((eq type :src-block)
|
|
(let ((lang (or (getf ast :language) ""))
|
|
(code (or (getf ast :value) "")))
|
|
(format nil "#+begin_src ~a~%~a~%#+end_src~%"
|
|
lang code)))
|
|
|
|
;; Unknown - return as-is
|
|
(t (format nil "")))))
|
|
|
|
(defvar *org-parser-cache* (make-hash-table :test 'equal)
|
|
"Cache for parsed org files.")
|
|
|
|
(defun emacs-edit-parse-file (file-path)
|
|
"Parses an org FILE-PATH using existing ingest-ast.
|
|
Returns the parsed AST. Uses cache for performance."
|
|
(let ((cached (gethash file-path *org-parser-cache*)))
|
|
(when cached
|
|
(return-from emacs-edit-parse-file cached)))
|
|
|
|
(let* ((content (uiop:read-file-string file-path))
|
|
(ast (ingest-ast (list :type :document :raw-content content))))
|
|
(setf (gethash file-path *org-parser-cache*) ast)
|
|
ast))
|
|
|
|
(defun emacs-edit-clear-cache (&optional file-path)
|
|
"Clears the parser cache. If FILE-PATH provided, clears only that entry."
|
|
(if file-path
|
|
(remhash file-path *org-parser-cache*)
|
|
(clrhash *org-parser-cache*)))
|
|
|
|
(defun emacs-edit-write-file (file-path ast)
|
|
"Writes AST back to FILE-PATH, preserving org structure.
|
|
Clears cache after write."
|
|
(let ((org-text (emacs-edit-ast-to-org ast)))
|
|
(with-open-file (out file-path :direction :output :if-exists :supersede)
|
|
(write-string org-text out)))
|
|
(emacs-edit-clear-cache file-path)
|
|
(harness-log "EMACS-EDIT: Wrote ~a" file-path))
|
|
|
|
(defun emacs-edit-add-headline (ast title &key todo properties)
|
|
"Adds a new headline to AST.
|
|
Returns modified AST."
|
|
(let ((new-id (emacs-edit-generate-id))
|
|
(new-props (list :ID new-id
|
|
:TITLE title
|
|
:TODO (or todo "TODO")
|
|
:CREATED (format nil "[~a]"
|
|
(multiple-value-bind (s mi h d mo y)
|
|
(decode-universal-time (get-universal-time))
|
|
(format nil "~a-~a-~a ~a:~a"
|
|
y mo d h mi)))))
|
|
(merged-props (loop for (k v) on properties by #'cddr
|
|
collect k collect v)))
|
|
|
|
(setf merged-props (append merged-props new-props))
|
|
|
|
(let ((new-headline (list :type :headline
|
|
:properties merged-props
|
|
:contents nil
|
|
:raw-content title)))
|
|
(push new-headline (getf ast :contents))
|
|
ast)))
|
|
|
|
(defun emacs-edit-find-headline-by-id (ast target-id)
|
|
"Recursively finds headline with matching :ID: property."
|
|
(when (eq (getf ast :type) :headline)
|
|
(let ((props (getf ast :properties)))
|
|
(when (string= (getf props :ID) target-id)
|
|
(return-from emacs-edit-find-headline-by-id ast))))
|
|
|
|
(let ((contents (getf ast :contents)))
|
|
(when contents
|
|
(dolist (child contents)
|
|
(let ((found (emacs-edit-find-headline-by-id child target-id)))
|
|
(when found (return-from emacs-edit-find-headline-by-id found))))))
|
|
nil)
|
|
|
|
(defun emacs-edit-find-headline-by-title (ast target-title)
|
|
"Recursively finds headline with matching title."
|
|
(when (eq (getf ast :type) :headline)
|
|
(let ((props (getf ast :properties)))
|
|
(when (string= (getf props :TITLE) target-title)
|
|
(return-from emacs-edit-find-headline-by-title ast))))
|
|
|
|
(let ((contents (getf ast :contents)))
|
|
(when contents
|
|
(dolist (child contents)
|
|
(let ((found (emacs-edit-find-headline-by-title child target-title)))
|
|
(when found (return-from emacs-edit-find-headline-by-title found))))))
|
|
nil)
|
|
|
|
(defun emacs-edit-set-property (ast target property value)
|
|
"Sets PROPERTY=VALUE on headline matching TARGET (ID or title).
|
|
Returns modified AST."
|
|
(let ((headline (if (search "id:" target)
|
|
(emacs-edit-find-headline-by-id ast target)
|
|
(emacs-edit-find-headline-by-title ast target))))
|
|
(when headline
|
|
(setf (getf (getf headline :properties) property) value)
|
|
(harness-log "EMACS-EDIT: Set ~a=~a on ~a" property value target)))
|
|
ast)
|
|
|
|
(defun emacs-edit-set-todo (ast target new-state)
|
|
"Sets TODO state on headline matching TARGET.
|
|
NEW-STATE should be 'TODO', 'DONE', 'IN-PROGRESS', etc."
|
|
(emacs-edit-set-property ast target :TODO new-state)
|
|
(harness-log "EMACS-EDIT: Set TODO to ~a on ~a" new-state target))
|
|
|
|
(defun emacs-edit-modify (file-path operation &key params)
|
|
"Main entry point for org-mode file manipulation.
|
|
OPERATIONS:
|
|
:read - Parse file to AST, return AST
|
|
:write - Write AST back to file (AST in params)
|
|
:add-headline - Add headline (params: :title, :todo, :properties)
|
|
:set-property - Set property (params: :target, :property, :value)
|
|
:set-todo - Set TODO (params: :target, :state)"
|
|
(let ((ast (emacs-edit-parse-file file-path)))
|
|
|
|
(case operation
|
|
(:read
|
|
ast)
|
|
|
|
(:write
|
|
(let ((ast-to-write (getf params :ast)))
|
|
(emacs-edit-write-file file-path ast-to-write)))
|
|
|
|
(:add-headline
|
|
(let ((title (getf params :title))
|
|
(todo (getf params :todo))
|
|
(properties (getf params :properties)))
|
|
(emacs-edit-add-headline ast title :todo todo :properties properties)))
|
|
|
|
(:set-property
|
|
(let ((target (getf params :target))
|
|
(property (getf params :property))
|
|
(value (getf params :value)))
|
|
(emacs-edit-set-property ast target property value)))
|
|
|
|
(:set-todo
|
|
(let ((target (getf params :target))
|
|
(state (getf params :state)))
|
|
(emacs-edit-set-todo ast target state)))
|
|
|
|
(t
|
|
(harness-log "EMACS-EDIT ERROR: Unknown operation ~a" operation)))))
|
|
|
|
(def-cognitive-tool :org-read
|
|
"Reads an org-mode file and parses it to structured AST.
|
|
Use this BEFORE modifying org files to understand their structure."
|
|
((:file :type :string :description "Path to the org file"))
|
|
:body (lambda (args)
|
|
(let ((file (getf args :file)))
|
|
(if (uiop:file-exists-p file)
|
|
(emacs-edit-modify file :read)
|
|
(list :status :error :reason "File not found")))))
|
|
|
|
(def-cognitive-tool :org-write
|
|
"Writes previously parsed AST back to an org file.
|
|
Use this AFTER modifications to save changes."
|
|
((:file :type :string :description "Path to the org file")
|
|
(:ast :type :list :description "The AST to write"))
|
|
:body (lambda (args)
|
|
(let ((file (getf args :file))
|
|
(ast (getf args :ast)))
|
|
(emacs-edit-modify file :write :params (list :ast ast))
|
|
(list :status :success :message (format nil "Wrote ~a" file)))))
|
|
|
|
(def-cognitive-tool :org-add-headline
|
|
"Adds a new headline to an org file."
|
|
((:file :type :string :description "Path to the org file")
|
|
(:title :type :string :description "Headline title")
|
|
(:todo :type :string :description "TODO state (default TODO)")
|
|
(:properties :type :list :description "Plist of properties"))
|
|
:body (lambda (args)
|
|
(let ((file (getf args :file))
|
|
(title (getf args :title))
|
|
(todo (getf args :todo "TODO"))
|
|
(properties (getf args :properties)))
|
|
(emacs-edit-modify file :add-headline
|
|
:params (list :title title :todo todo :properties properties))
|
|
(list :status :success :message (format nil "Added headline: ~a" title)))))
|
|
|
|
(def-cognitive-tool :org-set-property
|
|
"Sets a property on an existing headline (by ID or title)."
|
|
((:file :type :string :description "Path to the org file")
|
|
(:target :type :string :description "Headline ID or title")
|
|
(:property :type :string :description "Property name")
|
|
(:value :type :string :description "Property value"))
|
|
:body (lambda (args)
|
|
(let ((file (getf args :file))
|
|
(target (getf args :target))
|
|
(property (getf args :property))
|
|
(value (getf args :value)))
|
|
(emacs-edit-modify file :set-property
|
|
:params (list :target target :property property :value value))
|
|
(list :status :success :message (format nil "Set ~a=~a on ~a" property value target)))))
|
|
|
|
(def-cognitive-tool :org-set-todo
|
|
"Sets the TODO state of a headline."
|
|
((:file :type :string :description "Path to the org file")
|
|
(:target :type :string :description "Headline ID or title")
|
|
(:state :type :string :description "New TODO state (TODO, DONE, etc)"))
|
|
:body (lambda (args)
|
|
(let ((file (getf args :file))
|
|
(target (getf args :target))
|
|
(state (getf args :state)))
|
|
(emacs-edit-modify file :set-todo
|
|
:params (list :target target :state state))
|
|
(list :status :success :message (format nil "Set ~a to ~a" target state)))))
|