PSF: Internal kernel stabilization (auth/filler fixes).

This commit is contained in:
2026-04-04 20:27:43 -04:00
parent 39e5841beb
commit 26920b135a
5 changed files with 40 additions and 10 deletions

View File

@@ -4,7 +4,17 @@
(defvar *auth-providers* (make-hash-table :test 'equal))
(defun register-auth-provider (name fn) (setf (gethash name *auth-providers*) fn))
(defun get-provider-auth (provider) (let ((auth-fn (gethash provider *auth-providers*))) (if auth-fn (funcall auth-fn) nil)))
(defun get-provider-auth (provider)
"Retrieves authentication credentials for a provider.
Supports direct plists, functions, or environment variable fallbacks."
(let ((auth (gethash provider *auth-providers*)))
(cond
((functionp auth) (funcall auth))
((listp auth) auth)
(t (case provider
(:gemini (list :api-key (uiop:getenv "GEMINI_API_KEY")))
(:openrouter (list :api-key (uiop:getenv "OPENROUTER_API_KEY")))
(t nil))))))
(defvar *neuro-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* '(:gemini))
@@ -114,14 +124,12 @@
((and (let ((p (getf context :payload))) (eq (getf p :sensor) :chat-message))
(> (length cleaned-thought) 0))
(kernel-log "SYSTEM 1: SALVAGING plain-text response.~%")
;; Heuristic: If it looks like meta-commentary with quoted text, extract the quote
(let* ((quote-match (cl-ppcre:scan-to-strings "\"((?:\\\\.|[^\"\\\\])*)\"" cleaned-thought))
(payload-text (if (and quote-match (> (length quote-match) 0))
(elt (nth-value 1 (cl-ppcre:scan-to-strings "\"((?:\\\\.|[^\"\\\\])*)\"" cleaned-thought)) 0)
cleaned-thought)))
;; Remove common AI conversational filler at the start or end of the 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 ""))
(no-suffix (cl-ppcre:regex-replace "(?i)(\\s+okay,?|\\s+sure,?|\\s+got it\\.?|\\s+understood\\.?)$" no-prefix ""))
(payload-text (string-trim '(#\Space #\Newline #\Tab #\") no-suffix)))
`(:type :request :target :emacs :payload (:action :insert-at-end :buffer "*org-agent-chat*" :text ,payload-text))))
(t (kernel-log "SYSTEM 1 ERROR: Could not parse response as Lisp plist.~%") nil)))
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
(t (kernel-log "SYSTEM 1 ERROR: Could not parse response as Lisp plist.~%") nil))) '(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
nil)))
(defun distill-prompt (full-prompt successful-output)

View File

@@ -142,6 +142,18 @@ will assume you have started it manually (e.g., via SBCL)."
(org-agent--execute-request proc id payload))
((member type '(:response :RESPONSE))
(message "org-agent: Received response for ID %s" id))
((member type '(:log :LOG))
(let ((text (org-agent--plist-get payload :text)))
(save-excursion
(with-current-buffer (get-buffer-create "*org-agent-chat*")
(goto-char (point-max))
;; Clean up Thinking... if it exists
(save-excursion
(when (search-backward "** Thinking..." nil t)
(delete-region (point) (point-max))
(when (eq (char-before) ?\n) (backward-delete-char 1))))
(goto-char (point-max))
(insert "\n*SYSTEM LOG*: " text "\n")))))
(t (message "org-agent: Received unknown message type %s" type)))))
(defun org-agent--execute-request (proc id payload)
@@ -173,7 +185,7 @@ will assume you have started it manually (e.g., via SBCL)."
(when (eq (char-before) ?\n)
(backward-delete-char 1)))
(goto-char (point-max))
(insert "\n" text "\n")
(insert text "\n")
(org-agent-send `(:type :RESPONSE :id ,id :payload (:status :success)))))))
((member action '(:refactor-subtree :REFACTOR-SUBTREE))
(let ((target-id (org-agent--plist-get payload :target-id))