Amr Gharbeia
39e5841beb
- Implement outbound OACP bridge by passing streams through cognitive loop. - Robustify 'think' and 'dispatch-action' with salvage logic and case-insensitivity. - Fix skill loading crashes due to undefined functions in skeletal skills. - Update org-agent.el to cleanly manage 'Thinking...' status state.
60 lines
2.9 KiB
Common Lisp
60 lines
2.9 KiB
Common Lisp
(in-package :org-agent)
|
|
|
|
(defun context-query-store (&key tag todo-state type)
|
|
(let ((results nil))
|
|
(maphash (lambda (id obj)
|
|
(declare (ignore id))
|
|
(let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
|
(when (and type (not (eq (org-object-type obj) type))) (setf match nil))
|
|
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
|
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
|
(when match (push obj results))))
|
|
*object-store*)
|
|
results))
|
|
|
|
(defun context-get-active-projects ()
|
|
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
|
|
(context-query-store :tag "project" :type :HEADLINE)))
|
|
|
|
(defun context-get-recent-completed-tasks () (context-query-store :todo-state "DONE" :type :HEADLINE))
|
|
|
|
(defun context-list-all-skills ()
|
|
(let ((results nil))
|
|
(maphash (lambda (name skill)
|
|
(declare (ignore name))
|
|
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
|
|
*skills-registry*)
|
|
(sort results #'> :key (lambda (x) (getf x :priority)))))
|
|
|
|
(defun context-get-skill-source (skill-name)
|
|
(let* ((filename (format nil "~a.org" skill-name))
|
|
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent)))
|
|
(full-path (merge-pathnames filename skills-dir)))
|
|
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
|
|
|
|
(defun context-get-system-logs (&optional (limit 20))
|
|
(bt:with-lock-held (*logs-lock*)
|
|
(let ((count (min limit (length *system-logs*)))) (subseq *system-logs* 0 count))))
|
|
|
|
(defun context-get-skill-telemetry (skill-name)
|
|
(bt:with-lock-held (*telemetry-lock*) (gethash (string-downcase skill-name) *skill-telemetry*)))
|
|
|
|
(defun context-filter-sparse-tree (ast predicate)
|
|
(if (listp ast)
|
|
(let* ((contents (getf ast :contents))
|
|
(filtered-contents (remove-if #'null (mapcar (lambda (c) (context-filter-sparse-tree c predicate)) contents))))
|
|
(if (or (funcall predicate ast) (not (null filtered-contents)))
|
|
(let ((new-ast (copy-list ast))) (setf (getf new-ast :contents) filtered-contents) new-ast)
|
|
nil))
|
|
nil))
|
|
|
|
(defun context-resolve-path (path-string)
|
|
(if (and (stringp path-string) (uiop:string-prefix-p "$" path-string))
|
|
(let* ((parts (uiop:split-string path-string :separator '(#\/)))
|
|
(var-name (subseq (car parts) 1)) (var-val (uiop:getenv var-name))
|
|
(remaining (cl:reduce (lambda (a b) (format nil "~a/~a" a b)) (cdr parts))))
|
|
(if var-val (let ((clean-val (string-trim '(#\" #\Space) var-val)))
|
|
(format nil "~a/~a" (string-right-trim "/" clean-val) remaining))
|
|
path-string))
|
|
path-string))
|