From bdcca5c37694008d4191c38e9cf8c6d6f0929f05 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Wed, 8 Apr 2026 10:14:34 -0400 Subject: [PATCH] chore: add patches, new project skills, and utility scripts --- add-org-ids.el | 18 +++++++ patch-architect-actuate.lisp | 19 +++++++ patch-architect-neuro.lisp | 24 +++++++++ patch-architect-scan.lisp | 17 ++++++ patch-neuro-debug.lisp | 19 +++++++ patch-neuro-economist.lisp | 54 +++++++++++++++++++ patch-neuro-trace.lisp | 22 ++++++++ patch-think-robust.lisp | 33 ++++++++++++ .../src/accountant-logic.lisp | 33 ++++++++++++ .../src/economist-logic.lisp | 16 ++++++ .../tests/test-suite.lisp | 2 + .../tests/test-suite.lisp | 2 + 12 files changed, 259 insertions(+) create mode 100644 add-org-ids.el create mode 100644 patch-architect-actuate.lisp create mode 100644 patch-architect-neuro.lisp create mode 100644 patch-architect-scan.lisp create mode 100644 patch-neuro-debug.lisp create mode 100644 patch-neuro-economist.lisp create mode 100644 patch-neuro-trace.lisp create mode 100644 patch-think-robust.lisp create mode 100644 projects/org-skill-token-accountant/src/accountant-logic.lisp create mode 100644 projects/org-skill-token-accountant/src/economist-logic.lisp create mode 100644 projectsorg-skill-web-research/tests/test-suite.lisp create mode 100644 projectsorg-skill-workspace-manager/tests/test-suite.lisp diff --git a/add-org-ids.el b/add-org-ids.el new file mode 100644 index 0000000..b9c4993 --- /dev/null +++ b/add-org-ids.el @@ -0,0 +1,18 @@ +(require 'org) +(require 'org-id) + +;; Ensure IDs are created and formatted as UUIDs +(setq org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id) +;; Actually, org-id-get-create automatically creates an ID if it does not exist. +;; We'll use UUIDs for IDs +(setq org-id-method 'uuid) + +;; Iterate over all .org files in the notes/ directory +(let ((files (directory-files "notes/" t "\\.org$"))) + (dolist (file files) + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + ;; Generate ID for the file itself + (org-id-get-create t) + (save-buffer) + (kill-buffer)))) diff --git a/patch-architect-actuate.lisp b/patch-architect-actuate.lisp new file mode 100644 index 0000000..8885be3 --- /dev/null +++ b/patch-architect-actuate.lisp @@ -0,0 +1,19 @@ +(in-package :org-agent.skills.org-skill-architect) + +(defun architect-actuate (action context) + (declare (ignore context)) + (let* ((payload (getf action :payload)) + ;; Support both (getf action :payload) and direct top-level keys + (note-path (or (getf payload :path) (getf action :path))) + (blueprint-content (or (getf payload :content) (getf action :content)))) + + (if (and note-path blueprint-content) + (progn + (org-agent:kernel-log "ARCHITECT - Appending PROTOCOL to ~a" note-path) + (with-open-file (out note-path :direction :output :if-exists :append) + (format out "~%* Phase B: Blueprint (PROTOCOL)~%:PROPERTIES:~%:STATUS: SIGNED~%:END:~%~%~a" + blueprint-content)) + (format nil "SUCCESS - Architect established PROTOCOL in ~a" note-path)) + (progn + (org-agent:kernel-log "ARCHITECT FAILURE - Missing path or content in action: ~a" action) + nil)))) diff --git a/patch-architect-neuro.lisp b/patch-architect-neuro.lisp new file mode 100644 index 0000000..c2eea8c --- /dev/null +++ b/patch-architect-neuro.lisp @@ -0,0 +1,24 @@ +(in-package :org-agent.skills.org-skill-architect) + +(defun neuro-skill-architect (context) + (let* ((payload (getf context :payload)) + (note (car (getf payload :ready-notes))) + (note-path (getf note :note-path)) + (prd-content (getf note :content)) + (path-str (namestring note-path))) + (format nil " + You are the PSF Architect. + The Master Note '~a' has a FROZEN PRD and needs a PROTOCOL. + + NOTE CONTENT: + --- + ~a + --- + + TASK: + Draft the '* Phase B: Blueprint (PROTOCOL)' section. + 1. Define Architectural Intent. + 2. Define Semantic Interfaces using Lisp signatures. + + Return a Lisp plist: (:target :architect :action :actuate :path \"~a\" :content \"...blueprint section...\") + " path-str prd-content path-str))) diff --git a/patch-architect-scan.lisp b/patch-architect-scan.lisp new file mode 100644 index 0000000..b450c9e --- /dev/null +++ b/patch-architect-scan.lisp @@ -0,0 +1,17 @@ +(in-package :org-agent.skills.org-skill-architect) + +(defun architect-scan-all-notes () + (let* ((notes-dir (or (uiop:getenv "MEMEX_NOTES") "/home/user/memex/notes/")) + (files (uiop:directory-files (uiop:ensure-directory-pathname notes-dir))) + (ready-notes '())) + (org-agent:kernel-log "ARCHITECT - Scanning ~a files in ~a" (length files) notes-dir) + (dolist (file files) + (let ((name (pathname-name file)) + (type (pathname-type file))) + (when (and name type + (uiop:string-prefix-p "org-skill-" name) + (string-equal type "org")) + (let ((status (architect-perceive-frozen-prd file))) + (when status (push status ready-notes)))))) + (org-agent:kernel-log "ARCHITECT - Found ~a ready notes." (length ready-notes)) + ready-notes)) diff --git a/patch-neuro-debug.lisp b/patch-neuro-debug.lisp new file mode 100644 index 0000000..028db79 --- /dev/null +++ b/patch-neuro-debug.lisp @@ -0,0 +1,19 @@ +(in-package :org-agent) + +(defun execute-openrouter-request (prompt system-prompt &key model) + (let ((api-key (uiop:getenv "OPENROUTER_API_KEY")) + (endpoint "https://openrouter.ai/api/v1/chat/completions") + (model-id (or model "google/gemini-2.0-flash-001"))) + (unless api-key (return-from execute-openrouter-request "(:type :LOG :payload (:text \"OpenRouter API Key missing\"))")) + (kernel-log "OPENROUTER DEBUG - Using Model: ~a" model-id) + (let* ((headers `(("Content-Type" . "application/json") + ("Authorization" . ,(format nil "Bearer ~a" api-key)) + ("HTTP-Referer" . "https://github.com/amr/org-agent"))) + (body (cl-json:encode-json-to-string + `((model . ,model-id) + (messages . (( (role . "system") (content . ,system-prompt) ) + ( (role . "user") (content . ,prompt) ))))))) + (handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))) + (let ((json (cl-json:decode-json-from-string response))) + (cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json))))))))) + (error (c) (format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c)))))) diff --git a/patch-neuro-economist.lisp b/patch-neuro-economist.lisp new file mode 100644 index 0000000..767293e --- /dev/null +++ b/patch-neuro-economist.lisp @@ -0,0 +1,54 @@ +(in-package :org-agent) + +(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil)) + "Dispatches a neural request through the provider cascade. + If CASCADE is a function, it is called with CONTEXT to determine backends." + (let ((backends (cond + ((listp cascade) cascade) + ((functionp cascade) (funcall cascade context)) + ((functionp *provider-cascade*) (funcall *provider-cascade* context)) + (t *provider-cascade*)))) + (dolist (backend backends) + (let ((backend-fn (gethash backend *neuro-backends*))) + (when backend-fn + (kernel-log "SYSTEM 1: Attempting backend ~a..." backend) + (let* (;; Consult the Economist for the model ID if the skill is available + (model (ignore-errors + (uiop:symbol-call :org-agent.skills.org-skill-economist :economist-get-model-for-provider backend))) + (result (if model + (funcall backend-fn prompt system-prompt :model model) + (funcall backend-fn prompt system-prompt)))) + (if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result))) + (kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend) + (return-from ask-neuro result)))))) + "(:type :LOG :payload (:text \"Neural Cascade Failure\"))")) + +(defun execute-openrouter-request (prompt system-prompt &key model) + (let ((api-key (uiop:getenv "OPENROUTER_API_KEY")) + (endpoint "https://openrouter.ai/api/v1/chat/completions") + (model-id (or model "google/gemini-2.0-flash-001"))) + (unless api-key (return-from execute-openrouter-request "(:type :LOG :payload (:text \"OpenRouter API Key missing\"))")) + (let* ((headers `(("Content-Type" . "application/json") + ("Authorization" . ,(format nil "Bearer ~a" api-key)) + ("HTTP-Referer" . "https://github.com/amr/org-agent"))) + (body (cl-json:encode-json-to-string + `((model . ,model-id) + (messages . (( (role . "system") (content . ,system-prompt) ) + ( (role . "user") (content . ,prompt) ))))))) + (handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30)) + (json (cl-json:decode-json-from-string response))) + (cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json)))))))) + (error (c) (format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c)))))) + +(defun execute-gemini-request (prompt system-prompt &key model) + (let* ((auth (get-provider-auth :gemini)) (api-key (getf auth :api-key)) (bearer-token (getf auth :bearer-token)) + ;; Use model from Economist if provided, else default to pro + (endpoint-base (if model (format nil "https://generativelanguage.googleapis.com/v1beta/models/~a:generateContent" model) + "https://generativelanguage.googleapis.com/v1beta/models/gemini-pro:generateContent"))) + (unless (or api-key bearer-token) (return-from execute-gemini-request "(:type :LOG :payload (:text \"Authentication missing\"))")) + (let* ((url (if api-key (format nil "~a?key=~a" endpoint-base api-key) endpoint-base)) + (headers `(("Content-Type" . "application/json") ,@(when bearer-token `(("Authorization" . ,(format nil "Bearer ~a" bearer-token)))))) + (body (cl-json:encode-json-to-string `((contents . ((parts . ((text . ,(format nil "~a~%~%Prompt: ~a" system-prompt prompt)))))))))) + (handler-case (let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 30)) (json (cl-json:decode-json-from-string response))) + (cdr (assoc :text (cdr (assoc :parts (car (cdr (assoc :parts (car (cdr (assoc :candidates json))))))))))) + (error (c) (format nil "(:type :LOG :payload (:text \"Neural Engine Failure: ~a\"))" c)))))) diff --git a/patch-neuro-trace.lisp b/patch-neuro-trace.lisp new file mode 100644 index 0000000..afc15e1 --- /dev/null +++ b/patch-neuro-trace.lisp @@ -0,0 +1,22 @@ +(in-package :org-agent) + +(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil)) + (let ((backends (cond + ((listp cascade) cascade) + ((functionp cascade) (funcall cascade context)) + ((functionp *provider-cascade*) (funcall *provider-cascade* context)) + (t *provider-cascade*)))) + (dolist (backend backends) + (let ((backend-fn (gethash backend *neuro-backends*))) + (when backend-fn + (kernel-log "SYSTEM 1: Attempting backend ~a..." backend) + (let* ((model (ignore-errors + (uiop:symbol-call :org-agent.skills.org-skill-economist :economist-get-model-for-provider backend))) + (result (if model + (funcall backend-fn prompt system-prompt :model model) + (funcall backend-fn prompt system-prompt)))) + (kernel-log "SYSTEM 1: Backend ~a returned: ~a" backend (if (stringp result) (subseq result 0 (min 50 (length result))) result)) + (if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result))) + (kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend) + (return-from ask-neuro result)))))) + "(:type :LOG :payload (:text \"Neural Cascade Failure\"))")) diff --git a/patch-think-robust.lisp b/patch-think-robust.lisp new file mode 100644 index 0000000..3494968 --- /dev/null +++ b/patch-think-robust.lisp @@ -0,0 +1,33 @@ +(in-package :org-agent) + +(defun think (context) + (let ((active-skill (find-triggered-skill context))) + (if active-skill + (progn + (kernel-log "SYSTEM 1: Engaging skill '~a'~%" (skill-name active-skill)) + (let* ((prompt-generator (skill-neuro-prompt active-skill)) + (prompt (when prompt-generator (funcall prompt-generator context)))) + (if prompt + (let* ((thought (ask-neuro prompt :context context)) + ;; Improved cleaning: Extract content between ``` blocks if they exist + (cleaned-thought + (let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought))) + (if match + (let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought)))) + (if (and regs (> (length regs) 0)) (elt regs 0) thought)) + (string-trim '(#\Space #\Newline #\Tab) thought)))) + (suggestion (ignore-errors (read-from-string cleaned-thought)))) + (kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought) + (cond + ((and suggestion (listp suggestion)) suggestion) + ;; SALVAGE: If LLM returned plain text or a non-list symbol + ((and (let ((p (getf context :payload))) (eq (getf p :sensor) :chat-message)) + (> (length cleaned-thought) 0)) + (kernel-log "SYSTEM 1: SALVAGING plain-text response.~%") + (let* ((no-prefix (cl-ppcre:regex-replace "(?i)^(okay,? |sure,? |i will |i've |i have |here is |got it\\.? |understood\\.? |done\\.? |yes,? )+" cleaned-thought ""))) + `(:target :emacs :payload (:action :insert-at-end :buffer "*org-agent-chat*" :text ,no-prefix)))) + (t + (kernel-log "SYSTEM 1 ERROR: Could not parse response as Lisp plist.~%") + nil))) + nil))) + nil))) diff --git a/projects/org-skill-token-accountant/src/accountant-logic.lisp b/projects/org-skill-token-accountant/src/accountant-logic.lisp new file mode 100644 index 0000000..cd892b9 --- /dev/null +++ b/projects/org-skill-token-accountant/src/accountant-logic.lisp @@ -0,0 +1,33 @@ +(in-package :org-agent) + +(defvar *provider-pain-table* (make-hash-table :test 'equal)) + +(defun token-accountant-record-pain (provider) + "Marks a provider as 'pained' (failed). It will be de-prioritized." + (setf (gethash provider *provider-pain-table*) (+ (get-universal-time) 600)) ; 10 min penalty + (kernel-log "ACCOUNTANT - Provider ~a de-prioritized due to failure." provider)) + +(defun token-accountant-get-cascade (context) + "Returns a dynamic list of providers, routing around pained ones." + (let ((all-providers '(:openrouter :groq :gemini)) + (healthy nil) + (pained nil) + (now (get-universal-time))) + (dolist (p all-providers) + (if (> (or (gethash p *provider-pain-table*) 0) now) + (push p pained) + (push p healthy))) + (append (nreverse healthy) (nreverse pained)))) + + +(defun token-accountant-get-model-for-provider (provider &optional context) + "Returns the recommended model for the provider." + (case provider + (:openrouter "moonshotai/kimi-k2.5") + (:groq "llama-3.3-70b-versatile") + (:gemini "gemini-1.5-flash-latest") + (t nil))) + +(defun token-accountant-patch-kernel () + "Hot-patches the kernel's cascade to use our dynamic logic." + (setf *provider-cascade* #'token-accountant-get-cascade)) diff --git a/projects/org-skill-token-accountant/src/economist-logic.lisp b/projects/org-skill-token-accountant/src/economist-logic.lisp new file mode 100644 index 0000000..2d3b1f4 --- /dev/null +++ b/projects/org-skill-token-accountant/src/economist-logic.lisp @@ -0,0 +1,16 @@ +(in-package :org-agent) + +(defun economist-route-task (context) + (declare (ignore context)) + '(:openrouter)) + +(defun economist-get-model-for-provider (provider &optional context) + "Returns 100% Free/Subsidized model IDs from OpenRouter. Updated April 2026." + (let ((complexity (ignore-errors (uiop:symbol-call :org-agent.skills.org-skill-router :router-classify-complexity context)))) + (case provider + (:openrouter + (case complexity + (:REASONING "meta-llama/llama-3.3-70b-instruct:free") ; High fidelity, zero cost + (:COGNITION "qwen/qwen3.6-plus:free") ; Latest interaction, zero cost + (t "meta-llama/llama-3.2-3b-instruct:free"))) ; Ultra-fast reflex, zero cost + (t nil)))) diff --git a/projectsorg-skill-web-research/tests/test-suite.lisp b/projectsorg-skill-web-research/tests/test-suite.lisp new file mode 100644 index 0000000..c25276d --- /dev/null +++ b/projectsorg-skill-web-research/tests/test-suite.lisp @@ -0,0 +1,2 @@ +;;; TDD Suite for web-research +;;; TDD Suite for web-research\n(fiveam:test mock-test (5am:is t)) \ No newline at end of file diff --git a/projectsorg-skill-workspace-manager/tests/test-suite.lisp b/projectsorg-skill-workspace-manager/tests/test-suite.lisp new file mode 100644 index 0000000..8c28d1e --- /dev/null +++ b/projectsorg-skill-workspace-manager/tests/test-suite.lisp @@ -0,0 +1,2 @@ +;;; TDD Suite for workspace-manager +;;; TDD Suite for workspace-manager\n(fiveam:test mock-test (5am:is t)) \ No newline at end of file