An Agent-Shell Workspace
Table of Contents
- the stories: they hand work to each other, neither waits
- the shape of a workspace
- the code comes to the user
- where the headings accrue
- how the user walks them
- what the user raises
- answering
- what the writer can do to the file
- Permalink
- authorship
- this note is edited using Claude/default, governed by the note how to do literate programming
- tl;dr
- an org document, one heading per thing the user and the writer put to each other, stops them waiting on each other — and stops the user reading prose they never asked for.
- rule
- nothing here reaches into agent-shell or tracking by advice while a hook, an
event or a keymap will do.
- why: an advice is a last resort, and a feature that cannot be had without one is a feature to ask about before it is written.
the stories: they hand work to each other, neither waits
- what
- what either of them puts to the other lives in a document rather than in the
chat, so each works on something else and picks it up on getting there.
- why: a document carrying the state of each question lets them work apart, which the user hopes makes the work efficient.
- what
- each of them is a heading, so the ball changes hands per heading rather than per conversation.
- what
- yes or no to a question of the writer’s is one keystroke.
- rule
- each story below is measured whole, by one babel block run alone in the user’s
setup.
- why: the user’s « it’s absurb to have 200+ tests. it goes against the principles ».
playing a review with it
- what
- a writer finishes a branch, and the user puts every commit of it up for
review with
V, one question each.- why: which commits a review covers is git’s to say, not the writer’s.
- what
- the user walks them, reading each commit with
dand answering from its lines withM-RET, while the writer fixes what was answered first. - what
- the writer rewrites its commits, and
Vagain follows them, what the user already validated staying validated. - what
- the last one settled, there is nothing left for them in the file.
the promise this story asserts
- what
- the promise is that the user never waits on the writer and it never waits on them.
- what
- done means the file showing, at a glance, whose turn each question is on.
- what
- what links the two is that a turn shown is a turn nobody waits on unseen.
- how
- what shows whose turn it is is the question’s state.
- what
- the story going green entails that taking up a
DISCUSSmakes itTHINKING, since breaking it reddens the story at « the writer takes it up ». - what
- a branch put up with
V, walked withdandM-RETwhile the writer fixes and rewrites it,Vfollowing, shows at each step whose turn each question is, and at the end none is the user’s.
(require 'cl-lib)
(let* ((top (make-temp-file "check-story-review-" t))
(work (expand-file-name "work" top))
(file (expand-file-name "check-story-review.ws.org" top))
(writer (generate-new-buffer " check-story-review-writer"))
(konix/agent-shell-workspace-diff-buffer " check-story-review-diff")
(told 0)
(git (lambda (&rest args)
(let ((default-directory (file-name-as-directory work)))
(apply #'konix/agent-shell-workspace--git
"-c" "user.name=t" "-c" "user.email=t@t" args))))
(commit (lambda (name text &rest flags)
(with-temp-file (expand-file-name name work) (insert text))
(funcall git "add" name)
(apply git "commit" "-q" "-m" (concat "add " name) flags)))
workspace)
(make-directory work)
(funcall git "init" "-q" "-b" "main")
(funcall commit "base" "base\n")
(funcall git "checkout" "-q" "-b" "topic")
(funcall commit "a" "a\n")
(funcall commit "b" "b\n")
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"#+DIRECTORY: " work "\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (&rest _) (cl-incf told) t))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'konix/agent-shell--rename-with-label) #'ignore)
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore)
((symbol-function 'read-string) (lambda (&rest _) "main..topic"))
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "Name it after what it holds" nil))))
(setq workspace (find-file-noselect file))
(with-current-buffer workspace
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer))
(cl-labels ((press (map key)
(call-interactively (lookup-key map (kbd key))))
(on (heading)
(switch-to-buffer workspace)
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*+ [A-Z]+ " heading))
(org-entry-get (point) "ID"))
(seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(let ((asking (konix/agent-shell-workspace--asking-here)))
(cons
step
(delq nil
(org-map-entries
(lambda ()
(when-let* ((state (org-get-todo-state)))
(format "%s %s %s"
(cond ((member (org-entry-get nil "ID")
asking)
"you")
((equal state "DONE") "settled")
(t "writer"))
state
(replace-regexp-in-string
" [0-9a-f]\\{8\\}\\'" ""
(org-get-heading t t t t))))))))))))))
(save-window-excursion
(let (seens remark)
(switch-to-buffer workspace)
(press konix/agent-shell-workspace-mode-map "V")
(push (seen "V") seens)
(on "add a")
(press konix/agent-shell-workspace-mode-map "d")
(press konix/agent-shell-workspace-diff-mode-map "t")
(push (seen "d, t on a") seens)
(on "add b")
(press konix/agent-shell-workspace-mode-map "d")
(goto-char (point-min))
(re-search-forward "^\\+b$")
(press konix/agent-shell-workspace-diff-mode-map "M-RET")
(push (seen (format "d, M-RET on b, told %d" told)) seens)
(setq remark (on "Name it after"))
(konix/mcp-server-set-workspace-state remark "work")
(push (seen "the writer takes it up") seens)
(funcall git "checkout" "-q" "main")
(funcall commit "m" "m\n")
(funcall git "checkout" "-q" "topic")
(funcall git "rebase" "-q" "main")
(funcall commit "b" "b, named after what it holds\n" "--amend")
(konix/mcp-server-set-workspace-question
"Named after what it holds: is add b right now?"
"[\"what :: add b holds its new name, a left as it was\"]"
nil nil nil nil "refine" remark)
(push (seen "the writer rewrites") seens)
(switch-to-buffer workspace)
(press konix/agent-shell-workspace-mode-map "V")
(push (seen "V again") seens)
(on "Named after")
(press konix/agent-shell-workspace-mode-map "t")
(on "add b")
(press konix/agent-shell-workspace-mode-map "d")
(press konix/agent-shell-workspace-diff-mode-map "t")
(push (seen "t, d, t") seens)
(nreverse seens)))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(let ((kill-buffer-query-functions nil))
(dolist (name '("a" "b" "m" "base"))
(when-let* ((visiting (find-buffer-visiting (expand-file-name name work))))
(kill-buffer visiting)))
(when (get-buffer konix/agent-shell-workspace-diff-buffer)
(kill-buffer konix/agent-shell-workspace-diff-buffer))
(kill-buffer writer))
(delete-directory top t)))
- what
- the check above is right when it reads
add asettled fromd,add bthe writer’s while the remark is,add astill settled and oneadd basked afterVagain, and nothingyouon the last row.
when it goes astray
- what
- a question asks the user something that makes no sense.
- what
- the user takes the question away and stops the writer where it stands.
- why: the writer has gone astray.
- what
- it comes back with the single next question, and waits for them.
the promise this story asserts
- what
- the promise is that the user can stop the writer the moment it goes astray, and it comes back at their pace.
- what
- done means the question gone and the writer stopped, in one keystroke.
- what
- what links the two is that a writer stopped in one keystroke goes no further astray.
- scope
- the keystroke holds the stopping, and that it comes back at the user’s pace rests on the writer doing as it is told.
- scope
- the story opens at the question that makes no sense, the answering that leads up to it being told in playing a review with it.
- what
- the story going green entails that a writer with only questions asking the user left has nothing to do, since breaking what it is left reddens the story at « it comes back ».
- what
kon the question the writer works on, while it runs a command, takes the question away and cuts that writer’s turn; the writer’s next question then asks the user, and the writer is left nothing.
(require 'cl-lib)
(let* ((file (make-temp-file "check-story-astray-" nil ".ws.org"))
(writer (generate-new-buffer " check-story-astray-writer"))
cuts told workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Rewrite the parser in COBOL?\n"
" :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: every file in COBOL\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer &optional text now) (push (list text now) told) t))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--go-on-soon) #'ignore)
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'agent-shell--state)
(lambda ()
(copy-tree '((:tool-calls . (("t1" . ((:title . "make cobol")
(:status . "in_progress")))))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event &allow-other-keys) (list event))))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (push (buffer-name) cuts)))
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
(lambda (&rest _) 0))
((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
(setq workspace (find-file-noselect file))
(with-current-buffer workspace
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer))
(cl-flet ((seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(let ((asking (konix/agent-shell-workspace--asking-here)))
(cons
step
(or (delq nil
(org-map-entries
(lambda ()
(when-let* ((state (org-get-todo-state)))
(format "%s %s %s"
(if (member (org-entry-get nil "ID")
asking)
"you" "writer")
state
(org-get-heading t t t t))))))
(list "no question")))))))))
(save-window-excursion
(let (seens)
(switch-to-buffer workspace)
(push (seen "astray") seens)
(widen)
(goto-char (point-min))
(re-search-forward "COBOL")
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "k"))
(push (seen (format "k: writer cut %s, told %d"
(equal cuts (list (buffer-name writer)))
(length told)))
seens)
(konix/mcp-server-set-workspace-question
"Which parser should I rewrite, and in what?"
"[\"what :: the parser I was on makes no sense to you\"]"
nil nil nil nil "refine")
(push (seen (format "it comes back, left nothing %s, cut %d"
(konix/agent-shell-workspace--writer-done-p file)
(length cuts)))
seens)
(nreverse seens)))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when
kleaves no question and the writer cut once,cut t, then its one new question isyou, the writer left nothing:left nothing t, cut 1.
raising a subject of the user’s own
- what
- the user wants a subject worked on, and no question of the writer’s touches it.
- what
- they type it as a subject, with what they have to say under it.
- what
- the writer takes it up and comes back to them on it.
the promise this story asserts
- what
- the promise is that what the user wants worked on gets in, whether or not the writer thought to ask.
- what
- done means the subject and its body sitting there for the writer, and the writer told there is something to read.
- what
- what links the two is that a subject in the file, the writer told, is work the writer has, asked for or not.
- scope
- what the keystroke holds is the subject landing and the telling; the taking up rests on the writer doing as it is told.
- scope
- the story opens on a workspace already in front of the user, the getting there being told in playing a review with it.
- what
M-RETbeside a question of the writer’s on another thing lands the subject and its body as the writer’s, the idle writer told with its words; taken up and answered, it asks the user.
(require 'cl-lib)
(let* ((file (make-temp-file "check-story-subject-" nil ".ws.org"))
(writer (generate-new-buffer " check-story-subject-writer"))
said workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Keep the cache an hour?\n"
" :PROPERTIES:\n :ID: c\n :END:\n"
" - what :: the cache lives a minute now\n"))
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--briefed t))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--install-steering) #'ignore)
((symbol-function 'konix/agent-shell--rate-limited-p) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'agent-shell--insert-to-shell-buffer)
(cl-function (lambda (&key shell-buffer text &allow-other-keys)
(push (cons shell-buffer text) said))))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore)
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "Make the log rotate daily"
"it fills the disk in a week"))))
(setq workspace (find-file-noselect file))
(with-current-buffer workspace
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer))
(cl-flet ((seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(let ((asking (konix/agent-shell-workspace--asking-here)))
(cons
step
(delq nil
(org-map-entries
(lambda ()
(when-let* ((state (org-get-todo-state)))
(format "%s %s %s"
(if (member (org-entry-get nil "ID") asking)
"you" "writer")
state
(org-get-heading t t t t))))))))))))
(subject-id ()
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*+ [A-Z]+ Make the log")
(org-entry-get (point) "ID"))))))
(save-window-excursion
(let (seens)
(switch-to-buffer workspace)
(goto-char (point-max))
(let ((this-command (lookup-key konix/agent-shell-workspace-mode-map
(kbd "M-RET"))))
(call-interactively this-command))
(push (seen
(format "M-RET: body %s, told the writer %s"
(with-current-buffer workspace
(save-restriction
(widen)
(and (string-search "it fills the disk in a week"
(buffer-string))
t)))
(and (equal (length said) 1)
(eq (car (car said)) writer)
(string-search "Make the log rotate daily"
(cdr (car said)))
t)))
seens)
(konix/mcp-server-set-workspace-state (subject-id) "work")
(push (seen "the writer takes it up") seens)
(konix/mcp-server-set-workspace-question
"Rotate the log daily, keeping seven days?"
"[\"what :: logrotate set daily, seven kept\"]"
nil nil nil nil "refine" (subject-id))
(push (seen "it comes back") seens)
(nreverse seens)))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when
M-RETreadsbody t, told the writer twith the subjectwriter DISCUSS, thenTHINKING, thenyou REFINEon its answer.
asking what a thing meant
- what
- a question names a thing the user does not know.
- what
- they send it back and ask what it was supposed to mean.
- what
- the question comes again, carrying a link to a fact that explains it.
- what
- they follow the link and read the fact.
the promise this story asserts
- what
- the promise is that a thing the user does not know is put within reach of the question that used it.
- what
- done means the link standing in the question and the fact standing behind it.
- what
- what links the two is that a link in the question puts the fact one keystroke from it.
- scope
- what the program holds is the fact standing there and the link reaching it; the writer answering that way rests on it doing as it is told.
- scope
- the story stops at the user’s reading, the answering that follows being told in playing a review with it.
- what
?hands the question back, the writer told; written again with a fact about it, it links the fact, andoon that link lands on the fact, its words shown.
(require 'cl-lib)
(require 'org-id)
(let* ((org-id-locations (make-hash-table :test #'equal))
(org-id-files nil)
(file (make-temp-file "check-story-meant-" nil ".ws.org"))
(writer (generate-new-buffer " check-story-meant-writer"))
(q (org-id-new))
said workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Put the parser in the arena?\n"
" :PROPERTIES:\n :ID: " q "\n :END:\n"
" - what :: it allocates a lot\n"))
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--briefed t))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--install-steering) #'ignore)
((symbol-function 'konix/agent-shell--rate-limited-p) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'agent-shell--insert-to-shell-buffer)
(cl-function (lambda (&key shell-buffer text &allow-other-keys)
(push (cons shell-buffer text) said))))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore)
((symbol-function 'agent-shell-unsubscribe) #'ignore))
(setq workspace (find-file-noselect file))
(with-current-buffer workspace
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer))
(cl-flet ((seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(let ((asking (konix/agent-shell-workspace--asking-here)))
(cons
step
(delq nil
(org-map-entries
(lambda ()
(let ((id (org-entry-get nil "ID")))
(cond
((konix/agent-shell-workspace--fact-at-point-p)
(format "fact %s" (org-get-heading t t t t)))
((org-get-todo-state)
(format "%s %s %s%s"
(if (member id asking) "you" "writer")
(org-get-todo-state)
(org-get-heading t t t t)
(if (save-excursion
(re-search-forward
"^ +- link :: \\[\\[id:"
(save-excursion
(outline-next-heading) (point))
t))
", links a fact" ""))))))))))))))
(on (regexp)
(switch-to-buffer workspace)
(widen)
(org-fold-show-all)
(goto-char (point-min))
(re-search-forward regexp nil t)))
(save-window-excursion
(let (seens)
(on "Put the parser in the arena")
(let ((this-command (lookup-key konix/agent-shell-workspace-mode-map "?")))
(call-interactively this-command))
(push (seen (format "?: told the writer %s"
(and (equal (length said) 1)
(eq (car (car said)) writer)
t)))
seens)
(konix/mcp-server-set-workspace-fact
"The arena frees its objects in one go"
"[\"what :: objects allocated together, freed together\"]" nil q)
(konix/mcp-server-set-workspace-question
"Put the parser in the arena, freeing it in one go?"
"[\"what :: it allocates a lot\"]"
nil nil nil nil "refine" q)
(push (seen "it comes again") seens)
(push (list (if (not (and (on "^\\*+ [A-Z]+ Put the parser")
(re-search-forward
"^ +- link :: \\[\\["
(save-excursion (outline-next-heading) (point))
t)))
"o: no link to follow"
(call-interactively
(lookup-key konix/agent-shell-workspace-mode-map "o"))
(format "o: on %s, words shown %s"
(org-get-heading t t t t)
(save-excursion
(and (search-forward "freed together" nil t)
(not (invisible-p (point))))))))
seens)
(nreverse seens)))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when
?readstold the writer twith the question the writer’s, it comes againyou REFINE … links a fact, andolands on the fact,words shown t.
clearing out what has been settled
- what
- the user clears the settled questions out of the workspace, one at a time or
all at once with
K. - what
- a fact those questions pointed at is left with no question reaching it.
- what
Ksweeps it away with them, bar a fact the user pinned withp.
the promise this story asserts
- what
- the promise is that no fact stays in the workspace once it helps resolve no
question, bar one the user chose to keep.
- why: a fact that helps resolve no question is useless.
- what
- done means the workspace holding the questions the user still has and the facts they still need.
- what
- what links the two is that a workspace holding only what is still needed holds no useless fact.
- scope
- what the program holds is the sweep taking every fact no question reaches, the pinned ones left, and a fact being the user’s alone to drop.
- what
- a settled question dropped with
kleaves its fact unreached;ppins another;Ktakes the settled, the unreached fact, keeps the pinned and the one an open question reaches, asking nothing.
(require 'cl-lib)
(require 'org-id)
(let* ((org-id-locations (make-hash-table :test #'equal))
(org-id-files nil)
(file (make-temp-file "check-story-clear-out-" nil ".ws.org"))
(writer (generate-new-buffer " check-story-clear-out-writer"))
(ids (list (org-id-new) (org-id-new) (org-id-new)))
workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** DONE Keep the cache an hour?\n"
" :PROPERTIES:\n :ID: " (nth 0 ids) "\n :END:\n"
"** DONE Rotate the log daily?\n"
" :PROPERTIES:\n :ID: " (nth 1 ids) "\n :END:\n"
"** REFINE Put the parser in the arena?\n"
" :PROPERTIES:\n :ID: " (nth 2 ids) "\n :END:\n"))
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--briefed t))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore)
((symbol-function 'y-or-n-p) (lambda (&rest _) (error "Asked"))))
(cl-loop for id in ids
for label in '("The cache lived a minute" "The log filled the disk"
"The arena frees in one go")
do (konix/mcp-server-set-workspace-fact
label "[\"what :: found\"]" nil id))
(setq workspace (find-file-noselect file))
(with-current-buffer workspace
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer))
(cl-flet ((seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(cons
step
(delq nil
(org-map-entries
(lambda ()
(cond
((konix/agent-shell-workspace--fact-at-point-p)
(format "fact %s%s" (org-get-heading t t t t)
(if (konix/agent-shell-workspace--pinned-p)
", pinned" "")))
((org-get-todo-state)
(format "%s %s" (org-get-todo-state)
(org-get-heading t t t t))))))))))))
(on (regexp)
(switch-to-buffer workspace)
(widen)
(org-fold-show-all)
(goto-char (point-min))
(re-search-forward regexp)
(beginning-of-line)))
(save-window-excursion
(let (seens)
(push (seen "the facts written") seens)
(on "^\\*+ DONE Keep the cache")
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "k"))
(push (seen "k on one settled") seens)
(on "^\\*+ The log filled")
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "p"))
(push (seen "p") seens)
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "K"))
(push (seen "K") seens)
(nreverse seens)))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when
ktakes the one settled question alone, its fact staying, and theKrow holds the pinned fact, the reached one and the open question.
seeing which one it is on
- what
- the writer takes a question and puts it in
WORKING. - what
- the user sees which one it is.
the promise this story asserts
- what
- the promise is that the workspace shows which question the writer is on.
- what
- done means one question standing in
WORKINGand the rest not. - what
- what links the two is that the one question in
WORKINGis the one it is on. - scope
- what the program holds is one question there at a time, and every other tool refused while none is.
- what
- a writer holding none is refused a command; taking one up puts it alone in
WORKING, its writer named after it, and the command goes; a second taken up leaves one.
(require 'cl-lib)
(let* ((file (make-temp-file "check-story-which-one-" nil ".ws.org"))
(writer (generate-new-buffer " check-story-which-one-writer"))
(ids (list (org-id-new) (org-id-new)))
(command '((:title . "ls") (:kind . "execute")))
labels workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Fix the tilt?\n"
" :PROPERTIES:\n :ID: " (nth 0 ids) "\n :END:\n"
"** TODO Level the floor?\n"
" :PROPERTIES:\n :ID: " (nth 1 ids) "\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'konix/agent-shell--rename-with-label)
(lambda (_shell label) (push label labels)))
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore))
(setq workspace (find-file-noselect file))
(cl-flet ((seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(cons
step
(delq nil
(org-map-entries
(lambda ()
(when-let* ((state (org-get-todo-state)))
(format "%s %s" state
(org-get-heading t t t t)))))))))))
(ls ()
(with-current-buffer writer
(if (funcall (cdr (assoc "workspace-nothing-taken-up"
konix/agent-shell-tool-evaluators))
command)
"refused" "let through")))
(work (id)
(with-current-buffer writer
(prog1 (condition-case err
(progn (konix/mcp-server-set-workspace-state id "work")
"taken")
(error (error-message-string err)))
(setq-local konix/agent-shell-workspace--taking-up nil)))))
(let (seens)
(push (seen (format "holding none: ls %s" (ls))) seens)
(let ((taken (work (nth 0 ids))))
(push (seen (format "work on the first: %s, named %s, ls %s"
taken (car labels) (ls)))
seens))
(let ((taken (work (nth 1 ids))))
(push (seen (format "work on the second: %s, named %s"
(if (string= taken "taken") taken "refused")
(car labels)))
seens))
(nreverse seens))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when
lsis refused holding none and let through once one isWORKING, the writer named after it, and the second taken up is refused.
keeping the work aimed
- what
- the user sets a project with
w, saying what the work is for. - what
- each question the writer writes names the projects it moves forward, on its « for » line.
- what
- the questions run out with the project not reached, and the writer is told
to plan the next steps toward it, again whenever it is idle.
- why: letting the writer stop is a bad idea.
- what
- meanwhile the user sets a second project with
w, and the writer proposes its done and doing; while that waits on the user, the writer is handed the first project’s question. - what
- the writer holds the project done and says why; the user agrees with
y, and it is settled. - what
- only the second project’s proposal left, waiting on the user, the writer is left nothing.
the promise this story asserts
- what
- the promise is that the work neither drifts from a project the user set nor stops short of it.
- what
- done means every question the writer writes naming the project it is for, and a project with nothing in motion getting a plan or being said done.
- what
- and a project whose done and doing wait on the user stops no other: the writer is handed the others’ questions, and left nothing once only that wait is left.
- what
- what links the two is that a project always has something in motion toward it, or is said done.
- what
- the story going green entails that a project waiting on its DoD does not stop the writer, since setting every question aside while one waits reddens it at « g while its DoD waits », and leaving the writer something reddens its last row.
- scope
- what the program holds is the « for » line asked of every new question and the writer told to plan every time it is idle; that it plans, and well, rests on the writer.
- what
wsets a project, the writer told to propose its done and doing;yagrees; a question naming no project is refused; a second set, its proposal waiting, the first’s question is handed on; settled, the writer is told to plan; said done,ysettles the project, and with only the proposal left the writer is told nothing.
(require 'cl-lib)
(let* ((file (make-temp-file "check-story-aimed-" nil ".ws.org"))
(writer (generate-new-buffer " check-story-aimed-writer"))
(run-at-time (symbol-function 'run-at-time))
(projects (list "Ship the parser" "Write the docs"))
said soon workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"))
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--briefed t))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--install-steering) #'ignore)
((symbol-function 'konix/agent-shell--rate-limited-p) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'agent-shell--insert-to-shell-buffer)
(cl-function (lambda (&key shell-buffer text &allow-other-keys)
(push (cons shell-buffer text) said))))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore)
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'read-from-minibuffer)
(lambda (&rest _) (pop projects)))
((symbol-function 'y-or-n-p) (lambda (&rest _) (error "Asked")))
((symbol-function 'run-at-time)
(lambda (time repeat function &rest args)
(if (and (equal time 0) (null repeat))
(progn (push (cons function args) soon) nil)
(apply run-at-time time repeat function args)))))
(setq workspace (find-file-noselect file))
(with-current-buffer workspace
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer))
(cl-flet* ((seen (step)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(cons
step
(delq nil
(org-map-entries
(lambda ()
(when-let* ((state (org-get-todo-state)))
(format "%s %s%s" state (org-get-heading t t t t)
(if (save-excursion
(re-search-forward
"^ +- for :: \\[\\[id:"
(save-excursion
(outline-next-heading) (point))
t))
", for the project" "")))))))))))
(told (regexp)
(prog1 (format "told %s"
(and said (eq (car (car said)) writer)
(string-match-p regexp (cdr (car said)))
t))
(setq said nil)))
(id-of (regexp)
(with-current-buffer workspace
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward regexp)
(org-entry-get (point) "ID")))))
(press (regexp key)
(switch-to-buffer workspace)
(widen)
(org-fold-show-all)
(goto-char (point-min))
(re-search-forward regexp)
(beginning-of-line)
(call-interactively
(lookup-key konix/agent-shell-workspace-mode-map key))))
(save-window-excursion
(let (seens)
(switch-to-buffer workspace)
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "w"))
(push (seen (concat "w: " (told "workspace_project_define"))) seens)
(konix/mcp-server-workspace-project-define
(id-of "^\\*+ [A-Z]+ Ship the parser")
"[\"done :: it parses the corpus\", \"doing :: write the parser\"]")
(press "DoD: « Ship the parser »" "y")
(push (seen (format "the writer proposes, y: done and doing %s"
(with-current-buffer workspace
(save-restriction
(widen)
(and (konix/agent-shell-workspace--project-defined-p
(id-of "^\\*+ [A-Z]+ Ship the parser"))
t)))))
seens)
(let ((refused (condition-case err
(progn (konix/mcp-server-set-workspace-question
"Tidy the docs?" "[\"what :: they drift\"]")
"written")
(error "refused"))))
(konix/mcp-server-set-workspace-question
"Write the lexer?" "[\"what :: tokens first\"]"
nil nil nil nil nil nil nil nil
(id-of "^\\*+ [A-Z]+ Ship the parser"))
(push (seen (format "a question naming none: %s; naming it" refused))
seens))
(setq said nil)
(switch-to-buffer workspace)
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "w"))
(push (seen (concat "w, a second: " (told "workspace_project_define"))) seens)
(konix/mcp-server-workspace-project-define
(id-of "^\\*+ [A-Z]+ Write the docs")
"[\"done :: the docs say how\", \"doing :: write them\"]")
(press "^\\*+ [A-Z]+ Write the lexer" "g")
(setq said nil)
(with-current-buffer writer
(konix/agent-shell-workspace--turn-ended-as-ever
'((:data . ((:stop-reason . "end_turn")))) nil))
(push (seen (concat "g while its DoD waits, the turn ends: " (told "")))
seens)
(let ((lexer (id-of "^\\*+ [A-Z]+ Write the lexer")))
(konix/mcp-server-set-workspace-state lexer "work")
(konix/mcp-server-set-workspace-question
"Wrote the lexer" "[\"proof :: it reads every token of the corpus\"]"
nil nil nil nil "close" lexer))
(setq said nil soon nil)
(press "TOCHECK Wrote the lexer" "y")
(dolist (call (reverse soon)) (apply (car call) (cdr call)))
(push (seen (concat "y on its closing: " (told "set_workspace_plan")))
seens)
(with-current-buffer writer
(konix/agent-shell-workspace--turn-ended-as-ever
'((:data . ((:stop-reason . "end_turn")))) nil))
(push (seen (concat "its turn ends idle: " (told "set_workspace_plan")))
seens)
(konix/mcp-server-workspace-project-done
(id-of "^\\*+ [A-Z]+ Ship the parser")
"[\"what :: the corpus parses whole\"]")
(press "Is the project « Ship the parser » done" "y")
(push (seen "said done, y") seens)
(setq said nil)
(with-current-buffer writer
(konix/agent-shell-workspace--turn-ended-as-ever
'((:data . ((:stop-reason . "end_turn")))) nil))
(push (seen (concat "only its DoD left, the turn ends: " (told "")))
seens)
(nreverse seens)))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when every
toldreadstbut the last, which readsnil, the project has its done and doing, the question naming none isrefused, and the last row holdsDONE Ship the parserand the docs’ proposal still waiting.
the shape of a workspace
- what
- the writer puts two kinds of heading in it — a question, which asks the user
something, and a fact, which carries no state and no question mark.
- why: a writer left to its own devices writes findings for the user — three paragraphs telling them what the code does, which they already know, and which ask them nothing.
a heading: what it may hold, and how it is reached
- rule
- a heading is one line with something on it, whichever kind it is.
-
rule: and a question that does not end in a question mark is refused.
- scope: bar a review question, which
Vwrites, itsReviewpart doing the asking (what a review question looks like). - scope: bar a closed one, which is a claim of what was done, and refused if it
ends in a question mark.
- why: it asks nothing: closing a question, the writer was tacking « settle? » on a claim.
- scope: bar a review question, which
-
rule: and a question asking for an action is worded as that action, verb then object, « Fix the tilt, Go? »: one opening on « Shall I », « Should I », « Can I », « May I » or « Do you want me to » is refused.
- why: « Shall I » is just noise.
-
what: a question opening on each of the five is refused, nothing written, the refusal showing it as the action alone; worded as the action, it is written.
-
(require 'cl-lib)
(let ((file (make-temp-file "check-shall-" nil ".ws.org"))
(writer (generate-new-buffer " check-shall-writer")))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore))
(with-current-buffer writer
(list (mapcar
(lambda (opening)
(condition-case err
(progn (konix/mcp-server-set-workspace-question
(concat opening " fix the tilt?") "[\"what :: it tilts\"]")
'written)
(error (if (string-match-p "« Fix the tilt\\? »"
(error-message-string err))
'refused-showing-the-action
(error-message-string err)))))
'("Shall I" "Should I" "Can I" "May I" "Do you want me to"))
(progn (konix/mcp-server-set-workspace-question
"Fix the tilt?" "[\"what :: it tilts\"]")
'written)
(with-temp-buffer (insert-file-contents file)
(how-many "fix the tilt\\?" (point-min) (point-max))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
refused-showing-the-actionfive times, thenwritten 1. - rule
- nor does anything else the writer sends run past one line, so nothing it
writes opens a heading of its own.
- why: a writer can never start working on a question the user has not explicitly approved, and a heading slipped in that way would be one.
- rule
- a body is bullets in the note’s own grammar, never prose, whichever it is.
- rule: it has three hundred characters to spend, its bullets and its places’ captions
counted together, and no bullet may pass a hundred and twenty.
- why: given room, a writer fills it with padding, so the whole body shares one small budget.
- rule: and every refusal for length says what the limits are for: finding what
matters, saying it shorter, going to the point, and what will not go in them
being, as a rule, not worth reading.
- why: told only the number, the writer shortens words and keeps the padding, or shaves the one thing that carried information.
- rule: it has three hundred characters to spend, its bullets and its places’ captions
counted together, and no bullet may pass a hundred and twenty.
- rule
- and a heading rendered past eighty lines is refused, code shown counted in.
(defconst konix/agent-shell-workspace-limits-said
(concat "These limits are what make you find what matters: one thing to a bullet,"
" and only what the user has to know. Find shorter ways to say things, go"
" to the point, do not linger. Drop what carries nothing rather than"
" trimming what does. What will not go into them is, as a rule, not worth"
" their reading.")
"What a writer is told about the limits, whenever its words run past them.")
(defconst konix/agent-shell-workspace-bullet-max 120
"Longest bullet a question may carry.")
(defconst konix/agent-shell-workspace-body-max 300
"Longest body a question may carry, bullets and place captions together.")
(defconst konix/agent-shell-workspace-lines-max 80
"Most lines a rendered question may take, code shown included.")
(defconst konix/agent-shell-workspace-heading-max 120
"Longest heading the writer may word.")
(defvar konix/agent-shell-workspace--heading-ours nil
"Non-nil while a tool words the heading itself, which no limit counts.")
(defun konix/agent-shell-workspace--check-heading (heading)
"Refuse HEADING, worded by the writer, past its limit."
(when (and (not konix/agent-shell-workspace--heading-ours)
(> (length heading) konix/agent-shell-workspace-heading-max))
(konix/agent-shell-workspace--past-a-limit
"Heading" (length heading) konix/agent-shell-workspace-heading-max heading
"Say the claim or the ask alone; the why goes in a bullet.")))
(defun konix/agent-shell-workspace--past-a-limit (what length max heading and-then)
"Refuse WHAT, LENGTH long under HEADING, for passing MAX, saying AND-THEN last."
(error "%s of %d chars under \"%s\", max %d. %s %s"
what length heading max
konix/agent-shell-workspace-limits-said and-then))
(defun konix/agent-shell-workspace--no-longer-than (heading rendered)
"Refuse RENDERED, what HEADING comes to, for taking too many lines."
(let ((lines (1+ (cl-count ?\n rendered))))
(when (> lines konix/agent-shell-workspace-lines-max)
(error "\"%s\" comes to %d lines, max %d. %s Point at fewer places."
heading lines konix/agent-shell-workspace-lines-max
konix/agent-shell-workspace-limits-said))))
a body read and checked
- how
- a body reaches a tool as one string of JSON, since that is all MCP carries, and is read back into bullets before anything is asked of it.
(defun konix/mcp-server-decode-json-list (value)
"Parse VALUE into a list.
A lone object, or a string that is not JSON at all, yields a one-element list."
(cond
((null value) nil)
((not (stringp value)) (append value nil))
(t
(let ((parsed (condition-case nil
(json-parse-string value
:object-type 'alist
:array-type 'list)
(json-parse-error (list value)))))
(if (and (consp (car parsed)) (not (consp (car (car parsed)))))
(list parsed)
parsed)))))
(defun konix/agent-shell-workspace--bullets (note)
"Return NOTE, a question's body, as a list of bullets."
(konix/mcp-server-decode-json-list note))
- how
- a body is refused unless every bullet opens on an intention word of the
vocabulary, each bullet within its bound.
- scope: what a question is for is its « for » line, written by the tool, never a bullet of the writer’s.
- scope: and two words of the workspace’s own join it,
doneanddoing, in which the writer proposes what a project’s done means and what its doing looks like.
- what
- a bullet opening on
doneordoingpasses.
(mapcar (lambda (bullet)
(condition-case err
(progn (konix/agent-shell-workspace--check-bullet "h" bullet) 'passes)
(error (error-message-string err))))
'("done :: it works" "doing :: try it"))
- what
- the check above is right when it reads
(passes passes). - rule
- a bullet refused names the intention words it may open on.
- why: refused with no word of what is allowed, the writer guesses again.
- what :: a bullet with no «
- » and one with an unknown word are both refused naming
whatandproofamong the words allowed.
(mapcar (lambda (bullet)
(condition-case err
(progn (konix/agent-shell-workspace--check-bullet "h" bullet) 'passes)
(error (let ((said (error-message-string err)))
(and (string-search "one of: " said)
(string-search "what" said)
(string-search "proof" said)
t)))))
'("gated taking up" "gated :: taking up"))
- what
- the check above is right when it reads
(t t).
(defconst konix/agent-shell-workspace-intention-words
'(("done" . "what a project's done means")
("doing" . "what a project's doing looks like")
("proof" . "how the writer knows the work it closes is done and tested"))
"Intention words a workspace body takes beyond the notes' own.")
(defun konix/agent-shell-workspace--check-bullet (heading bullet)
"Refuse BULLET under HEADING unless it is a short « intention :: text »."
(when (> (length bullet) konix/agent-shell-workspace-bullet-max)
(konix/agent-shell-workspace--past-a-limit
"Bullet" (length bullet) konix/agent-shell-workspace-bullet-max heading
(format "Here: %s" bullet)))
(let ((words (append konix/note-intention-words
konix/agent-shell-workspace-intention-words)))
(unless (string-match "\\`\\([^ ].*?\\) :: .+\\'" bullet)
(error "Bullet under \"%s\" is not « intention :: text », intention one of: %s: %s"
heading (mapconcat #'car words ", ") bullet))
(unless (assoc (match-string 1 bullet) words)
(error "Unknown intention \"%s\" under \"%s\" — one of: %s"
(match-string 1 bullet) heading
(mapconcat #'car words ", ")))))
- how
- and the body as a whole: each bullet, each caption one line and as short, and their sum.
(defun konix/agent-shell-workspace--check-body (heading bullets captions)
"Refuse a question's BULLETS and CAPTIONS under HEADING unless they stay short."
(dolist (bullet bullets)
(konix/agent-shell-workspace--check-bullet heading bullet))
(dolist (caption captions)
(when (string-match-p "\n" caption)
(error "A caption is one line, or it opens a heading of its own: %S" caption))
(when (> (length caption) konix/agent-shell-workspace-bullet-max)
(konix/agent-shell-workspace--past-a-limit
"Caption" (length caption) konix/agent-shell-workspace-bullet-max heading
(format "Here: %s" caption))))
(let ((total (apply #'+ 0 (mapcar #'length (append bullets captions)))))
(when (> total konix/agent-shell-workspace-body-max)
(konix/agent-shell-workspace--past-a-limit
"Body" total konix/agent-shell-workspace-body-max heading
(concat "Drop a bullet rather than an address: places and web addresses go"
" in their own fields, which count against nothing")))))
addressing a heading
- rule
- the level a question stands at is said in one place, and every reading or
writing of a question’s or an answer’s heading takes it from there.
- why: the questions stand a level down, under the part headings, so that hiding them is narrowing to one root heading.
- how: an answer stands one level below its question.
(defconst konix/agent-shell-workspace-question-level 2
"Level a question's heading stands at; its answers stand one below.")
(defun konix/agent-shell-workspace--stars (&optional deeper)
"Stars opening a heading DEEPER levels below a question's."
(make-string (+ konix/agent-shell-workspace-question-level (or deeper 0)) ?*))
(defun konix/agent-shell-workspace--heading-re (&optional deeper)
"Regexp of a heading's start DEEPER levels below a question's."
(concat "^" (regexp-quote (konix/agent-shell-workspace--stars deeper)) " "))
- how
- how far a heading runs is found by one search — for the next heading shallow
enough to end it — made at two depths.
- what: a question or a fact runs on to the next of its own depth, taking the answers under it with it, and an answer runs only as far as whatever heading comes next.
- why: two searches of their own drift apart, and one reading too far takes a question’s answers for its own.
- therefore: the depth is said out loud at each of the two, and a third reading would say its own rather than write another search.
(defun konix/agent-shell-workspace--ends-at (depth)
"Return where what point stands in ends: the next heading no deeper than DEPTH."
(save-excursion
(unless (org-before-first-heading-p)
(org-back-to-heading t))
(end-of-line)
(let ((case-fold-search nil))
(if (re-search-forward (format "^\\*\\{1,%d\\}[ \t]" depth) nil t)
(line-beginning-position)
(point-max)))))
(defun konix/agent-shell-workspace--question-end ()
"Return where the question or fact containing point ends.
A question ends at the next heading of its own level, anything else at the next top one."
(konix/agent-shell-workspace--ends-at
(save-excursion
(unless (org-before-first-heading-p)
(org-back-to-heading t)
(while (and (> (org-current-level) konix/agent-shell-workspace-question-level)
(org-up-heading-safe))))
(if (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-question-level
1))))
(defun konix/agent-shell-workspace--answer-end ()
"Return where the answer containing point ends."
(konix/agent-shell-workspace--ends-at (1+ konix/agent-shell-workspace-question-level)))
- rule
- a call of the writer’s reaches a heading by its id, and by nothing else.
- rule: a call naming no id reaches no heading at all, and writes a new one.
- rule: and whose id it is, is org’s own reading of its property, not ours.
- why: the writer must not delete what is not done, and a rewrite reaches everything under the heading its id lands on.
- how: a property belongs to the heading it is drawn under.
- therefore: an id names one heading and never the one above it, whatever the depths around it.
(defun konix/agent-shell-workspace--goto-id (id)
"Move to the question, fact or answer whose id is ID, nil when there is none."
(when-let ((id id)
(heading (org-find-property "ID" id)))
(goto-char heading)
t))
- rule
- whichever line of a heading the user stands on, the keystroke acts on that
heading.
- rule: and standing on an answer, the heading it acts on is the question that answer sits under.
(defun konix/agent-shell-workspace--goto-heading ()
"Move to the heading point stands in, or to the first one when point is above them."
(when (org-before-first-heading-p)
(org-next-visible-heading 1))
(org-back-to-heading t))
(defun konix/agent-shell-workspace--goto-question ()
"Move to the question point stands in, from an answer under it or from itself."
(konix/agent-shell-workspace--goto-heading)
(when (and (equal (org-current-level) (1+ konix/agent-shell-workspace-question-level))
(not (konix/agent-shell-workspace--fact-at-point-p)))
(org-up-heading-safe)))
- what
- and what tells a fact from a question is the one thing a fact has not: a state to stand in.
(defun konix/agent-shell-workspace--state-at-point ()
"Return the keyword the question at point opens on, nil when it is no question."
(and (equal (org-current-level) konix/agent-shell-workspace-question-level)
(org-get-todo-state)))
(defun konix/agent-shell-workspace--fact-at-point-p ()
"Non-nil when the heading point is on is a fact rather than a question.
A fact stands under the facts heading; one standing at the top counts too."
(pcase (org-current-level)
(1 (not (or (org-get-todo-state)
(konix/agent-shell-workspace--memos-at-point-p)
(konix/agent-shell-workspace--facts-at-point-p)
(konix/agent-shell-workspace--part-at-point-p))))
(2 (save-excursion
(and (org-up-heading-safe)
(konix/agent-shell-workspace--facts-at-point-p))))))
- rule
- nor is the writer’s memos heading a fact,
though it stands in no state either.
- how: it wears a tag of its own, so it is told apart whatever the user renames it.
(defconst konix/agent-shell-workspace-memos-tag "memos"
"Tag the heading holding the writer's memos wears.")
(defun konix/agent-shell-workspace--memos-at-point-p ()
"Non-nil when the heading point is on holds the writer's memos."
(and (equal (org-current-level) 1)
(member konix/agent-shell-workspace-memos-tag (org-get-tags nil t))))
- rule
- nor is the heading the facts stand under a fact.
- how: it too wears a tag of its own.
(defconst konix/agent-shell-workspace-facts-tag "facts"
"Tag the heading holding the facts wears.")
(defun konix/agent-shell-workspace--facts-at-point-p ()
"Non-nil when the heading point is on holds the facts."
(and (equal (org-current-level) 1)
(member konix/agent-shell-workspace-facts-tag (org-get-tags nil t))))
- rule
- nor is a heading a part of the questions opens on a fact: the projects’, the
reviews’, the user’s, the writer’s, the later ones’, the settled ones'.
- how: each too wears a tag of its own.
(defconst konix/agent-shell-workspace-projects-part-tag "projects"
"Tag the heading the projects stand after wears.")
(defconst konix/agent-shell-workspace-reviews-part-tag "reviews"
"Tag the heading the review questions stand after wears.")
(defconst konix/agent-shell-workspace-mine-part-tag "mine"
"Tag the heading the user's part of the questions opens on wears.")
(defconst konix/agent-shell-workspace-writers-part-tag "writers"
"Tag the heading the writer's part of the questions opens on wears.")
(defconst konix/agent-shell-workspace-later-part-tag "later"
"Tag the heading the user's questions held back stand after wears.")
(defconst konix/agent-shell-workspace-done-part-tag "done"
"Tag the heading the settled questions stand after wears.")
(defun konix/agent-shell-workspace--part-at-point-p ()
"Non-nil when the heading point is on opens a part of the questions."
(and (equal (org-current-level) 1)
(seq-intersection (list konix/agent-shell-workspace-projects-part-tag
konix/agent-shell-workspace-reviews-part-tag
konix/agent-shell-workspace-mine-part-tag
konix/agent-shell-workspace-writers-part-tag
konix/agent-shell-workspace-later-part-tag
konix/agent-shell-workspace-done-part-tag)
(org-get-tags nil t))))
- rule
- and within it, the place the user is standing on is the one the keystroke acts on.
(defconst konix/agent-shell-workspace-link-regexp
"\\[\\[file\\(?:\\+emacs\\)?:\\([^]]+?\\)::\\([0-9]+\\)\\]"
"Regexp matching a location link of the workspace.")
(defun konix/agent-shell-workspace--link-on-line ()
"Return (FILE . LINE) for a location link on the current line, or nil."
(save-excursion
(beginning-of-line)
(when (re-search-forward konix/agent-shell-workspace-link-regexp
(line-end-position) t)
(cons (match-string 1) (string-to-number (match-string 2))))))
- rule
- failing a place on the line the user stands on, it is the heading’s first one.
(defun konix/agent-shell-workspace--location-at-point (&optional noerror)
"Return (FILE . LINE) for the place point is on.
NOERROR returns nil where the heading names no place at all."
(or (konix/agent-shell-workspace--link-on-line)
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(let ((limit (save-excursion (org-end-of-subtree t t))))
(if (re-search-forward konix/agent-shell-workspace-link-regexp
limit t)
(cons (match-string 1) (string-to-number (match-string 2)))
(unless noerror
(user-error "This heading carries no location")))))))
what a fact carries
- what
- it holds whatever the writer thinks the user may want to know.
- what: it is the user’s to read, not to answer.
- how: the writer writes and edits one with a tool of its own.
- rule: and only the user drops one.
- rule: one whose heading asks something, or opens on a state, is refused, and so is
a body past the limits.
- why: the user hopes the limits mitigate the chance of its being prose they never asked for.
(defun konix/agent-shell-workspace--render-fact (entry)
"Return ENTRY as one Org fact, asking nothing and standing in no state."
(let* ((bullets (konix/agent-shell-workspace--bullets (alist-get 'note entry)))
(places (konix/agent-shell-workspace--places entry))
(addresses (konix/agent-shell-workspace--addresses entry))
(heading (string-trim
(or (alist-get 'label entry)
(error "A label is what the fact is called — there is none"))))
(id (or (alist-get 'id entry) (org-id-new))))
(konix/agent-shell-workspace--refuse-a-fact heading)
(konix/agent-shell-workspace--check-heading heading)
(konix/agent-shell-workspace--check-body
heading bullets (delq nil (mapcar #'caddr places)))
(konix/agent-shell-workspace--check-addresses heading addresses)
(konix/agent-shell-workspace--refuse-dangling heading (cons heading bullets))
(let ((fact (concat (format "** %s\n" heading)
" :PROPERTIES:\n :ID: " id "\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(mapconcat (lambda (bullet)
(concat " - " bullet "\n"))
bullets)
(konix/agent-shell-workspace--addresses-written addresses)
(konix/agent-shell-workspace--places-written places)
"\n")))
(konix/agent-shell-workspace--no-longer-than heading fact)
fact)))
- how
- its heading is checked before anything is written, and it is stamped as touched.
(defun konix/agent-shell-workspace--refuse-a-fact (heading)
"Refuse HEADING for a fact where it runs past a line, asks, or opens on a state."
(unless (string-match-p "\\`[^\n]+\\'" heading)
(error "A heading is one line with something on it: %S" heading))
(when (string-suffix-p "?" heading)
(error "A fact asks nothing, so its heading cannot end in a question mark: %s"
heading))
(when (member (car (split-string heading))
konix/agent-shell-workspace-keywords)
(error "A fact stands in no state, so its heading cannot open on a keyword: %s"
heading)))
- rule
- and a fact names places, as a question does, each a link to a file and line.
- why: a writer telling the user where something is needs somewhere to put the link, a « line 935 » in words being the one thing they will not follow.
- therefore: it has no question to invent to have somewhere to link from.
- how: each place comes with what stands there, its code or its picture, as the code comes to the user says.
(defun konix/agent-shell-workspace--places-written (places)
"Return PLACES as the lines of a heading, each with what stands there."
(mapconcat
(lambda (place)
(concat
(if (cadr place)
(format " - %s[[file+emacs:%s::%s][%s:%s]]\n"
(if (caddr place) (concat (caddr place) " : ") "")
(car place) (cadr place)
(file-name-nondirectory (car place))
(cadr place))
(format " - %s[[file+emacs:%s][%s]]\n"
(if (caddr place) (concat (caddr place) " : ") "")
(car place)
(file-name-nondirectory (car place))))
(or (konix/agent-shell-workspace--picture-text (car place))
(and (cadr place)
(konix/agent-shell-workspace--source-text
(car place) (cadr place)))
"")))
places))
- rule
- and a place may name a file with no line: the link opens the file, and no code
comes with it.
- why: given a file and no line, the fact was refused with « number-or-marker-p, nil ».
(mapcar (lambda (entry)
(condition-case err
(progn (konix/agent-shell-workspace--render-fact
(append '((label . "A fact") (note . "[\"what :: it\"]")) entry))
'written)
(error (error-message-string err))))
(list `((file . ,(expand-file-name "an_agent_shell_workspace.org"
"~/perso/perso/roam/")))
`((file . ,(expand-file-name "an_agent_shell_workspace.org"
"~/perso/perso/roam/"))
(line . 3)
(also . ,(format "[{\"file\": %S, \"line\": 4, \"says\": \"there\"}]"
(expand-file-name "an_agent_shell_workspace.org"
"~/perso/perso/roam/")))))))
- what
- the check above is right when it reads
(written written): a file with no line, then a file and line with a further place inalso.
writing a fact, and the question it reports on
- rule
- a fact names the question it reports on, which then links to it, and one
naming none is refused.
- why: the writer must be drawn to a fact rather than a question that asks nothing.
- therefore: reporting has a home: a fact about the question, reached by it, so it neither pads a question nor stands unreached.
- how
- the id decides: the fact it names is rewritten, a call naming none adds one, and an id naming nothing, or naming something that is not a fact, is refused.
- rule
- a fact is written under a folded heading of its own, made the first time, as
memos are.
- why: facts at the top pollute the workspace.
- how: a fact standing at the top goes under it the next time one is written.
(defun konix/agent-shell-workspace--put-fact (id fact)
"Write FACT in place of the fact ID names, or last under the facts heading.
Return non-nil where it was added."
(prog1 (if (konix/agent-shell-workspace--goto-id id)
(progn
(unless (konix/agent-shell-workspace--fact-at-point-p)
(error "%s is not a fact — use set_workspace_question for a question"
id))
(let ((top (equal (org-current-level) 1)))
(delete-region (point) (konix/agent-shell-workspace--fact-end))
(when top
(konix/agent-shell-workspace--goto-facts-end)))
nil)
(when id
(error "No heading %s in the workspace" id))
(konix/agent-shell-workspace--goto-facts-end)
t)
(insert fact)))
(defun konix/agent-shell-workspace--goto-facts ()
"Move to the facts heading, which every write makes."
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:" konix/agent-shell-workspace-facts-tag))
(beginning-of-line))
(defun konix/agent-shell-workspace--fact-end ()
"Return where the fact point is on ends, at whatever depth it stands."
(save-excursion (org-end-of-subtree t t) (point)))
(defun konix/agent-shell-workspace--goto-facts-end ()
"Move to where a fact is added: the end of the facts heading.
A fact standing at the top goes under it first."
(let ((old (konix/agent-shell-workspace--facts-at-the-top)))
(konix/agent-shell-workspace--goto-facts)
(org-end-of-subtree t t)
(unless (bolp) (insert "\n"))
(dolist (fact old)
(insert (replace-regexp-in-string "^\\*" "**" fact)))))
(defun konix/agent-shell-workspace--facts-at-the-top ()
"Take every fact standing at the top out, and return them as they were written."
(let (spans)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\* " nil t)
(beginning-of-line)
(when (konix/agent-shell-workspace--fact-at-point-p)
(push (cons (point) (konix/agent-shell-workspace--fact-end)) spans))
(end-of-line)))
(prog1 (mapcar (lambda (span) (buffer-substring (car span) (cdr span)))
(reverse spans))
(dolist (span spans)
(delete-region (car span) (cdr span))))))
- what
- with a question linking an old fact at the top, writing a new fact puts both
under Facts; a rewrite keeps one; the listing, the sweep,
pand deleting see them there.
(require 'cl-lib)
(let ((file (make-temp-file "check-facts-heading-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Kept?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: [[id:f1][Old]]\n"
"* Old\n :PROPERTIES:\n :ID: f1\n :END:\n"
"* Memos :memos:\n** A memo\n"))
(unwind-protect
(cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(let ((inhibit-read-only t))
(cl-flet ((headings ()
(let (found)
(org-map-entries
(lambda () (push (format "%d %s" (org-current-level)
(org-get-heading t t t t))
found)))
(nreverse found)))
(fact (name id)
(format "** %s\n :PROPERTIES:\n :ID: %s\n :END:\n"
name id)))
(list
(progn (konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--put-fact nil (fact "New" "f2")))
(headings))
(progn (konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--put-fact "f2" (fact "Newer" "f2")))
(headings))
(save-excursion
(konix/agent-shell-workspace--goto-facts)
(end-of-line)
(konix/agent-shell-workspace--fact-rows
(konix/agent-shell-workspace--question-end)))
(konix/agent-shell-workspace--unlinked-facts)
(save-excursion
(konix/agent-shell-workspace--goto-id "f2")
(konix/agent-shell-workspace--goto-question)
(org-entry-get (point) "ID"))
(progn (konix/agent-shell-workspace-delete-facts) (headings)))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("1 Memos" "2 A memo" "1 Facts" "2 Old" "2 New" "1 [0/0] Projects" "1 [0/0] Review" "1 [0/0] Mine" "1 [0/1] Writer's" "2 Kept?" "1 [0/0] Later" "1 [0/0] Done") (… "2 Old" "2 Newer" …) ("FACT f1 — Old" "FACT f2 — Newer") ("f2") "f2" (… "1 Facts" "1 [0/0] Projects" …)): each write sorts, and deleting leavesFactsempty. - how
- the tool renders the fact, writes it there, and links it to the question it names.
(defconst konix/agent-shell-workspace-fact-about-nothing-error
(concat "A fact reports on a question: pass about with the id of the one it"
" reports on, so that question links to it.")
"What a writer is told when its fact names no question it reports on.")
(defun konix/mcp-server-set-workspace-fact
(label &optional note id about file line says also url)
"Write one fact of the workspace, replacing the one ID names or adding it.
MCP Parameters:
label - What the fact is called, ending in no question mark and opening on no state
note - Optional JSON array of « intention :: text » bullets
id - Optional id of the fact to rewrite, as the listing tool gives it
about - Id of the question this reports on, which then links to it; required
file - Optional absolute path of a place this fact points at
line - Line in that file; about a review, a line of its new code shows the fact under it in the diff
says - Optional caption for the link itself
also - Optional JSON array of further {file, line, says} or {url, says}
url - Optional web address, written out whole and counting against no limit"
(mcp-server-lib-with-error-handling
(when (string-empty-p (string-trim (or about "")))
(error "%s" konix/agent-shell-workspace-fact-about-nothing-error))
(konix/agent-shell-workspace--refuse-unread-work)
(let* ((its-id (or id (org-id-new)))
(entry (list (cons 'label label) (cons 'note note) (cons 'id its-id)
(cons 'file file)
(cons 'line (if (stringp line) (string-to-number line) line))
(cons 'says says) (cons 'also also) (cons 'url url)))
added)
(konix/agent-shell-workspace--edit
(lambda ()
(setq added (konix/agent-shell-workspace--put-fact
id (konix/agent-shell-workspace--render-fact entry)))
(konix/agent-shell-workspace--link-both about its-id label)))
(if added
(format "Added the fact \"%s\"" label)
(format "Rewrote %s" id)))))
- how
- the link opens what is written under that question, the newest first, and
not a word else of it is touched.
- rule: and one already there for the same thing is rewritten where it stands, so a
fact written again is linked once, by the words it now carries.
- scope: there means the question’s own body: a line of the same in an answer
under it, the writer’s earlier wording kept there say, is no link of the
question’s.
- why: the question itself must link the fact, and not only what is said under it.
- scope: there means the question’s own body: a line of the same in an answer
under it, the writer’s earlier wording kept there say, is no link of the
question’s.
- rule: and one already there for the same thing is rewritten where it stands, so a
fact written again is linked once, by the words it now carries.
- what
- a question whose earlier wording, kept under it, already names the fact gets the link in its own body all the same.
(with-temp-buffer
(insert "* TODO the question\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: now\n"
"** - writer: before\n :PROPERTIES:\n :ID: w\n :END:\n"
" - what :: [[id:f][the fact]]\n"
"* the fact\n :PROPERTIES:\n :ID: f\n :END:\n")
(org-mode)
(konix/agent-shell-workspace--link-under "q" "f" "the fact")
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(if (re-search-backward "\\[\\[id:f\\]" nil t)
"the question links the fact"
"FAILED: the question does not link the fact"))
- what
- the check above is right when it reads
the question links the fact. - rule
- and the link line opens on « link », a word no bullet of the writer’s may
open on.
- rule: and one opening on « what » for the same fact is the same line.
(defconst konix/agent-shell-workspace-link-said "link"
"What a line linking a fact opens on, a word the writer's bullets may not.")
(defun konix/agent-shell-workspace--link-under (here there label &optional said)
"Put a link to THERE, called LABEL, under the heading HERE, changing nothing else.
SAID is the word the line opens on, « link » where none is given. A new one opens
what is written under HERE, and one saying the same of THERE already there is
rewritten where it stands rather than joined by a second: with no SAID, one opening
on « what » says the same."
(unless (konix/agent-shell-workspace--goto-id here)
(error "No heading %s in the workspace" here))
(let* ((limit (min (konix/agent-shell-workspace--question-end)
(save-excursion (outline-next-heading) (point))))
(already
(seq-some
(lambda (one)
(save-excursion
(when (re-search-forward
(konix/agent-shell-workspace--said-line-regexp one there)
limit t)
(cons (line-beginning-position)
(min (point-max) (1+ (line-end-position)))))))
(if said
(list said)
(list konix/agent-shell-workspace-link-said "what")))))
(when already
(delete-region (car already) (cdr already)))
(if already
(goto-char (car already))
(org-end-of-meta-data))
(insert (format " - %s :: [[id:%s][%s]]\n"
(or said konix/agent-shell-workspace-link-said) there label))))
- rule
- and the fact links back, so the pair is doubly linked.
- why: the user goes from a fact to the questions using it, and that wants no search, only the link written both ways.
- therefore: the user follows it either way, as
odoes, and nothing has to search.
(defun konix/agent-shell-workspace--link-both (question fact label)
"Link the QUESTION to the FACT called LABEL, and the fact back to the question."
(let ((heading (save-excursion
(when (and (konix/agent-shell-workspace--goto-id question)
(looking-at
(concat "^\\*+ +\\(?:[A-Z]+ +\\)?"
"\\(?:\\[#[A-Z]\\] +\\)?\\(.*\\)$")))
(string-trim (match-string 1))))))
(konix/agent-shell-workspace--link-under question fact label)
(when heading
(konix/agent-shell-workspace--link-under fact question heading))))
the writer’s memos
- what
- a memo is what the writer writes to remember, where a fact is what it tells
the user.
- why: writers put their logs in the user’s own work to remember them, which is no place for them.
- rule
- the memos stand under one heading of their own, made folded, the first time a
memo is written.
- why: the user reads them when they want, and they stay out of sight otherwise.
- rule
- the writer writes, rewrites and deletes one memo at a time, with a tool of its
own, under a fact’s limits.
- scope: the user reads, edits and deletes them as any heading.
- scope: nothing deleting facts touches them, nor does the sweep.
- how: a memo is called by its heading, which needs no question to report on.
(defun konix/agent-shell-workspace--goto-memos ()
"Move to the memos heading, which every write makes."
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:" konix/agent-shell-workspace-memos-tag))
(beginning-of-line))
(defun konix/agent-shell-workspace--render-memo (heading bullets id)
"Return the memo called HEADING, saying BULLETS, going by ID."
(unless (string-match-p "\\`[^\n]+\\'" heading)
(error "A heading is one line with something on it: %S" heading))
(konix/agent-shell-workspace--check-body heading bullets nil)
(concat (format "** %s\n" heading)
" :PROPERTIES:\n :ID: " id "\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(mapconcat (lambda (bullet) (concat " - " bullet "\n")) bullets)))
(defun konix/agent-shell-workspace--memo-span (id)
"Return (START . END) of the memo ID names, or nil where none does."
(save-excursion
(when (konix/agent-shell-workspace--goto-id id)
(unless (and (equal (org-current-level) 2)
(save-excursion (org-up-heading-safe)
(konix/agent-shell-workspace--memos-at-point-p)))
(error "%s is no memo" id))
(cons (point) (save-excursion (org-end-of-subtree t t) (point))))))
(defun konix/mcp-server-set-workspace-memo (label &optional note id drop)
"Write one memo of the writer's, replacing the one ID names, or delete it.
MCP Parameters:
label - What the memo is called, one line
note - JSON array of « intention :: text » bullets: what to remember
id - Optional id of the memo to rewrite or delete, as the listing gives it
drop - Optional \"true\" to delete the memo id names rather than write it"
(mcp-server-lib-with-error-handling
(let ((heading (string-trim (or label "")))
(bullets (konix/agent-shell-workspace--bullets note))
(its-id (or id (org-id-new)))
said)
(konix/agent-shell-workspace--edit
(lambda ()
(let ((span (and id (konix/agent-shell-workspace--memo-span id))))
(when (and id (not span))
(error "No memo %s in the workspace" id))
(if (equal drop "true")
(progn (unless span (error "Name the memo to delete by its id"))
(delete-region (car span) (cdr span))
(setq said (format "Deleted the memo %s" id)))
(let ((memo (konix/agent-shell-workspace--render-memo
heading bullets its-id)))
(if span
(progn (goto-char (car span))
(delete-region (car span) (cdr span)))
(konix/agent-shell-workspace--goto-memos)
(org-end-of-subtree t t)
(unless (bolp) (insert "\n")))
(insert memo)
(setq said (format (if span "Rewrote the memo %s" "Added the memo %s")
its-id)))))))
said)))
- rule
- and the writer retrieves them with a tool of their own: every one, or those
matching what it searches for, each with all it says.
- why: they are its memory, and a memory is to be read back, not only written.
- how: the search is a regexp, case aside, over each memo’s heading and body.
(defun konix/mcp-server-list-workspace-memos (&optional query)
"Return the writer's memos with all they say, or those QUERY matches.
MCP Parameters:
query - Optional regexp, case aside, a memo's heading or body must match"
(mcp-server-lib-with-error-handling
(let* ((file (konix/agent-shell-workspace--file-or-error))
(query (and query (not (string-empty-p (string-trim query))) query))
(rows (konix/agent-shell-workspace--read-file file
(save-excursion
(konix/agent-shell-workspace--memo-rows-in-buffer query)))))
(cond (rows (string-join rows "\n"))
(query (format "No memo matches %s" query))
(t "No memo written yet")))))
(defun konix/agent-shell-workspace--memo-rows-in-buffer (query)
"Return the rows of every memo of this buffer QUERY matches, with their bodies."
(goto-char (point-min))
(catch 'found
(while (re-search-forward "^\\* " nil t)
(beginning-of-line)
(when (konix/agent-shell-workspace--memos-at-point-p)
(end-of-line)
(throw 'found
(konix/agent-shell-workspace--memo-rows
(konix/agent-shell-workspace--question-end) t query)))
(end-of-line))))
- what
- a memo is added under a heading made for it, rewritten in place, deleted, listed with its body, and never taken for a fact.
(require 'cl-lib)
(require 'org-id)
(let ((file (make-temp-file "check-memos-" nil ".ws.org"))
(org-id-locations (make-hash-table :test #'equal))
(org-id-files nil))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO A question?\n :PROPERTIES:\n :ID: q\n :END:\n"
"* A fact\n :PROPERTIES:\n :ID: f\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore))
(let* ((added (konix/mcp-server-set-workspace-memo
"Where I am" "[\"what :: step one\"]"))
(id (car (last (split-string added)))))
(list
(and (string-prefix-p "Added the memo " added) t)
(and (string-prefix-p "Rewrote the memo "
(konix/mcp-server-set-workspace-memo
"Where I was" "[\"what :: step two\"]" id))
t)
(replace-regexp-in-string
"\n" "|" (replace-regexp-in-string
id "ID" (konix/agent-shell-workspace--listing file)))
(with-current-buffer (find-file-noselect file)
(length (konix/agent-shell-workspace--facts)))
(replace-regexp-in-string
"\n" "|" (replace-regexp-in-string
id "ID" (konix/mcp-server-list-workspace-memos "step T")))
(konix/mcp-server-list-workspace-memos "nowhere")
(and (string-prefix-p "Deleted the memo "
(konix/mcp-server-set-workspace-memo "x" nil id "true"))
t)
(replace-regexp-in-string
"\n" "|" (konix/agent-shell-workspace--listing file)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads: added, rewritten, the listing naming the memo by heading alone, one fact only, « step T » finding the memo with its body, « nowhere » nothing, then deleted and gone from the listing.
- rule
- a writer newly bound, or whose context
ForZcut, is shown every memo, each with all it says.- why: it is to remember with them, as with the facts it is nudged with.
- how:
Zhas the summary carry them word for word, ahead of the work line; the briefing, whichF’s handover rides, shows them after it. - scope: with no memo, none of them says a word of memos.
(defun konix/agent-shell-workspace--memos-said (file)
"Return the writer's memos in FILE, each with all it says, or nil with none."
(when-let* ((rows (and file (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(save-excursion
(konix/agent-shell-workspace--memo-rows-in-buffer nil))))))
(concat "Your memos, as they stand:\n" (string-join rows "\n"))))
- what
- a memo shows, with its body, in the briefing after the work line and in
Z’s/compactahead of it; with none, neither speaks of memos.
(require 'cl-lib)
(let ((file (make-temp-file "check-memos-told-" nil ".ws.org")) said)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"#+WORK: /x/the-work.org\n"
"* WORKING Fix the tilt?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING"))
((symbol-function 'konix/agent-shell-workspace--projects-in) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t))
((symbol-function 'konix/agent-shell-workspace--forget-session-grants)
#'ignore)
((symbol-function 'shell-maker-busy) #'ignore))
(let ((told (lambda ()
(list (with-temp-buffer
(konix/agent-shell-workspace--briefing-owed
(current-buffer) "A"))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--send-compact
(current-buffer))
(car said))))))
(let ((before (funcall told)))
(konix/mcp-server-set-workspace-memo "Where I am" "[\"what :: step one\"]")
(let ((after (funcall told))
(memo "MEMO \\S-+ — Where I am\n - what :: step one"))
(list (seq-every-p (lambda (text) (not (string-search "memo" text))) before)
(and (string-match-p (concat "read it first.\n\nYour memos, as they"
" stand:\n" memo "\n\nA\\'")
(car after))
'briefing-after-work)
(and (string-match-p (concat memo " End the summary on this")
(cadr after))
'compact-ahead-of-work))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(t briefing-after-work compact-ahead-of-work).
whose turn it is
- what
- a state is a keyword, and it says whose the next move is and nothing else.
TODO ──▸ WORKING ──▸ TOCHECK ──▸ DONE
writer writer the user nobody
│ ▴
▾ │ the run ends
AWAITING ◂── y ── PERM
nobody, while the user, when no rule
its run goes lets the run; n hands it back
TODO, WORKING ──▸ REFINE the writer asking the user
any state ──▸ DISCUSS the user answering it, DONE too
DISCUSS ──▸ REFINE the writer answering back
DISCUSS ──▸ THINKING ──▸ REFINE the writer taking it up to answer it
THINKING ──▸ DISCUSS the writer putting it down
any state ──g──▸ TODO the user's go
WORKING ──▸ TODO the writer putting it down
any state ──▸ MAYBE ──▸ DISCUSS the user's alone, both ways
- what
AWAITINGis one the writer set aside while a run Emacs goes on with for it.- what
DISCUSSis one still being worked out, the writer’s to answer.- why:
REFINEmeans it still has to be worked out, yet the user’s answer made itTODOand the writer set to work instead of answering. - rule: an answer of the user’s leaves it
DISCUSS, whatever it stood in,ytoo, andgis their go, making itTODO.- why: a yes that answers a question is not a yes to go ahead.
- rule: and a subject the user raises opens on
DISCUSS. - rule: the writer answers it by rewriting it, which hands it back as
REFINE, and never works on it. - therefore:
REFINEsays the user is to answer,DISCUSSthe writer, at a glance. - therefore: an answer ending in « ? » needs no mark of its own: it is a
DISCUSS.
- why:
- what
THINKINGis aDISCUSSthe writer took up to answer: held, as aWORKINGis, yet only to answer.- why: the writer answered a
DISCUSSfrom the nudge it remembered, and missed the answers the user gave after it. - rule: taking it up hands it whole, every answer under it read from the file then.
- rule: an answer of the user’s on it leaves it
THINKING, and is pushed into the writer’s turn at once, as on one it works on.- why: what the user adds often contradicts what came before, and the writer must know before it answers.
- scope:
gstill makes itTODO, the user’s go.
- rule:
refineis its way out;closeis refused it, and putting it down leaves itDISCUSS. - rule: while it is held, and only then, the writer may do what answering takes:
read, draw, ask buddies, write facts and memos, propose a rule merge.
- scope: a
DISCUSSnot taken up lets it read nothing.
- scope: a
- why: the writer answered a
- what
ron aREFINEor aTOCHECKleaves itDISCUSS,yon aREFINEtoo,gon one makes itTODO, and a subject the user raises opens onDISCUSS.
(require 'cl-lib)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE First?\n :PROPERTIES:\n :ID: a\n :END:\n"
" - what :: one\n"
"** REFINE Second?\n :PROPERTIES:\n :ID: b\n :END:\n"
" - what :: two\n"
"** TOCHECK Third?\n :PROPERTIES:\n :ID: c\n :END:\n"
" - proof :: three\n"
"** REFINE Fourth?\n :PROPERTIES:\n :ID: d\n :END:\n"
" - what :: four\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "what rule?" nil))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(cl-flet ((state-of (heading)
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*\\* \\([A-Z]+\\) " heading))
(match-string 1)))
(on (heading command)
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*\\* [A-Z]+ " heading)))
(funcall command)))
(on "First" #'konix/agent-shell-workspace-answer)
(on "Second" #'konix/agent-shell-workspace-answer-go)
(on "Third" #'konix/agent-shell-workspace-answer)
(on "Fourth" #'konix/agent-shell-workspace-answer-yes)
(goto-char (point-max))
(konix/agent-shell-workspace-add-subject "A subject of mine")
(prog1 (list (state-of "First") (state-of "Second") (state-of "Third")
(state-of "Fourth") (state-of "A subject of mine"))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))))
(delete-file file)))
- what
- the check above is right when it reads
("DISCUSS" "TODO" "DISCUSS" "DISCUSS" "DISCUSS"). - what
- the checks below run in one world: a workspace holding a single
DISCUSS, and a writer holding nothing.
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
- what
- and the same world once the writer took the
DISCUSSup, it beingTHINKING.
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk))))
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))
- what
- taking a
DISCUSSup frees nothing in that turn, and onceTHINKINGthe writer may still read, but not edit outside.agent-shell/tmp.
(require 'cl-lib)
(let ((in-world
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(setq-local konix/agent-shell-workspace--taking-up nil)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore))
(list (funcall judge
'((:title . "mcp__konix-emacs-workspace__set_workspace_state")
(:kind . "other")
(:raw-input . ((id . "q") (act . "work")))))
(progn (konix/mcp-server-set-workspace-state "q" "work")
(funcall judge '((:title . "Read /x/y.el") (:kind . "read"))))
(funcall judge '((:title . "Edit /x/y.el") (:kind . "edit")
(:raw-input . ((file_path . "/x/y.el")))))
konix/agent-shell-workspace--taking-up)))))
- what
- the check above is right when it reads
(let-through let-through refused nil): the taking up is one of the workspace’s own calls, let through as ever. - what
- an answer on a
THINKINGleaves it so and is told the writer at once;gon one makes itTODO.
(require 'cl-lib)
(mapcar
(lambda (key)
(let ((file (make-temp-file "check-thinkanswer-" nil ".ws.org")) now)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** THINKING Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--writer-done-p) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer _text at-once) (setq now at-once) t))
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "and the left one?" nil))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer (current-buffer))
(goto-char (point-min))
(re-search-forward "^\\*\\* THINKING")
(funcall key)
(prog1 (list (save-excursion
(goto-char (point-min))
(re-search-forward "^\\*\\* \\([A-Z]+\\) Explain")
(match-string 1))
(if now 'at-once 'later))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file))))
(list #'konix/agent-shell-workspace-answer #'konix/agent-shell-workspace-answer-go))
- what
- the check above is right when it reads
(("THINKING" at-once) ("TODO" at-once)), a go on the one held told at once, as on aWORKING. - what
- on a
THINKING, the writer may still read, search the web, and callreadonly_grep,readonly_function_source,readonly_library_source,readonly_variable_value,readonly_package_locationandreadonly_list_workspace_memos, no otherreadonly_tool but the buddies’ below.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(mapcar judge
'(((:title . "Read /tmp/x") (:kind . "read"))
((:title . "WebSearch hooks") (:kind . "fetch"))
((:title . "mcp__konix-files__readonly_grep") (:kind . "other"))
((:title . "mcp__konix-emacs-buffers__readonly_list_buffers")
(:kind . "other")))))))
- what
- the check above is right when it reads
(let-through let-through let-through refused), the last areadonly_tool not listed. - what
- on a
DISCUSSnot taken up, the same reads are refused.
(require 'cl-lib)
(let ((in-world
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(mapcar judge
'(((:title . "Read /tmp/x") (:kind . "read"))
((:title . "mcp__konix-files__readonly_grep") (:kind . "other")))))))
- what
- the check above is right when it reads
(refused refused). - what
- on a
THINKING, the writer may write a fact, and is told so.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(list (funcall judge
'((:title . "mcp__konix-emacs-workspace__set_workspace_fact")
(:kind . "other")))
(and (string-match-p "set_workspace_fact"
konix/agent-shell-workspace-discuss-said)
t)))))
- what
- the check above is right when it reads
(let-through t). - what
- on a
THINKING, the writer may ask other buddies and find who is or could be there, but not spawn one nor hand out a task.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(mapcar judge
'(((:title . "mcp__konix-coord__coord_ask_and_wait") (:kind . "other"))
((:title . "mcp__konix-coord__readonly_coord_list_buddies")
(:kind . "other"))
((:title . "mcp__konix-emacs-agents__readonly_list_potential_buddies")
(:kind . "other"))
((:title . "mcp__konix-emacs-agents__spawn_buddy") (:kind . "other"))
((:title . "mcp__konix-coord__coord_post_task") (:kind . "other")))))))
- what
- the check above is right when it reads
(let-through let-through let-through refused refused). - what
- on a
THINKING, the writer may write and draw with plantuml in.agent-shell/tmp, nowhere else.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(mapcar judge
'(((:title . "Edit /tmp/x") (:kind . "edit")
(:raw-input . ((file_path . "/tmp/x"))))
((:title . "Write") (:kind . "edit")
(:raw-input . ((file_path . "/r/.agent-shell/tmp/d.puml"))))
((:title . "plantuml") (:kind . "execute")
(:raw-input . ((command . "plantuml .agent-shell/tmp/d.puml")))))))))
- what
- the check above is right when it reads
(refused let-through let-through). - what
- the steering judges a call once it runs, its input whole, not while it is still
pending with its input empty or half streamed, whatever its kind; a call asking leave
is judged by the same test at its permission, its input whole there.
- why: the agent reports a call first with no input, then with partial input, and only then whole; judged early, a scratch write or a plantuml run reads as anything.
(require 'cl-lib)
(mapcar
(lambda (status)
(let ((shell (generate-new-buffer " check-pending-writer"))
told)
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event)
`(((:title . "Terminal") (:kind . "execute") (:status . ,status))
. "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'konix/agent-shell--interrupt-and-deliver)
(lambda (text &rest _) (setq told text) 'injected)))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--rounds 0)
(konix/agent-shell-steering--react '((:event . tool-call-update)))
(and told t)))
(kill-buffer shell))))
'("pending" "in_progress"))
- what
- the check above is right when it reads
(nil t). - what
- on a
THINKING, a call asking leave that is not one of these is refused before it runs, the writer told « this is a discussion, not work »; one of them is left to the other answers.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk))))))
(funcall in-world
(lambda ()
(mapcar
(lambda (tool-call)
(let (answered told)
(cl-letf (((symbol-function 'konix/agent-shell--interrupt-and-deliver)
(lambda (text &rest _) (setq told text))))
(list (konix/agent-shell-workspace--held-back-responder
`((:tool-call . ,tool-call)
(:options . [((:kind . "allow_once") (:option-id . "ok"))
((:kind . "reject_once") (:option-id . "no"))])
(:respond . ,(lambda (id) (setq answered id)))))
answered
(and told (string-match-p "A DISCUSS is to discuss" told) t)))))
'(((:title . "rm /x") (:kind . "execute") (:status . "pending")
(:raw-input . ((command . "rm /x"))))
((:title . "Read /x") (:kind . "read") (:status . "pending")))))))
- what
- the check above is right when it reads
((t "no" t) (nil nil nil)). - what
- and holding nothing with no question to discuss, a call asking leave is refused too, the writer told to take a question up first.
(require 'cl-lib)
(let ((file (make-temp-file "check-heldperm-" nil ".ws.org"))
(shell (generate-new-buffer " check-heldperm-writer"))
answered told)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Do it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell--interrupt-and-deliver)
(lambda (text &rest _) (setq told text))))
(with-current-buffer shell
(list (konix/agent-shell-workspace--held-back-responder
`((:tool-call . ((:title . "mkdir /x") (:kind . "execute")
(:raw-input . ((command . "mkdir /x")))))
(:options . [((:kind . "reject_once") (:option-id . "no"))])
(:respond . ,(lambda (id) (setq answered id)))))
answered
(and told (string-match-p "Take a question up" told) t))))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(t "no" t). - what
- each call judged leaves a
steeringline naming it and the verdict.
(require 'cl-lib)
(let ((in-world
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through)))
(konix/agent-shell-workspace-debug-log " check-steering-log"))
(unwind-protect
(progn
(funcall in-world
(lambda ()
(funcall judge '((:title . "Edit /tmp/x") (:kind . "edit")
(:status . "in_progress")
(:raw-input . ((file_path . "/tmp/x")))))))
(with-current-buffer konix/agent-shell-workspace-debug-log
(and (string-match-p "\\[steering\\] .*Edit /tmp/x (edit, in_progress).*-> held back"
(buffer-string))
t)))
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))))
- what
- the check above is right when it reads
t. - what
- on a
THINKING, the writer may run a shell command made only of the readersjq,head,tail,wc,lsandstrings, piped one into the next, nothing written and nothing run hidden.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(mapcar (lambda (command)
(funcall judge `((:title . "Bash") (:kind . "execute")
(:raw-input . ((command . ,command))))))
'("jq -r .x /f.jsonl | head -5"
"ls .agent-shell"
"jq . /f > /tmp/out"
"rm -rf /x"
"head /f; rm /x"
"jq $(rm /x) /f")))))
- what
- the check above is right when it reads
(let-through let-through refused refused refused refused). - what
- on a
THINKING, the writer may run plantuml, orclk ipfs browseto show what it drew, however it words the line, so long as every file it names is in.agent-shell/tmp.
(require 'cl-lib)
(let ((in-world
(lambda (thinking-thunk)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-discuss-" nil ".ws.org"))
(shell (generate-new-buffer " check-discuss-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: say why\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) shell) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () shell)))
(with-current-buffer shell (funcall thunk)))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda ()
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-set-workspace-state "q" "work"))
(setq-local konix/agent-shell-workspace--taking-up nil)
(funcall thinking-thunk)))))
(judge
(lambda (call)
(if (funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
call)
'refused
'let-through))))
(funcall in-world
(lambda ()
(mapcar (lambda (command)
(funcall judge `((:title . "Bash") (:kind . "execute")
(:raw-input . ((command . ,command))))))
(list "plantuml .agent-shell/tmp/d.puml"
(concat "plantuml -tsvg "
(expand-file-name ".agent-shell/tmp/d.puml"))
"plantuml -tsvg -o .agent-shell/tmp .agent-shell/tmp/d.puml"
"plantuml /etc/d.puml"
"plantuml -o /tmp .agent-shell/tmp/d.puml"
"plantuml .agent-shell/tmp/d.puml > /etc/x"
"clk ipfs browse .agent-shell/tmp/d.png"
"clk ipfs browse /etc/passwd"
"clk ipfs add .agent-shell/tmp/d.png")))))
- what
- the check above is right when it reads
(let-through let-through let-through refused refused refused let-through refused refused). - what
DONEis settled, the user’s alone to declare.- what
- and
MAYBEis off to one side of all the others: the user’s to give and to take back, and the writer’s to leave alone.- why: the user wants to say « those are for later » and have it stick.
- rule: any state goes to
MAYBE, andMAYBEcomes back toDISCUSS. - rule: the writer is refused it both ways — it may neither put a question off nor pick one back up.
- scope: it waits on nobody, so it neither stops the user stepping nor counts as work left to the writer.
- rule:
mputs the question the user stands on off, and on one already put off it takes it back toDISCUSS.- how: the cursor stays where it is.
- rule: and taking one back tells the writer, which putting one off never does.
- why: it is work handed to it, and nothing else tells it the question is its own again.
- therefore: the two directions are not one gesture: one gives work, the other takes it away, and only the giving is worth waking anybody for.
- scope: bar one that is no work of the writer’s — a project, or one another holds back — which tells nobody while the writer has nothing of its own.
(defun konix/agent-shell-workspace-put-off ()
"Put the question at point off, or take back one already put off and say so."
(interactive)
(save-excursion
(konix/agent-shell-workspace--goto-question)
(unless (org-get-todo-state)
(user-error "A fact stands in no state, so there is nothing here to put off"))
(let ((later (equal (org-get-todo-state)
konix/agent-shell-workspace-later-keyword)))
(konix/agent-shell-workspace--write
(org-todo (if later
konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-later-keyword)))
(when-let* ((later)
(writer (konix/agent-shell-workspace--target-writer))
(file (konix/agent-shell-workspace-file writer))
((not (konix/agent-shell-workspace--writer-done-p file))))
(konix/agent-shell-workspace--submit writer)))))
each state read and written
- what
- each state is one keyword, named once, which every reading and writing goes by.
(defconst konix/agent-shell-workspace-fresh-keyword "TODO"
"Keyword a question the writer has to take up opens on.")
(defconst konix/agent-shell-workspace-refine-keyword "REFINE"
"Keyword a question waiting on the user's answer opens on.")
(defconst konix/agent-shell-workspace-discuss-keyword "DISCUSS"
"Keyword a question still being worked out, the writer to answer, opens on.")
(defconst konix/agent-shell-workspace-working-keyword "WORKING"
"Keyword a question the writer is on opens on.")
(defconst konix/agent-shell-workspace-thinking-keyword "THINKING"
"Keyword a question the writer took up to discuss, not to work on, opens on.")
(defconst konix/agent-shell-workspace-awaiting-keyword "AWAITING"
"Keyword a question the writer set aside while a run of its own goes opens on.")
(defconst konix/agent-shell-workspace-permission-keyword "PERM"
"Keyword a question whose awaited run waits on the user's leave opens on.")
(defconst konix/agent-shell-workspace-closing-keyword "TOCHECK"
"Keyword a question waiting on the user to agree it is finished opens on.")
(defconst konix/agent-shell-workspace-old-closing-keyword "CLOSING"
"Keyword such a question opened on before, turned into the new one wherever met.")
(defconst konix/agent-shell-workspace-done-keyword "DONE"
"Keyword a settled question opens on.")
(defconst konix/agent-shell-workspace-later-keyword "MAYBE"
"Keyword a question the user has put off opens on.")
(defconst konix/agent-shell-workspace-users-keywords
(list konix/agent-shell-workspace-refine-keyword
konix/agent-shell-workspace-permission-keyword
konix/agent-shell-workspace-closing-keyword)
"Keywords a question waiting on the user opens on.")
(defconst konix/agent-shell-workspace-writers-keywords
(list konix/agent-shell-workspace-fresh-keyword
konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-working-keyword
konix/agent-shell-workspace-thinking-keyword)
"Keywords a question waiting on the writer opens on.")
(defconst konix/agent-shell-workspace-held-keywords
(list konix/agent-shell-workspace-working-keyword
konix/agent-shell-workspace-thinking-keyword)
"Keywords the one question the writer holds opens on, at work or thinking.")
(defun konix/agent-shell-workspace--held-state-p (state)
"Non-nil when STATE is one the writer holds a question in."
(member state konix/agent-shell-workspace-held-keywords))
(defconst konix/agent-shell-workspace-open-keywords
(list konix/agent-shell-workspace-fresh-keyword
konix/agent-shell-workspace-refine-keyword
konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-permission-keyword
konix/agent-shell-workspace-working-keyword
konix/agent-shell-workspace-thinking-keyword
konix/agent-shell-workspace-awaiting-keyword
konix/agent-shell-workspace-closing-keyword
konix/agent-shell-workspace-later-keyword)
"Keywords a question still open opens on, in the order the file declares them.")
(defconst konix/agent-shell-workspace-keywords
(append konix/agent-shell-workspace-open-keywords
(list konix/agent-shell-workspace-done-keyword))
"Keywords a question's heading can open on, the open ones and the settled one.")
- how
- three cheap lookups are made of the file over and over — which keyword a question opens on, whether it is the user’s, whether it is the writer’s — so each is one search.
- rule
- a keyword is searched for with its case told apart.
- why: searching an Org buffer folds case by default, and a heading opening on the word « closing » is no question the writer closed.
- scope: a heading is the user’s to word as they please, and only the keywords in capitals are states.
(defun konix/agent-shell-workspace--keyword-regexp (keywords)
"Return a regexp matching a question's heading opening on one of KEYWORDS."
(concat (konix/agent-shell-workspace--heading-re)
"\\(" (mapconcat #'identity keywords "\\|") "\\) "))
(defun konix/agent-shell-workspace--search-state (regexp &optional bound backwards)
"Search for REGEXP, a heading's keyword, telling its case apart.
BOUND ends the search and BACKWARDS looks the other way."
(let ((case-fold-search nil))
(funcall (if backwards #'re-search-backward #'re-search-forward)
regexp bound t)))
(defun konix/agent-shell-workspace--state-in (line)
"Non-nil when LINE, a heading, opens on a keyword, its case told apart."
(let ((case-fold-search nil))
(string-match konix/agent-shell-workspace-state-regexp line)))
(defconst konix/agent-shell-workspace-state-regexp
(konix/agent-shell-workspace--keyword-regexp
konix/agent-shell-workspace-keywords)
"Regexp matching a question's heading, its keyword captured.")
(defconst konix/agent-shell-workspace-users-regexp
(konix/agent-shell-workspace--keyword-regexp
konix/agent-shell-workspace-users-keywords)
"Regexp matching a question waiting on the user: to answer, or to agree with.")
(defconst konix/agent-shell-workspace-writers-regexp
(konix/agent-shell-workspace--keyword-regexp
(cons konix/agent-shell-workspace-awaiting-keyword
konix/agent-shell-workspace-writers-keywords))
"Regexp matching a question that may be the writer's: whether an awaiting one is
depends on its run, `konix/agent-shell-workspace--the-writers-at-point-p' says.")
(defconst konix/agent-shell-workspace-settled-regexp
(konix/agent-shell-workspace--keyword-regexp
(list konix/agent-shell-workspace-done-keyword))
"Regexp matching a question the user has settled.")
each state’s colour, and the project’s
- rule
- each keyword wears its own face, and no two share one.
- how: named faces rather than colours, so the theme decides how they look.
- rule: and the one waiting on the user’s settling wears no green.
- why: green reads as done, and it is not done until they say so.
- rule: and the one asking leave to run a command stands out as a block.
- why: it asks for a permission, which wants another look than an answer.
- scope: a keyword the user’s own configuration already faces keeps the face they gave it, and the rest of that configuration survives.
- how: the colouring makes the highlighting read its rules afresh, not merely paint again, as the file says about itself.
- rule
- and a question’s « for » line is in bold.
- why: it says what the work is for, and the user reads it at a glance.
- rule
- and the headings of the projects, of the reviews, of the user’s part, of the
writer’s part, of the later part, of the settled part, of the facts and of the memos
each wear a colour of their own, on their name alone.
- scope: not the stars, the count, the tags nor the rest of the line.
- why: for the reviews’ heading: settling a review question records that the user agreed with a commit, and it wants another attention than settling any other question.
- how: named faces, picked by the heading’s tag, so one the user renames keeps its colour.
- what
- each of the eight headings wears its own face, from its first word on.
(with-temp-buffer
(org-mode)
(insert "* Projects :projects:\n* Review :reviews:\n* Mine :mine:\n"
"* Writer's :writers:\n* Later :later:\n* Done :done:\n"
"* Facts :facts:\n* Memos :memos:\n")
(konix/agent-shell-workspace--colour-keywords)
(font-lock-ensure)
(mapcar (lambda (word)
(goto-char (point-min))
(search-forward word)
(let ((face (get-text-property (match-beginning 0) 'face)))
(seq-find (lambda (one)
(memq one '(konix/agent-shell-workspace-projects-part-face
konix/agent-shell-workspace-review-face
konix/agent-shell-workspace-mine-part-face
konix/agent-shell-workspace-writers-part-face
konix/agent-shell-workspace-later-part-face
konix/agent-shell-workspace-done-part-face
konix/agent-shell-workspace-facts-face
konix/agent-shell-workspace-memos-face)))
(ensure-list face))))
'("Projects" "Review" "Mine" "Writer's" "Later" "Done" "Facts" "Memos")))
- what
- the check above is right when it reads
(konix/agent-shell-workspace-projects-part-face konix/agent-shell-workspace-review-face konix/agent-shell-workspace-mine-part-face konix/agent-shell-workspace-writers-part-face konix/agent-shell-workspace-later-part-face konix/agent-shell-workspace-done-part-face konix/agent-shell-workspace-facts-face konix/agent-shell-workspace-memos-face). - what
- on « *
[0/4]Mine :mine: », the name alone wears the face: not the star, the count, the tag nor the line’s end.
(with-temp-buffer
(org-mode)
(insert "* [0/4] Mine :mine:\n")
(konix/agent-shell-workspace--colour-keywords)
(font-lock-ensure)
(mapcar (lambda (pos)
(and (memq 'konix/agent-shell-workspace-mine-part-face
(ensure-list (get-text-property pos 'face)))
t))
(list 1 4 9 14 (1- (line-end-position 1)))))
- what
- the check above is right when it reads
(nil nil t nil nil).
(defface konix/agent-shell-workspace-permission-face
'((t :inherit font-lock-function-name-face :inverse-video t))
"Face of the keyword a question asking leave to run a command opens on.
WORKING's colour, inverted: the writer is at work, waiting on a leave."
:group 'agent-shell)
(defface konix/agent-shell-workspace-thinking-face
'((t :inherit font-lock-type-face :weight bold :slant italic))
"Face of the keyword a question the writer thinks through opens on, a DISCUSS taken up."
:group 'agent-shell)
(defface konix/agent-shell-workspace-projects-part-face
'((t :inherit font-lock-constant-face :inverse-video t))
"Face of the heading the projects stand after."
:group 'agent-shell)
(defface konix/agent-shell-workspace-mine-part-face
'((t :inherit font-lock-keyword-face :inverse-video t))
"Face of the heading the user's part of the questions opens on."
:group 'agent-shell)
(defface konix/agent-shell-workspace-writers-part-face
'((t :inherit font-lock-builtin-face :inverse-video t))
"Face of the heading the writer's part of the questions opens on."
:group 'agent-shell)
(defface konix/agent-shell-workspace-later-part-face
'((t :inherit font-lock-comment-face :inverse-video t))
"Face of the heading the user's questions held back stand after."
:group 'agent-shell)
(defface konix/agent-shell-workspace-done-part-face
'((t :inherit shadow :inverse-video t))
"Face of the heading the settled questions stand after."
:group 'agent-shell)
(defface konix/agent-shell-workspace-facts-face
'((t :inherit font-lock-doc-face :inverse-video t))
"Face of the heading the facts stand under."
:group 'agent-shell)
(defface konix/agent-shell-workspace-memos-face
'((t :inherit font-lock-variable-name-face :inverse-video t))
"Face of the heading the writer's memos stand under."
:group 'agent-shell)
(defface konix/agent-shell-workspace-empty-count-face
'((t :inherit org-checkbox-statistics-done))
"Face of the « [0] » a part with nothing in it shows."
:group 'agent-shell)
(defface konix/agent-shell-workspace-count-face
'((t :inherit font-lock-function-name-face))
"Face of the « [n] » a part holding something shows."
:group 'agent-shell)
(defun konix/agent-shell-workspace--part-headings-font-lock ()
"What picks out the parts, facts and memos headings, each by its tag, and their counts."
(append
'(("^\\* \\(\\[ *0\\]\\) " 1 'konix/agent-shell-workspace-empty-count-face prepend)
("^\\* \\(\\[ *\\(?:[0-9]+/ *\\)?[1-9][0-9]*\\]\\) " 1 'konix/agent-shell-workspace-count-face prepend))
(mapcar (lambda (tag-face)
`(,(format "^\\* \\(?:\\[[ 0-9/%%]*\\] +\\)?\\([^\n]*?\\) +:%s:[ \t]*$"
(car tag-face))
1 ',(cdr tag-face) prepend))
(list (cons konix/agent-shell-workspace-projects-part-tag
'konix/agent-shell-workspace-projects-part-face)
(cons konix/agent-shell-workspace-reviews-part-tag
'konix/agent-shell-workspace-review-face)
(cons konix/agent-shell-workspace-mine-part-tag
'konix/agent-shell-workspace-mine-part-face)
(cons konix/agent-shell-workspace-writers-part-tag
'konix/agent-shell-workspace-writers-part-face)
(cons konix/agent-shell-workspace-later-part-tag
'konix/agent-shell-workspace-later-part-face)
(cons konix/agent-shell-workspace-done-part-tag
'konix/agent-shell-workspace-done-part-face)
(cons konix/agent-shell-workspace-facts-tag
'konix/agent-shell-workspace-facts-face)
(cons konix/agent-shell-workspace-memos-tag
'konix/agent-shell-workspace-memos-face)))))
(defconst konix/agent-shell-workspace-project-font-lock
'(("^[ \t]*- for :: .*$" 0 'bold prepend))
"What picks out a question's « for » line, in bold.")
(defconst konix/agent-shell-workspace-keyword-faces
(list (cons konix/agent-shell-workspace-fresh-keyword
'font-lock-comment-face)
(cons konix/agent-shell-workspace-refine-keyword
'error)
(cons konix/agent-shell-workspace-discuss-keyword
'font-lock-type-face)
(cons konix/agent-shell-workspace-working-keyword
'font-lock-function-name-face)
(cons konix/agent-shell-workspace-thinking-keyword
'konix/agent-shell-workspace-thinking-face)
(cons konix/agent-shell-workspace-awaiting-keyword
'font-lock-keyword-face)
(cons konix/agent-shell-workspace-permission-keyword
'konix/agent-shell-workspace-permission-face)
(cons konix/agent-shell-workspace-closing-keyword
'font-lock-preprocessor-face)
(cons konix/agent-shell-workspace-done-keyword
'font-lock-string-face)
(cons konix/agent-shell-workspace-later-keyword
'shadow))
"Face each keyword wears where nothing else names them.")
(defun konix/agent-shell-workspace--colour-keywords ()
"Face the keywords nothing else names, and refontify."
(let ((configured (default-value 'org-todo-keyword-faces)))
(setq-local org-todo-keyword-faces
(append (seq-remove
(lambda (entry) (assoc (car entry) configured))
konix/agent-shell-workspace-keyword-faces)
configured)))
(org-set-font-lock-defaults)
(font-lock-refresh-defaults)
(font-lock-add-keywords nil konix/agent-shell-workspace-project-font-lock 'append)
(font-lock-add-keywords nil konix/agent-shell-workspace-rejects-font-lock 'append)
(font-lock-add-keywords nil (konix/agent-shell-workspace--part-headings-font-lock)
'append)
(setq-local font-lock-extra-managed-props
(cl-adjoin 'display font-lock-extra-managed-props))
(font-lock-flush))
- rule
THINKINGwears the colour ofDISCUSS, in bold italic: aDISCUSStaken up.- why: in a face of its own it read near plain text.
(let ((face (cdr (assoc konix/agent-shell-workspace-thinking-keyword
konix/agent-shell-workspace-keyword-faces))))
(list (face-attribute face :inherit)
(face-attribute face :weight)
(face-attribute face :slant)))
- what
- the check above is right when it reads
(font-lock-type-face bold italic).
what waits on what
- what
- a question may wait on others, which is the user saying the work has an order
the headings alone do not show.
- why: the writer takes what it likes of what is open, and half of it cannot be done until the rest is.
- rule
- one waiting on anything unsettled is neither takeable nor shown to the
writer, bar the one it already holds, the refusal naming what it waits on.
- why: settled is the user’s own word for done, and the writer calling a thing finished is not the same as the user agreeing it is.
- scope: a question it waits on that has gone from the workspace holds it back no longer, there being nothing left to wait for.
written under both questions
- rule
- both ways round are written under the questions themselves, each a line of
its own linking the other by its heading: what one waits on, and what waits on it.
- why: the user asked to walk it with the keys they walk everything with, and the cursor can stand on a line of the file, never on something only drawn on screen.
- therefore:
RETon either goes to the question it names, org following the link and nothing here being asked to. - therefore: both lines show wherever the question’s body is read, by the user or by the writer, with nothing told to add them.
- how: by id under a heading of the other’s words, so moving or rewording the other leaves it pointing where it pointed.
- scope: and a rewrite does not carry either into the wording it keeps, the order of the work being the user’s and no part of what the question asked.
(defconst konix/agent-shell-workspace-waits-said "waits on"
"What a line naming one the question waits on opens on.")
(defconst konix/agent-shell-workspace-holds-said "holds back"
"What a line naming one the question holds back opens on.")
(defun konix/agent-shell-workspace--said-line-regexp (said &optional id)
"Return what a line SAID of ID looks like, or of anything where none is given."
(concat "^ *- " (regexp-quote said)
" :: \\[\\[id:" (if id (regexp-quote id) "\\([^]]+\\)") "\\]"))
(defun konix/agent-shell-workspace--named-at-point (said)
"Return the ids the question point stands on names SAID of."
(save-excursion
(org-back-to-heading t)
(let ((limit (konix/agent-shell-workspace--question-end))
found)
(while (re-search-forward
(konix/agent-shell-workspace--said-line-regexp said) limit t)
(push (match-string-no-properties 1) found))
(nreverse found))))
(defun konix/agent-shell-workspace--needs-at-point ()
"Return the ids the question point stands on says it waits on."
(konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-waits-said))
a looser order: coming after
- rule
- a looser order stands beside waiting: a question may come after another, held
back until the writer has closed that other, or
while both are the user’s.
- why: the writer should do one before the other, but once it has closed the first there is no reason for it to sit idle while the user reads.
- scope: the first handed back for the user to refine, or to give leave, still holds the second back, the first not done.
- rule: and the moment the first is the writer’s again — the user answering it — the
second is held back again, being after it and not merely after its first closing.
- how: nothing is remembered of it: what holds a question back is read off where the other stands now, every time.
- how: a line pair of its own,
afterunder the one that comes after andbeforeunder the other, so the file says which of the two orders each is.
- what
- the writer is not offered a question coming after one the user is to refine or to give leave on, and is offered it once that one is closed.
(let (files)
(cl-flet ((offered (state)
(let ((file (make-temp-file "check-afterclose-" nil ".ws.org")))
(push file files)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK | DONE\n"
"* Mine :mine:\n"
"** " state " First?\n :PROPERTIES:\n :ID: a\n :END:\n"
" - before :: [[id:b][Second?]]\n"
"* Writer's :writers:\n"
"** TODO Second?\n :PROPERTIES:\n :ID: b\n :END:\n"
" - after :: [[id:a][First?]]\n"))
(if (string-match-p "Second\\?"
(or (konix/agent-shell-workspace--listing file t) ""))
'offered
'held))))
(unwind-protect
(list (offered "REFINE") (offered "PERM") (offered "TOCHECK"))
(let ((kill-buffer-query-functions nil))
(dolist (file files)
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file))))))
- what
- the check above is right when it reads
(held held offered).
(defconst konix/agent-shell-workspace-after-said "after"
"What a line naming one the question comes after opens on.")
(defconst konix/agent-shell-workspace-before-said "before"
"What a line naming one the question comes before opens on.")
(defun konix/agent-shell-workspace--afters-at-point ()
"Return the ids the question point stands on says it comes after."
(konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-after-said))
(defun konix/agent-shell-workspace--edge-words (loose)
"Return (SAID . MIRROR), the words of the stricter order or, where LOOSE, the looser."
(if loose
(cons konix/agent-shell-workspace-after-said
konix/agent-shell-workspace-before-said)
(cons konix/agent-shell-workspace-waits-said
konix/agent-shell-workspace-holds-said)))
- rule
- the two lines of a pair, either kind, are written and taken back together,
one waiting being one thing said twice rather than two things to keep in step.
- scope: two questions may each wait on the other, and both lines stay.
- why: such a ring, two questions waiting on each other, is the user’s to make: it stops the writer, which is what they wanted of it, and nothing here is in a position to tell them not to.
- scope: two questions may each wait on the other, and both lines stay.
(defun konix/agent-shell-workspace--unlink-under (here there said)
"Take out the line under HERE saying SAID of THERE."
(save-excursion
(when (konix/agent-shell-workspace--goto-id here)
(when (re-search-forward
(konix/agent-shell-workspace--said-line-regexp said there)
(konix/agent-shell-workspace--question-end) t)
(delete-region (line-beginning-position)
(min (point-max) (1+ (line-end-position))))))))
(defun konix/agent-shell-workspace--say-waiting (mine other &optional loose)
"Write that MINE waits on OTHER, or comes after it where LOOSE, both ways round."
(let ((words (konix/agent-shell-workspace--edge-words loose))
(its (save-excursion
(unless (konix/agent-shell-workspace--goto-id other)
(error "No heading %s here to wait on" other))
(unless (konix/agent-shell-workspace--state-at-point)
(error "%s is a fact, and waiting on one waits on nothing" other))
(org-get-heading t t t t)))
(ours (save-excursion
(konix/agent-shell-workspace--goto-id mine)
(org-get-heading t t t t))))
(konix/agent-shell-workspace--link-under mine other its (car words))
(konix/agent-shell-workspace--link-under other mine ours (cdr words))))
(defun konix/agent-shell-workspace--unsay-waiting (mine other &optional loose)
"Take back that MINE waits on OTHER, or comes after it where LOOSE."
(let ((words (konix/agent-shell-workspace--edge-words loose)))
(konix/agent-shell-workspace--unlink-under mine other (car words))
(konix/agent-shell-workspace--unlink-under other mine (cdr words))))
both kinds read alike, and said with D
- rule
Dsays the question the user stands in waits on another, picking it out of the others by their headings, and picking it again says it no longer does.- how: one key both ways, so curating the thing is the same gesture as making it.
- rule: and what the picking offers is the headings themselves as plain words,
nothing org has put on them carried along, and ahead of them what the line
shows: the keyword.
- why: a heading read out of the buffer comes with everything org has put on it, and what a completion does with that is its own business, not the user’s.
- why: a candidate carrying what it already waits on is not how anything else in Emacs is picked, and reads as a list of something else.
- therefore: what it already waits on is read where it is written, under the question, and the picking is only for saying which one.
- scope: it offers what is not settled, and whatever it already waits on: one
already settled holds nothing back, so offering it would only be a way to lie.
- scope: a project is offered too.
- why: a question turning out harder than expected becomes a project, and another question or project cannot go on before it is done.
- scope: a project is offered too.
- rule: and a fact waits on nothing and is waited on by nobody, the key refusing it
on either side.
- why: waiting is about work not being takeable yet, and a fact is nobody’s to take: nothing of it would ever come loose.
- how: the picking offers none, standing as they do in no state, and the one being stood on is refused as well.
- rule:
C-u Ddoes the same for the looser kind.
- rule
- and every reading of what holds a question back reads both kinds.
(defun konix/agent-shell-workspace--waited-on ()
"Return the headings of what still holds the question point stands on back."
(let ((questions (konix/agent-shell-workspace--every-question)))
(mapcar (lambda (id) (or (nth 1 (assoc id questions)) id))
(konix/agent-shell-workspace--holding-back
(org-entry-get (point) "ID") questions))))
(defun konix/agent-shell-workspace--wait-on-each (mine needs &optional loose)
"Say that MINE waits on each of NEEDS, or comes after each where LOOSE."
(dolist (need needs)
(konix/agent-shell-workspace--say-waiting mine need loose)))
(defun konix/agent-shell-workspace--the-others (mine needs)
"Return (HEADING . ID) for every question but MINE it may be said to wait on."
(let (found)
(save-excursion
(goto-char (point-min))
(while (konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-state-regexp)
(when-let* ((id (org-entry-get (point) "ID"))
((not (equal id mine)))
((or (member id needs)
(not (equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-done-keyword)))))
(push (cons (konix/agent-shell-workspace--labelled-heading) id)
found))))
(nreverse found)))
(defun konix/agent-shell-workspace--labelled-heading ()
"Return the heading at point as plain words, its keyword ahead of them."
(let ((keyword (org-get-todo-state)))
(concat (when keyword (concat (substring-no-properties keyword) " "))
(substring-no-properties (org-get-heading t t t t)))))
- how
Ditself: it writes or takes back the pair, and a question it frees is told to its writer.
(defun konix/agent-shell-workspace-needs (&optional loose)
"Say what the question point stands in waits on, or that it does no longer.
LOOSE says what it comes after instead, held back by it only in the looser way."
(interactive "P")
(save-excursion
(konix/agent-shell-workspace--goto-question)
(when (konix/agent-shell-workspace--fact-at-point-p)
(user-error "A fact is nobody's to do, so nothing holds it back"))
(let* ((mine (or (org-entry-get (point) "ID")
(user-error "That one has no id to be waited on by")))
(needs (if loose
(konix/agent-shell-workspace--afters-at-point)
(konix/agent-shell-workspace--needs-at-point)))
(others (or (konix/agent-shell-workspace--the-others mine needs)
(user-error
"This is the only question here that is not settled")))
(chosen (cdr (assoc (completing-read
(if loose "Comes after: " "Waits on: ")
others nil t)
others)))
(off (member chosen needs))
(had (konix/agent-shell-workspace--anything-left-p)))
(konix/agent-shell-workspace--write
(if off
(konix/agent-shell-workspace--unsay-waiting mine chosen loose)
(konix/agent-shell-workspace--say-waiting mine chosen loose)))
(konix/agent-shell-workspace--tell-if-freed had)
(message "It %s that one %s" (if loose "comes after" "waits on")
(if off "no longer" "now")))))
taken back with X
- rule
Xtakes back what the question the user stands in waits on or comes after.- rule: and it offers those alone, both kinds at once.
- how: each is offered as « waits on » or « after », then its heading.
- rule: and with just one, it takes it back unasked.
- rule:
C-u Xtakes them all back. - rule: and a question it frees is told to its writer, as with
D.
- rule: and it offers those alone, both kinds at once.
(defun konix/agent-shell-workspace-take-back (&optional all)
"Take back what the question point stands in waits on or comes after, or ALL of it."
(interactive "P")
(save-excursion
(konix/agent-shell-workspace--goto-question)
(let* ((mine (or (org-entry-get (point) "ID")
(user-error "That one has no id to be held back by")))
(questions (konix/agent-shell-workspace--every-question))
(heading (lambda (id)
(substring-no-properties (or (nth 1 (assoc id questions)) id))))
(orders (append
(mapcar (lambda (id)
(list (concat "waits on " (funcall heading id)) id nil))
(konix/agent-shell-workspace--needs-at-point))
(mapcar (lambda (id)
(list (concat "after " (funcall heading id)) id t))
(konix/agent-shell-workspace--afters-at-point))))
(chosen (cond ((null orders) (user-error "Nothing holds this one back"))
((or all (null (cdr orders))) orders)
(t (list (assoc (completing-read "Take back: " orders nil t)
orders)))))
(had (konix/agent-shell-workspace--anything-left-p)))
(konix/agent-shell-workspace--write
(dolist (order chosen)
(konix/agent-shell-workspace--unsay-waiting mine (nth 1 order) (nth 2 order))))
(konix/agent-shell-workspace--tell-if-freed had)
(message "%d taken back" (length chosen)))))
walking it
- rule
- the user walks the thing:
M-<left>goes to what the question they stand in waits on,M-<right>to what waits on it.- why: what is written under a heading names the others but takes them nowhere, and a graph is read by going along it.
- how:
M-<left>follows the « waits on » and « after » lines under the heading,M-<right>the « holds back » and « before » ones, so the key and what it reads point the same way. - how: with one on that side it goes straight there, and with several it asks which, by their headings.
- scope: the open ones alone, as the writing under the heading names the open ones alone.
- scope: both kinds, an after being gone to as a wait is.
- how: each way reads the lines under the question itself, the other side’s being written there as well.
- rule: and what it goes to is opened and shown the way every walk leaves a question.
(defun konix/agent-shell-workspace--goto-one-of (ids prompt)
"Go to one of IDS, asking at PROMPT where there are several, nil where none."
(let* ((questions (konix/agent-shell-workspace--every-question))
(them (delq nil
(mapcar
(lambda (id)
(when-let*
((heading
(konix/agent-shell-workspace--heading-if-open
id questions)))
(cons (substring-no-properties heading) id)))
ids))))
(when them
(let ((id (if (cdr them)
(cdr (assoc (completing-read prompt them nil t) them))
(cdar them))))
(goto-char (point-min))
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--land-on (point))
id))))
(defun konix/agent-shell-workspace-goto-waited-on ()
"Go to what the question point stands in waits on."
(interactive)
(unless (konix/agent-shell-workspace--goto-one-of
(save-excursion
(konix/agent-shell-workspace--goto-question)
(append (konix/agent-shell-workspace--needs-at-point)
(konix/agent-shell-workspace--afters-at-point)))
"Waits on: ")
(user-error "That one waits on nothing")))
(defun konix/agent-shell-workspace-goto-holding-back ()
"Go to what waits on the question point stands in."
(interactive)
(unless (konix/agent-shell-workspace--goto-one-of
(save-excursion
(konix/agent-shell-workspace--goto-question)
(append (konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-holds-said)
(konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-before-said)))
"Holds back: ")
(user-error "That one holds nothing back")))
which one to take first
- what
- a question may wear a priority after its keyword, org’s own cookie, running
from
[#A]down.- why: the writer keeps taking the ones written for later and leaving the urgent.
- scope: the range is the user’s own, declared by the file, so it is whatever they already press elsewhere.
- rule
- the writer is shown, and may take up, only the questions of its own standing
highest, the rest being none of its business until those stop being its.
- why: a writer left to weigh it reads the cookie as part of the heading and takes whatever comes first regardless.
- therefore: what it cannot see it cannot choose wrongly, so the order is kept by the arrangement rather than by the writer remembering.
- how: how high a question stands is org’s own reckoning, so one wearing no cookie stands at whatever the file says the default is.
- rule: and what the writer is shown drops to the next standing of itself, the
moment the last of the higher ones is the user’s, settled or held back.
- why: a higher one waiting on the user is not the writer’s, so holding the lower ones back for it would stop the work while nobody was doing it.
- scope: the one it already holds is shown whatever it stands at, since it is what it is working on.
- rule
- and a rewrite keeps the one the user set.
- rule: the writer never writes a cookie, so a question carries only what the user put on it.
- rule
,sets it, on the question the user stands in, and it is org’s own prompt.- how: standing on an answer it reaches the question above, the way answering does.
(defun konix/agent-shell-workspace-set-priority ()
"Set the priority of the question at point, and save so the writer reads it."
(interactive)
(save-excursion
(konix/agent-shell-workspace--goto-question)
(konix/agent-shell-workspace--write
(call-interactively #'org-priority))))
- how
- what a rewrite keeps is read the way the keyword is, one walk over the questions asking org what each wears.
(defun konix/agent-shell-workspace--asked-of-each-question (ask)
"Return what ASK, run on each question of the workspace, says of it, by id."
(let ((said (make-hash-table :test 'equal)))
(save-excursion
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(while (org-at-heading-p)
(let ((id (org-entry-get nil "ID")))
(when (and id (org-get-todo-state))
(when-let ((this (funcall ask)))
(puthash id this said))))
(outline-next-heading)))
said))
(defun konix/agent-shell-workspace--priorities ()
"Return each question's priority cookie, keyed by its id."
(konix/agent-shell-workspace--asked-of-each-question
(lambda ()
(when-let ((priority (org-element-property :priority
(org-element-at-point))))
(format "[#%c] " priority)))))
- how
- and the highest of the writer’s own is the one org reckons highest among the questions still its own and free to take, held back by none.
(defun konix/agent-shell-workspace--standing-at-point ()
"Return how high the heading point stands on stands, as org reckons it."
(org-get-priority (buffer-substring-no-properties
(line-beginning-position) (line-end-position))))
(defun konix/agent-shell-workspace--free-to-take-at-point-p (questions)
"Non-nil when the writer's question at point is held back by none of QUESTIONS.
The one it holds counts as free, being the one it works on."
(and (konix/agent-shell-workspace--the-writers-at-point-p)
(or (konix/agent-shell-workspace--held-state-p (org-get-todo-state))
(not (konix/agent-shell-workspace--holding-back
(org-entry-get (point) "ID") questions)))))
(defun konix/agent-shell-workspace--standing-highest ()
"Return (HOW-HIGH . HEADING) for the highest the writer's own free ones stand, or nil."
(let ((questions (konix/agent-shell-workspace--every-question))
best)
(save-excursion
(goto-char (point-min))
(while (konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-writers-regexp)
(let ((how-high (konix/agent-shell-workspace--standing-at-point)))
(when (and (konix/agent-shell-workspace--free-to-take-at-point-p questions)
(or (null best) (> how-high (car best))))
(setq best (cons how-high (org-get-heading t t t t)))))))
best))
what the file says about itself
- rule
- whoever reads or writes a workspace does it in the buffer holding that file,
the one the user reads, and nowhere else.
- why: it is an Org buffer, so org answers what a heading is, which state it opens on and whose id it carries — none of which a copy read as text answers.
- why: and a buffer of its own has no file, so org refuses to give a heading an id in it, and every reader would have a second reading of the same file to keep true.
- therefore: there is one place a workspace is, whoever is looking.
- how: it is read and written widened, whatever the user narrowed it to, the narrowing kept after.
(defmacro konix/agent-shell-workspace--read-file (file &rest body)
"Run BODY in the buffer holding FILE widened, leaving point and narrowing as they stood."
(declare (indent 1) (debug t))
`(with-current-buffer (find-file-noselect ,file)
(save-excursion
(save-restriction
(widen)
,@body))))
- what
- a workspace narrowed to one question is read whole and written whole, and stays narrowed after.
(let ((file (make-temp-file "check-narrowed-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"
"* Mine :mine:\n"
"** REFINE Yours\n :PROPERTIES:\n :ID: u\n :END:\n"
"* Writer's :writers:\n"
"** WORKING The writer's\n :PROPERTIES:\n :ID: w\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-flet ((tops ()
(save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\*\\*? \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
(nreverse found)))))
(konix/agent-shell-workspace--goto-id "w")
(org-narrow-to-subtree)
(prog1 (list (konix/agent-shell-workspace--read-file file (tops))
(with-temp-buffer
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "u")
(org-todo "DONE"))
(with-current-buffer (find-file-noselect file)
(save-restriction (widen) (tops))))
(buffer-narrowed-p))
(widen)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("Mine :mine:" "REFINE Yours" "Writer's :writers:" "WORKING The writer's") (… "[0/0] Mine :mine:" "[0/1] Writer's :writers:" "WORKING The writer's" … "[1/1] Done :done:" "DONE Yours") t). - rule
- and writing it shows it whole first, and saves it after.
-
why: the same reason the user’s own keys go through one write.
-
rule: and a refused write folds the workspace back, and nothing else happens.
- why: the rest of the call never runs, and the workspace would stay unfolded.
-
rule: and a write that goes through folds it back too, the cursor kept unless its body folds, then on that body’s heading.
- why: a write lands while the user reads the workspace.
-
what: an auditor’s verdict passing a refine leaves the workspace folded, the user’s cursor, which stood in a body now folded, on that body’s heading.
-
(require 'cl-lib)
(let ((file (make-temp-file "check-write-folds-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(writer (generate-new-buffer " check-write-folds-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING AWAITING TOCHECK | DONE\n"
"* AWAITING asked\n :PROPERTIES:\n :ID: q\n :END:\n"
" - auditing :: w::auditor, task #1, from WORKING\n"
" - what :: body q\n"
"* TODO other\n :PROPERTIES:\n :ID: o\n :END:\n"
" - what :: body o\n"))
(puthash 1 (list "q" "REFINE" file writer "WORKING" "w::auditor" nil)
konix/agent-shell-workspace--gates)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace-mode t)
(org-fold-show-all)
(goto-char (point-min))
(search-forward "body o")
(konix/mcp-server--gate-verdict 1 "{\"verdict\": \"PASS\", \"findings\": []}")
(prog1 (list (save-excursion
(goto-char (point-min))
(search-forward "body q")
(and (invisible-p (match-beginning 0)) 'folded))
(and (not (invisible-p (point))) (org-at-heading-p)
(org-get-heading t t t t)))
(setq-local konix/agent-shell-workspace-mode nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
(folded "other"). - rule
- and shown whole means widened out of the part the
/view narrows to, while it writes.- why: org acts on no heading it cannot reach:
yon a project’s closing question narrowed toMinefailed on the project, outside that part.
- why: org acts on no heading it cannot reach:
(defmacro konix/agent-shell-workspace--unnarrowed (&rest body)
"Run BODY widened."
(declare (indent 0) (debug t))
`(save-restriction
(widen)
,@body))
(defmacro konix/agent-shell-workspace--write-file (file &rest body)
"Run BODY in the buffer holding FILE, shown whole, and save it.
The region the user left active is set aside, for org to touch no heading but the one
BODY is at. The workspace is folded back after, the cursor and every window's kept, or
before the failure goes on where BODY fails."
(declare (indent 1) (debug t))
(let ((written (make-symbol "written"))
(spot (make-symbol "spot")))
`(let ((,spot (with-current-buffer (find-file-noselect ,file)
(konix/agent-shell-workspace--spots))))
(prog1
(konix/agent-shell-workspace--read-file ,file
(let ((inhibit-read-only t)
(mark-active nil)
(,written nil))
(konix/agent-shell-workspace--note-unfolded)
(org-fold-show-all)
(unwind-protect
(prog1 (konix/agent-shell-workspace--unnarrowed
(konix/agent-shell-workspace--sort-keeping-point)
(konix/agent-shell-workspace--lists-into-drawer)
(konix/agent-shell-workspace--folded-into-opened)
(prog1 (progn ,@body)
(konix/agent-shell-workspace--sort-by-turn))
(save-buffer))
(setq ,written t))
(unless ,written
(when (bound-and-true-p konix/agent-shell-workspace-mode)
(ignore-errors (konix/agent-shell-workspace-focus-question)))))))
(with-current-buffer (find-file-noselect ,file)
(konix/agent-shell-workspace--spots-back ,spot)
(when (bound-and-true-p konix/agent-shell-workspace-mode)
(ignore-errors (konix/agent-shell-workspace--focus-standing-still))))))))
- what
- narrowed to the
Minepart, the writer settles its own question, outside it, and the workspace is narrowed toMineagain after.
(let ((file (make-temp-file "check-write-file-view-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"
"* Writer's :writers:\n"
"** WORKING The writer's?\n :PROPERTIES:\n :ID: w\n :END:\n"
" - what :: its own\n"
"* Mine :mine:\n"
"** REFINE Yours?\n :PROPERTIES:\n :ID: u\n :END:\n - what :: yours\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-cycle-view)
(prog1 (list (and (ignore-errors
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "w")
(org-todo "DONE"))
t))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*\\* \\([A-Z]+\\) The writer's")
(match-string 1)))
(buffer-narrowed-p)
(save-excursion
(goto-char (point-min))
(and (org-at-heading-p) (org-get-heading t t t t)))
(save-excursion
(goto-char (point-min))
(and (search-forward "The writer's" nil t) t)))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
(t "DONE" t "[0/1] Mine" nil). - rule
- every write puts the memos first, then the facts, then a heading
Projectsand the projects, then a headingReviewand the review questions, then a headingMineand the questions in a state of the user’s, then a headingWriter'sand all the others, then a headingLaterand theREFINEquestions held back, by another question or a schedule to come, and theMAYBEones, then last a headingDoneand theDONEquestions.- why: the user wants to see apart what is theirs and what is the writer’s.
- why: and
Laterbecause they mostly make no sense to settle before they are really the user’s. - why: and the
Projects,ReviewandMineheadings let the user better see the structure. - why: and
Donebecause the user seldom looks at them, keeping them in case something changes after, and cleans them now and then. - how: each part keeps the order the file had, so the user’s own ordering holds within it; only a question changing hands crosses the line.
- how: each part’s heading wears a tag of its own, as the facts’ heading does, and
is no question nor fact; each question stands under its part’s heading, a level down.
- why: so that hiding them is narrowing to one root heading.
- how: a file whose questions stand at the top nests them on its first write.
- scope: what is nobody’s, an
AWAITINGwhose run goes say, stands with the writer’s;Projectsis there only with a project,Reviewonly with a review question, whoever’s turn it is,Lateronly with aREFINEheld back,Doneonly with aDONEquestion; aTOCHECKor aPERMheld back stays inMine.
- what
- a write over a file ordered anyhow, its questions at the top, leaves the memos, the facts, the projects, the reviews, the user’s, the rest, the refines held back, then the settled, each in its order, each question a level down under its part; a second write leaves it as it is.
(let ((file (make-temp-file "check-sort-turn-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"
"* WORKING First of the writer's\n :PROPERTIES:\n :ID: w1\n :END:\n"
"* REFINE First of yours\n :PROPERTIES:\n :ID: u1\n :END:\n"
" - what :: under it\n"
"* TODO A project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* REFINE A commit :review:\n :PROPERTIES:\n :ID: r\n :END:\n"
"* TODO Second of the writer's\n :PROPERTIES:\n :ID: w2\n :END:\n"
"* REFINE Second of yours\n :PROPERTIES:\n :ID: u2\n :END:\n"
"* REFINE Yours, waiting\n SCHEDULED: <2999-01-01 Tue>\n"
" :PROPERTIES:\n :ID: u3\n :END:\n"
"* REFINE Yours, after another\n :PROPERTIES:\n :ID: u4\n :END:\n"
" - waits on :: [[id:w1][First of the writer's]]\n"
"* TOCHECK Yours to settle, waiting\n :PROPERTIES:\n :ID: c\n :END:\n"
" - waits on :: [[id:w1][First of the writer's]]\n"
"* DONE A settled one\n :PROPERTIES:\n :ID: d\n :END:\n"
"* Facts :facts:\n** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"
"* Memos :memos:\n** A memo\n :PROPERTIES:\n :ID: m\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-flet ((tops ()
(save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\(\\*\\*?\\) \\(.*\\)$" nil t)
(let ((heading (match-string-no-properties 2)))
(when (or (equal (match-string 1) "*") (org-get-todo-state))
(push heading found))))
(nreverse found))))
(levels ()
(let ((case-fold-search nil))
(list (how-many "^\\* [A-Z][A-Z]+ " (point-min) (point-max))
(how-many "^\\*\\* [A-Z][A-Z]+ " (point-min) (point-max))))))
(prog1 (list (progn (konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "u1"))
(tops))
(levels)
(progn (konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "u1"))
(tops))
(save-excursion
(goto-char (point-min))
(and (search-forward "under it" nil t) 'answer-kept)))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("Memos :memos:" "Facts :facts:" "[0/1] Projects :projects:" "TODO A project :project:" "[0/1] Review :reviews:" "REFINE A commit :review:" "[0/3] Mine :mine:" "REFINE First of yours" "REFINE Second of yours" "TOCHECK Yours to settle, waiting" "[0/2] Writer's :writers:" "WORKING First of the writer's" "TODO Second of the writer's" "[0/2] Later :later:" "REFINE Yours, waiting" "REFINE Yours, after another" "[1/1] Done :done:" "DONE A settled one"), then(0 10), no question left at the top and the ten a level down, then that list again, thenanswer-kept). - rule
- a
MAYBEquestion, put off, goes toLatertoo, beside the refines held back.- why: the user said « maybe questions are “Later” ».
- what
- a write over a
MAYBEand aTODOleaves theMAYBEunderLater.
(let ((file (make-temp-file "check-sort-maybe-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE MAYBE WORKING | DONE\n"
"* MAYBE Put off\n :PROPERTIES:\n :ID: m\n :END:\n"
"* TODO The writer's\n :PROPERTIES:\n :ID: w\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "w"))
(prog1 (save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\*\\*? \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
(nreverse found)))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
("Memos :memos:" "Facts :facts:" "[0/0] Projects :projects:" "[0/0] Review :reviews:" "[0/0] Mine :mine:" "[0/1] Writer's :writers:" "TODO The writer's" "[0/1] Later :later:" "MAYBE Put off" "[0/0] Done :done:"). - rule
- a workspace already in its parts is not rebuilt: only a question out of its
part is moved, to that part’s end, and the parts’ counts set again.
- why: rebuilding the whole file each write sent each saved cursor, a
save-excursion, a window come back to, onto theMemosheading, under the user; a quit in the middle left the workspace empty; it was most of a write’s time. - why: the user said « you write the whole org file, so no need to sort, you just put the questions at the appropriate locations ».
- how: the move pastes the question first and cuts it after: a quit between leaves it twice, never lost.
- rule: one lacking its parts, or with a question outside them, is still rebuilt.
- why: rebuilding the whole file each write sent each saved cursor, a
- what
- a sorted workspace; a cursor saved in the user’s question; the writer’s
question set
DONE, then sorted.
(let ((file (make-temp-file "check-sort-moves-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* REFINE Asked of you\n :PROPERTIES:\n :ID: q\n :END:\n"
" A body long enough to be the text the sort leaves where it is.\n"
"* TODO The writer's\n :PROPERTIES:\n :ID: w\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--sort-by-turn)
(let ((saved (save-excursion (goto-char (point-min))
(search-forward "long enough")
(point-marker))))
(save-excursion
(konix/agent-shell-workspace--goto-id "w")
(org-todo "DONE"))
(konix/agent-shell-workspace--sort-by-turn)
(prog1 (list (save-excursion (goto-char saved) (org-get-heading t t t t))
(save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\*\\*? \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
(nreverse found))))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("Asked of you" ("Memos :memos:" "Facts :facts:" "[0/0] Projects :projects:" "[0/0] Review :reviews:" "[0/1] Mine :mine:" "REFINE Asked of you" "[0/0] Writer's :writers:" "[0/0] Later :later:" "[1/1] Done :done:" "DONE The writer's")). - rule
- a buffer unchanged since its last sort is not sorted again.
- why: every write sorted before and after its change, the first for nothing when the last write had just sorted it: a sort of a 200 KB workspace takes a tenth of a second or more.
- what
- a buffer sorted into its parts, then sorted twice more unchanged: no sort runs.
(let ((file (make-temp-file "check-sort-once-" nil ".ws.org"))
(sorted 0))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* REFINE Asked of you\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(dotimes (_ 2) (konix/agent-shell-workspace--sort-by-turn))
(let ((here (symbol-function 'konix/agent-shell-workspace--sort-questions-here)))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--sort-questions-here)
(lambda () (cl-incf sorted) (funcall here))))
(dotimes (_ 2) (konix/agent-shell-workspace--sort-by-turn))))
(prog1 sorted
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
0; it read2before. - rule
- and each part’s heading is made afresh whole, wearing no id, every write.
- why: given an id as every heading is, its drawer stayed behind once the heading was made afresh, one more each write.
- what
- two writes making the workspace well formed leave no drawer outside a heading, and no id on any part’s heading.
(let ((file (make-temp-file "check-sort-drawer-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"
"* REFINE Yours\n :PROPERTIES:\n :ID: u\n :END:\n"
"* TODO A project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* REFINE A commit :review:\n :PROPERTIES:\n :ID: r\n :END:\n"
"* WORKING The writer's\n :PROPERTIES:\n :ID: w\n :END:\n"
"* REFINE Yours, waiting\n SCHEDULED: <2999-01-01 Tue>\n"
" :PROPERTIES:\n :ID: u2\n :END:\n"
"* DONE A settled one\n :PROPERTIES:\n :ID: d\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(dotimes (_ 2)
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--ensure-well-formed)))
(prog1 (save-excursion
(goto-char (point-min))
(let ((stray 0))
(while (re-search-forward "^ *:PROPERTIES:$" nil t)
(unless (save-excursion
(forward-line -1)
(or (org-at-heading-p) (looking-at-p org-planning-line-re)))
(setq stray (1+ stray))))
(cons stray
(mapcar (lambda (heading)
(goto-char (point-min))
(let (ids)
(while (re-search-forward
(concat "^\\* \\(\\[[ 0-9/]*\\] \\)?" heading " :")
nil t)
(push (org-entry-get (point) "ID") ids))
(delq nil ids)))
'("Projects" "Review" "Mine" "Writer's" "Later" "Done")))))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
(0 nil nil nil nil nil nil). - rule
- and each part’s heading wears an org
[/]cookie, filled every write: how many of its questions are done, of how many, written before the part’s name.- why: the user asked the count first, the name after.
- why: the user sees how many a part holds without unfolding it.
- scope: the memos and the facts wear none, holding nothing in a state to count.
- what
- a write gives each part’s heading its count, and a question added changes it.
(let ((file (make-temp-file "check-parts-counted-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"
"* REFINE Yours\n :PROPERTIES:\n :ID: u\n :END:\n"
"* WORKING The writer's\n :PROPERTIES:\n :ID: w\n :END:\n"
"* DONE A settled one\n :PROPERTIES:\n :ID: d\n :END:\n"
"* Facts :facts:\n** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-flet ((tops ()
(save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\* \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
(nreverse found)))))
(prog1 (list (progn (konix/agent-shell-workspace--write-file file)
(tops))
(progn (konix/agent-shell-workspace--write-file file
(goto-char (point-max))
(insert "* REFINE Another\n :PROPERTIES:\n :ID: a\n :END:\n"))
(tops)))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("Memos :memos:" "Facts :facts:" "[0/0] Projects :projects:" "[0/0] Review :reviews:" "[0/1] Mine :mine:" "[0/1] Writer's :writers:" "[0/0] Later :later:" "[1/1] Done :done:") (… "[0/2] Mine :mine:" …)), the second the same but forMine. - rule
- and every top heading is written each time, an empty part counting
[0/0], the memos’ and the facts’ too.- why: a part left out made another one last: a question written at the file’s end
fell under
Facts, and was taken for a fact.
- why: a part left out made another one last: a question written at the file’s end
fell under
- what
- an empty file written reads every top heading, in order.
(let ((file (make-temp-file "check-parts-all-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(prog1 (progn (konix/agent-shell-workspace--write-file file)
(save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\* \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
(nreverse found))))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
("Memos :memos:" "Facts :facts:" "[0/0] Projects :projects:" "[0/0] Review :reviews:" "[0/0] Mine :mine:" "[0/0] Writer's :writers:" "[0/0] Later :later:" "[0/0] Done :done:"). - rule
- a cursor or window a rewrite puts on another heading than its own is logged,
a line to the debug log under
cursor.- why: the user keeps answering memos and facts by mistake, the cursor jumped there, and asked for logs to find when.
- how: the time, the command, the file, the heading left and its part then, where that heading went, the heading landed on, and the case: beside it or its part.
- what
- a question gone from Mine logs one jump, landing on the one beside it; one staying logs none.
(let ((file (make-temp-file "check-jump-" nil ".ws.org"))
(konix/agent-shell-workspace-debug-tags '(cursor))
(konix/agent-shell-workspace-debug-workspace-regexp nil)
(konix/agent-shell-workspace-debug-log " check-jump-log"))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* [0/2] Mine :mine:\n"
"** REFINE Going?\n :PROPERTIES:\n :ID: g\n :END:\n"
"** REFINE Staying?\n :PROPERTIES:\n :ID: s\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-flet ((lines ()
(when (get-buffer konix/agent-shell-workspace-debug-log)
(with-current-buffer konix/agent-shell-workspace-debug-log
(split-string (buffer-string) "\n" t)))))
(prog1 (list (progn (goto-char (point-min))
(re-search-forward "Staying")
(konix/agent-shell-workspace--sort-by-turn)
(length (lines)))
(progn (goto-char (point-min))
(re-search-forward "Going")
(org-todo "TODO")
(konix/agent-shell-workspace--sort-by-turn)
(mapcar (lambda (line)
(and (string-match "left « \\(.*\\) » .* on « \\(.*\\) », \\(.*\\)$"
line)
(list (match-string 1 line) (match-string 2 line)
(match-string 3 line))))
(lines))))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))))
- what
- the check above is right when it reads
(0 (("Going?" "Staying?" "beside it"))). - rule
- the writer’s part reads the held one,
WORKINGorTHINKING, thenAWAITING, thenTODO, thenDISCUSS, each state in the order they arrived.- why: the user asked « TODO before DISCUSS », « WAITING before discuss » and « awaiting before todo ».
- what
- a writer’s part reading
DISCUSS a,TODO b,AWAITING c,TODO d,WORKING e, sorted.
(let ((file (make-temp-file "check-writers-by-state-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING AWAITING TOCHECK | DONE\n"
"* DISCUSS a\n :PROPERTIES:\n :ID: a\n :END:\n"
"* TODO b\n :PROPERTIES:\n :ID: b\n :END:\n"
"* AWAITING c\n :PROPERTIES:\n :ID: c\n :END:\n"
"* TODO d\n :PROPERTIES:\n :ID: d\n :END:\n"
"* WORKING e\n :PROPERTIES:\n :ID: e\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(prog1 (progn (konix/agent-shell-workspace--sort-by-turn)
(save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\*\\* \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
(nreverse found))))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
("WORKING e" "AWAITING c" "TODO b" "TODO d" "DISCUSS a").
(defun konix/agent-shell-workspace--log-jump (spot place)
"Log SPOT, as `--spot-at' gave it, landing at PLACE on another heading than its own."
(pcase-let ((`(,id ,_offset ,part ,around) spot))
(let ((landed (and place (save-excursion (goto-char place)
(car (konix/agent-shell-workspace--spot-at place))))))
(unless (or (null spot) (null place) (equal landed id))
(cl-flet ((heading (where)
(save-excursion (goto-char where) (org-back-to-heading t)
(org-get-heading t t t t))))
(let ((went (save-excursion
(and id (konix/agent-shell-workspace--goto-id id)
(cons (heading (point))
(konix/agent-shell-workspace--part-at))))))
(konix/agent-shell-workspace--debug
'cursor (and buffer-file-name (file-name-nondirectory buffer-file-name))
"%s left « %s » in %s, now %s; landed in %s on « %s », %s"
this-command (or (car went) id) part
(if went (format "in %s" (cdr went)) "gone")
(save-excursion (goto-char place) (konix/agent-shell-workspace--part-at))
(heading place)
(if (member landed around) "beside it" "its part"))))))))
(defun konix/agent-shell-workspace--sort-by-turn ()
"Put the memos, facts, projects, reviews, the user's, the others, the later, the settled.
Each part keeps the order the file had, but the writer's goes by state, the held
one first, and the memos and facts newest written first; any other
heading stays where it is.
Point, and every window's, stays in the question it stood in, as far into it."
(let ((spots (konix/agent-shell-workspace--spots)))
(save-excursion
(konix/agent-shell-workspace--sort-questions))
(konix/agent-shell-workspace--spots-back spots)))
(defun konix/agent-shell-workspace--spots ()
"Return where point and every window on this buffer stand, as spots."
(cons (konix/agent-shell-workspace--spot-at (point))
(mapcar (lambda (window)
(cons window (konix/agent-shell-workspace--spot-at
(window-point window))))
(get-buffer-window-list nil nil t))))
(defun konix/agent-shell-workspace--spots-back (spots)
"Put point and the windows back where SPOTS, as `--spots' gave them, now are."
(when-let* ((place (konix/agent-shell-workspace--spot-place (car spots))))
(konix/agent-shell-workspace--log-jump (car spots) place)
(goto-char place))
(pcase-dolist (`(,window . ,spot) (cdr spots))
(when-let* (((window-live-p window))
((eq (window-buffer window) (current-buffer)))
(place (konix/agent-shell-workspace--spot-place spot)))
(konix/agent-shell-workspace--log-jump spot place)
(set-window-point window place))))
(defun konix/agent-shell-workspace--spot-at (pos)
"Return (ID OFFSET PART AROUND) of POS, nil above the first heading.
ID is the nearest heading above it with an id, else none and the part's heading is
taken; OFFSET how far into that heading POS stands; PART the tag of the top heading
holding it; AROUND the ids beside its question in that part, below first, then above."
(save-excursion
(goto-char pos)
(unless (org-before-first-heading-p)
(org-back-to-heading t)
(while (and (not (org-entry-get (point) "ID")) (org-up-heading-safe)))
(let ((id (org-entry-get (point) "ID")))
(list id (- pos (point)) (konix/agent-shell-workspace--part-at)
(and id (konix/agent-shell-workspace--ids-around)))))))
(defun konix/agent-shell-workspace--part-at ()
"Return the tag of the top heading point stands under, nil above the first."
(save-excursion
(unless (org-before-first-heading-p)
(org-back-to-heading t)
(while (org-up-heading-safe))
(car (org-get-tags nil t)))))
(defun konix/agent-shell-workspace--ids-around ()
"Return the ids of the questions beside the one point stands in, below first, then
above, nearest first."
(save-excursion
(org-back-to-heading t)
(while (and (> (org-current-level) 2) (org-up-heading-safe)))
(when (= (org-current-level) 2)
(let ((start (point)) below above)
(while (org-get-next-sibling) (push (org-entry-get (point) "ID") below))
(goto-char start)
(while (org-get-previous-sibling) (push (org-entry-get (point) "ID") above))
(delq nil (append (nreverse below) (nreverse above)))))))
(defun konix/agent-shell-workspace--goto-part (tag)
"Go to the top heading tagged TAG; nil, not moving, when there is none."
(when-let* ((found (save-excursion
(goto-char (point-min))
(catch 'found
(while (re-search-forward "^\\* " nil t)
(when (member tag (org-get-tags nil t))
(throw 'found (line-beginning-position))))))))
(goto-char found)))
(defun konix/agent-shell-workspace--spot-place (spot)
"Return where SPOT, as `konix/agent-shell-workspace--spot-at' gives it, now is: in its
heading while it stays in its part, or wherever it went from no part, else on the
nearest heading beside it still there, else on the part's heading."
(pcase-let ((`(,id ,offset ,part ,around) spot))
(save-excursion
(cl-flet ((in-part (other)
(and other (konix/agent-shell-workspace--goto-id other)
(or (null part)
(equal (konix/agent-shell-workspace--part-at) part))
(point)))
(into (start)
(min (+ start offset) (save-excursion (org-end-of-subtree t t) (point)))))
(cond
((not spot) nil)
((in-part id) (into (point)))
((seq-some #'in-part around))
((and part (konix/agent-shell-workspace--goto-part part))
(if id (point) (into (point)))))))))
(defun konix/agent-shell-workspace--shift-question (text by)
"Return TEXT, a question and its answers, each heading BY levels deeper.
BY below zero brings them up; what is written under them stays as it is."
(if (zerop by)
text
(with-temp-buffer
(insert text)
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\) " nil t)
(goto-char (match-beginning 1))
(if (> by 0)
(insert (make-string by ?*))
(delete-char (min (- by) (1- (length (match-string 1))))))
(forward-line 1))
(buffer-string))))
(defvar-local konix/agent-shell-workspace--sorted-at nil
"The buffer's modification tick right after its last sort.")
(defun konix/agent-shell-workspace--sort-questions ()
"Move the questions as `konix/agent-shell-workspace--sort-by-turn' says.
A buffer unchanged since its last sort is left as it is, unless that sort found
questions out of their level, read before they were put back in it. One already in
its parts only has the questions out of their part moved."
(unless (or (eql (buffer-chars-modified-tick) konix/agent-shell-workspace--sorted-at)
(if (konix/agent-shell-workspace--in-parts-p)
(progn (konix/agent-shell-workspace--place-the-misplaced) nil)
(konix/agent-shell-workspace--sort-questions-here)))
(setq konix/agent-shell-workspace--sorted-at (buffer-chars-modified-tick))))
(defun konix/agent-shell-workspace--sort-keeping-point ()
"Sort by turn, point left in the heading it stood in wherever that went, as far in.
What a write does after acts at point: on the question it was aimed at, never on the
one left beside it."
(let* ((heading (save-excursion
(unless (org-before-first-heading-p)
(org-back-to-heading t)
(point))))
(id (and heading (save-excursion (goto-char heading)
(org-entry-get nil "ID"))))
(offset (and heading (- (point) heading))))
(konix/agent-shell-workspace--sort-by-turn)
(when (and id (konix/agent-shell-workspace--goto-id id))
(forward-char (min offset (- (point-max) (point)))))))
(defun konix/agent-shell-workspace--part-tags ()
"Return the tags of the parts, in the order they stand."
(list konix/agent-shell-workspace-memos-tag
konix/agent-shell-workspace-facts-tag
konix/agent-shell-workspace-projects-part-tag
konix/agent-shell-workspace-reviews-part-tag
konix/agent-shell-workspace-mine-part-tag
konix/agent-shell-workspace-writers-part-tag
konix/agent-shell-workspace-later-part-tag
konix/agent-shell-workspace-done-part-tag))
(defun konix/agent-shell-workspace--in-parts-p ()
"Non-nil when every part stands once, in order, and no question stands at the top."
(save-excursion
(goto-char (point-min))
(let ((tags (konix/agent-shell-workspace--part-tags))
found (whole t))
(while (and whole (re-search-forward "^\\* " nil t))
(beginning-of-line)
(if (org-get-todo-state)
(setq whole nil)
(when-let* ((tag (car (seq-intersection (org-get-tags nil t) tags))))
(push tag found)))
(end-of-line))
(and whole (equal (nreverse found) tags)))))
(defun konix/agent-shell-workspace--part-due (questions)
"Return the tag of the part the question at point belongs in, QUESTIONS being
what `konix/agent-shell-workspace--every-question' gives."
(let ((state (org-get-todo-state)))
(cond ((konix/agent-shell-workspace--project-at-point-p)
konix/agent-shell-workspace-projects-part-tag)
((member konix/agent-shell-workspace-review-tag (org-get-tags nil t))
konix/agent-shell-workspace-reviews-part-tag)
((member state konix/agent-shell-workspace-users-keywords)
(if (and (equal state konix/agent-shell-workspace-refine-keyword)
(konix/agent-shell-workspace--holding-back
(org-entry-get (point) "ID") questions))
konix/agent-shell-workspace-later-part-tag
konix/agent-shell-workspace-mine-part-tag))
((equal state konix/agent-shell-workspace-done-keyword)
konix/agent-shell-workspace-done-part-tag)
((equal state konix/agent-shell-workspace-later-keyword)
konix/agent-shell-workspace-later-part-tag)
(t konix/agent-shell-workspace-writers-part-tag))))
(defun konix/agent-shell-workspace--goto-part (tag)
"Move to the heading of the part wearing TAG."
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:[ \t]*$" (regexp-quote tag)))
(beginning-of-line))
(defun konix/agent-shell-workspace--place-the-misplaced ()
"Move each question standing out of its part to that part's end, and count again.
The question is pasted before it is cut, so a quit between leaves it twice, never lost."
(let ((questions (konix/agent-shell-workspace--every-question))
(parts (konix/agent-shell-workspace--part-tags))
moving)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*\\* " nil t)
(beginning-of-line)
(when-let* (((org-get-todo-state))
(part (konix/agent-shell-workspace--part-at))
((member part (konix/agent-shell-workspace--part-tags)))
(due (konix/agent-shell-workspace--part-due questions))
((not (equal due part))))
(push (list (copy-marker (point))
(copy-marker (konix/agent-shell-workspace--ends-at 2))
due)
moving))
(end-of-line))
(pcase-dolist (`(,start ,end ,due) (nreverse moving))
(let ((text (buffer-substring start end)))
(unless (string-suffix-p "\n" text)
(setq text (concat text "\n")))
(konix/agent-shell-workspace--goto-part due)
(goto-char (konix/agent-shell-workspace--ends-at 1))
(unless (bolp) (insert "\n"))
(insert text)
(delete-region start end)
(set-marker start nil)
(set-marker end nil)))
(konix/agent-shell-workspace--order-within-parts)
(konix/agent-shell-workspace--count-parts parts))))
(defun konix/agent-shell-workspace--order-within-parts ()
"Order the writer's part by state, and the memos and facts newest first."
(konix/agent-shell-workspace--order-writers-part)
(konix/agent-shell-workspace--newest-first konix/agent-shell-workspace-memos-tag)
(konix/agent-shell-workspace--newest-first konix/agent-shell-workspace-facts-tag))
(defun konix/agent-shell-workspace--newest-first (tag)
"Order the headings under the part wearing TAG by when last written, newest first.
One never stamped goes last; equals keep their order."
(save-excursion
(konix/agent-shell-workspace--goto-part tag)
(let ((end (konix/agent-shell-workspace--ends-at 1))
start entries)
(while (re-search-forward "^\\*\\* " end t)
(beginning-of-line)
(setq start (or start (point)))
(let ((stop (konix/agent-shell-workspace--ends-at 2))
(stamp (or (konix/agent-shell-workspace--touched-at-point) "")))
(push (cons stamp (buffer-substring (point) stop)) entries)
(goto-char stop)))
(when start
(let ((ordered (mapconcat (lambda (entry)
(if (string-suffix-p "\n" (cdr entry))
(cdr entry)
(concat (cdr entry) "\n")))
(sort (nreverse entries)
(lambda (a b) (string> (car a) (car b)))))))
(unless (equal ordered (buffer-substring start end))
(delete-region start end)
(goto-char start)
(insert ordered)))))))
(defun konix/agent-shell-workspace--writers-rank (state)
"Return where a question in STATE stands in the writer's part, lowest first.
The held one, then the awaiting, the fresh, the discussed, any other last."
(cond ((konix/agent-shell-workspace--held-state-p state) 0)
((equal state konix/agent-shell-workspace-awaiting-keyword) 1)
((equal state konix/agent-shell-workspace-fresh-keyword) 2)
((equal state konix/agent-shell-workspace-discuss-keyword) 3)
(t 4)))
(defun konix/agent-shell-workspace--order-writers-part ()
"Order the writer's part by state, as `--writers-rank' says; equals keep their order."
(save-excursion
(konix/agent-shell-workspace--goto-part konix/agent-shell-workspace-writers-part-tag)
(let ((end (konix/agent-shell-workspace--ends-at 1))
start entries)
(while (re-search-forward "^\\*\\* " end t)
(beginning-of-line)
(setq start (or start (point)))
(let ((stop (konix/agent-shell-workspace--ends-at 2))
(rank (konix/agent-shell-workspace--writers-rank (org-get-todo-state))))
(push (cons rank (buffer-substring (point) stop)) entries)
(goto-char stop)))
(when start
(let ((ordered (mapconcat (lambda (entry)
(if (string-suffix-p "\n" (cdr entry))
(cdr entry)
(concat (cdr entry) "\n")))
(sort (nreverse entries)
(lambda (a b) (< (car a) (car b)))))))
(unless (equal ordered (buffer-substring start end))
(delete-region start end)
(goto-char start)
(insert ordered)))))))
(defconst konix/agent-shell-workspace--part-cookie-regexp "^\\* \\[\\([ 0-9/]*\\)\\] "
"What matches the cookie of a part heading, its text in the first group.")
(defun konix/agent-shell-workspace--count-cookie (count done &optional width)
"Write COUNT as the cookie of a part heading, with DONE of them when only some are.
The cookie is padded with spaces to WIDTH."
(format "[%s]" (string-pad (if (< 0 done count)
(format "%d/%d" done count)
(number-to-string count))
(or width 0) nil t)))
(defun konix/agent-shell-workspace--pad-part-cookies ()
"Pad the cookie of every part heading with spaces to the widest of them, no more."
(save-excursion
(cl-flet ((bare () (string-replace " " "" (match-string-no-properties 1))))
(let ((width 0))
(goto-char (point-min))
(while (re-search-forward konix/agent-shell-workspace--part-cookie-regexp nil t)
(setq width (max width (length (bare)))))
(goto-char (point-min))
(while (re-search-forward konix/agent-shell-workspace--part-cookie-regexp nil t)
(let ((padded (string-pad (bare) width nil t)))
(unless (equal padded (match-string-no-properties 1))
(replace-match padded t t nil 1))))))))
(defun konix/agent-shell-workspace--done-heading-p (text)
"Say whether TEXT starts with a heading in a done state."
(string-match-p (concat "\\`\\*+ " (regexp-opt org-done-keywords) " ") text))
(defun konix/agent-shell-workspace--count-parts (parts)
"Set again on the heading of each of PARTS how many headings it holds."
(dolist (tag parts)
(konix/agent-shell-workspace--goto-part tag)
(let ((heading (point))
(end (konix/agent-shell-workspace--ends-at 1))
(headings 0)
(done 0))
(forward-line 1)
(while (re-search-forward "^\\*\\* " end t)
(cl-incf headings)
(when (konix/agent-shell-workspace--done-heading-p
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))
(cl-incf done)))
(goto-char heading)
(let ((line (format "* %s %s :%s:"
(konix/agent-shell-workspace--count-cookie
headings done
(and (looking-at konix/agent-shell-workspace--part-cookie-regexp)
(length (match-string 1))))
(replace-regexp-in-string
"\\`\\[ *[0-9]+\\(/ *[0-9]+\\)?\\] *" ""
(org-get-heading t t t t))
tag)))
(unless (equal line (buffer-substring-no-properties
(point) (line-end-position)))
(delete-region (point) (line-end-position))
(insert line)))))
(konix/agent-shell-workspace--pad-part-cookies))
(defun konix/agent-shell-workspace--sort-questions-here ()
"Move the questions of this buffer as `konix/agent-shell-workspace--sort-by-turn' says.
Return non-nil when a question had to be put back to its level."
(let ((questions (konix/agent-shell-workspace--every-question))
top place memos facts projects reviews yours others later done shifted)
(goto-char (point-min))
(while (re-search-forward "^\\*+ " nil t)
(beginning-of-line)
(let* ((start (point))
(level (org-current-level))
(question (and (org-get-todo-state)
(or (equal level 1)
(and (equal level konix/agent-shell-workspace-question-level)
(memq top '(nil part))))))
(end (konix/agent-shell-workspace--ends-at (if question level 1))))
(when (equal level 1)
(setq top (if (konix/agent-shell-workspace--part-at-point-p) 'part 'other)))
(cond
((konix/agent-shell-workspace--part-at-point-p)
(setq place (or place start))
(delete-region start (line-beginning-position 2)))
((or (konix/agent-shell-workspace--memos-at-point-p)
(konix/agent-shell-workspace--facts-at-point-p)
question)
(let ((text (buffer-substring (if question
start
(save-excursion (org-end-of-meta-data t) (point)))
end)))
(unless (or (string-empty-p text) (string-suffix-p "\n" text))
(setq text (concat text "\n")))
(when question
(unless (equal level konix/agent-shell-workspace-question-level)
(setq shifted t))
(setq text (konix/agent-shell-workspace--shift-question
text (- konix/agent-shell-workspace-question-level level))))
(cond ((konix/agent-shell-workspace--memos-at-point-p) (push text memos))
((konix/agent-shell-workspace--facts-at-point-p) (push text facts))
((konix/agent-shell-workspace--project-at-point-p) (push text projects))
((member konix/agent-shell-workspace-review-tag (org-get-tags nil t))
(push text reviews))
((member (org-get-todo-state) konix/agent-shell-workspace-users-keywords)
(if (and (equal (org-get-todo-state)
konix/agent-shell-workspace-refine-keyword)
(konix/agent-shell-workspace--holding-back
(org-entry-get (point) "ID") questions))
(push text later)
(push text yours)))
((equal (org-get-todo-state) konix/agent-shell-workspace-done-keyword)
(push text done))
((equal (org-get-todo-state) konix/agent-shell-workspace-later-keyword)
(push text later))
(t (push text others)))
(setq place (or place start))
(delete-region start end)))
((equal level 1) (goto-char (max end (line-beginning-position 2))))
(t (forward-line 1)))))
(goto-char (or place (point-max)))
(unless (bolp) (insert "\n"))
(cl-flet ((part (name tag texts)
(format "* %s :%s:\n%s" name tag (apply #'concat (reverse texts)))))
(insert (part "Memos" konix/agent-shell-workspace-memos-tag memos)
(part "Facts" konix/agent-shell-workspace-facts-tag facts)
(part "Projects" konix/agent-shell-workspace-projects-part-tag projects)
(part "Review" konix/agent-shell-workspace-reviews-part-tag reviews)
(part "Mine" konix/agent-shell-workspace-mine-part-tag yours)
(part "Writer's" konix/agent-shell-workspace-writers-part-tag others)
(part "Later" konix/agent-shell-workspace-later-part-tag later)
(part "Done" konix/agent-shell-workspace-done-part-tag done)))
(konix/agent-shell-workspace--count-parts (konix/agent-shell-workspace--part-tags))
(konix/agent-shell-workspace--order-within-parts)
shifted))
- rule
- a file keyword the workspace needs is put back at the top on every rewrite, whatever the file had and wherever it had it.
(defun konix/agent-shell-workspace--goto-front-matter (&optional last)
"Move where a file keyword belongs: after a leading property drawer.
LAST goes past the keywords already there instead."
(goto-char (point-min))
(when (looking-at "^:PROPERTIES:$")
(when (re-search-forward "^:END:$" nil t)
(forward-line 1)))
(when last
(while (looking-at "^#\\+")
(forward-line 1))))
(defun konix/agent-shell-workspace--ensure-keyword (name value &optional last)
"Make this buffer's NAME file keyword say VALUE, in the front matter.
LAST puts it below every other keyword there."
(save-excursion
(goto-char (point-min))
(while (re-search-forward (format "^#\\+%s:.*\n" name) nil t)
(replace-match ""))
(konix/agent-shell-workspace--goto-front-matter last)
(insert (format "#+%s: %s\n" name value))))
(defun konix/agent-shell-workspace--keyword (name)
"Return the value of this buffer's NAME file keyword, or nil."
(cadr (car (org-collect-keywords (list name)))))
- rule
- the file says it is a workspace, declares its keywords and the range its
priorities run over, and names the folded view it opens in, pictures shown.
- how: a file opened by hand is a workspace by its
#+WORKSPACE:line, theTODOkeywords alone telling it from no other file. - how: the range is the one the user’s own configuration names, written into the file rather than assumed of whoever opens it.
- rule: and org is made to read those lines again wherever they are written.
- why: it works a file’s keywords out once, as the file is opened, and a workspace says what its own are after that.
- therefore: the states are coloured from the moment one is bound, rather than from the first time the file is read afresh.
- how: a file opened by hand is a workspace by its
(defun konix/agent-shell-workspace--ensure-front-matter ()
"Declare in this buffer what its own keywords have to say, and have org read it."
(konix/agent-shell-workspace--ensure-keyword "WORKSPACE" "t")
(konix/agent-shell-workspace--ensure-keyword
"TODO" (format "%s | %s"
(mapconcat #'identity
konix/agent-shell-workspace-open-keywords " ")
konix/agent-shell-workspace-done-keyword))
(konix/agent-shell-workspace--ensure-keyword
"PRIORITIES" (format "%c %c %c"
(default-value 'org-highest-priority)
(default-value 'org-lowest-priority)
(default-value 'org-default-priority)))
(konix/agent-shell-workspace--ensure-keyword
"STARTUP" "overview linkpreviews")
(org-set-regexps-and-options))
- rule
- and it names the session writing into it, as a link that resumes it.
- how: it is the
agent-shell:link org itself stores for a session, so following it lands where it would from anywhere else. - scope: it is the session that wrote last, and there is none while that session has no id yet.
- how: it is the
(defun konix/agent-shell-workspace--ensure-session-link (shell)
"Declare in this buffer the link resuming SHELL, when it has a session to link to."
(when-let ((spec (konix/org-agent-shell--session-spec shell)))
(konix/agent-shell-workspace--ensure-keyword
"SESSION"
(format "[[agent-shell:%s][%s]]"
spec (konix/org-agent-shell--shell-label shell)))))
every heading addressable
- what
- a heading with no id can be neither pointed at nor removed by the writer, so
every one is given one on the way in.
-
why: a link by id survives the heading being reworded or moved.
-
how: it is org’s own giving of one, so where the drawer goes, and what already counts as an id, are org’s to say rather than ours.
- why: the drawer goes under the heading, or under a planning line org may have slipped between the two, and one call of org’s knows which.
-
rule: and one gaining its id is the user’s own, made by hand, and says so, as a subject raised with their keys does.
- why: a rewrite keeps the words it replaces under the question, and must tell whose they were.
- how:
BYset touserin its drawer, the tools’ to read.
-
(defun konix/agent-shell-workspace--part-name (words)
"Return WORDS as a part is named: case, a « ' » and a closing « s » aside."
(string-remove-suffix "s" (string-replace "'" "" (downcase (string-trim words)))))
(defun konix/agent-shell-workspace--tag-part-named-bare ()
"Give the top heading at point its part's tag, where it is bare and named as one."
(when-let* (((equal (org-current-level) 1))
((not (org-get-todo-state)))
((not (org-get-tags nil t)))
(name (konix/agent-shell-workspace--part-name
(org-get-heading t t t t)))
(tag (seq-find
(lambda (tag)
(equal (konix/agent-shell-workspace--part-name tag) name))
(list konix/agent-shell-workspace-projects-part-tag
konix/agent-shell-workspace-reviews-part-tag
konix/agent-shell-workspace-mine-part-tag
konix/agent-shell-workspace-writers-part-tag
konix/agent-shell-workspace-later-part-tag
konix/agent-shell-workspace-done-part-tag
konix/agent-shell-workspace-facts-tag
konix/agent-shell-workspace-memos-tag))))
(org-set-tags (list tag))))
(defconst konix/agent-shell-workspace-by-hand-property "BY"
"Property saying who made a heading, where the user made it by hand.")
(defun konix/agent-shell-workspace--made-by-hand ()
"Say the heading at point is the user's own, and stamp it as written now."
(org-entry-put (point) konix/agent-shell-workspace-by-hand-property "user")
(konix/agent-shell-workspace--touch))
(defun konix/agent-shell-workspace--by-hand-p ()
"Non-nil when the heading at point is the user's own, made by hand."
(equal (org-entry-get (point) konix/agent-shell-workspace-by-hand-property) "user"))
(defun konix/agent-shell-workspace--ensure-ids ()
"Give every heading of this buffer an id, keeping the one it already has.
One gaining its id is new, made by hand, and says so; a part written bare first gains
its tag. The id is not put in org-id's table, saved on quit."
(org-map-entries
(lambda ()
(konix/agent-shell-workspace--tag-part-named-bare)
(unless (or (org-entry-get nil "ID")
(konix/agent-shell-workspace--part-at-point-p))
(org-entry-put nil "ID" (org-id-new))
(konix/agent-shell-workspace--made-by-hand)))))
- rule
- but a top heading the user writes bare, named as a part is, « Memo », « Facts »,
« Done », is that part: it gains the part’s tag, never an id making it a question.
- why: the user said turning a structure heading into a question is stupid and must be prevented.
- how: its words, case aside, singular or plural, with or without the « ’s », name the part; one with a keyword or other words is a question as before.
(let ((file (make-temp-file "check-part-named-bare-" nil ".org"))
(org-id-locations (make-hash-table :test #'equal))
(org-id-files nil)
(org-id-track-globally nil))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(unwind-protect
(progn
(insert "* Memo\n* Facts\n* writer's\n* Done\n* TODO Done\n* Done soon\n")
(konix/agent-shell-workspace--ensure-ids)
(org-map-entries
(lambda ()
(list (org-get-heading t t t t)
(org-get-tags nil t)
(konix/agent-shell-workspace--by-hand-p)))))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
(("Memo" ("memos") t) ("Facts" ("facts") t) ("writer's" ("writers") nil) ("Done" ("done") nil) ("Done" nil t) ("Done soon" nil t)): the memos and facts headings gain an id, as they always did, the parts none. - rule
- and a workspace is made well formed, its keywords and its ids, before anything looks at it, whether it is being bound or rewritten.
(defun konix/agent-shell-workspace--ensure-well-formed ()
"Make this buffer a workspace: its keywords said, its headings addressable."
(konix/agent-shell-workspace--ensure-front-matter)
(konix/agent-shell-workspace--ensure-ids))
- rule
- and a question the writer closed opens on
TOCHECK, which it once did onCLOSING, and a workspace still saying the old word says the new one once opened or written.- why: the user: « closing nudges me into pressing “t”, TOCHECK nudges me into verifying before pressing “t” ».
- how: its headings and its
#+TODOline are rewritten, and the file saved at once when opened.- why: a heading of the old word, the line saying the new one, is a heading org no longer reads a state on.
- what
- a workspace saying the old word, opened, reads
TOCHECKon its heading, in the buffer and on disk, and on its#+TODOline, the old word gone.
(let* ((old konix/agent-shell-workspace-old-closing-keyword)
(file (make-temp-file "check-tocheck-" nil ".ws.org")))
(with-temp-file file
(insert (format "#+TODO: TODO REFINE WORKING %s | DONE\n" old)
(format "* %s Fixed the tilt\n :PROPERTIES:\n :ID: c\n :END:\n" old)))
(unwind-protect
(let ((buffer (find-file-noselect file)))
(prog1 (list (with-current-buffer buffer
(goto-char (point-min))
(re-search-forward "^\\* ")
(org-get-todo-state))
(with-temp-buffer
(insert-file-contents file)
(list (and (search-forward "* TOCHECK Fixed" nil t) 'heading)
(progn (goto-char (point-min))
(and (re-search-forward "^#\\+TODO:.* TOCHECK " nil t)
'todo-line))
(progn (goto-char (point-min))
(and (search-forward old nil t) 'old-left)))))
(with-current-buffer buffer
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("TOCHECK" (heading todo-line nil)).
(defun konix/agent-shell-workspace--closing-into-tocheck ()
"Turn this buffer's headings and #+TODO line of the old closing word into the new one.
Return non-nil when anything changed."
(save-excursion
(save-restriction
(widen)
(let ((case-fold-search nil)
(inhibit-read-only t)
(old konix/agent-shell-workspace-old-closing-keyword)
(new konix/agent-shell-workspace-closing-keyword)
changed)
(goto-char (point-min))
(while (re-search-forward (format "^\\*+ \\(%s\\)\\_>" old) nil t)
(replace-match new t t nil 1)
(setq changed t))
(goto-char (point-min))
(while (re-search-forward (format "^#\\+TODO:.*?\\_<\\(%s\\)\\_>" old) nil t)
(replace-match new t t nil 1)
(setq changed t))
(when changed
(org-set-regexps-and-options))
changed))))
(defun konix/agent-shell-workspace--closing-into-tocheck-saved ()
"Turn the old closing word into the new one here, saving the file when it changed."
(when (and (konix/agent-shell-workspace--closing-into-tocheck)
buffer-file-name)
(save-buffer)))
what a rewrite does, and keeps
- rule
- a rewrite hands the question back to the user, always, as writing one says.
- rule
- and a question the user settled cannot be rewritten at all — the call is
refused.
- why: what the user settled made sense to them, and they will not have the writer turn it into something they never agreed to.
- scope: and one the user put off is refused, as a settled one is.
- rule
- a rewrite keeps the user’s answers under the question.
- why: the writer rewrites a question whenever it sharpens it, and a rewrite that reset the user’s answer would make answering pointless.
- scope: folded away, the answers being for the writer to read, not for the user.
- rule
- and the wording a rewrite writes over stays under the question, among the
answers, so the two read as the conversation they were.
- why: the writer sharpens a question into another one, and the user is left answering a wording they can no longer see.
- how: it goes in above the answers it drew — after the last wording kept there, everything under which was said since — so the order is the order it happened in.
- rule: and each line of that conversation says whose it is, the wordings opening on
writer:and the answers onme:.- why: they stand side by side under the one question, and a reader who cannot tell them apart is reading someone else’s words as their own.
- rule: and a question the user made by hand, written over, stays theirs:
me:.- how: it is the one that says it was made by hand.
- how
- the revision
Vwrites on a review question (what a review question looks like) is read back before anything is written over it, so a rewrite keeps it.
(defun konix/agent-shell-workspace--revisions ()
"Return the revision each heading is read against, keyed by its id."
(let ((said (make-hash-table :test 'equal)))
(save-excursion
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(while (org-at-heading-p)
(when-let* ((id (org-entry-get nil "ID"))
(revspec (org-entry-get nil "REVSPEC")))
(puthash id revspec said))
(outline-next-heading)))
said))
(defun konix/agent-shell-workspace--tags ()
"Return the tags each heading wears, its own and not inherited, keyed by its id."
(let ((said (make-hash-table :test 'equal)))
(save-excursion
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(while (org-at-heading-p)
(when-let* ((id (org-entry-get nil "ID"))
(tags (org-get-tags nil t)))
(puthash id tags said))
(outline-next-heading)))
said))
(defun konix/agent-shell-workspace--revision-of (id revisions)
"Return the revision ID was written with in REVISIONS, which a rewrite keeps."
(and revisions (gethash id revisions)))
the question rendered
- how
- a question is written out whole, its id generated once and kept, and what the
user put on it (priority, revision) kept through every rewrite; with no act named, it
stands in
REFINE.
(defun konix/agent-shell-workspace--render-question (entry &optional cookies
revisions tags)
"Return ENTRY as one Org question, in the state its writer's act names, or REFINE.
COOKIES carries the priority each question wears, REVISIONS the revision it
is read against and TAGS the tags the user put on it, so a rewrite keeps them."
(let* ((places (konix/agent-shell-workspace--places entry))
(addresses (konix/agent-shell-workspace--addresses entry))
(bullets (konix/agent-shell-workspace--bullets (alist-get 'note entry)))
(heading (string-trim
(or (alist-get 'label entry)
(error "A label is what you are asking the user — there is none"))))
(id (or (alist-get 'id entry) (konix/agent-shell-workspace--new-question-id)))
(revspec (konix/agent-shell-workspace--revision-of id revisions))
(state (or (alist-get 'keyword entry)
konix/agent-shell-workspace-refine-keyword))
(cookie (or (and cookies (gethash id cookies)) ""))
(tagged (and tags (gethash id tags))))
(unless (member state konix/agent-shell-workspace-keywords)
(error "Unknown keyword \"%s\" — one of: %s" state
(mapconcat #'identity konix/agent-shell-workspace-keywords ", ")))
(unless (string-match-p "\\`[^\n]+\\'" heading)
(error "A heading is one line with something on it: %S" heading))
(konix/agent-shell-workspace--check-heading heading)
(when (and (equal state konix/agent-shell-workspace-closing-keyword)
(string-suffix-p "?" heading))
(error "A closed question asks nothing: word its heading as a claim of what was done, with no question mark: %s"
heading))
(unless (or (equal state konix/agent-shell-workspace-closing-keyword)
(string-suffix-p "?" heading))
(error "A heading has to end in a question mark, or it asks the user nothing: %s"
heading))
(when (string-match (concat "\\`\\(?:\\(?:[Ss]hall\\|[Ss]hould\\|[Cc]an\\|[Mm]ay\\) I"
"\\|[Dd]o you want me to\\) +\\(.\\)\\(.*\\)\\'")
heading)
(error "« Shall I » and the like are just noise: word it as the action, verb then object, « %s%s »"
(upcase (match-string 1 heading)) (match-string 2 heading)))
(dolist (place places)
(dolist (part (list (car place) (cadr place)))
(when (and part (string-match-p "\n" (format "%s" part)))
(error "A place is one line, or it opens a heading of its own: %S" part))))
(konix/agent-shell-workspace--check-body
heading bullets (delq nil (mapcar #'caddr places)))
(konix/agent-shell-workspace--check-addresses heading addresses)
(let ((ids (konix/agent-shell-workspace--ids-here)))
(setq heading (konix/agent-shell-workspace--link-cut-ids heading ids)
bullets (mapcar (lambda (bullet)
(konix/agent-shell-workspace--link-cut-ids bullet ids))
bullets))
(konix/agent-shell-workspace--refuse-dangling heading (cons heading bullets) ids))
(let ((question
(concat (format "%s %s %s%s%s\n"
(konix/agent-shell-workspace--stars) state cookie heading
(if tagged (concat " :" (string-join tagged ":") ":") ""))
" :PROPERTIES:\n :ID: " id "\n"
(if revspec (concat " :REVSPEC: " revspec "\n") "")
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(mapconcat (lambda (bullet) (concat " - " bullet "\n")) bullets)
(konix/agent-shell-workspace--addresses-written addresses)
(konix/agent-shell-workspace--places-written places)
"\n")))
(konix/agent-shell-workspace--no-longer-than heading question)
question)))
- how
- what is refused is checked before anything is written: the heading’s rules, the keyword, each place on one line, the body and addresses within their limits.
(unless (member state konix/agent-shell-workspace-keywords)
(error "Unknown keyword \"%s\" — one of: %s" state
(mapconcat #'identity konix/agent-shell-workspace-keywords ", ")))
(unless (string-match-p "\\`[^\n]+\\'" heading)
(error "A heading is one line with something on it: %S" heading))
(konix/agent-shell-workspace--check-heading heading)
(when (and (equal state konix/agent-shell-workspace-closing-keyword)
(string-suffix-p "?" heading))
(error "A closed question asks nothing: word its heading as a claim of what was done, with no question mark: %s"
heading))
(unless (or (equal state konix/agent-shell-workspace-closing-keyword)
(string-suffix-p "?" heading))
(error "A heading has to end in a question mark, or it asks the user nothing: %s"
heading))
(when (string-match (concat "\\`\\(?:\\(?:[Ss]hall\\|[Ss]hould\\|[Cc]an\\|[Mm]ay\\) I"
"\\|[Dd]o you want me to\\) +\\(.\\)\\(.*\\)\\'")
heading)
(error "« Shall I » and the like are just noise: word it as the action, verb then object, « %s%s »"
(upcase (match-string 1 heading)) (match-string 2 heading)))
(dolist (place places)
(dolist (part (list (car place) (cadr place)))
(when (and part (string-match-p "\n" (format "%s" part)))
(error "A place is one line, or it opens a heading of its own: %S" part))))
(konix/agent-shell-workspace--check-body
heading bullets (delq nil (mapcar #'caddr places)))
(konix/agent-shell-workspace--check-addresses heading addresses)
- what
- a closed heading is a claim, refused with a mark; an open one is refused without.
(with-temp-buffer
(org-mode)
(mapcar (lambda (case)
(condition-case nil
(progn (konix/agent-shell-workspace--render-question
`((label . ,(car case)) (keyword . ,(cdr case))
(note . "[\"proof :: it ran\"]")))
'written)
(error 'refused)))
(list (cons "Fixed the tilt" konix/agent-shell-workspace-closing-keyword)
(cons "Fixed the tilt; settle?" konix/agent-shell-workspace-closing-keyword)
(cons "Fix the tilt, Go?" konix/agent-shell-workspace-refine-keyword)
(cons "Fix the tilt" konix/agent-shell-workspace-refine-keyword))))
- what
- the check above is right when it reads
(written refused written refused). - rule
- a heading the writer words, a question’s, a plan step’s or a fact’s, is at most
a hundred and twenty characters.
- why: the user reads a workspace by its headings, and a long one is a body in disguise.
- scope: a heading a tool words itself, around a project’s name, is not counted.
- what
- a question or fact heading of 121 characters is refused, 120 written, and a project’s own heading passes whatever its length.
(with-temp-buffer
(org-mode)
(cl-flet ((try (render label)
(condition-case nil
(progn (funcall render `((label . ,label)
(note . "[\"what :: it tilts\"]")))
'written)
(error 'refused))))
(list (try #'konix/agent-shell-workspace--render-question
(concat (make-string 120 ?a) "?"))
(try #'konix/agent-shell-workspace--render-question
(concat (make-string 119 ?a) "?"))
(try #'konix/agent-shell-workspace--render-fact (make-string 121 ?a))
(try #'konix/agent-shell-workspace--render-fact (make-string 120 ?a))
(let ((konix/agent-shell-workspace--heading-ours t))
(try #'konix/agent-shell-workspace--render-question
(concat (make-string 149 ?a) "?"))))))
- what
- the check above is right when it reads
(refused written refused written written). - rule
- a heading’s ID cut short in a question’s heading or bullets becomes a link
to that heading, showing its title.
- why: the writer names questions by the first chars of their ID, which say nothing to the user.
- scope: a hex run no ID of the workspace starts with, a git sha say, stays as written, it being maybe what the user looks for.
- how: seven hex chars at least, standing alone: not inside an ID, a link or a path.
(defun konix/agent-shell-workspace--ids-here ()
"Return each heading's (ID . TITLE) in this workspace."
(let (ids)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)" nil t)
(let ((id (match-string-no-properties 1)))
(save-excursion
(unless (org-before-first-heading-p)
(org-back-to-heading t)
(push (cons id (org-link-display-format (org-get-heading t t t t)))
ids))))))
ids))
(defun konix/agent-shell-workspace--link-cut-ids (text ids)
"Return TEXT with each hex run starting exactly one ID of IDS made a link to it."
(let ((start 0) (out ""))
(while (string-match (concat "\\(?:\\`\\|[^-:#/[:alnum:]]\\)"
"\\([0-9a-f]\\{7,\\}\\)"
"\\(?:\\'\\|[^-[:alnum:]]\\)")
text start)
(let* ((cut (match-string 1 text))
(end (match-end 1))
(hits (seq-filter (lambda (one) (string-prefix-p cut (car one))) ids)))
(setq out (concat out (substring text start (match-beginning 1))
(if (= (length hits) 1)
(format "[[id:%s][%s]]" (caar hits) (cdar hits))
cut))
start end)))
(concat out (substring text start))))
(defun konix/agent-shell-workspace--refuse-dangling (heading texts &optional ids)
"Refuse TEXTS under HEADING where they link an id no heading of IDS, nor any known, has."
(let ((ids (or ids (konix/agent-shell-workspace--ids-here))))
(dolist (text texts)
(let ((start 0))
(while (string-match "\\[\\[id:\\([^]]+\\)\\]" text start)
(let ((id (string-trim (match-string 1 text))))
(setq start (match-end 0))
(unless (or (assoc id ids) (org-id-find-id-file id))
(error "Under \"%s\", the link to %s reaches no heading: drop it" heading id))))))))
- what
- a cut ID becomes a link to its heading; a sha, a full ID and a link stay.
(let ((ids '(("86c6d2f4-8025-4b44" . "Merger #5094") ("870f022a-1111" . "Merger #5087"))))
(list (konix/agent-shell-workspace--link-cut-ids
"suivie avec #5094 (86c6d2f4). Bon ?" ids)
(konix/agent-shell-workspace--link-cut-ids
"what :: 870f022a and sha 1234abcd" ids)
(konix/agent-shell-workspace--link-cut-ids
"[[id:86c6d2f4-8025-4b44][x]] awaited-86c6d2f4-8025.log" ids)))
- what
- the check above is right when it reads
("suivie avec #5094 ([[id:86c6d2f4-8025-4b44][Merger #5094]]). Bon ?" "what :: [[id:870f022a-1111][Merger #5087]] and sha 1234abcd" "[[id:86c6d2f4-8025-4b44][x]] awaited-86c6d2f4-8025.log"). - what
- through the tool, a cut ID in the heading and in a bullet lands as links.
(require 'cl-lib)
(let ((file (make-temp-file "check-cutids-" nil ".ws.org"))
(writer (generate-new-buffer " check-cutids-writer")))
(with-temp-file file
(insert "* DONE Merge it?\n :PROPERTIES:\n :ID: 86c6d2f4-8025-4b44\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore))
(with-current-buffer writer
(konix/mcp-server-set-workspace-question
"Followed with 86c6d2f4, good?" "[\"what :: after 86c6d2f4, sha 1234abcd\"]")
(with-temp-buffer
(insert-file-contents file)
(list (how-many (regexp-quote "[[id:86c6d2f4-8025-4b44][Merge it?]]")
(point-min) (point-max))
(how-many "sha 1234abcd" (point-min) (point-max))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(2 1). - rule
- a question or a fact linking an id no heading has, here or in any org file
known, is refused.
- why: the user follows the link and lands on « no link ».
- what
- a question and a fact linking a heading here are written, linking none refused.
(with-temp-buffer
(org-mode)
(insert "* A\n :PROPERTIES:\n :ID: here-id\n :END:\n")
(let (result)
(dolist (render (list #'konix/agent-shell-workspace--render-question
#'konix/agent-shell-workspace--render-fact))
(dolist (target '("here-id" "gone-id"))
(push (condition-case nil
(progn (funcall render
`((label . ,(if (eq render #'konix/agent-shell-workspace--render-fact)
"It tilts" "Fix it?"))
(note . ,(format "[\"what :: [[id:%s][it]]\"]" target))))
'written)
(error 'refused))
result)))
(nreverse result)))
- what
- the check above is right when it reads
(written refused written refused).
when it was last touched
- rule
- each write stamps the heading it writes
TOUCHED, a plain org timestamp in its drawer: a question, a fact, a memo, an answer, a subject, an act on a question, a review questionVputs up or asks again.- rule: and the user’s own writes too: a heading made by hand, as it gains its id;
a heading reworded; a state their keys move.
- how: every state org moves in a workspace, heard from org’s own hook, whoever moved it.
- scope: a review question
Vfollows again unchanged is not stamped; its age stays. - why: when it was last touched says whether it went stale.
- rule: and the user’s own writes too: a heading made by hand, as it gains its id;
a heading reworded; a state their keys move.
(defconst konix/agent-shell-workspace-touched-property "TOUCHED"
"Property saying when its heading was last written.")
(defun konix/agent-shell-workspace--now ()
"Return now as a plain inactive org timestamp."
(format-time-string (org-time-stamp-format t t)))
(defun konix/agent-shell-workspace--touched (indent)
"Return the drawer line saying a heading is written now, INDENT before it."
(concat indent ":" konix/agent-shell-workspace-touched-property ": "
(konix/agent-shell-workspace--now) "\n"))
(defun konix/agent-shell-workspace--touch ()
"Say the heading at point is written now."
(org-entry-put (point) konix/agent-shell-workspace-touched-property
(konix/agent-shell-workspace--now)))
(defun konix/agent-shell-workspace--touch-the-moved ()
"Stamp a question of a workspace whose state org has just moved."
(when (bound-and-true-p konix/agent-shell-workspace-mode)
(konix/agent-shell-workspace--touch)))
(add-hook 'org-after-todo-state-change-hook
#'konix/agent-shell-workspace--touch-the-moved)
(defun konix/agent-shell-workspace--touched-at-point ()
"Return when the heading at point was last written, or nil."
(org-entry-get (point) konix/agent-shell-workspace-touched-property))
- rule
- and each heading under a top one shows how long ago, dimmed ahead of it:
« 2h »; a top heading never does, aged or not.
- why: the drawer stays folded away, and the age is what the user reads of it.
- how: the display’s alone, at the heading’s start, which a fold never hides, so a folded question shows it too.
- how: redrawn as the view settles.
- rule: and the ages are padded to the widest, a heading with none padded too, so
the headings line up after them.
- scope: not a top heading: it stays at the left.
- what
- a part heading with no age gets nothing ahead of it, an aged question its age.
(with-temp-buffer
(org-mode)
(insert "* [0/1] Mine :mine:\n"
"** REFINE Aged?\n :PROPERTIES:\n :TOUCHED: [2020-01-01 Wed 10:00]\n :END:\n"
"** REFINE Unaged?\n")
(konix/agent-shell-workspace--show-ages)
(mapcar (lambda (heading)
(goto-char (point-min))
(search-forward heading)
(and (seq-some (lambda (overlay)
(overlay-get overlay 'konix/agent-shell-workspace-age))
(overlays-in (line-beginning-position)
(line-beginning-position)))
t))
'("Mine" "Aged?" "Unaged?")))
- what
- the check above is right when it reads
(nil t t). - what
- a memo is written stamped; Memos, Facts and Mine, aged or not, show nothing, a memo, a fact and a question their age.
(list
(and (string-match-p ":TOUCHED:" (konix/agent-shell-workspace--render-memo
"M" '("what :: m") "m"))
t)
(with-temp-buffer
(org-mode)
(insert "* [1] Memos :memos:\n :PROPERTIES:\n :TOUCHED: [2020-01-01 Wed 10:00]\n :END:\n"
"** A memo\n :PROPERTIES:\n :TOUCHED: [2020-01-01 Wed 10:00]\n :END:\n"
"* [1] Facts :facts:\n :PROPERTIES:\n :TOUCHED: [2020-01-01 Wed 10:00]\n :END:\n"
"** A fact\n :PROPERTIES:\n :TOUCHED: [2020-01-01 Wed 10:00]\n :END:\n"
"* [1] Mine :mine:\n"
"** REFINE Aged?\n :PROPERTIES:\n :TOUCHED: [2020-01-01 Wed 10:00]\n :END:\n")
(konix/agent-shell-workspace--show-ages)
(mapcar (lambda (heading)
(goto-char (point-min))
(search-forward heading)
(and (seq-some (lambda (overlay)
(overlay-get overlay 'konix/agent-shell-workspace-age))
(overlays-in (line-beginning-position)
(line-beginning-position)))
t))
'("Memos" "A memo" "Facts" "A fact" "Mine" "Aged?"))))
- what
- the check above is right when it reads
(t (nil t nil t nil t)).
(defface konix/agent-shell-workspace-age-face
'((t :inherit shadow))
"Face of how long ago a heading was touched."
:group 'agent-shell)
(defun konix/agent-shell-workspace--age-said (seconds)
"Say SECONDS as an age: minutes, hours, then days."
(cond ((< seconds 3600) (format "%dm" (/ seconds 60)))
((< seconds 86400) (format "%dh" (/ seconds 3600)))
(t (format "%dd" (/ seconds 86400)))))
(defun konix/agent-shell-workspace--show-ages ()
"Show ahead of each heading of this buffer under a top one how long ago it was touched."
(remove-overlays (point-min) (point-max) 'konix/agent-shell-workspace-age t)
(save-excursion
(goto-char (point-min))
(let (ages)
(while (re-search-forward "^\\*\\*+ " nil t)
(let ((touched (konix/agent-shell-workspace--touched-at-point)))
(push (cons (line-beginning-position)
(if touched
(konix/agent-shell-workspace--age-said
(truncate (float-time
(time-subtract
nil (org-time-string-to-time touched)))))
""))
ages))
(end-of-line))
(let ((width (apply #'max 0 (mapcar (lambda (age) (length (cdr age))) ages))))
(when (> width 0)
(pcase-dolist (`(,where . ,said) ages)
(let ((overlay (make-overlay where where)))
(overlay-put overlay 'konix/agent-shell-workspace-age t)
(overlay-put overlay 'before-string
(propertize (format (format "%%%ds " width) said)
'face 'konix/agent-shell-workspace-age-face)))))))))
- how
- and every minute in the workspaces a window shows, so the age moves on while nothing is written, the writer’s idle age in the header line with them.
(defun konix/agent-shell-workspace--show-ages-shown ()
"Show the ages again in every workspace a window shows."
(dolist (window (window-list-1 nil 'nomini 'visible))
(with-current-buffer (window-buffer window)
(when (bound-and-true-p konix/agent-shell-workspace-mode)
(konix/agent-shell-workspace--show-ages)
(force-mode-line-update)))))
(defvar konix/agent-shell-workspace--ages-timer
(run-with-timer 60 60 #'konix/agent-shell-workspace--show-ages-shown)
"What moves the ages on while nothing is written.")
the places and addresses it names
- what
- one question may be about several places at once, one of them leading.
- scope: and a heading may name none at all, which a fact telling something rather than pointing somewhere does.
(defun konix/agent-shell-workspace--places (entry)
"Return ENTRY's places as a list of (FILE LINE CAPTION), the ones it names."
(seq-filter
#'car
(cons (list (alist-get 'file entry) (alist-get 'line entry)
(alist-get 'says entry))
(mapcar (lambda (place)
(list (alist-get 'file place) (alist-get 'line place)
(alist-get 'says place)))
(konix/mcp-server-decode-json-list
(alist-get 'also entry))))))
- what
- and an address on the web is named the same way, in a slot of its own, with
the caption the writer gives it.
- why: a writer with only a bullet to put an address in, and refused for length, shaves off the scheme, the eight characters that make it a link.
- rule: what it names is written out whole, and never counts against the body.
- therefore: nothing an address is put in is something to shorten, so the instinct that cut it has nothing left to cut.
- rule: and its caption is one line and no longer than a bullet, counting against nothing all the same.
- rule: and the refusal for a body too long says it: cut words, never an address.
- why: that refusal is the one place a writer trimming to fit is certain to read.
- rule: and it counts as saying nothing, the way a place does: a question carrying
an address and no words is still handed over empty.
- why: what a heading says and where it points are two different things, and the user cannot answer « what about it? ».
(defun konix/agent-shell-workspace--addresses (entry)
"Return ENTRY's web addresses as a list of (URL . CAPTION), the ones it names."
(seq-filter
#'car
(cons (cons (alist-get 'url entry) (alist-get 'says entry))
(mapcar (lambda (also)
(cons (alist-get 'url also) (alist-get 'says also)))
(konix/mcp-server-decode-json-list
(alist-get 'also entry))))))
(defun konix/agent-shell-workspace--check-addresses (heading addresses)
"Refuse ADDRESSES under HEADING whose caption runs long or over a line."
(dolist (address addresses)
(when-let* ((caption (cdr address)))
(when (string-match-p "\n" caption)
(error "A caption is one line, or it opens a heading of its own: %S"
caption))
(when (> (length caption) konix/agent-shell-workspace-bullet-max)
(konix/agent-shell-workspace--past-a-limit
"Caption" (length caption) konix/agent-shell-workspace-bullet-max heading
(format "Here: %s" caption))))))
(defun konix/agent-shell-workspace--addresses-written (addresses)
"Return ADDRESSES as the lines of a heading, each whole and as a link."
(mapconcat (lambda (address)
(format " - %s[[%s]]\n"
(if (cdr address) (concat (cdr address) " : ") "")
(car address)))
addresses))
the question written out
- rule
- the writer never names a revision: what a question is about in git is
V’s to say.
(concat (format "%s %s %s%s%s\n"
(konix/agent-shell-workspace--stars) state cookie heading
(if tagged (concat " :" (string-join tagged ":") ":") ""))
" :PROPERTIES:\n :ID: " id "\n"
(if revspec (concat " :REVSPEC: " revspec "\n") "")
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(mapconcat (lambda (bullet) (concat " - " bullet "\n")) bullets)
(konix/agent-shell-workspace--addresses-written addresses)
(konix/agent-shell-workspace--places-written places)
"\n")
- rule
- a rewrite keeps the tags the user put on the question’s heading,
:design:say.- why: the heading is written anew from the stars, and a tag left out of it is a tag the user put on for nothing.
- what
- a question rendered with
designamong its tags keeps:design:on its heading line, and one with no tags has none.
(with-temp-buffer
(org-mode)
(let ((tags (make-hash-table :test 'equal))
(id "5f0c1d2e-0000-4000-8000-000000000001"))
(puthash id '("design") tags)
(mapcar (lambda (with)
(let ((question (konix/agent-shell-workspace--render-question
`((id . ,id) (label . "Draw the flow, Go?")
(note . "[\"what :: it tilts\"]"))
nil nil (and with tags))))
(if (string-match-p "Go\\? +:design:$"
(car (split-string question "\n")))
'kept
'none)))
'(t nil))))
- what
- the check above is right when it reads
(kept none).
the code comes to the user
- rule
- every place a question names shows its code, right there.
- why: a question about a line the user has to go and open is a question the user answers badly, or postpones.
- what
- the code as it stands, four lines either side.
- rule
- the code goes in escaped the way org escapes any source block,
,*for*and,#+for#+. - rule
- and what opens and closes the block is indented under the bullet naming the
place, the code inside it left where it stands.
- why: flush left, the block belongs to no bullet, and the ones after it read as a list of their own.
(defconst konix/agent-shell-workspace-context-lines 4
"Lines shown either side of the line a place names.")
(defconst konix/agent-shell-workspace-under-a-bullet " "
"Indentation of what belongs to a bullet the workspace writes.")
(defun konix/agent-shell-workspace--source-text (file line)
"Return FILE around LINE as an Org source block, numbered from its own lines."
(when (and (file-readable-p file)
(not (konix/agent-shell-workspace--bytes-p file)))
(let ((from (max 1 (- line konix/agent-shell-workspace-context-lines)))
(to (+ line konix/agent-shell-workspace-context-lines)))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(forward-line (1- from))
(let ((start (point)))
(forward-line (1+ (- to from)))
(let ((text (buffer-substring-no-properties start (point))))
(format "%s#+begin_src %s -n %d\n%s%s#+end_src\n"
konix/agent-shell-workspace-under-a-bullet
(konix/agent-shell-workspace--src-lang file)
from
(org-escape-code-in-string
(if (string-suffix-p "\n" text)
text
(concat text "\n")))
konix/agent-shell-workspace-under-a-bullet)))))))
- how
- the block’s language is the mode Emacs would open the file in, text where it has none.
(defun konix/agent-shell-workspace--src-lang (file)
"Return the Org source language whose mode Emacs would open FILE with."
(let ((mode (assoc-default file auto-mode-alist 'string-match)))
(when (consp mode) (setq mode (car mode)))
(if (and (symbolp mode)
(string-suffix-p "-mode" (symbol-name mode)))
(string-remove-suffix "-mode" (symbol-name mode))
"text")))
a file that is not text
- rule
- a file that is not text shows nothing of itself, the link to it being all
there is to say.
- why: the bytes of an image are no lines to read.
- how: the head of the file decides it, a byte no text carries being what tells them apart.
(defconst konix/agent-shell-workspace-sniffed-bytes 4096
"How much of a file's head is read to tell text from bytes.")
(defun konix/agent-shell-workspace--bytes-p (file)
"Non-nil when FILE holds bytes rather than text."
(with-temp-buffer
(insert-file-contents-literally
file nil 0 konix/agent-shell-workspace-sniffed-bytes)
(and (string-search "\0" (buffer-substring-no-properties
(point-min) (point-max)))
t)))
- rule
- a picture is the exception: it shows itself.
- why: a question about a drawing is answered by looking at it, not by going to open it first.
- how: it is org’s own showing of one: a plain link to the file, on a line of its own, and the file says it opens with its pictures shown.
- scope: a picture Emacs can display; anything else it cannot is bytes like the rest.
(defun konix/agent-shell-workspace--picture-text (file)
"Return FILE as the link org shows a picture by, when it is one."
(when (and (file-readable-p file)
(image-supported-file-p file))
(format "%s[[file:%s]]\n"
konix/agent-shell-workspace-under-a-bullet file)))
the commit shown as git shows it
- rule
- the diff is produced on demand from the revision the question names.
- how: in practice the revision is written
SHA^!, git’s « this commit alone », and the^!is dropped forgit show, which wants the bare commit. - rule: and it reads as git shows a commit: its message on top, then its diff.
- why: the message says what the commit meant to do, which is what the diff is judged against.
- why: a diff kept on disk goes stale or goes missing.
- rule: and the diff stands in the repository’s top, where git’s paths start.
- why: standing in the review’s directory,
roam/,C-c C-clooked forwiki/…under it and reached no file.
- why: standing in the review’s directory,
- how: in practice the revision is written
(defconst konix/agent-shell-workspace-diff-buffer "*konix-workspace-diff*"
"Buffer holding the diff the user opened.")
(defun konix/agent-shell-workspace--render-diff (revspec directory)
"Fill the buffer the user reads diffs in with the commit REVSPEC, from DIRECTORY.
Its message comes first, as `git show' gives it, then its diff."
(let ((args (list "show" "--format=fuller"
(string-remove-suffix "^!" revspec)))
(buffer (get-buffer-create konix/agent-shell-workspace-diff-buffer)))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(widen)
(erase-buffer)
(setq-local default-directory directory)
(setq-local default-directory
(file-name-as-directory
(or (ignore-errors
(car (process-lines "git" "rev-parse" "--show-toplevel")))
directory)))
(unless (zerop (apply #'call-process "git" nil t nil args))
(error "git show failed: %s" (buffer-string)))
(when (= (point-min) (point-max))
(error "Empty diff for %s" revspec))
(diff-mode)
(konix/agent-shell-workspace-diff-mode 1)
(goto-char (point-min))))
buffer))
the commit under review, read whole
- what
- the user reviewing a commit opens its diff from the question, reads it, and
answers from the line they are on.
- therefore: the whole change is a keystroke away from the question, and one back.
(defvar-local konix/agent-shell-workspace--buffer nil
"Workspace this diff was shown from.")
(defvar-local konix/agent-shell-workspace--diff-question nil
"What was stood on as this diff was opened: the question it is answered to.")
(defun konix/agent-shell-workspace-back ()
"Go back to the workspace this diff was shown from."
(interactive)
(if (buffer-live-p konix/agent-shell-workspace--buffer)
(pop-to-buffer konix/agent-shell-workspace--buffer)
(quit-window)))
- rule
- and the keys that answer are the workspace’s own, bound here unchanged:
r, orRasr, for what the user types,yandnfor yes and no,gfor go on,?for what it was supposed to mean,.for done.- why: the user opened the diff to be able to answer, so the answer is where the reading ends and not one key further on.
- how: each answering command asks one helper what it stands on, and in a diff that
helper goes back to the question the diff was opened from.
- therefore: a key is written once and both places press it, and
C-h kon the diff names the same command as in the workspace.
- therefore: a key is written once and both places press it, and
- scope: a workspace gone from under it says so and answers nothing.
- rule: and
rquotes under the answer the diff line it was pressed on, linked to its source, asM-RETdoes under a subject.- how: one helper reads that diff line for both keys, nothing outside a diff.
- what
ron a line of the diff writes the answer with that line quoted and linked to the file it stands for.
(require 'cl-lib)
(let ((file (make-temp-file "check-rquote-" nil ".ws.org"))
(source (make-temp-file "check-rquote-src-" t))
(diff (generate-new-buffer " check-rquote-diff")))
(with-temp-file (expand-file-name "nowhere.el" source)
(insert "(new line)\n"))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"* Mine :mine:\n"
"** REFINE Review it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: the commit\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "too long" nil))))
(let ((workspace (find-file-noselect file)))
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer nil))
(with-current-buffer diff
(insert "diff --git a/nowhere.el b/nowhere.el\n"
"--- a/nowhere.el\n+++ b/nowhere.el\n"
"@@ -1,1 +1,1 @@\n-(old)\n+(new line)\n")
(diff-mode)
(setq-local default-directory (file-name-as-directory source))
(konix/agent-shell-workspace-diff-mode 1)
(setq-local konix/agent-shell-workspace--buffer workspace)
(setq-local konix/agent-shell-workspace--diff-question
(list nil "q" "Review it?"))
(goto-char (point-min))
(search-forward "+(new line)")
(save-window-excursion
(call-interactively
(lookup-key konix/agent-shell-workspace-diff-mode-map "r"))))
(with-current-buffer workspace
(prog1 (save-restriction
(widen)
(goto-char (point-min))
(and (re-search-forward
(concat "^\\*\\*\\* .*too long\\(.*\n\\)*?.*#\\+BEGIN_QUOTE\n"
" *\\+(new line)\n"
" *--- \\[\\[file\\+emacs:[^]]*nowhere\\.el::1\\]")
nil t)
'quoted-and-linked))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting
(expand-file-name "nowhere.el" source))))
(kill-buffer visiting)))
(kill-buffer diff)
(delete-directory source t)
(delete-file file)))
- what
- the check above is right when it reads
quoted-and-linked. - rule
- and
E,w,c,Kedit a commit and resolve what the edit brings, as editing a reviewed commit says.
(defconst konix/agent-shell-workspace-diff-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" #'konix/agent-shell-workspace-back)
(define-key map "r" #'konix/agent-shell-workspace-answer)
(define-key map "R" #'konix/agent-shell-workspace-answer)
(define-key map "y" #'konix/agent-shell-workspace-answer-yes)
(define-key map "g" #'konix/agent-shell-workspace-answer-go)
(define-key map "n" #'konix/agent-shell-workspace-answer-no)
(define-key map "?" #'konix/agent-shell-workspace-answer-what)
(define-key map "." #'konix/agent-shell-workspace-answer-done)
(define-key map (kbd "M-RET")
#'konix/agent-shell-workspace-answer-from-diff)
(define-key map "t" #'konix/agent-shell-workspace-done-from-diff)
(define-key map "E" #'konix/agent-shell-workspace-edit-diff)
(define-key map "w" #'konix/agent-shell-workspace-resolve-visit)
(define-key map "c" #'konix/agent-shell-workspace-resolve-continue)
(define-key map "K" #'konix/agent-shell-workspace-resolve-drop)
map)
"Keymap of `konix/agent-shell-workspace-diff-mode'.")
(define-minor-mode konix/agent-shell-workspace-diff-mode
"Read the diff of a workspace question.
\\{konix/agent-shell-workspace-diff-mode-map}"
:lighter " WorkspaceDiff"
:keymap konix/agent-shell-workspace-diff-mode-map
(setq buffer-read-only konix/agent-shell-workspace-diff-mode))
- rule
- and
M-RETraises a subject of the user’s own about the line being read, which the question the diff was opened from then waits on.- why: reviewing a commit, the user has many remarks on it, each a piece of work for the writer; the commit’s question is settled once they all are.
- how: the place is the one the diff line stands for in the file itself, so the link opens the source and not the diff.
- rule: and the line is quoted as it reads in the diff, its sign kept.
- why: what the user saw is the line as the change shows it.
- rule: and the question that waits is the one the diff was opened from,
remembered as it opened.
- why: the workspace’s cursor moves on while the user reads, so where it stands says nothing of what they are reviewing.
- rule: and the user stays in the diff, the subject written behind them.
- why: they are reading, and taking them to the workspace breaks it off.
- rule: and a line whose file cannot be found is quoted unlinked, nothing asked.
- why: a prompt in the middle of answering is the answer interrupted.
(defun konix/agent-shell-workspace--source-here ()
"Return (FILE . LINE) for the file line the diff line at point stands for."
(let (file line)
(save-window-excursion
(save-excursion
(ignore-errors
(cl-letf (((symbol-function 'read-file-name)
(lambda (&rest _) (error "No file this line stands for"))))
(diff-goto-source))
(setq file (buffer-file-name)
line (line-number-at-pos)))))
(when (and file line) (cons file line))))
(defun konix/agent-shell-workspace--diff-line-here ()
"Return (FILE LINE QUOTED) for the diff line at point, or nil outside a diff.
FILE and LINE are those of the source it stands for, nil where none is found;
QUOTED is the line as the diff shows it."
(when (bound-and-true-p konix/agent-shell-workspace-diff-mode)
(let ((source (konix/agent-shell-workspace--source-here)))
(list (car source) (cdr source)
(string-trim-right
(buffer-substring-no-properties (line-beginning-position)
(line-end-position)))))))
(defun konix/agent-shell-workspace-answer-from-diff (subject &optional body)
"Raise SUBJECT, and BODY under it, about the line point is on in this diff.
The question this diff was opened from waits on it."
(declare (modes konix/agent-shell-workspace-diff-mode))
(interactive (konix/agent-shell-workspace--read-heading-and-body "Remark: "))
(let* ((diff-line (konix/agent-shell-workspace--diff-line-here))
(workspace (if (buffer-live-p konix/agent-shell-workspace--buffer)
konix/agent-shell-workspace--buffer
(user-error "The workspace this diff was shown from is gone")))
(reviewed (or (nth 1 konix/agent-shell-workspace--diff-question)
(user-error "This diff was opened from no question"))))
(save-selected-window
(with-current-buffer workspace
(konix/agent-shell-workspace-add-subject
subject body (nth 0 diff-line) (nth 1 diff-line) (nth 2 diff-line)
nil nil (list reviewed))))))
- rule
- and
tsettles from the diff the question it was opened from, landing on the next question waiting.- why: a commit read and found right is settled where it was read.
- rule: and the diff’s window goes, the commit being done with.
(defun konix/agent-shell-workspace-done-from-diff ()
"Settle the question this diff was opened from, and go on to the next one."
(declare (modes konix/agent-shell-workspace-diff-mode))
(interactive)
(let ((id (or (nth 1 konix/agent-shell-workspace--diff-question)
(user-error "This diff was opened from no question")))
(workspace (if (buffer-live-p konix/agent-shell-workspace--buffer)
konix/agent-shell-workspace--buffer
(user-error "The workspace this diff was shown from is gone"))))
(when (and (eq (window-buffer) (current-buffer))
(not (one-window-p)))
(delete-window))
(pop-to-buffer workspace)
(unless (konix/agent-shell-workspace--goto-id id)
(user-error "The question this diff was opened from is gone"))
(konix/agent-shell-workspace--settle-question)))
- rule
- the revision shown is the question’s own,
written by
V.- scope: a question
Vdid not write names none, anddsays so, asking nobody.
- scope: a question
(defun konix/agent-shell-workspace--revision-here ()
"Return the revision the heading point stands in is read against, or nil."
(save-excursion
(konix/agent-shell-workspace--goto-question)
(org-entry-get (point) "REVSPEC")))
- rule
dopens it at its top, the whole of the change, never narrowed.- why: a commit is reviewed whole.
(defun konix/agent-shell-workspace--show-diff-at-point (select)
"Display what the question point sits in is about, of the change it names.
Selects its window when SELECT is non-nil."
(let ((revspec (or (konix/agent-shell-workspace--revision-here)
(user-error "This question is about no commit: V writes those")))
(workspace (current-buffer)))
(let* ((buffer (konix/agent-shell-workspace--render-diff
revspec (konix/agent-shell-workspace--review-directory)))
(question (save-excursion
(konix/agent-shell-workspace--goto-question)
(list nil (org-entry-get (point) "ID")
(konix/agent-shell-workspace--line-here))))
(window (display-buffer buffer)))
(with-current-buffer buffer
(setq-local konix/agent-shell-workspace--buffer workspace)
(setq-local konix/agent-shell-workspace--diff-question question)
(setq-local konix/agent-shell-workspace--diff-revision revspec)
(konix/agent-shell-workspace--annotate-diff (nth 1 question)))
(with-selected-window window
(goto-char (point-min))
(recenter 0))
(when select (select-window window)))))
- rule
- and each fact the review question links, pointing at a line of the new code
the diff shows, is shown under that line, its heading alone, in a face of its own.
- why: the user wants the writer to say, there in the diff, why a part matters.
- how: the writer writes it as any fact, about the review question, its place the file and line of the new code; nothing new to store, and the user reads, edits and drops it as any fact.
- scope: the diff is untouched: overlays, gone when it is shown afresh.
- scope: a fact pointing at a line the diff does not show is not shown in it.
- rule: the diff’s paths are read from its directory, the repository’s top.
- why: the nearest
.gitup from the review’s directory wasroam/, not the top, and no annotation of commit 0d70d821 found its line.
- why: the nearest
(defface konix/agent-shell-workspace-annotation-face
'((t :inherit (highlight italic) :box (:line-width -1)))
"Face of a writer's fact shown under the diff line it points at."
:group 'agent-shell)
(face-spec-set 'konix/agent-shell-workspace-annotation-face
'((t :inherit (highlight italic) :box (:line-width -1)))
'face-defface-spec)
(defun konix/agent-shell-workspace--diff-new-lines ()
"Return a table of (FILE . LINE) of the new code this diff shows to where that line ends."
(let ((lines (make-hash-table :test #'equal))
(root default-directory)
file new)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(cond ((looking-at "^diff ") (setq new nil))
((looking-at "^\\+\\+\\+ \\(?:b/\\)?\\(.*\\)$")
(setq file (expand-file-name (match-string 1) root) new nil))
((looking-at "^@@ -[0-9,]+ \\+\\([0-9]+\\)")
(setq new (string-to-number (match-string 1))))
((and new file (looking-at "^[ +]"))
(puthash (cons file new) (line-end-position) lines)
(setq new (1+ new))))
(forward-line 1)))
lines))
(defun konix/agent-shell-workspace--facts-placed (id)
"Return (LABEL FILE LINE) for each place of each fact question ID links, in the workspace."
(let (found)
(save-excursion
(when (konix/agent-shell-workspace--goto-id id)
(let ((end (save-excursion (outline-next-heading) (point)))
facts)
(while (re-search-forward "\\[\\[id:\\([^]]+\\)\\]" end t)
(push (match-string-no-properties 1) facts))
(dolist (fact (nreverse facts))
(when (and (konix/agent-shell-workspace--goto-id fact)
(konix/agent-shell-workspace--fact-at-point-p))
(let ((label (org-get-heading t t t t))
(end (save-excursion (outline-next-heading) (point))))
(while (re-search-forward
"\\[\\[file\\+emacs:\\([^]]+?\\)::\\([0-9]+\\)\\]" end t)
(push (list label
(expand-file-name (match-string-no-properties 1))
(string-to-number (match-string-no-properties 2)))
found))))))))
(nreverse found)))
(defun konix/agent-shell-workspace--annotate-diff (id)
"Show under each line of this diff the facts question ID links that point at it."
(remove-overlays (point-min) (point-max) 'konix/agent-shell-workspace-annotation t)
(when (and id (buffer-live-p konix/agent-shell-workspace--buffer))
(let ((lines (konix/agent-shell-workspace--diff-new-lines))
(placed (with-current-buffer konix/agent-shell-workspace--buffer
(konix/agent-shell-workspace--facts-placed id))))
(pcase-dolist (`(,label ,file ,line) placed)
(when-let* ((at (gethash (cons file line) lines)))
(let ((overlay (make-overlay at at)))
(overlay-put overlay 'konix/agent-shell-workspace-annotation t)
(overlay-put overlay 'after-string
(concat "\n "
(propertize (concat " ▸ writer: " label " ")
'face 'konix/agent-shell-workspace-annotation-face)))))))))
- what
- a fact linked from the review, pointing at the second new line of
foo.el, shows under that line, one pointing at a line the diff does not show nowhere.
(let* ((root (file-name-as-directory (make-temp-file "check-annot-" t)))
(file (expand-file-name "foo.el" root))
(workspace (generate-new-buffer " check-annot-ws"))
(diff (generate-new-buffer " check-annot-diff")))
(make-directory (expand-file-name ".git" root))
(unwind-protect
(progn
(with-current-buffer workspace
(insert "#+TODO: TODO REFINE | DONE\n"
"* REFINE Review it :review:\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: [[id:f][Why two]]\n - what :: [[id:g][Elsewhere]]\n"
"* Why two\n :PROPERTIES:\n :ID: f\n :END:\n"
" - [[file+emacs:" file "::2][foo.el:2]]\n"
"* Elsewhere\n :PROPERTIES:\n :ID: g\n :END:\n"
" - [[file+emacs:" file "::40][foo.el:40]]\n")
(org-mode))
(with-current-buffer diff
(setq default-directory root)
(insert "diff --git a/foo.el b/foo.el\n--- a/foo.el\n+++ b/foo.el\n"
"@@ -1,2 +1,3 @@\n one\n+two\n three\n")
(setq-local konix/agent-shell-workspace--buffer workspace)
(konix/agent-shell-workspace--annotate-diff "q")
(mapcar (lambda (overlay)
(list (save-excursion
(goto-char (overlay-start overlay))
(buffer-substring-no-properties
(line-beginning-position) (point)))
(substring-no-properties (overlay-get overlay 'after-string))))
(seq-filter (lambda (overlay)
(overlay-get overlay 'konix/agent-shell-workspace-annotation))
(overlays-in (point-min) (point-max))))))
(kill-buffer workspace)
(kill-buffer diff)
(delete-directory root t)))
▸ writer: Why two | ▸ writer: Why two | ▸ Why two | ▸ Why two |
- what
- the check above is right when it reads
(("+two" "\n ▸ writer: Why two ")). - rule
- and it reads as a note, not a line of the hunk: boxed, on a background of its
own, opening on « writer: ».
- why: italic text indented like code read as one more line of the diff.
- rule
- and
don the question the diff already shows goes back to it as it was left, nothing shown again.- why: the user removes the hunks they have read, and does not want them back.
- scope: the commit rewritten since, by an edit, is shown afresh.
- how: the diff remembers the revision it shows, as well as its question.
(defvar-local konix/agent-shell-workspace--diff-revision nil
"Revision this diff shows.")
(defun konix/agent-shell-workspace--diff-showing ()
"Return the diff buffer when it shows already the question point sits in."
(when-let* ((buffer (get-buffer konix/agent-shell-workspace-diff-buffer))
(revspec (konix/agent-shell-workspace--revision-here))
(id (save-excursion
(konix/agent-shell-workspace--goto-question)
(org-entry-get (point) "ID")))
(workspace (current-buffer)))
(with-current-buffer buffer
(and (eq konix/agent-shell-workspace--buffer workspace)
(equal (nth 1 konix/agent-shell-workspace--diff-question) id)
(equal konix/agent-shell-workspace--diff-revision revspec)
buffer))))
(defun konix/agent-shell-workspace-goto-diff ()
"Show the change the question point sits in is about, whole, from its top.
The diff already showing it is gone back to as it was left."
(interactive)
(if-let* ((buffer (konix/agent-shell-workspace--diff-showing)))
(pop-to-buffer buffer)
(konix/agent-shell-workspace--show-diff-at-point t)))
- what
- a hunk taken off the diff,
dagain on the same question keeps it off; on another, or the commit rewritten, the diff is shown afresh.
(require 'cl-lib)
(let ((file (make-temp-file "check-dkeep-" nil ".ws.org"))
(konix/agent-shell-workspace-diff-buffer " check-dkeep-diff")
(shown 0)
workspace)
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING TOCHECK | DONE\n"
"* REFINE Review one?\n :PROPERTIES:\n :ID: one\n"
" :REVSPEC: aaa^!\n :END:\n"
"* REFINE Review two?\n :PROPERTIES:\n :ID: two\n"
" :REVSPEC: bbb^!\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--review-directory)
(lambda () default-directory))
((symbol-function 'konix/agent-shell-workspace--render-diff)
(lambda (revspec _directory)
(cl-incf shown)
(with-current-buffer (get-buffer-create
konix/agent-shell-workspace-diff-buffer)
(let ((inhibit-read-only t))
(erase-buffer)
(diff-mode)
(insert revspec " hunk\n"))
(current-buffer)))))
(setq workspace (find-file-noselect file))
(save-window-excursion
(let ((d (lambda (heading)
(switch-to-buffer workspace)
(goto-char (point-min))
(search-forward heading)
(konix/agent-shell-workspace-goto-diff)
(current-buffer))))
(with-current-buffer (funcall d "Review one?")
(let ((inhibit-read-only t)) (erase-buffer) (insert "left as it was\n")))
(let* ((again (with-current-buffer (funcall d "Review one?")
(list (buffer-string) shown)))
(other (progn (funcall d "Review two?") shown))
(rewritten
(progn (funcall d "Review one?")
(with-current-buffer workspace
(goto-char (point-min))
(search-forward "aaa^!")
(replace-match "ccc^!"))
(with-current-buffer (funcall d "Review one?")
(list (buffer-string) shown)))))
(list (if (equal again '("left as it was\n" 1)) 'kept 'redone)
(if (= other 2) 'other-afresh 'other-kept)
(if (equal rewritten '("ccc^! hunk\n" 4))
'rewritten-afresh 'rewritten-kept))))))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(when-let* ((diff (get-buffer konix/agent-shell-workspace-diff-buffer)))
(kill-buffer diff))
(delete-file file)))
- what
- the check above is right when it reads
(kept other-afresh rewritten-afresh).
where the headings accrue
the workspace itself
- what
- the headings live in a workspace, a document of their own, which is never the thing being worked on.
- rule
- it is an Org file whose name ends in
.ws.org, which opens it as one even before anything is loaded; one with another name is claimed by its#+WORKSPACE:line.
bound to the session
- rule
- the binding lives on the session.
- why: a writer bound to a workspace must not wander off it.
- rule
- the binding is kept in a store on disk.
- why: a writer that resumes has to find its binding again.
- how: the session id is the key it is filed under.
- how
- binding a session also lets its answering tools through, steers it, opens the workspace and tints it, each said where it is done: what can be bound, steered back, kept in front of the user, a bound session says so.
(defvar-local konix/agent-shell-workspace--file nil
"Document this agent-shell session writes its questions into.")
(defvar konix/agent-shell-workspace-store
(konix/agent-shell-session-store-create
:file (expand-file-name "konix/konix-workspaces.el"
user-emacs-directory))
"Store mapping a session id to the document it writes its questions into.")
(defvar konix/agent-shell-workspace--binding
(konix/agent-shell-session-binding-create
:store konix/agent-shell-workspace-store
:variable 'konix/agent-shell-workspace--file
:on-bind
(lambda (shell file)
(if (not file)
(konix/agent-shell-workspace--unsteer shell)
(konix/agent-shell-workspace--whitelist-answering-tools shell)
(konix/agent-shell-workspace--steer shell)
(konix/agent-shell-workspace--show file shell nil))
(konix/agent-shell-workspace--tint-session shell)))
"What a session's workspace is bound through.")
(defun konix/agent-shell-workspace-file (&optional shell)
"Return the document SHELL writes its questions into, or nil."
(konix/agent-shell-session-binding-value
konix/agent-shell-workspace--binding shell))
(defun konix/agent-shell-workspace--remember (shell file)
"Bind FILE as SHELL's workspace, buffer-local and on disk."
(konix/agent-shell-session-binding-bind
konix/agent-shell-workspace--binding shell file))
(defun konix/agent-shell-workspace--forget (shell)
"Drop SHELL's workspace, buffer-local and on disk."
(with-current-buffer shell
(setq-local konix/agent-shell-workspace--briefed nil))
(konix/agent-shell-session-binding-unbind
konix/agent-shell-workspace--binding shell))
- how
- which shell is calling comes from the tool call itself, and failing that from whichever agent-shell the request was routed through.
(defun konix/agent-shell-workspace--writer ()
"Return the agent-shell buffer calling this tool, or nil."
(or (and (buffer-live-p konix/mcp-server--calling-buffer)
konix/mcp-server--calling-buffer)
(konix/mcp-server--calling-agent-buffer)))
- rule
- a workspace tool called from a session with nothing bound is refused, and never falls back on a file of its own choosing.
- how
- the tool is told plainly.
(defun konix/agent-shell-workspace--file-or-error ()
"Return the document the calling session writes its questions into."
(let ((writer (konix/agent-shell-workspace--writer)))
(unless (buffer-live-p writer)
(error "Cannot tell which session is calling, so nothing is written"))
(or (konix/agent-shell-workspace-file writer)
(error "No workspace is bound to this session — ask the user to bind one"))))
kept in front of the user
- rule
- binding opens the file too, read-only and auto-reverting.
- rule
- and reaching it again is one key from wherever the user talks to the writer.
- rule
- and it is put in the tracking round, the list of buffers waiting on the user
that they step through, on two counts only: a question is asking them something, or
its writer has stopped with nothing of its own left.
- why: the user sends a batch of work and reads it when the batch is done, so a question finished, or a fact written, is no reason to disturb them.
- why: and a question asking them stops the writer, so they have to know.
- why: and a writer with nothing left is one the user has more to give, and nothing else tells them it is free.
- scope: the writer’s other moves count for nothing: taking one up, awaiting a run, having it back.
- scope: what is finished, and what is written to be read, are theirs all the same — the walk through the workspace stops on them, but they do not put it in the round.
- rule: and it is put there when a question newly asks them, not on every write.
- why: a write that leaves the same questions asking sends them back to a workspace they have already read.
- scope: and fewer asking is nothing new: they answered one and left the rest.
- how: what asked when it was last looked at is remembered, and only a question not among them puts it there again.
- scope: and it leaves the round as soon as neither holds.
jumping to the shell and back
- what
- a question turns the user’s attention to something already discussed, so the user jumps to the shell to see what the writer did, and interrupts it to guide it if it needs guiding.
- rule
- then
Otakes the user back to the workspace, to answer the rest.- rule: in the shell as in its viewport, an empty prompt included.
- scope: bar a message being written at an idle prompt, where it is a letter.
- rule: and it lands on a question that is theirs, as stepping in from the round
does.
- why: whichever way the user arrives, what they arrived for is a question of theirs.
- rule: in the shell as in its viewport, an empty prompt included.
(defun konix/agent-shell-workspace--bound-file-or-error (shell)
"Return the workspace SHELL is bound to, or refuse."
(or (konix/agent-shell-workspace-file shell)
(user-error "No workspace is bound to that session")))
- what
- the commands reaching a session’s workspace from it refuse alike when none is bound.
(require 'cl-lib)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (shell) (and (eq shell 'bound) "/x.ws.org"))))
(list (konix/agent-shell-workspace--bound-file-or-error 'bound)
(condition-case err
(konix/agent-shell-workspace--bound-file-or-error 'free)
(user-error (cadr err)))))
- what
- the check above is right when it reads
("/x.ws.org" "No workspace is bound to that session").
(defun konix/agent-shell-workspace-goto ()
"Visit the workspace bound to the agent-shell this is called from."
(declare (modes agent-shell-mode
agent-shell-viewport-view-mode
agent-shell-viewport-edit-mode))
(interactive)
(let* ((shell (konix/agent-shell--current-shell-or-error))
(file (konix/agent-shell-workspace--bound-file-or-error shell)))
(unless (file-readable-p file)
(user-error "Workspace gone from disk: %s" file))
(pop-to-buffer (konix/agent-shell-workspace--show file shell nil))
(konix/agent-shell-workspace--land-on-a-users-question)))
(defun konix/agent-shell-workspace--prompt-text ()
"Return what the user has typed at the shell's last prompt so far."
(save-excursion
(goto-char (point-max))
(if (re-search-backward comint-prompt-regexp nil t)
(string-trim (buffer-substring-no-properties (match-end 0) (point-max)))
"")))
(defun konix/agent-shell-workspace-goto-unless-writing ()
"Go to the workspace, unless a message is being written at the prompt."
(interactive)
(if (and (shell-maker-point-at-last-prompt-p)
(not (shell-maker-busy))
(not (string-empty-p (konix/agent-shell-workspace--prompt-text))))
(self-insert-command 1)
(call-interactively #'konix/agent-shell-workspace-goto)))
(with-eval-after-load 'agent-shell
(define-key agent-shell-mode-map (kbd "O")
#'konix/agent-shell-workspace-goto-unless-writing)
(define-key agent-shell-viewport-view-mode-map (kbd "O")
#'konix/agent-shell-workspace-goto))
picking one of the working directory’s own
- rule
- the workspaces of a working directory sit in one place, so one command asks which of
them is meant and goes there.
- why: the user comes back to a piece of work with nothing open to jump from, and a path typed out is not how they hold a day-old subject in mind.
- scope: a single one is offered as the default,
RETgoing to it, so a new name can always be typed.
- rule
- and picking one that stands starts nothing: the workspace opens, and the
writer with it when there is something to say to it.
- why: the first subject the user raises resumes the session the workspace names, so starting one at the picking is starting it to sit there.
- therefore: picking one costs nothing and can be done to look, which is what picking is for.
- how
- the user is left in the workspace, landed there the way arriving at one lands
them by any other road.
- scope: it binds nothing, opening what is already bound and written down.
- rule
- but a name standing for no workspace yet starts one: the workspace is made, a
writer started on the preferred agent and the default model, bound to it, and the
user left in the workspace to raise the first subject.
- why: the user starts the journey from the workspace rather than binding one from an agent-shell.
- how: the writer starts unfocused in the working directory, its binding written as soon as its session has an id.
- what
- a new name typed at the picker, one workspace already there, leaves a workspace file of that name, a writer on the preferred agent and the default model bound to it, and the user in that workspace.
(require 'cl-lib)
(let* ((top (make-temp-file "check-pick-" t))
(writer (generate-new-buffer " check-pick-writer"))
(file (expand-file-name (concat konix/agent-shell-workspace-directory
"/fresh" konix/agent-shell-workspace-suffix)
top))
started)
(with-current-buffer writer (setq major-mode 'agent-shell-mode))
(make-directory (file-name-directory file) t)
(write-region "" nil (expand-file-name
(concat "old" konix/agent-shell-workspace-suffix)
(file-name-directory file)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--working-directory-of)
(lambda (&rest _) top))
((symbol-function 'completing-read) (lambda (&rest _) "fresh"))
((symbol-function 'agent-shell--resolve-preferred-config)
(lambda () '((:name . "claude"))))
((symbol-function 'agent-shell--start)
(lambda (&rest args)
(let ((config (plist-get args :config)))
(setq started
(list (map-elt config :name)
(equal (funcall (map-elt config :default-model-id))
konix/agent-shell-default-model-id))))
writer))
((symbol-function 'konix/agent-shell-ensure-viewport) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--tint-session) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--whitelist-answering-tools)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell--shell-session-id) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore))
(save-window-excursion
(with-temp-buffer
(konix/agent-shell-workspace-pick))
(prog1 (list (and (file-exists-p file) 'made)
started
(and (equal (konix/agent-shell-workspace-file writer) file)
'bound)
(and (equal (buffer-file-name (window-buffer (selected-window)))
file)
'landed)
(and (member konix/agent-shell-workspace-server-name
(mapcar (lambda (server) (alist-get 'name server))
(buffer-local-value 'agent-shell-mcp-servers
writer)))
'served)
(let ((bare (generate-new-buffer " check-pick-bare")))
(unwind-protect
(condition-case nil
(with-current-buffer bare
(setq major-mode 'agent-shell-mode)
(konix/agent-shell-workspace-bind file)
'bound-bare)
(user-error 'refused))
(kill-buffer bare))))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer visiting))))))
(kill-buffer writer)
(delete-directory top t)))
- what
- the check above is right when it reads
(made ("claude" t) bound landed served refused): the writer gets the workspace’s tools, wherever it starts, and a session without them is refused binding. - rule
- a writer a workspace starts holds the workspace’s tool server, whatever the
directory it starts in gives.
- why: contribute’s writer, started in a project not giving it, was told to use tools it never had, nudge after nudge.
(defun konix/agent-shell-workspace--of-this-working-directory ()
"Return the workspaces of the working directory this buffer sits in, by their paths.
The one changed last comes first."
(let ((where (file-name-as-directory
(expand-file-name
konix/agent-shell-workspace-directory
(konix/agent-shell-workspace--working-directory-of (current-buffer))))))
(when (file-directory-p where)
(sort (seq-filter (lambda (file)
(string-suffix-p konix/agent-shell-workspace-suffix file))
(directory-files where t))
#'file-newer-than-file-p))))
(defun konix/agent-shell-workspace--as-listed (names)
"Return a completion table of NAMES that keeps them in the order given."
(lambda (string predicate action)
(if (eq action 'metadata)
'(metadata (display-sort-function . identity)
(cycle-sort-function . identity))
(complete-with-action action names string predicate))))
(defun konix/agent-shell-workspace-pick ()
"Go to one of this working directory's workspaces, or start one under a new name."
(interactive)
(let* ((where (file-name-as-directory
(expand-file-name
konix/agent-shell-workspace-directory
(konix/agent-shell-workspace--working-directory-of (current-buffer)))))
(files (konix/agent-shell-workspace--of-this-working-directory))
(names (mapcar #'file-name-nondirectory files))
(name (completing-read "Workspace (a new name starts one): "
(konix/agent-shell-workspace--as-listed names) nil nil nil
nil (and (= (length names) 1) (car names))))
(file (expand-file-name
(if (string-suffix-p konix/agent-shell-workspace-suffix name)
name
(concat name konix/agent-shell-workspace-suffix))
where)))
(if (file-exists-p file)
(progn
(pop-to-buffer (find-file-noselect file))
(konix/agent-shell-workspace--land-on-a-users-question))
(konix/agent-shell-workspace--start-with-a-writer
file (konix/agent-shell-workspace--working-directory-of (current-buffer))))))
(defun konix/agent-shell-workspace--start-with-a-writer (file directory &optional summary)
"Start a writer in DIRECTORY on the preferred agent, bound to the workspace FILE.
SUMMARY, the one before it summed up, is told it with its briefing."
(let* ((default-directory (file-name-as-directory directory))
(model (konix/agent-shell-workspace--writer-model file))
(shell (agent-shell--start
:config (map-insert (agent-shell--resolve-preferred-config)
:default-model-id
(lambda () model))
:new-session t
:session-strategy 'new
:no-focus t)))
(konix/agent-shell-ensure-viewport shell)
(when-let* ((workspace (find-buffer-visiting file)))
(with-current-buffer workspace
(setq konix/agent-shell-workspace--turn-ended nil)
(unless (eq konix/agent-shell-workspace--context 'fresh)
(setq konix/agent-shell-workspace--context nil))))
(with-current-buffer shell
(unless (seq-find (lambda (server)
(equal (alist-get 'name server)
konix/agent-shell-workspace-server-name))
agent-shell-mcp-servers)
(setq-local agent-shell-mcp-servers
(append agent-shell-mcp-servers
(konix/agent-shell-mcp-servers-for
(list konix/agent-shell-workspace-server-name)))))
(setq-local konix/agent-shell-workspace--handed-over summary)
(konix/agent-shell-workspace-bind file))
(when-let* ((workspace (find-buffer-visiting file)))
(with-current-buffer workspace
(setq-local konix/agent-shell-workspace--writer-buffer shell)))
shell))
(defun konix/agent-shell-workspace--writer-model (file)
"Return the model id the writer the workspace FILE names was set to, or the default."
(or (when-let* (((file-exists-p file))
((fboundp 'konix/agent-shell-session-model-get))
(spec (with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--named-session-spec))))
(konix/agent-shell-session-model-get (car (split-string spec "\\?cwd="))))
konix/agent-shell-default-model-id))
- rule
- a writer starts on the model the writer before it was set to, from the
agent’s own list; on the agent’s default where there was none.
- why: the default let a writer run on Haiku while the user thought it was Opus.
- scope: read before the new writer is bound, while the workspace names the old one.
- rule
- the picker lists the workspaces changed last first, in that order whatever
the completion UI sorts by.
- why: the one wanted is mostly the one just worked in.
- how: a table whose metadata sorts by
identity, so vertico keeps the order.
(let* ((top (make-temp-file "check-pick-order-" t))
(where (expand-file-name konix/agent-shell-workspace-directory top))
(old (expand-file-name (concat "a" konix/agent-shell-workspace-suffix) where))
(new (expand-file-name (concat "b" konix/agent-shell-workspace-suffix) where)))
(make-directory where t)
(write-region "" nil new)
(write-region "" nil old)
(set-file-times new (time-add nil 60))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--working-directory-of)
(lambda (&rest _) top)))
(let* ((names (mapcar #'file-name-nondirectory
(konix/agent-shell-workspace--of-this-working-directory)))
(table (konix/agent-shell-workspace--as-listed names)))
(list names
(completion-metadata-get (completion-metadata "" table nil)
'display-sort-function))))
(delete-directory top t)))
- what
- the check above is right when it reads
(("b.ws.org" "a.ws.org") identity).
steered back to the workspace
- what
- the writer starts on prose the user will not read, and the steering stops it there and sends it to the workspace.
- what
- the question it writes instead comes padded, and the limits refuse that too.
- therefore
- what reaches the user is a question short enough to read at a glance, which the user answers, and so it goes on.
what the steering does
- rule
- a writer that writes prose while a workspace is bound is stopped, and told
to shut up and work, nobody reading what it writes.
- why: let run, the writer believes the user read it: it writes the reasoning for a bad move, hears no « no », and goes on as though it had been agreed.
- therefore: stopping costs a turn, and a turn is cheap beside a writer building on an agreement nobody gave.
- how: a named evaluator, referenced as a steering key, firing on the events that
carry the writer’s prose — never on its tool calls.
- scope: prose is words: a message without a letter or a digit is not, a lone
« . » say.
- scope: nor is « No response », what a turn that said nothing shows as.
- scope: and only what it wrote since the user last spoke counts.
- why: the last message it ever wrote stays the last one through a turn in which it writes nothing, and read again it is words said long before.
- scope: prose is words: a message without a letter or a digit is not, a lone
« . » say.
- scope: a writer left nothing of its own is stopped all the same.
- rule
- and it is told as it binds that nobody reads the chat.
- rule: and every nudge with work in it ends on it, as a fact, not an order.
- why: a writer woken for work has said nothing yet, and an order to be quiet reads to it as a telling-off.
- why: and what is said once, at binding, is forgotten a few turns on.
- rule: and a writer with nothing of its own is not woken to be told so.
- why: a turn spent reading that there is nothing to do is a turn for nothing.
- scope: a nudge with words of its own still goes, the projects said again for one.
- rule: and every nudge with work in it ends on it, as a fact, not an order.
- scope
- and the user can drop the whole arrangement, workspace and steering together, wanting the plain conversation back.
what is left to the writer
- what
- work of the writer’s own is a question still the writer’s, or a plan owed
toward a project, and nothing else.
- scope: a fact no question reaches is
no work of the writer’s,
Kbeing how the user clears those out. - therefore: whether anything is the writer’s own is one question, asked wherever the arrangement has to know whether it is done.
- scope: a fact no question reaches is
no work of the writer’s,
- rule
- and one held back by another is none of it, being work the writer is refused
rather than work it has not done.
- why: the user may hold every one of them back, and a writer told there is something for it and shown nothing goes round.
- scope: the one it holds counts whatever holds it back, it being in hand already and the putting down of it the writer’s own to do.
- therefore: a ring the user makes stops the writer rather than spinning it.
(defun konix/agent-shell-workspace--anything-left-p ()
"Non-nil when this buffer holds a question of the writer's own it can take up."
(let ((questions (konix/agent-shell-workspace--every-question)))
(seq-some
(lambda (one)
(and (konix/agent-shell-workspace--the-writers-p (nth 2 one) (car one))
(or (konix/agent-shell-workspace--held-state-p (nth 2 one))
(not (or (konix/agent-shell-workspace--holding-back
(car one) questions)
(konix/agent-shell-workspace--for-undefined-project-p
(car one)))))))
questions)))
- rule
- and what is left is named by
the listing itself, whole, rather than by
reciting the conditions.
- why: the writer keeps trying to move on while there are questions to read, so it must be told which ones.
- rule: and it carries what is written under each, the user’s answers included.
- why: named by their headings alone, a writer takes one up and acts without reading what the user said on it.
- how: it is written afresh whenever the workspace changes, since what it names is
whatever stands there at the time.
- how: every rewrite goes through writing the file out, and every word the user says through telling the writer, and it is written in those two places.
the turn cut short
- rule
- with nothing left of its own the writer’s turn is cut short for it, nothing
being said to it.
- why: it must not waste tokens on a turn with no work in it.
- scope: one waiting on a permission is cut too, the permission cancelled with it, asking as it does to go on with work no longer its own.
- therefore: nothing tells it what to do with nothing left, there being no turn left to tell.
- how: the cut rides the rewrite that emptied the workspace, so it lands the
moment the last question stops being the writer’s.
- rule: and a change of the user’s own rides it too, every one of their keys
going through the one write.
- why: the user may put the last question off, settle it or drop it, and the writer must not go on working with nothing there to work on.
- therefore: it is not the writer emptying it that cuts, but the workspace being empty after anything at all.
- rule: and a writer with nothing left is cut rather than told what changed.
- why: being told to read a workspace back and finding nothing in it is a turn spent to be cut at the end of it.
- rule: and a change of the user’s own rides it too, every one of their keys
going through the one write.
- rule
- what the writer has to do is read in one place, in order: a DoD to propose
or to rework, then nothing while a DoD waits on the user, then a plan to make, then
its own questions.
- why: the algorithm is simple: work to do, do the work; and what is work to do depends on whether there is a DoD to write, a plan to write, and so on.
- therefore: the cut, the telling to carry on and the badge all ask that one place.
- what
- a turn ending with the writer’s question open, its project’s DoD awaiting
the user, tells it to go on: that question is its work.
- why: if I put work to a project, even though its DoD is not done yet, it’s work from me, so it must be told to take it.
(require 'cl-lib)
(let ((file (make-temp-file "check-dodloop-" nil ".ws.org"))
(writer (generate-new-buffer " check-dodloop-writer"))
told)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Projects :projects:\n"
"** TODO The project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* Mine :mine:\n"
"** REFINE DoD: « The project »?\n :PROPERTIES:\n :ID: d\n"
" :PROJECT-DEFINE: p\n :END:\n - for :: [[id:p][The project]]\n"
" - done :: it works\n - doing :: try it\n"
"* Writer's :writers:\n"
"** WORKING Look at it\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][The project]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-cut) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (&rest _) (setq told t))))
(with-current-buffer writer
(konix/agent-shell-workspace--turn-ended-as-ever
'((:data . ((:stop-reason . "end_turn")))) nil))
(if told 'told 'quiet))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
told. - what
- once the user answers the DoD proposal, handing it back, the writer is told to rework it.
(let ((file (make-temp-file "check-dodback-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO The project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* TODO DoD: « The project »?\n :PROPERTIES:\n :ID: d\n"
" :PROJECT-DEFINE: p\n :END:\n - for :: [[id:p][The project]]\n"
" - done :: it works\n - doing :: try it\n"
"** me: what rule?\n :PROPERTIES:\n :ID: a\n :END:\n"
"* WORKING Look at it\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][The project]]\n"))
(unwind-protect
(konix/agent-shell-workspace--work-to-do file)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
dod.
(defun konix/agent-shell-workspace--work-to-do (file)
"Return what the writer of FILE has to do: `dod', `plan' or `questions'; nil for none."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(cond ((konix/agent-shell-workspace--dod-owed-project) 'dod)
((konix/agent-shell-workspace--dod-proposal-handed-back-p) 'dod)
((konix/agent-shell-workspace--starving-project) 'plan)
((konix/agent-shell-workspace--anything-left-p) 'questions)))))
(defun konix/agent-shell-workspace--dod-proposal-handed-back-p ()
"Non-nil when a DoD proposal of this buffer is the writer's to rework."
(save-excursion
(goto-char (point-min))
(let (found)
(while (and (not found)
(re-search-forward
(format "^ *:%s:" konix/agent-shell-workspace-define-property)
nil t))
(save-excursion
(org-back-to-heading t)
(setq found (member (org-get-todo-state)
konix/agent-shell-workspace-writers-keywords))))
found)))
(defun konix/agent-shell-workspace--writer-done-p (file)
"Non-nil when FILE leaves the writer nothing to do."
(not (konix/agent-shell-workspace--work-to-do file)))
- rule
- a writer left nothing has its turn cut as soon as the call that left it nothing
completes, before it can say a word.
- why: cut while that call is in flight, the call comes back « STOP what you are doing and wait for the user »; left to go on, it talks.
- rule: and the cut that waits for that call is the turn’s only one, made only if
the writer is still left nothing when the call completes, and dropped with the turn.
- why: a cut outliving the turn it was meant for cuts a later one, where the writer may have work.
- what
- the checks below share one world: a busy writer left nothing, a call of it in flight, and the events it waits on fired by hand.
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
- what
- a busy writer left nothing is not cut while a call is in flight, and is cut once it completes.
(require 'cl-lib)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer _file complete fire cut-p _waiting)
(konix/agent-shell-workspace--cut-short writer)
(list (funcall cut-p)
(progn (funcall complete)
(funcall fire 'tool-call-update)
(funcall cut-p)))))
- what
- the check above is right when it reads
(nil t). - what
- a writer given work while its cut waits is not cut when the call completes.
(require 'cl-lib)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer file complete fire cut-p _waiting)
(konix/agent-shell-workspace--cut-short writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Doing it\n :PROPERTIES:\n :ID: w\n :END:\n"))
(funcall complete)
(funcall fire 'tool-call-update)
(funcall cut-p)))
- what
- the check above is right when it reads
nil. - what
- told twice it is left nothing while a call is in flight, the writer has one cut waiting, not two.
(require 'cl-lib)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer _file _complete _fire _cut-p waiting)
(konix/agent-shell-workspace--cut-short writer)
(konix/agent-shell-workspace--cut-short writer)
(funcall waiting 'tool-call-update)))
- what
- the check above is right when it reads
1. - what
- a turn ending while its cut waits drops that cut.
(require 'cl-lib)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer _file _complete fire _cut-p waiting)
(konix/agent-shell-workspace--cut-short writer)
(funcall fire 'turn-complete)
(funcall waiting 'tool-call-update)))
- what
- the check above is right when it reads
0. - what
- each weighing of a cut leaves a
cutline saying what was decided.
(require 'cl-lib)
(let ((konix/agent-shell-workspace-debug-log " check-cut-log"))
(unwind-protect
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer _file complete _fire _cut-p _waiting)
(konix/agent-shell-workspace--cut-short writer)
(funcall complete)
(konix/agent-shell-workspace--cut-short writer)
(with-current-buffer konix/agent-shell-workspace-debug-log
(list (and (string-match-p "\\[cut\\] .*-> waiting for the call in flight"
(buffer-string))
t)
(and (string-match-p "\\[cut\\] .*-> left: a cut already waits"
(buffer-string))
t)))))
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))))
- what
- the check above is right when it reads
(t t). - rule
- a writer whose question the user takes out of
WORKINGorTHINKINGhas its turn cut there and then, other questions left to it or not.- scope: a call in flight is cut with it.
- scope: but not where its own call to the workspace is in flight, the writer letting the question go itself.
- what
- the user taking back the question held cuts a writer running a shell command, and not one whose own call to the workspace is in flight.
(require 'cl-lib)
(mapcar
(lambda (title)
(let ((file (make-temp-file "check-takenback-" nil ".ws.org"))
(writer (generate-new-buffer " check-takenback-writer"))
cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Do it?\n :PROPERTIES:\n :ID: q\n :END:\n"
"** TODO Then that?\n :PROPERTIES:\n :ID: t\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--go-on-soon) #'ignore)
((symbol-function 'agent-shell--state)
(lambda ()
`((:tool-calls . (("t1" . ((:title . ,title)
(:status . "in_progress"))))))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(konix/agent-shell-workspace--write
(goto-char (point-min))
(re-search-forward "^\\*\\* WORKING")
(replace-match "** TODO"))
cut))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
'("python3 x.py" "mcp__konix-emacs-workspace__set_workspace_question"))
- what
- the check above is right when it reads
(t nil).
(defvar-local konix/agent-shell-workspace--cut nil
"Non-nil while this writer's turn was cut short for want of work.")
(defvar konix/agent-shell-workspace--cut-held nil
"Non-nil while a plan is being written, the cut waiting for it to stand.")
(defvar-local konix/agent-shell-workspace--cut-waiting nil
"The subscriptions of the cut waiting on this writer's calls, or nil.")
(defun konix/agent-shell-workspace--call-in-flight-p ()
"Non-nil while this session has a tool call not yet completed."
(seq-some (lambda (call)
(member (map-elt (cdr call) :status) '("pending" "in_progress")))
(map-elt (agent-shell--state) :tool-calls)))
(defun konix/agent-shell-workspace--cut (writer)
"Cut WRITER's turn, now that no call of it is in flight."
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--cut t)
(let ((agent-shell-confirm-interrupt nil))
(ignore-errors (agent-shell-interrupt)))
(ignore-errors
(konix/agent-shell--cancel-pending-permissions))
(konix/agent-shell-workspace--leave-the-round writer)))
(defun konix/agent-shell-workspace--stop-waiting (writer)
"Drop the cut WRITER's turn was waiting to make."
(with-current-buffer writer
(dolist (token konix/agent-shell-workspace--cut-waiting)
(agent-shell-unsubscribe :subscription token))
(setq-local konix/agent-shell-workspace--cut-waiting nil)))
(defun konix/agent-shell-workspace--wait-to-cut (writer)
"Cut WRITER once none of its calls is in flight, if still left nothing then."
(with-current-buffer writer
(setq-local
konix/agent-shell-workspace--cut-waiting
(list (agent-shell-subscribe-to
:shell-buffer writer :event 'tool-call-update
:on-event
(lambda (_event)
(when (and (buffer-live-p writer)
(with-current-buffer writer
(not (konix/agent-shell-workspace--call-in-flight-p))))
(konix/agent-shell-workspace--stop-waiting writer)
(konix/agent-shell-workspace--cut-short writer))))
(agent-shell-subscribe-to
:shell-buffer writer :event 'turn-complete
:on-event
(lambda (_event)
(when (buffer-live-p writer)
(konix/agent-shell-workspace--stop-waiting writer))))))))
(defvar-local konix/agent-shell-workspace--spare-start nil
"Non-nil while the turn just sent opens on /compact, not to be cut at its start.")
(defvar-local konix/agent-shell-workspace--compacting nil
"Non-nil from a /compact sent until its compaction is seen done.
(FILE . SIZE): the session's JSONL and its size as /compact was sent; t where unknown.")
(defun konix/agent-shell-workspace--spared-p (writer)
"Non-nil, once, where WRITER's turn was started to compact it; the mark goes."
(with-current-buffer writer
(prog1 konix/agent-shell-workspace--spare-start
(setq konix/agent-shell-workspace--spare-start nil))))
(defun konix/agent-shell-workspace--note-compact (&rest args)
"Mark the shell ARGS send to as spared where the prompt opens on /compact."
(when-let* ((prompt (plist-get args :prompt))
(shell (plist-get args :shell-buffer))
((buffer-live-p shell))
((string-prefix-p "/compact" (string-trim-left
(substring-no-properties prompt)))))
(with-current-buffer shell
(when konix/agent-shell-workspace--quiet
(setq konix/agent-shell-workspace--quiet 'compact-sent))
(setq konix/agent-shell-workspace--spare-start t)
(setq konix/agent-shell-workspace--compacting
(or (when-let* ((file (konix/agent-shell-workspace--session-file-of shell))
((file-readable-p file)))
(cons file (file-attribute-size (file-attributes file))))
t)))
(ignore-errors (konix/agent-shell-workspace--context-say shell 'compacting))))
(defun konix/agent-shell-workspace--cut-short (writer)
"Cut WRITER's turn short when its workspace leaves it nothing to work on."
(when-let (((not konix/agent-shell-workspace--cut-held))
((not (konix/agent-shell-workspace--spared-p writer)))
(file (konix/agent-shell-workspace-file writer)))
(let ((done (konix/agent-shell-workspace--writer-done-p file)))
(with-current-buffer writer
(let* ((busy (or (shell-maker-busy)
(konix/agent-shell-workspace--asking-leave-p writer)))
(in-flight (and done busy (konix/agent-shell-workspace--call-in-flight-p)))
(decision
(cond ((not done) "left: work left")
((not busy) "left: not busy")
(konix/agent-shell-workspace--cut-waiting "left: a cut already waits")
(in-flight (konix/agent-shell-workspace--wait-to-cut writer)
"waiting for the call in flight")
(t (konix/agent-shell-workspace--cut writer) "cut"))))
(konix/agent-shell-workspace--debug
'cut (file-name-nondirectory file) "%s -> %s" (buffer-name writer) decision))))))
(defun konix/agent-shell-workspace--own-call-in-flight-p ()
"Non-nil while this session has a call to the workspace's own tools in flight."
(seq-some (lambda (call)
(and (member (map-elt (cdr call) :status) '("pending" "in_progress"))
(konix/agent-shell-workspace--own-tool-p (cdr call))))
(map-elt (agent-shell--state) :tool-calls)))
(defun konix/agent-shell-workspace--cut-taken-back (writer file)
"Cut WRITER's turn now, the user having taken back the question it held in FILE.
Return non-nil where it was cut."
(with-current-buffer writer
(let* ((busy (or (shell-maker-busy)
(konix/agent-shell-workspace--asking-leave-p writer)))
(decision
(cond ((not busy) "left: not busy")
((konix/agent-shell-workspace--own-call-in-flight-p)
"left: its own call let it go")
(t (konix/agent-shell-workspace--stop-waiting writer)
(konix/agent-shell-workspace--cut writer)
"cut: its question taken back"))))
(konix/agent-shell-workspace--debug
'cut (file-name-nondirectory file) "%s -> %s" (buffer-name writer) decision)
(string-prefix-p "cut" decision))))
- rule
- a turn the workspace opens on
/compactis never cut at its start, and a compacting call, a thinking one, is never held back, whoever started it.- why: compacting is the session tidying itself, no talk and no work.
- scope: any word said in that turn is cut as ever.
- what
- a /compact turn is spared at its start, once; another is not; the compact call is let through.
(with-temp-buffer
(let ((shell (current-buffer)))
(konix/agent-shell-workspace--note-compact :prompt "/compact keep it" :shell-buffer shell)
(list (and (konix/agent-shell-workspace--spared-p shell) t)
(konix/agent-shell-workspace--spared-p shell)
(progn (konix/agent-shell-workspace--note-compact :prompt "hello" :shell-buffer shell)
(konix/agent-shell-workspace--spared-p shell))
(funcall (cdr (assoc "workspace-nothing-taken-up" konix/agent-shell-tool-evaluators))
'((:title . "Compact conversation") (:kind . "think"))))))
- what
- the check above is right when it reads
(t nil nil nil).
out of the round the user walks
- rule
- a writer with nothing of its own stays out of the round the user walks, and
leaves it where it already stood there.
- why: a session that stops is a session waiting on nobody, and the round is for what waits on the user.
- how: the tracking asks whoever knows whether a ready session is for the user,
and this arrangement answers for the one it bound.
- therefore: nothing there knows what a workspace is, and the answer is given where the reason lives.
- how: and the answer is given again at the end of every turn, since a session taken into the round before it was done would otherwise sit there.
- scope: only that one leaves; every other reason the round holds a session is none of this arrangement’s business.
(defun konix/agent-shell-workspace--leave-the-round (writer)
"Take WRITER, and whatever shows it, out of the round the user walks."
(tracking-remove-buffer writer)
(when-let ((shown (agent-shell-viewport--buffer
:shell-buffer writer :existing-only t)))
(tracking-remove-buffer shown)))
(defun konix/agent-shell-workspace--nothing-left-for-the-writer-p ()
"Non-nil when this session's own workspace leaves it nothing to do."
(when-let ((file (konix/agent-shell-workspace-file (current-buffer))))
(konix/agent-shell-workspace--writer-done-p file)))
(add-hook 'konix/agent-shell-track-ready-skip-functions
#'konix/agent-shell-workspace--nothing-left-for-the-writer-p)
apart in the tree the user watches
- rule
- the tree the user watches says at a glance where each workspace stands: the
user having something to do, the writer at work, the writer slacking, or nothing
left.
- why: whenever the user has something to do, they must see it in the tree; with nothing theirs and the writer busy, a glance at the tree tells them; and whenever the writer is just slacking, they must see it.
- how: one list of faces, each with what makes it hold, read from the top, the
first that holds giving the face.
- why: the user wants no case dealt with on its own: one order says them all.
- how: a line wears the colour of its own badge, so a colour of its own is a face
of its own, and not a word more.
- why: the tree is a window the user keeps narrow, and a badge saying « nothing left » would cost every line of it the width.
- therefore: the badge still reads
[idle], the tree’s own words are untouched, and what changes is what the colour says.
- how: and the tree asks the way the tracking asks: whatever badge it has settled
on, it lets whoever knows give the face, telling them the status, and wears
whatever comes back.
- therefore: the tree names no workspace anywhere, and this arrangement names nothing of the tree but the two places it answers at: the face a line wears, and whether a session counts as working.
- scope: an error, or a permission pending, keeps the tree’s own colour: it is what the user wants to see first, whatever its workspace says.
- scope: and the status itself stays what it was, so everything else the tree reads off it is none of this arrangement’s business, bar whether one with a run going counts as working.
- how: named faces rather than colours, the way the keywords are faced, so the theme decides how it looks.
- rule: first, one wears the colour of the keyword of its most important question
not held back,
WORKING, thenTHINKING,REFINE,PERM,AWAITING,DISCUSS,TODO,TOCHECK, andDONElast, whatever the session is doing.- why: the user wants one rule: the colour is that of the workspace’s most important question; a busy or idle writer changes nothing to it.
- why: and
TOCHECKis the least important: aTOCHECKbeside aWORKINGor aTHINKINGhid that the writer was at it. - why: and a
DONEquestion still there givesDONE’s green: it showed the grey of an empty workspace. - scope: questions only: a fact, read or not, gives no colour.
- rule: but a
REFINEreview question counts apart, afterPERM, and gives theReviewheading’s colour.- why: a review session holds many, which are no writer waiting on the user,
and their
REFINEcolour hid the writer’s ownREFINE.
- why: a review session holds many, which are no writer waiting on the user,
and their
- rule: and the colour is the very one the keyword wears in the workspace’s
headings, the user’s org configuration first.
- why: the badge read another list, and gave
TODOa dim grey where its heading shows bold red.
- why: the badge read another list, and gave
- how: one function: the face of the first keyword, in that order, that a
question counting there opens on.
- why: a face of its own copying a keyword’s was the same choice made twice.
- rule: and the tree as a whole counts one with a run going as working.
- why: the tree’s « nobody works » says the user has to act, and here nobody has to.
- rule: then, one whose own questions are all held back by others still open wears
a colour of its own.
- why: it has work, and what frees it is the user settling what it waits on.
- rule: last, one with no question at all is shadowed, receding rather than calling for the eye.
- rule: and while the writer compacts, or is
F’s fresh writer before its first turn ends, its line is underlined too, over whichever colour it wears.- why: compacting or refreshing is another dimension than the colour, composed with it.
- how: from the
/compactsent until its compaction shows in the session file; forF, while the workspace’s header says « fresh ». - how: the tree wears a list of faces, the last giving the colour, and a seen line keeps the ones laid over it.
- scope: while
F’s summary is written there is no line to underline: the old writer is gone, the new one not up.
- what
- busy with a
REFINE, the badge wearsREFINE’s colour, with only aTOCHECK,TOCHECK’s; busy with aWORKING,WORKING’s; aTHINKINGbeside aTOCHECK,THINKING’s; idle with aTODO,TODO’s; idle with anAWAITING, the awaiting colour; idle with its own held back, the held-back colour; with only aDONE,DONE’s; with no question, the shadow.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-whosemove-writer"))
files)
(cl-flet ((face (status question &optional run)
(let ((file (make-temp-file "check-whosemove-" nil ".ws.org"))
(process (and run (start-process "check-whosemove" nil "sleep" "5"))))
(push file files)
(when process
(process-put process 'konix/agent-shell-workspace file)
(process-put process 'konix/agent-shell-workspace-id "a"))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
(replace-regexp-in-string "^\\* " "** " question)))
(find-file-noselect file)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(konix/mcp-server--given-status-face shell status))
(when process (delete-process process))))))
(unwind-protect
(list (face 'busy "* REFINE Fix it?\n :PROPERTIES:\n :ID: a\n :END:\n")
(face 'busy "* WORKING Fix it?\n :PROPERTIES:\n :ID: a\n :END:\n")
(face 'busy "* TOCHECK Fix it?\n :PROPERTIES:\n :ID: a\n :END:\n")
(face 'busy (concat "* TOCHECK Fixed?\n :PROPERTIES:\n :ID: a\n :END:\n"
"* THINKING Fix it?\n :PROPERTIES:\n :ID: b\n :END:\n"))
(face 'idle "* TODO Fix it?\n :PROPERTIES:\n :ID: a\n :END:\n")
(face 'idle "* AWAITING Run it?\n :PROPERTIES:\n :ID: a\n :END:\n" t)
(face 'idle (concat "* MAYBE Later?\n :PROPERTIES:\n :ID: a\n"
" :END:\n - holds back :: [[id:b][Fix it?]]\n"
"* TODO Fix it?\n :PROPERTIES:\n :ID: b\n"
" :END:\n - waits on :: [[id:a][Later?]]\n"))
(face 'idle (concat "* REFINE Then?\n :PROPERTIES:\n :ID: a\n"
" :END:\n - waits on :: [[id:b][First?]]\n"
"* TODO First?\n :PROPERTIES:\n :ID: b\n"
" :END:\n - holds back :: [[id:a][Then?]]\n"))
(face 'idle "* DONE Fix it?\n :PROPERTIES:\n :ID: a\n :END:\n")
(face 'idle ""))
(let ((kill-buffer-query-functions nil))
(dolist (file files)
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file))
(kill-buffer shell)))))
- what
- the check above is right when it reads
(error font-lock-function-name-face font-lock-preprocessor-face …-thinking-face (:foreground red :weight bold) font-lock-keyword-face …-held-back-face (:foreground red :weight bold) (:foreground forest green :weight bold) …-nothing-left-face), the keyword ones the faces ofREFINE,WORKING,TOCHECK,THINKING,TODO,AWAITINGandDONEas the headings wear them,TODO’s andDONE’s from the user’s org configuration. - what
- compacting, or freshly started by
F, the badge wears the underline over its colour, a seen line too; otherwise its colour alone.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-renewing-writer"))
(file (make-temp-file "check-renewing-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* Writer's :writers:\n"
"** WORKING Fix it?\n :PROPERTIES:\n :ID: a\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(let ((workspace (find-file-noselect file))
(face (lambda () (konix/mcp-server--given-status-face shell 'busy))))
(list (funcall face)
(progn (with-current-buffer shell
(setq-local konix/agent-shell-workspace--compacting t))
(funcall face))
(progn (with-current-buffer shell
(setq-local konix/agent-shell-workspace--compacting nil))
(with-current-buffer workspace
(setq konix/agent-shell-workspace--context 'fresh))
(prog1 (funcall face)
(with-current-buffer workspace
(setq konix/agent-shell-workspace--context nil))))
(konix/mcp-server--faces-of '(:foreground "red"))
(butlast (konix/mcp-server--faces-of
'(konix/agent-shell-workspace-renewing-face error))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer)))
(delete-file file)
(kill-buffer shell))))
- what
- the check above is right when it reads
(font-lock-function-name-face (…-renewing-face font-lock-function-name-face) (…-renewing-face font-lock-function-name-face) ((:foreground "red")) (…-renewing-face)): a plist is one face, and a seen line keeps all but the colour’s. - what
- a writer’s
REFINEbeside a review wearsREFINE’s colour; reviews alone, or beside aTODO, theReviewheading’s.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-reviewapart-writer"))
files)
(cl-flet ((face (question)
(let ((file (make-temp-file "check-reviewapart-" nil ".ws.org")))
(push file files)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING THINKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
(replace-regexp-in-string "^\\* " "** " question)))
(find-file-noselect file)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(konix/mcp-server--given-status-face shell 'idle)))))
(unwind-protect
(list (face (concat "* REFINE Review it :review:\n :PROPERTIES:\n :ID: a\n :END:\n"
"* REFINE Fix it?\n :PROPERTIES:\n :ID: b\n :END:\n"))
(face (concat "* REFINE Review it :review:\n :PROPERTIES:\n :ID: a\n :END:\n"
"* TODO Fix it?\n :PROPERTIES:\n :ID: b\n :END:\n"))
(face "* REFINE Review it :review:\n :PROPERTIES:\n :ID: a\n :END:\n"))
(let ((kill-buffer-query-functions nil))
(dolist (file files)
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file))
(kill-buffer shell)))))
- what
- the check above is right when it reads
(error konix/agent-shell-workspace-review-face konix/agent-shell-workspace-review-face). - rule
- the awaiting colour comes from the
AWAITINGquestion alone, never from whether a command runs.- why: an idle writer with nothing left but an
AWAITINGquestion, no command found running for it, showed green.
- why: an idle writer with nothing left but an
- what
- idle, nothing left for the writer, an
AWAITINGquestion, a fact and no command running at all: the awaiting colour.- why: a fact is no question, and gives no colour: one blanked the badge.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-awaitcolour-writer"))
(file (make-temp-file "check-awaitcolour-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** AWAITING Run it?\n :PROPERTIES:\n :ID: a\n :END:\n"
"* A fact not read yet\n :PROPERTIES:\n :ID: f\n :END:\n"))
(find-file-noselect file)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--nothing-left-for-the-writer-p)
(lambda () t)))
(konix/mcp-server--given-status-face shell 'idle))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer)))
(delete-file file)
(kill-buffer shell))))
- what
- the check above is right when it reads
font-lock-keyword-face. - rule
- and a question of the user’s held back by another is not theirs yet: it
wears no colour of theirs, and no « Waiting on you » names it.
- how: one test,
--users-turn-p, says what is the user’s turn; the badge, the round, the walk, the landing and the folding all ask it and nothing else. - why: a
REFINEwaiting on aTODOshowed as the user’s when it was neither theirs nor the writer’s.
- how: one test,
- rule
- a session picked in the tree goes where any pop to it goes,
its entry, on
RETand onoalike.- why: one place to say where a session is reached, not two to keep in step.
- scope:
RETstill moves the focus there andostill keeps it on the tree.
(defun konix/agent-shell-workspace--show-target (buf)
"Return what to show for BUF, a session or its viewport: where its entry goes when bound."
(let ((shell (with-current-buffer buf
(ignore-errors (konix/agent-shell--current-shell-or-error)))))
(if (and (buffer-live-p shell) (konix/agent-shell-workspace-file shell))
(konix/agent-shell-entry-buffer shell)
buf)))
(with-eval-after-load 'KONIX_agent-shell-common
(add-to-list 'konix/agent-shell-show-target-functions
#'konix/agent-shell-workspace--show-target))
- what
- a bound shell picked in the tree comes as its workspace; an unbound one as itself.
(require 'cl-lib)
(let ((file (make-temp-file "check-treews-" nil ".ws.org"))
(bound (generate-new-buffer " check-treews-bound"))
(free (generate-new-buffer " check-treews-free"))
(viewport (generate-new-buffer " check-treews-viewport"))
(agent-shell-prefer-viewport-interaction t)
asking shown)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional shell) (and (eq shell bound) file)))
((symbol-function 'konix/agent-shell--pending-permission-ids)
(lambda () (and asking (eq (current-buffer) bound) '("id"))))
((symbol-function 'agent-shell-viewport--buffer)
(lambda (&rest _) viewport))
((symbol-function 'pop-to-buffer) (lambda (b &rest _) (push b shown)))
((symbol-function 'display-buffer) (lambda (b &rest _) (push b shown))))
(dolist (b (list bound free))
(with-current-buffer b (setq major-mode 'agent-shell-mode)))
(konix/mcp-server--pop-to-agent-from-tree
(konix/agent-shell-show-target bound))
(konix/mcp-server--display-agent-from-tree
(konix/agent-shell-show-target bound))
(konix/mcp-server--pop-to-agent-from-tree
(konix/agent-shell-show-target free))
(setq asking t)
(konix/mcp-server--display-agent-from-tree
(konix/agent-shell-show-target bound))
(mapcar (lambda (b) (cond ((eq b free) 'free)
((eq b viewport) 'viewport)
((equal (buffer-file-name b) file) 'workspace)
(t b)))
(reverse shown)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(kill-buffer visiting))
(kill-buffer bound)
(kill-buffer free)
(kill-buffer viewport))
(delete-file file)))
- what
- the check above is right when it reads
(workspace workspace free viewport).
(defface konix/agent-shell-workspace-nothing-left-face
'((t :inherit shadow :weight bold))
"Face the badge of a session whose workspace leaves it nothing wears."
:group 'agent-shell)
(defun konix/agent-shell-workspace--run-going-here-p ()
"Non-nil when this session's workspace has a run going or queued, to wake it."
(when-let* ((file (konix/agent-shell-workspace-file (current-buffer))))
(or (> (konix/agent-shell-workspace--running file) 0)
(gethash file konix/agent-shell-workspace--queued))))
(defface konix/agent-shell-workspace-held-back-face
'((t :inherit font-lock-type-face :weight bold))
"Face the badge of a session whose own questions are all held back wears."
:group 'agent-shell)
(defun konix/agent-shell-workspace--held-back-p ()
"Non-nil when this session's workspace holds back questions of its own."
(when-let* ((file (konix/agent-shell-workspace-file (current-buffer)))
(workspace (find-buffer-visiting file)))
(with-current-buffer workspace
(let ((questions (konix/agent-shell-workspace--every-question)))
(seq-some (lambda (one)
(and (member (nth 2 one) konix/agent-shell-workspace-writers-keywords)
(konix/agent-shell-workspace--holding-back (car one) questions)))
questions)))))
(defconst konix/agent-shell-workspace-badge-faces
'((konix/agent-shell-workspace--question-keyword-face
. (lambda (_status) (konix/agent-shell-workspace--question-keyword-face)))
(konix/agent-shell-workspace-held-back-face
. (lambda (_status) (konix/agent-shell-workspace--held-back-p)))
(konix/agent-shell-workspace-nothing-left-face
. (lambda (_status) t)))
"Each face a badge may wear, with what makes it hold, the first holding winning.
A face given as a function is the one that function returns.")
(defun konix/agent-shell-workspace--pressing-keyword-face (keywords pick)
"Return the face of the first of KEYWORDS a question of this session's workspace opens on.
The face is the one that keyword wears in the workspace's own headings. Only the questions
PICK keeps count: called in the workspace with all its questions, it returns the ids of
those."
(when-let* ((file (konix/agent-shell-workspace-file (current-buffer)))
(workspace (find-buffer-visiting file)))
(with-current-buffer workspace
(when-let* ((questions (konix/agent-shell-workspace--every-question))
(states (mapcar #'konix/agent-shell-workspace--badge-state
(funcall pick questions)))
(keyword (seq-find (lambda (keyword) (member keyword states)) keywords)))
(if (equal keyword konix/agent-shell-workspace-badge-review)
'konix/agent-shell-workspace-review-face
(org-get-todo-face keyword))))))
(defconst konix/agent-shell-workspace-badge-review "REVIEW"
"What a review question still the user's counts as among the badge's keywords.")
(defun konix/agent-shell-workspace--badge-state (id)
"Return the keyword question ID counts as in the badge: its own, but a review's apart.
A project counts as none."
(let ((state (save-excursion
(goto-char (point-min))
(when (re-search-forward
(format "^[ \t]*:ID:[ \t]+%s[ \t]*$" (regexp-quote id)) nil t)
(org-back-to-heading t)
(unless (konix/agent-shell-workspace--project-at-point-p)
(cons (konix/agent-shell-workspace--state-at-point)
(member konix/agent-shell-workspace-review-tag
(org-get-tags nil t))))))))
(if (and (cdr state)
(equal (car state) konix/agent-shell-workspace-refine-keyword))
konix/agent-shell-workspace-badge-review
(car state))))
(defconst konix/agent-shell-workspace-badge-keywords
(list konix/agent-shell-workspace-working-keyword
konix/agent-shell-workspace-thinking-keyword
konix/agent-shell-workspace-refine-keyword
konix/agent-shell-workspace-permission-keyword
konix/agent-shell-workspace-badge-review
konix/agent-shell-workspace-awaiting-keyword
konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-fresh-keyword
konix/agent-shell-workspace-closing-keyword
konix/agent-shell-workspace-done-keyword)
"Keywords a badge wears the colour of, the most important first.")
(defun konix/agent-shell-workspace--question-keyword-face ()
"Return the face of the keyword of this session's most important question.
A question held back by another does not count."
(konix/agent-shell-workspace--pressing-keyword-face
konix/agent-shell-workspace-badge-keywords
(lambda (questions)
(seq-remove (lambda (id) (konix/agent-shell-workspace--holding-back id questions))
(mapcar #'car questions)))))
(defface konix/agent-shell-workspace-renewing-face
'((t :underline t))
"Face laid over the badge of a session compacting, or freshly started by F."
:group 'agent-shell)
(defun konix/agent-shell-workspace--renewing-p ()
"Non-nil while this session compacts, or is F's fresh writer before its first turn ends."
(or konix/agent-shell-workspace--compacting
(when-let* ((file (konix/agent-shell-workspace-file (current-buffer)))
(workspace (find-buffer-visiting file)))
(eq (buffer-local-value 'konix/agent-shell-workspace--context workspace)
'fresh))))
(defun konix/agent-shell-workspace--badge-face (status)
"Return the face for this session's badge, STATUS being the tree's, or nil.
Renewing, the renewing face is laid over it."
(when (konix/agent-shell-workspace-file (current-buffer))
(let* ((face (car (seq-find (lambda (face) (funcall (cdr face) status))
konix/agent-shell-workspace-badge-faces)))
(face (if (functionp face) (funcall face) face)))
(if (konix/agent-shell-workspace--renewing-p)
(list 'konix/agent-shell-workspace-renewing-face face)
face))))
(add-hook 'konix/mcp-server-status-face-functions
#'konix/agent-shell-workspace--badge-face)
(add-hook 'konix/mcp-server-goes-on-functions
#'konix/agent-shell-workspace--run-going-here-p)
- rule
- a project counts for nothing in the badge: only questions give it a colour.
- why: a project opens on
TODO, so a workspace with one and aTOCHECKworeTODO’s colour; the user said « the bug is that it takes the colors of project ».
- why: a project opens on
- what
- a workspace holding a project and a
TOCHECK: the badge’s face.
(require 'cl-lib)
(let ((file (make-temp-file "check-badge-project-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* Mine :mine:\n"
"** TOCHECK Fixed it\n :PROPERTIES:\n :ID: c\n :END:\n"))
(unwind-protect
(progn
(find-file-noselect file)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(with-temp-buffer
(konix/agent-shell-workspace--question-keyword-face))))
(with-current-buffer (find-buffer-visiting file)
(set-buffer-modified-p nil)
(kill-buffer))
(delete-file file)))
- what
- the check above is right when it reads
font-lock-preprocessor-face,TOCHECK’s.
what the shell says of a cut turn
- rule
- where the shell would say the turn was cancelled it says nothing more is the
writer’s to do.
- why: a cancel reads as one done by hand, hiding that the work simply ran out.
- how: the cut leaves a mark on the session it cut, and the block the shell writes
as the turn ends is rewritten from it.
- scope: so a cancel by hand still reads as one, as does the one the steering takes when the writer narrates.
- rule: and the mark goes at the end of every turn, whichever way it ended.
- why: a mark left standing would put those words on the next cancel, which would be a lie about a different turn.
- rule: and the workspace is read again as the words are said, not trusted from
when the cut was taken.
- why: work arrives between the two — the user writes a subject, or the writer takes one up — and then the words would be false of the very turn they label.
(defconst konix/agent-shell-workspace-cut-said "Nothing more to do for the writer"
"What the shell says where it would have said the turn was cancelled.")
(defun konix/agent-shell-workspace--say-cut (event)
"Say on EVENT what a turn cut short for want of work was, in the shell's own block."
(when (and konix/agent-shell-workspace--cut
(equal (map-elt (map-elt event :data) :stop-reason) "cancelled")
(when-let ((file (konix/agent-shell-workspace-file (current-buffer))))
(konix/agent-shell-workspace--writer-done-p file)))
(agent-shell--update-fragment
:state (agent-shell--state)
:block-id (format "%s-stop-reason"
(map-elt (agent-shell--state) :request-count))
:body konix/agent-shell-workspace-cut-said)))
told to carry on
- rule
- a turn that ends of its own accord with work still the writer’s has the
writer told to carry on.
- why: work to do? then do work.
- scope: a turn the user cancelled is not set going as it ends.
- why: the user cancels to stop something harmful, or to give guidance.
- rule: nor later: the cancel drops the telling it was waiting for.
- why: the user said « when I cancel, it must not be nudged back ».
- rule: and it is told every time it stops so, at once.
- why: letting the writer stop is a bad idea.
- what
- a turn ending cancelled, work left, leaves the writer idle.
(require 'cl-lib)
(let ((file (make-temp-file "check-cancelled-" nil ".ws.org"))
(writer (generate-new-buffer " check-cancelled-writer"))
told)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: it tilts\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer) (when (eq (or buffer (current-buffer)) writer) file)))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-cut) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (target &rest _) (when (eq target writer) (setq told t)))))
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--nudge-timer
(run-at-time 60 nil #'ignore))
(konix/agent-shell-workspace--turn-ended-as-ever
'((:data . ((:stop-reason . "cancelled")))) nil)
(list (if told 'told 'left-idle)
(if (memq konix/agent-shell-workspace--nudge-timer timer-list)
(progn (cancel-timer konix/agent-shell-workspace--nudge-timer)
'nudge-armed)
'nudge-dropped))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(left-idle nudge-dropped).
(defvar konix/agent-shell-workspace--going-on nil
"Non-nil while a telling to go on is given, so one queued checks the wait as it is said.")
(defun konix/agent-shell-workspace--waiting-p (writer)
"Non-nil while WRITER waits to be set going again, its workspace unchanged since."
(with-current-buffer writer
(and (memq konix/agent-shell-workspace--nudge-timer timer-list)
(equal konix/agent-shell-workspace--nudged-stamp
(file-attribute-modification-time
(file-attributes (konix/agent-shell-workspace-file writer)))))))
(defun konix/agent-shell-workspace--tell-to-go-on (writer)
"Tell WRITER, its workspace leaving it work, to do it: carry on, or plan.
Return what telling it gave, or the refusal's words where it was refused."
(when-let* (((buffer-live-p writer))
(file (konix/agent-shell-workspace-file writer))
((not (konix/agent-shell-workspace--writer-done-p file)))
((not (konix/agent-shell-workspace--waiting-p writer))))
(condition-case err
(let ((konix/agent-shell-workspace--going-on t))
(konix/agent-shell-workspace--submit
writer (konix/agent-shell-workspace--plan-next-text file)))
(user-error (error-message-string err))
(error nil))))
- rule
- and an idle writer with work left is told to carry on whenever the workspace
changes, whatever stopped it.
- why: work to do means do the work, as simple as that.
- what
- a change to the workspace tells its idle writer, its work left, to carry on.
(require 'cl-lib)
(let* ((file (make-temp-file "check-wake-" nil ".ws.org"))
(writer (generate-new-buffer " check-wake-writer"))
told soon)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: it tilts\n"))
(unwind-protect
(cl-letf (((symbol-function 'run-at-time)
(let ((run-at-time (symbol-function 'run-at-time)))
(lambda (time repeat function &rest args)
(if (and (equal time 0) (null repeat))
(progn (push (cons function args) soon) nil)
(apply run-at-time time repeat function args)))))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (memq (or buffer (current-buffer))
(list writer (find-buffer-visiting file)))
file)))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (target &rest _) (when (eq target writer) (setq told t)))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(konix/agent-shell-workspace--write
(goto-char (point-max))
(insert "* A fact\n :PROPERTIES:\n :ID: f\n :END:\n"))
(dolist (call (reverse soon))
(apply (car call) (cdr call)))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))
(if told 'told 'left-idle))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
told. - what
- with no timer, a change outside any command tells the writer at once; one inside a command tells it once the command is done, not before.
(require 'cl-lib)
(let* ((file (make-temp-file "check-wake-cmd-" nil ".ws.org"))
(writer (generate-new-buffer " check-wake-cmd-writer"))
(told 0))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: it tilts\n"))
(unwind-protect
(cl-letf (((symbol-function 'run-at-time) #'ignore)
((symbol-function 'run-with-timer) #'ignore)
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (memq (or buffer (current-buffer))
(list writer (find-buffer-visiting file)))
file)))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (target &rest _) (when (eq target writer) (cl-incf told)))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(prog1
(list (let ((this-command nil))
(konix/agent-shell-workspace--go-on-soon)
told)
(let ((this-command 'org-todo))
(konix/agent-shell-workspace--go-on-soon)
told)
(progn (run-hooks 'post-command-hook) told)
(progn (run-hooks 'post-command-hook) told))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
(1 1 2 2): told once outside a command, once after the command, and no more.
(defun konix/agent-shell-workspace--go-on-soon ()
"In a workspace, tell its idle writer to carry on or plan, once the user's gesture is done."
(when (and (bound-and-true-p konix/agent-shell-workspace-mode)
(buffer-live-p konix/agent-shell-workspace--writer-buffer))
(let ((writer konix/agent-shell-workspace--writer-buffer))
(konix/agent-shell-workspace--after-command
(lambda ()
(when (and (buffer-live-p writer)
(not (with-current-buffer writer (shell-maker-busy))))
(konix/agent-shell-workspace--tell-to-go-on writer)))))))
(defun konix/agent-shell-workspace--after-command (function)
"Call FUNCTION once the command running now is done, or at once outside any command.
An error of FUNCTION is said, never reaching the caller."
(let ((guarded (lambda ()
(condition-case err
(funcall function)
(error (message "After command: %s" (error-message-string err)))))))
(if (not this-command)
(funcall guarded)
(letrec ((once (lambda ()
(remove-hook 'post-command-hook once)
(funcall guarded))))
(add-hook 'post-command-hook once)))))
(add-hook 'org-after-todo-state-change-hook
#'konix/agent-shell-workspace--go-on-soon)
- rule
- a state put on a memo or a fact, or on the heading holding them, is refused
with an error, by a key as by a tool.
- why: a fact wearing
DISCUSScounted as the writer’s work, which it could only take up and put down again: twatchs3’s writer was told about it 117 times. - why: the user said « error plainly when a fact or a memo becomes a question ».
- why: a fact wearing
- what
DISCUSSset on a fact, then on a memo, each in a fresh workspace.
(mapcar
(lambda (id)
(let ((file (make-temp-file "check-no-state-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"* Memos :memos:\n** A memo\n :PROPERTIES:\n :ID: m\n :END:\n"
"* Facts :facts:\n** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(prog1 (list (condition-case nil
(progn (konix/agent-shell-workspace--goto-id id)
(org-todo "DISCUSS")
'changed)
(user-error 'refused))
(progn (konix/agent-shell-workspace--goto-id id)
(org-get-todo-state)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file))))
'("f" "m"))
- what
- the check above is right when it reads
((refused nil) (refused nil)).
(defun konix/agent-shell-workspace--refuse-state-on-facts (change)
"Refuse CHANGE, as `org-blocker-hook' gives it, putting a state on a memo or fact."
(when (and (bound-and-true-p konix/agent-shell-workspace-mode)
(plist-get change :to)
(member (konix/agent-shell-workspace--part-at)
(list konix/agent-shell-workspace-memos-tag
konix/agent-shell-workspace-facts-tag)))
(user-error "« %s » is a %s: it takes no state"
(org-get-heading t t t t)
(if (equal (konix/agent-shell-workspace--part-at)
konix/agent-shell-workspace-memos-tag)
"memo" "fact")))
t)
(add-hook 'org-blocker-hook #'konix/agent-shell-workspace--refuse-state-on-facts)
- rule
- and a writer the steering stopped, its tries spent, is set going again, told
what a turn’s end tells it.
- why: the steering hands the turn back to the user, and a bound writer has nothing to say to them: what it said is what got it stopped.
- how: once the turn has settled, so the stopped turn says why it stopped first, and only so, whatever the turn ended on.
- rule: and one stopped so again, the workspace as it was at the last setting
going, waits longer each time, the user notified louder each time.
- how: the wait starts at a minute and doubles up to an hour; the notice goes from low to urgent; any change to the file starts it all over.
- rule: and the writer’s buffer says so, with how long it waits.
- rule: and set going so, nothing having changed, it is told just that, in a
line, and what it owes: a project’s done and doing, a plan, or its questions,
which it lists itself.
- why: resending the same questions it was just stopped on is tokens for nothing.
- why: told to list the questions while it owes a project’s done and doing, it finds nothing of its own there and ends its turn.
- what
- a writer set going again on an unchanged workspace is told one line, naming what it owes.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-unchanged-writer")))
(unwind-protect
(mapcar
(lambda (work)
(let (told)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) "/w"))
((symbol-function 'konix/agent-shell-workspace--work-to-do)
(lambda (_file) work))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text) (setq told text))))
(konix/agent-shell-workspace--tell-unchanged writer)
(cond ((null told) 'quiet)
((string-search "\n" told) 'lines)
((string-match-p "propose them" told) 'dod)
((string-match-p "plan it" told) 'plan)
((string-match-p "List the questions" told) 'questions)))))
'(dod plan questions nil))
(kill-buffer writer)))
- what
- the check above is right when it reads
(dod plan questions quiet).- rule: and while it waits, nothing changed, no telling to go on reaches it: not one
queued before the wait, nor one a turn’s end gives.
- why: contribute’s writer, steered 1/3 and 2/3, queued a telling each time; the 3/3 wait started, then the turn’s end said them at once, looping every second.
- rule: and while it waits, nothing changed, no telling to go on reaches it: not one
queued before the wait, nor one a turn’s end gives.
- what
- a telling queued on a busy writer, then the wait; the turn ends, a turn end tells again, then the file changes and it tells again.
(require 'cl-lib)
(let ((file (make-temp-file "check-wait-" nil ".ws.org"))
(writer (generate-new-buffer " check-wait-writer"))
busy handlers said)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer-done-p) #'ignore)
((symbol-function 'konix/agent-shell-workspace--plan-next-text)
(lambda (_file) "Go on."))
((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'konix/agent-shell-workspace--debug) #'ignore)
((symbol-function 'konix/agent-shell-workspace--notify) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show-in-writer) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () busy))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key on-event &allow-other-keys)
(push on-event handlers)
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t)))
(with-current-buffer writer
(setq busy t)
(konix/agent-shell-workspace--tell-to-go-on writer)
(setq-local konix/agent-shell-workspace--nudged-stamp
(file-attribute-modification-time (file-attributes file)))
(konix/agent-shell-workspace--go-on writer)
(setq busy nil)
(dolist (handler handlers)
(funcall handler '((:data . ((:stop-reason . "end_turn"))))))
(list (prog1 said (setq said nil))
(progn (konix/agent-shell-workspace--tell-to-go-on writer)
(prog1 said (setq said nil)))
(progn (set-file-times file (time-add nil 10))
(konix/agent-shell-workspace--tell-to-go-on writer)
said))))
(with-current-buffer writer
(when (timerp konix/agent-shell-workspace--nudge-timer)
(cancel-timer konix/agent-shell-workspace--nudge-timer)))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
(nil nil ("Go on.")). - how
- every shell listens for the end of its own turns, which all of this hangs on.
- rule: and the turn’s end clears the leave to take one up, given for the rest of the turn.
(defconst konix/agent-shell-workspace-nudge-first-wait 60
"Seconds a writer the steering stops again waits to be set going, nothing changed.")
(defconst konix/agent-shell-workspace-nudge-last-wait 3600
"Seconds no telling waits longer than.")
(defconst konix/agent-shell-workspace-nudge-priorities '("low" "default" "high" "urgent")
"The notices a writer told again and again gives the user, the quietest first.")
(defvar-local konix/agent-shell-workspace--nudges 0
"How many tellings in a row found the workspace as the one before left it.")
(defvar-local konix/agent-shell-workspace--nudged-stamp nil
"When the workspace file had last changed, at this writer's last telling.")
(defvar-local konix/agent-shell-workspace--nudge-timer nil
"The telling this writer waits for, or nil.")
(defun konix/agent-shell-workspace--notify (priority message)
"Notify the user of MESSAGE at PRIORITY."
(ignore-errors
(start-process "clk-ntfy" nil "clk" "ntfy" "--priority" priority message)))
(defconst konix/agent-shell-workspace-nudge-wait-said
(concat "Stopped by the steering again, the workspace unchanged since:"
" set going again in %d minute(s).")
"What a writer's buffer says as it waits to be set going again.")
(defun konix/agent-shell-workspace--show-in-writer (writer text)
"Show TEXT in WRITER's buffer, a block of its own, the writer told nothing."
(when (buffer-live-p writer)
(with-current-buffer writer
(condition-case err
(agent-shell--update-fragment
:state (agent-shell--state)
:block-id (format "%s-nudge-wait" (map-elt (agent-shell--state) :request-count))
:body text
:expanded t)
(error (message "Could not show in %s « %s »: %s"
(buffer-name writer) text (error-message-string err)))))))
(defun konix/agent-shell-workspace--go-on (writer)
"Set WRITER, which the steering stopped, going now, or later if nothing changed since."
(when-let* ((file (konix/agent-shell-workspace-file writer))
((not (konix/agent-shell-workspace--writer-done-p file))))
(with-current-buffer writer
(let ((stamp (file-attribute-modification-time (file-attributes file))))
(setq-local konix/agent-shell-workspace--nudges
(if (equal stamp konix/agent-shell-workspace--nudged-stamp)
(1+ konix/agent-shell-workspace--nudges)
0))
(setq-local konix/agent-shell-workspace--nudged-stamp stamp))
(when (timerp konix/agent-shell-workspace--nudge-timer)
(cancel-timer konix/agent-shell-workspace--nudge-timer))
(let ((again konix/agent-shell-workspace--nudges))
(if (zerop again)
(konix/agent-shell-workspace--tell-to-go-on writer)
(let ((wait (min konix/agent-shell-workspace-nudge-last-wait
(* konix/agent-shell-workspace-nudge-first-wait
(expt 2 (1- again))))))
(konix/agent-shell-workspace--notify
(nth (min (1- again)
(1- (length konix/agent-shell-workspace-nudge-priorities)))
konix/agent-shell-workspace-nudge-priorities)
(format "%s was stopped by its steering again; set going in %d minutes"
(buffer-name writer) (/ wait 60)))
(konix/agent-shell-workspace--show-in-writer
writer (format konix/agent-shell-workspace-nudge-wait-said (/ wait 60)))
(setq-local konix/agent-shell-workspace--nudge-timer
(run-at-time wait nil
#'konix/agent-shell-workspace--tell-unchanged
writer))))))))
(defconst konix/agent-shell-workspace-unchanged-said
'((dod . "A project still says neither done nor doing: propose them.")
(plan . "A project has nothing moving it: plan it.")
(questions . "List the questions to see what is yours."))
"What a writer set going again on an unchanged workspace is told, after saying
nothing changed, per what `konix/agent-shell-workspace--work-to-do' says it owes.")
(defun konix/agent-shell-workspace--tell-unchanged (writer)
"Set WRITER going again on a workspace unchanged since, in one line naming what it owes."
(when-let* (((buffer-live-p writer))
(file (konix/agent-shell-workspace-file writer))
(work (konix/agent-shell-workspace--work-to-do file)))
(ignore-errors
(konix/agent-shell-workspace--submit
writer
(concat "Nothing changed in the workspace since you were stopped. "
(alist-get work konix/agent-shell-workspace-unchanged-said))))))
(defun konix/agent-shell-workspace--steered-back ()
"Set this writer, once the steering said why it stopped it, going: at once, or later
if nothing changed. An error is said, never reaching the steering."
(when (konix/agent-shell-workspace-file (current-buffer))
(condition-case err (konix/agent-shell-workspace--go-on (current-buffer))
(error (message "Steered back: %s" (error-message-string err))))))
(add-hook 'konix/agent-shell-steering-handed-back-hook
#'konix/agent-shell-workspace--steered-back)
(defun konix/agent-shell-workspace--turn-ended (event)
"Say on EVENT what a cut turn was, or tell a writer that stopped to go on."
(ignore-errors (konix/agent-shell-workspace--context-at-turn-end (current-buffer)))
(let ((steered (and (bound-and-true-p konix/agent-shell-steering--cap-stopped)
(konix/agent-shell-workspace-file (current-buffer))))
(shell (current-buffer)))
(handler-bind
((error (lambda (err)
(ignore-errors
(konix/agent-shell-workspace--debug
'failing (konix/agent-shell-workspace--debug-name shell)
"%s\n%s" (error-message-string err) (backtrace-to-string))))))
(konix/agent-shell-workspace--turn-ended-as-ever event steered))))
(defun konix/agent-shell-workspace--turn-ended-as-ever (event steered)
"Do what every end of turn EVENT does, telling the writer to go on unless STEERED."
(konix/agent-shell-workspace--say-cut event)
(setq-local konix/agent-shell-workspace--cut nil)
(setq-local konix/agent-shell-workspace--taking-up nil)
(when (konix/agent-shell-workspace--nothing-left-for-the-writer-p)
(konix/agent-shell-workspace--leave-the-round (current-buffer)))
(when-let* ((file (konix/agent-shell-workspace-file (current-buffer)))
(workspace (find-buffer-visiting file)))
(with-current-buffer workspace
(konix/agent-shell-workspace--tracked-or-not workspace t)))
(when-let* ((file (konix/agent-shell-workspace-file (current-buffer))))
(konix/agent-shell-workspace--free-stranded file))
(pcase (and (not steered) (map-elt (map-elt event :data) :stop-reason))
("end_turn" (konix/agent-shell-workspace--tell-to-go-on (current-buffer)))
("cancelled" (when (timerp konix/agent-shell-workspace--nudge-timer)
(cancel-timer konix/agent-shell-workspace--nudge-timer)))))
(defvar-local konix/agent-shell-workspace--watching nil
"Non-nil once this shell is listening for the end of its turns.")
(defun konix/agent-shell-workspace--watch-turns ()
"Have this shell answer the end of its own turns, once."
(unless konix/agent-shell-workspace--watching
(setq-local konix/agent-shell-workspace--watching t)
(let ((buffer (current-buffer)))
(agent-shell-subscribe-to
:shell-buffer buffer :event 'turn-complete
:on-event (lambda (event)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(konix/agent-shell-workspace--turn-ended event))))))))
(add-hook 'agent-shell-mode-hook #'konix/agent-shell-workspace--watch-turns)
- rule
- an error at the turn’s end writes a
failingline in the debug log, with its backtrace, then goes on as before.- why: agent-shell says only the error’s message, which names no line.
(require 'cl-lib)
(let ((konix/agent-shell-workspace-debug-tags '(failing))
(konix/agent-shell-workspace-debug-log " *check failing log*")
raised)
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--context-at-turn-end) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-cut)
(lambda (_event) (signal 'wrong-type-argument '(stringp nil)))))
(with-temp-buffer
(condition-case nil (konix/agent-shell-workspace--turn-ended nil)
(wrong-type-argument (setq raised t)))))
(prog1 (list raised
(and (get-buffer konix/agent-shell-workspace-debug-log)
(with-current-buffer konix/agent-shell-workspace-debug-log
(and (string-match-p "\\[failing\\]" (buffer-string))
(string-match-p "--say-cut" (buffer-string))))
t))
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))))
- what
- the check above is right when it reads
(t t): the error still raised, and logged naming the failing step. - rule
- a turn that starts while the writer is left nothing is cut before its first
word, as one left nothing by a call is, whoever started it, the user or the workspace.
- why: the user’s words in the chat reach no one, and a writer answering them is talking to nobody; the workspace has nothing to hand a writer left nothing either.
- what
- a turn starting while the writer is left nothing is cut.
(require 'cl-lib)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer _file complete fire cut-p _waiting)
(funcall complete)
(let (sent)
(cl-letf (((symbol-function 'run-at-time) #'ignore)
((symbol-function 'agent-shell--emit-event)
(cl-function (lambda (&key event &allow-other-keys) (funcall fire event))))
((symbol-function 'agent-shell--send-request)
(lambda (&rest _) (setq sent (not (funcall cut-p)))))
((symbol-function 'agent-shell--cancel-idle-timer) #'ignore)
((symbol-function 'agent-shell--append-transcript) #'ignore)
((symbol-function 'agent-shell-viewport--buffer) #'ignore)
((symbol-function 'agent-shell--set-session-title) #'ignore))
(with-current-buffer writer
(setq-local agent-shell--state
(list (cons :last-entry-type nil) (cons :session (list (cons :id "s") (cons :title "t")))))
(let ((agent-shell-show-busy-indicator nil))
(agent-shell--send-command :prompt "hello" :shell-buffer writer))))
(list sent (funcall cut-p)))))
- what
- the check above is right when it reads
(t t): the prompt is sent uncut, and cut once sent.
(defun konix/agent-shell-workspace--cut-sent (&rest _args)
"Cut the turn this shell just sent where its writer is left nothing.
An error is said, never reaching agent-shell's send."
(condition-case err (konix/agent-shell-workspace--cut-short (current-buffer))
(error (message "Cut at the turn's start: %s" (error-message-string err)))))
(advice-add 'agent-shell--send-command :after #'konix/agent-shell-workspace--cut-sent)
a plan owed to a project
- rule
- a project with nothing in motion toward it owes the writer a plan for it: it
is told to make one, or to say that project is done, as the one thing left to do.
- why: the project outlives the questions, and nothing else asks what comes next.
- scope: in motion means a question whose « for » line names the project is open
and not put off.
- scope: an open project linked « for » it counts as a question in motion.
- scope: one project at a time, the first in the file; a project put off owes nothing.
- scope: nor does a project
held back by another, for as long as
it is held.
- why: the writer must not be asked to do anything for it before then.
- rule: told every time it is found so, as its turn ends and as the user changes
the workspace — settles the last one, drops one, sets a project.
- why: either answer puts something in motion, and until then there is nothing else for it to do.
- rule: and a writer owed a plan has work, so it is neither cut nor shown idle with nothing.
- therefore: and it is told that what it needs to look at to know which is a step of the plan, taken up like any, a writer holding no question being refused every other tool.
(defconst konix/agent-shell-workspace-plan-next-said
(concat "Nothing is in motion toward the project « %s », %s. Make a plan: call"
" set_workspace_plan with the next steps toward it, each naming that project."
" If you hold it done, call workspace_project_done instead with its id,"
" saying why."
" Anything you need to look at first, to know which, a git status say, is"
" itself a step: plan it, take it up, then look."
" This is told you again whenever you are idle, until you have done one of"
" the two.")
"What a writer owed a plan is told, and told again while it owes it.")
(defun konix/agent-shell-workspace--in-motion-for-p (project)
"Non-nil when a question of this buffer for PROJECT is neither settled nor put off."
(save-excursion
(goto-char (point-min))
(let (found)
(while (and (not found)
(re-search-forward
(konix/agent-shell-workspace--said-line-regexp
konix/agent-shell-workspace-for-said project)
nil t))
(save-excursion
(konix/agent-shell-workspace--goto-question)
(setq found (member (org-get-todo-state)
(remove konix/agent-shell-workspace-later-keyword
konix/agent-shell-workspace-open-keywords)))))
found)))
(defun konix/agent-shell-workspace--starving-project ()
"Return (ID . WORDS) of the first open project of this buffer nothing moves, or nil."
(save-excursion
(goto-char (point-min))
(let ((questions (konix/agent-shell-workspace--every-question))
starving)
(while (and (not starving)
(konix/agent-shell-workspace--next-open-project))
(let ((id (org-entry-get (point) "ID")))
(unless (or (not (konix/agent-shell-workspace--project-defined-p id))
(konix/agent-shell-workspace--in-motion-for-p id)
(konix/agent-shell-workspace--holding-back id questions))
(setq starving
(cons id (string-trim (substring-no-properties
(org-get-heading t t t t))))))))
starving)))
(defun konix/agent-shell-workspace--proposal-open-for-p (id)
"Non-nil when a question of this buffer proposing the DoD of project ID is open."
(save-excursion
(goto-char (point-min))
(let (found)
(while (and (not found)
(re-search-forward
(format "^ *:%s: *%s *$"
konix/agent-shell-workspace-define-property
(regexp-quote id))
nil t))
(save-excursion
(org-back-to-heading t)
(setq found (member (org-get-todo-state)
(remove konix/agent-shell-workspace-later-keyword
konix/agent-shell-workspace-open-keywords)))))
found)))
(defun konix/agent-shell-workspace--dod-owed-project ()
"Return (ID . WORDS) of the first open project of this buffer owed its done and doing."
(save-excursion
(goto-char (point-min))
(let ((questions (konix/agent-shell-workspace--every-question))
owed)
(while (and (not owed)
(konix/agent-shell-workspace--next-open-project))
(let ((id (org-entry-get (point) "ID")))
(unless (or (konix/agent-shell-workspace--project-defined-p id)
(konix/agent-shell-workspace--holding-back id questions)
(konix/agent-shell-workspace--proposal-open-for-p id))
(setq owed
(cons id (string-trim (substring-no-properties
(org-get-heading t t t t))))))))
owed)))
(defun konix/agent-shell-workspace--plan-owed-p (file)
"Return (ID . WORDS) of the project of FILE owed its done and doing, or a plan; or nil."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(or (konix/agent-shell-workspace--dod-owed-project)
(konix/agent-shell-workspace--starving-project)))))
- rule
- but a project that does not yet say what done means and what doing looks
like is owed those first: the writer is told to propose both, before any plan.
- why: when moving a project into motion, one should ask the GTD mantra: what done means and what doing looks like.
- how: a project says them as two lines under it,
doneanddoing. - rule: the proposal is made by a tool of its own,
workspace_project_define, and it alone: the user’syon it writes both lines into the project.- why: a
ywriting into the project is easy to miss, so it is never a side effect of an ordinary question. - how: the heading the tool writes says what is asked, and no label more.
- why: a label like the review’s or the project’s is too much for it.
- how: as short as it goes:
DoD:, for what done means and doing looks like, and the project’s words.
- rule: and that
ydrops the proposal there and then.- how: nothing more is said to the writer: it hears of it as it is next told to plan, the project then owing a plan.
- why: a
- rule: and a project lacking them owes them even while questions move it, the
writer told so as it is told to plan.
- scope: but not while a proposal of them is open, the user’s to answer.
- what
- a writer idle beside a project lacking done and doing, a question moving it, is told to propose them, and told nothing while a proposal of them is open.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-dodowed-writer"))
files)
(cl-flet ((told (proposal)
(let ((file (make-temp-file "check-dodowed-" nil ".ws.org"))
said)
(push file files)
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n"
" :ID: p\n :END:\n"
"* Mine :mine:\n"
"** REFINE Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n"
proposal))
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text) (setq said text))))
(konix/agent-shell-workspace--plan-next writer))
(cond ((null said) 'nothing)
((string-match-p "workspace_project_define" said) 'told-define)
(t said)))))
(unwind-protect
(list (told "")
(told (concat "** REFINE DoD: « the project »?\n :PROPERTIES:\n"
" :ID: d\n :PROJECT-DEFINE: p\n :END:\n"
" - for :: [[id:p][the project]]\n")))
(let ((kill-buffer-query-functions nil))
(dolist (file files)
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file))
(kill-buffer writer)))))
- what
- the check above is right when it reads
(told-define nothing). - what
- the project goes from owing them to owing a plan, through the user’s
yon the proposal, headedDoD:, which drops it, and ayon an ordinary question saying the same writes nothing.
(require 'cl-lib)
(let ((file (make-temp-file "check-define-" nil ".ws.org"))
(writer (generate-new-buffer " check-define-writer"))
said)
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* REFINE Done means it works, doing means try it?\n"
" :PROPERTIES:\n :ID: o\n :END:\n"
" - for :: [[id:p][the project]]\n"
" - done :: it works\n - doing :: try it\n"
"* REFINE Another of yours?\n :PROPERTIES:\n :ID: n\n :END:\n"
" - what :: waits on you\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'yes-on)
(lambda (id)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id id))
(konix/agent-shell-workspace-answer-yes)))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(yes-on "o")
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id "o")
(org-todo "DONE"))
(push (konix/agent-shell-workspace--plan-next-text file) said)
(konix/mcp-server-workspace-project-define
"p" "[\"done :: it works\", \"doing :: try it\"]")
(revert-buffer t t t)
(push (save-restriction
(widen)
(konix/agent-shell-workspace--goto-id
(konix/agent-shell-workspace--last-question-id file))
(and (string-prefix-p "DoD: " (org-get-heading t t t t))
'dod-heading))
said)
(let ((proposal (konix/agent-shell-workspace--last-question-id file)))
(yes-on proposal)
(push (and (equal (org-entry-get (point) "ID") "n") 'moved-on) said)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(push (save-restriction
(widen)
(and (konix/agent-shell-workspace--project-defined-p "p")
'defined))
said)
(push (save-restriction
(widen)
(if (konix/agent-shell-workspace--goto-id proposal)
'still-there
'dropped))
said))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))
(push (konix/agent-shell-workspace--plan-next-text file) said)
(mapcar (lambda (one)
(cond ((not (stringp one)) one)
((string-match-p "does not say yet" one) 'owed-done-and-doing)
((string-match-p "Make a plan" one) 'owed-a-plan)))
(nreverse said)))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(owed-done-and-doing dod-heading moved-on defined dropped owed-a-plan): the ordinary question’syleft the project still owing them, the proposal came headedDoD:, and itsymoved the user on to the question waiting on them and dropped it. - rule
- and the tool proposes them for the open project whose id it is given, owed a
plan or not.
- why: the user said ids are the single unambiguous mechanism: no tool guesses the heading it acts on.
- therefore: a writer held until a project has them can propose them, even while questions already move that project.
- what
- a project lacking done and doing, a question already moving it, gets its proposal.
(require 'cl-lib)
(let ((file (make-temp-file "check-definemotion-" nil ".ws.org"))
(writer (generate-new-buffer " check-definemotion-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* Mine :mine:\n"
"** REFINE Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(condition-case err
(progn
(konix/mcp-server-workspace-project-define
"p" "[\"done :: it works\", \"doing :: try it\"]")
(with-temp-buffer (insert-file-contents file)
(how-many "^\\*\\* .*DoD: « the project »\\?"
(point-min) (point-max))))
(error (error-message-string err))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
1. - rule
- and it refuses a project whose proposal already waits on the user.
- why: otherwise proposals pile up on one project.
- what
- two projects lacking done and doing, the first’s proposal waiting: the second, named, gets its proposal, and the first, named, is refused.
(require 'cl-lib)
(let ((file (make-temp-file "check-defineskip-" nil ".ws.org"))
(writer (generate-new-buffer " check-defineskip-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* Projects :projects:\n"
"** TODO first :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"** TODO second :project:\n :PROPERTIES:\n :ID: o\n :END:\n"
"* Mine :mine:\n"
"** REFINE DoD: « first »?\n :PROPERTIES:\n :ID: d\n"
" :PROJECT-DEFINE: p\n :END:\n - for :: [[id:p][first]]\n"
" - done :: it works\n - doing :: try it\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(condition-case err
(progn
(konix/mcp-server-workspace-project-define
"o" "[\"done :: it works\", \"doing :: try it\"]")
(with-temp-buffer (insert-file-contents file)
(list (how-many "^\\*\\* .*DoD: « first »\\?"
(point-min) (point-max))
(how-many "^\\*\\* .*DoD: « second »\\?"
(point-min) (point-max))
(condition-case nil
(progn (konix/mcp-server-workspace-project-define
"p" "[\"done :: it works\", \"doing :: try it\"]")
'written)
(error 'refused)))))
(error (error-message-string err))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(1 1 refused): one proposal each, and the first refused a second one.
(defconst konix/agent-shell-workspace-define-said
(concat "The project « %s », %s, does not say yet what done means nor what doing"
" looks like. Before any plan, propose both with workspace_project_define,"
" passing its id, as two bullets « done :: … » and « doing :: … »: the user's yes on it writes"
" them under the project.")
"What a writer owed a plan is told while the project does not say done and doing.")
(defun konix/agent-shell-workspace--said-under-p (said end)
"Return the line saying SAID between point and END, or nil."
(save-excursion
(when (re-search-forward (format "^ *- %s :: .*$" (regexp-quote said)) end t)
(string-trim (match-string-no-properties 0)))))
(defun konix/agent-shell-workspace--project-defined-p (id)
"Non-nil when the project ID says what done means and what doing looks like."
(save-excursion
(when (konix/agent-shell-workspace--goto-id id)
(let ((end (save-excursion (outline-next-heading) (point))))
(and (konix/agent-shell-workspace--said-under-p "done" end)
(konix/agent-shell-workspace--said-under-p "doing" end))))))
(defconst konix/agent-shell-workspace-define-property "PROJECT-DEFINE"
"Property naming the project whose done and doing a question proposes.")
(defun konix/mcp-server-workspace-project-define (project note)
"Propose what PROJECT means by done and doing, NOTE being both.
MCP Parameters:
project - id of the open project to define
note - JSON array of two bullets, « done :: … » and « doing :: … »"
(mcp-server-lib-with-error-handling
(let* ((file (konix/agent-shell-workspace--file-or-error))
(project (konix/agent-shell-workspace--open-project-or-error file project)))
(konix/agent-shell-workspace--read-file file
(cond ((konix/agent-shell-workspace--project-defined-p (car project))
(error "« %s » says done and doing already" (cdr project)))
((konix/agent-shell-workspace--proposal-open-for-p (car project))
(error "« %s » has a proposal waiting on the user: stop there"
(cdr project)))))
(unless (seq-every-p (lambda (said)
(seq-some (lambda (bullet)
(string-prefix-p (concat said " :: ") bullet))
(konix/agent-shell-workspace--bullets note)))
'("done" "doing"))
(error "Pass both bullets, « done :: … » and « doing :: … »"))
(let ((konix/agent-shell-workspace--heading-ours t))
(konix/mcp-server-set-workspace-question
(format "DoD: « %s »?" (cdr project))
note nil nil nil nil nil nil nil nil (car project)))
(let ((id (konix/agent-shell-workspace--last-question-id file)))
(konix/agent-shell-workspace--edit
(lambda ()
(konix/agent-shell-workspace--goto-id id)
(org-entry-put (point) konix/agent-shell-workspace-define-property
(car project)))))
"Put to the user; their yes writes both under the project.")))
(defun konix/agent-shell-workspace--project-defined-on-yes (id)
"Where the question ID is a proposal of a project's done and doing, write them in it.
The proposal is dropped with it; return non-nil where it was."
(save-excursion
(when-let* ((id)
((konix/agent-shell-workspace--goto-id id))
(project (org-entry-get
(point) konix/agent-shell-workspace-define-property))
(end (save-excursion (outline-next-heading) (point)))
(done (konix/agent-shell-workspace--said-under-p "done" end))
(doing (konix/agent-shell-workspace--said-under-p "doing" end)))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id project)
(org-end-of-meta-data)
(insert " " done "\n " doing "\n")
(konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end)))
t)))
(defun konix/agent-shell-workspace--project-text (id)
"Return what the user wrote under the project ID, quoted on lines of its own, or \"\"."
(save-excursion
(if (not (konix/agent-shell-workspace--goto-id id))
""
(let* ((end (save-excursion (outline-next-heading) (point)))
(text (progn (org-end-of-meta-data t)
(string-trim (buffer-substring-no-properties
(min (point) end) end)))))
(if (string-empty-p text)
""
(concat "\n" (mapconcat (lambda (line) (concat " " (string-trim line)))
(split-string text "\n") "\n")))))))
(defun konix/agent-shell-workspace--plan-next-text (file)
"Return what the writer of FILE is told to plan, or nil where nothing is owed."
(when-let ((project (konix/agent-shell-workspace--plan-owed-p file)))
(let ((text (konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--project-text (car project)))))
(concat
(format (if (konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--project-defined-p (car project)))
konix/agent-shell-workspace-plan-next-said
konix/agent-shell-workspace-define-said)
(cdr project) (car project))
(if (string-empty-p text) "" (concat "\n\nWhat the user wrote under it:" text))))))
- rule
- and what the user wrote under the project is quoted with its name, wherever
the writer is told to define or plan it.
- why: named by title and id alone, a writer asked the user what that text already said.
- what
- told to define the project, then in the nudge’s group, the writer reads the text under it.
(let ((file (make-temp-file "check-project-text-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" only usb works\n"))
(unwind-protect
(list (and (string-match-p "only usb works"
(or (konix/agent-shell-workspace--plan-next-text file) ""))
t)
(and (string-match-p "only usb works"
(cdr (car (car (konix/agent-shell-workspace--owing-projects
file)))))
t))
(delete-file file)))
- what
- the check above is right when it reads
(t t). - rule
- the user rewrites a project’s done and doing from the minibuffer, the buffer
being read-only.
- how: on the project, two prompts filled with what it says now; an empty answer drops that line, so the writer is owed proposing it again.
(defun konix/agent-shell-workspace--said-text (line said)
"Return what LINE, a « SAID :: … » bullet or nil, says after its label."
(if line (replace-regexp-in-string (format "\\`- %s :: " (regexp-quote said)) "" line) ""))
(defun konix/agent-shell-workspace--drop-said-under (said)
"Drop the « SAID :: » line under the heading at point, if it has one."
(save-excursion
(let ((end (save-excursion (outline-next-heading) (point))))
(when (re-search-forward (format "^ *- %s :: .*\n?" (regexp-quote said)) end t)
(delete-region (match-beginning 0) (match-end 0))))))
(defconst konix/agent-shell-workspace-redefined-said
(concat "The user has rewritten what the project « %s » means by done and what its"
" doing looks like. Done: « %s ». Doing: « %s ». Hold your work to these now,"
" not to what they said before.")
"What a writer is told when the user rewrites a project's done and doing.")
(defun konix/agent-shell-workspace-redefine-project (&optional later)
"Rewrite what the project point stands in means by done and what its doing looks like.
The writer is told at once, unless LATER leaves it to hear it as its turn ends."
(interactive "P")
(pcase-let* ((`(,id ,name ,was-done ,was-doing)
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(unless (konix/agent-shell-workspace--project-at-point-p)
(user-error "Point stands in no project"))
(let ((end (save-excursion (outline-next-heading) (point))))
(list (org-entry-get (point) "ID")
(org-get-heading t t t t)
(konix/agent-shell-workspace--said-text
(konix/agent-shell-workspace--said-under-p "done" end) "done")
(konix/agent-shell-workspace--said-text
(konix/agent-shell-workspace--said-under-p "doing" end) "doing")))))
(done (string-trim (read-string "Done: " was-done)))
(doing (string-trim (read-string "Doing: " was-doing))))
(unless (and (equal done was-done) (equal doing was-doing))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--drop-said-under "done")
(konix/agent-shell-workspace--drop-said-under "doing")
(save-excursion
(org-end-of-meta-data)
(insert (if (string-empty-p done) "" (format " - done :: %s\n" done))
(if (string-empty-p doing) "" (format " - doing :: %s\n" doing))))
(konix/agent-shell-workspace--touch))
(when-let* ((writer (konix/agent-shell-workspace--target-writer)))
(message
(if (eq t (konix/agent-shell-workspace--submit
writer
(format konix/agent-shell-workspace-redefined-said name done doing)
(not later)))
"Woke the writer"
"Queued — the writer reads it as its turn ends"))))))
- what
- rewriting puts the new done and doing in place of the old, an empty doing leaving only done, and the writer is told both.
(require 'cl-lib)
(let ((file (make-temp-file "check-redefine-" nil ".ws.org"))
(answers (list "it ships" ""))
told)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* P :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - done :: it works\n - doing :: try it\n - what :: kept\n"))
(unwind-protect
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) (pop answers)))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text &rest _) (setq told text)))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () 'writer)))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(search-forward "* P")
(konix/agent-shell-workspace-redefine-project)
(goto-char (point-min))
(list (konix/agent-shell-workspace--said-under-p "done" (point-max))
(konix/agent-shell-workspace--said-under-p "doing" (point-max))
(and (string-match-p "what :: kept" (buffer-string)) t)
(and told (string-match-p "« P ».*Done: « it ships »" told) t))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what :: the check above is right when it reads =("- done
- it ships" nil t t)=.
- how
- the telling goes to an idle writer, the project read off the file.
(defun konix/agent-shell-workspace--plan-next (writer)
"Tell WRITER to make a plan, where its workspace owes one and it is idle."
(when-let* ((file (konix/agent-shell-workspace-file writer))
((konix/agent-shell-workspace--plan-owed-p file))
((not (with-current-buffer writer (shell-maker-busy)))))
(ignore-errors
(konix/agent-shell-workspace--submit
writer (konix/agent-shell-workspace--plan-next-text file)))))
- rule
workspace_project_doneputs it to the user whether the project is done, the writer saying why.- how: a question like any other: while it stands open, nothing is settled, and nothing tells the writer to plan.
- rule: and
yon it drops it and settles the project it asks of, telling the writer nothing.- why: agreed, there is nothing left to say, and no project to plan toward.
(defconst konix/agent-shell-workspace-project-check-property "PROJECT-CHECK"
"Property naming the project a question asks the user to say done.")
(defun konix/agent-shell-workspace--open-project-or-error (file id)
"Return (ID . WORDS) of the open project ID of FILE, or refuse naming what ID is."
(konix/agent-shell-workspace--read-file file
(unless (and id (konix/agent-shell-workspace--goto-id id))
(error "No heading has the id « %s »" id))
(unless (konix/agent-shell-workspace--project-at-point-p)
(error "« %s » is no project" (org-get-heading t t t t)))
(when (member (org-get-todo-state)
(list konix/agent-shell-workspace-later-keyword
konix/agent-shell-workspace-done-keyword))
(error "« %s » is no open project" (org-get-heading t t t t)))
(cons id (string-trim (substring-no-properties (org-get-heading t t t t))))))
(defun konix/mcp-server-workspace-project-done (project why)
"Ask the user whether PROJECT is done, WHY being the writer's say.
MCP Parameters:
project - id of the open project held done
why - JSON array of « intention :: text » bullets: what makes the project done"
(mcp-server-lib-with-error-handling
(let* ((file (konix/agent-shell-workspace--file-or-error))
(project (konix/agent-shell-workspace--open-project-or-error file project)))
(let ((konix/agent-shell-workspace--heading-ours t))
(konix/mcp-server-set-workspace-question
(format "Is the project « %s » done?" (cdr project))
why nil nil nil nil nil nil nil nil (car project)))
(let ((id (konix/agent-shell-workspace--last-question-id file)))
(konix/agent-shell-workspace--edit
(lambda ()
(konix/agent-shell-workspace--goto-id id)
(org-entry-put (point) konix/agent-shell-workspace-project-check-property
(car project)))))
"Put to the user; stop there.")))
(defun konix/agent-shell-workspace--project-agreed (id)
"Where the question ID asks whether a project is done, drop it and settle that project.
Return non-nil where it did."
(save-excursion
(when-let* ((id)
((konix/agent-shell-workspace--goto-id id))
(project (org-entry-get
(point) konix/agent-shell-workspace-project-check-property)))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end))
(when (konix/agent-shell-workspace--goto-id project)
(org-todo konix/agent-shell-workspace-done-keyword)))
(message "The project is done, settled with its question gone")
t)))
- rule
- the project is named by its id, and asked done whatever questions still
stand for it; a heading that is no open project is refused.
- why: the writer’s own question asking to call it done kept the project from being guessed, so the tool refused it; ids are the one unambiguous way.
(require 'cl-lib)
(let ((file (make-temp-file "check-doneid-" nil ".ws.org"))
(writer (generate-new-buffer " check-doneid-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - done :: it works\n - doing :: try it\n"
"* Mine :mine:\n"
"** REFINE Call it done?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(cl-flet ((try (id)
(condition-case nil
(progn (konix/mcp-server-workspace-project-done
id "[\"proof :: it works\"]")
'asked)
(error 'refused))))
(list (try "q") (try "p")
(with-temp-buffer
(insert-file-contents file)
(how-many "^\\*\\* .*Is the project « the project » done\\?"
(point-min) (point-max))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(refused asked 1): a question is no project, and the project is asked done though a question stands for it; it read(refused refused 0)before. - rule
workspace_project_promoteproposes to the user making a question a project, the writer saying why.- why: the writer finds a question is several pieces of work before the user does.
- rule: and
yorgon it drops it and does to that question what^does, telling the writer nothing;ndrops it alone.- why: as with done and doing, a
ymaking a project is never a side effect of an ordinary question.
- why: as with done and doing, a
- how: headed
Project:and the question’s words, as short asDoD:. - scope: a fact, a project already, or no question at all is refused.
(defconst konix/agent-shell-workspace-promote-property "PROJECT-PROMOTE"
"Property naming the question a proposal asks the user to make a project.")
(defun konix/mcp-server-workspace-project-promote (id why &optional project)
"Propose to the user making the question ID a project, WHY being the writer's say.
MCP Parameters:
id - Id of the question to make a project, as the listing gives it
why - JSON array of « intention :: text » bullets: why it is a project of its own
project - Id of the project the proposal moves forward, or a JSON array; required under projects"
(mcp-server-lib-with-error-handling
(let* ((file (konix/agent-shell-workspace--file-or-error))
(words (konix/agent-shell-workspace--read-file file
(unless (konix/agent-shell-workspace--goto-id id)
(error "No question has the id %s" id))
(unless (org-get-todo-state)
(error "A fact is no question to make a project of"))
(when (konix/agent-shell-workspace--project-at-point-p)
(error "That is a project already"))
(string-remove-suffix
"?" (string-trim
(substring-no-properties (org-get-heading t t t t)))))))
(let ((konix/agent-shell-workspace--heading-ours t))
(konix/mcp-server-set-workspace-question
(format "Project: « %s »?" words)
why nil nil nil nil nil nil nil nil project))
(let ((proposal (konix/agent-shell-workspace--last-question-id file)))
(konix/agent-shell-workspace--edit
(lambda ()
(konix/agent-shell-workspace--goto-id proposal)
(org-entry-put (point) konix/agent-shell-workspace-promote-property id))))
"Put to the user; their yes makes it a project.")))
(defun konix/agent-shell-workspace--promote-proposal (id)
"Return the question the question ID proposes making a project, or nil."
(save-excursion
(and id
(konix/agent-shell-workspace--goto-id id)
(org-entry-get (point) konix/agent-shell-workspace-promote-property))))
(defun konix/agent-shell-workspace--promote-on-yes (id)
"Where the question ID proposes making a question a project, drop it and make it one.
Return non-nil where it did."
(when-let* ((promoted (konix/agent-shell-workspace--promote-proposal id)))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end)))
(save-excursion
(if (konix/agent-shell-workspace--goto-id promoted)
(konix/agent-shell-workspace-promote-to-project)
(message "The question to make a project is gone")))
t))
(defun konix/agent-shell-workspace--promote-on-no (id)
"Where the question ID proposes making a question a project, drop it.
Return non-nil where it did."
(when (konix/agent-shell-workspace--promote-proposal id)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end)))
(message "Not a project, the proposal gone")
t))
- rule
Min the policy menu asks the writer of its session for merges of the project’s rules, those of.dir-locals.el, and of the workspace’s own lines; the writer then proposes each withpropose_rule_merge, and only the user’sywrites one.- why: accepting variants of a command one by one piles up rules a single one would
say, as
$ sha256sum*and$ sha256sum -c*do. - how: its session is found from whatever buffer the menu was opened from: the shell, or the workspace, whose writer it is.
- rule: the writer never edits a rule, and proposes only while a request of the
user’s for it stands.
- why: what a writer may run is no writer’s to change.
- scope: the project’s rules and the workspace’s own lines alone, the global ones left as they are, and the session’s bar what the workspace’s lines carry into it.
- rule: a merge takes the rules of one place only, its heading naming it:
Merge 2 project whitelist rules into one?orMerge 2 workspace ….- why: the merge must be clear about whether it is about workspace or project.
- how: the request lists each rule under its place,
project ::orworkspace ::, and the writer names the place it proposes for.
- how: the request is a task of the user’s, listing the rules, which the writer
takes up at once and closes once it has proposed; each proposal is a question of
its own, headed
Merge.- why: a request to discuss bars the very call it asks for, held to talk, and needs a Go before any diff shows.
- how: each proposal says what, among the session’s calls, the new rule lets in that the old ones did not, and what it lets out that they let in.
- how: its body opens on one
old ::bullet per rule replaced and anew ::one, whatever their length, andyswaps in what they say then.- why: kept in a property, the rules could only be seen unfolding it.
- therefore: the user may rewrite
new ::before sayingy. - how: a property naming the policy alone marks the proposal, which no writer’s
tool sets, so that no question a writer writes swaps rules on a
y.
- rule:
yon one swaps the old rules for the new in.dir-locals.elor in the workspace’s own lines, whichever its place, keeping the first note they carried, and drops it;ndrops it alone.- how: the workspace’s lines are written as its panel column writes them, so the writer carries the new one at once and no longer the old ones.
- scope: a new workspace line naming the sudo rule’s key is refused, as the panels refuse it.
- why: accepting variants of a command one by one piles up rules a single one would
say, as
(defconst konix/agent-shell-workspace-merge-request-property "RULE-MERGE-REQUEST"
"Property naming the policy whose project and workspace rules the user asked merges of.")
(defconst konix/agent-shell-workspace-merge-property "RULE-MERGE"
"Property of a proposed merge: the name of the policy its rules are of.")
(defun konix/agent-shell-workspace--policy-named (name)
"Return the tool policy called NAME, or nil."
(seq-find (lambda (policy) (equal (konix/agent-shell-policy-name policy) name))
(list konix/agent-shell--whitelist konix/agent-shell--blacklist)))
(defconst konix/agent-shell-workspace-merge-places '("project" "workspace")
"Where the rules a merge is of live: the project's, or the workspace's own lines.")
(defconst konix/agent-shell-workspace-merge-place-property "RULE-MERGE-PLACE"
"Property of a proposed merge: the place its rules live in.")
(defvar konix/agent-shell-workspace--answering-merges nil
"Non-nil while a proposal of merges is written, which naming no project is fine for.")
(defun konix/agent-shell-workspace--merge-entries (writer policy place)
"Return the (KEY . NOTE) of POLICY's rules PLACE holds, for WRITER."
(if (equal place "workspace")
(konix/agent-shell-workspace--declared
(konix/agent-shell-workspace-file writer)
(konix/agent-shell-workspace--policy-key policy))
(with-current-buffer writer
(konix/agent-shell-policy--project-entries policy))))
(defun konix/agent-shell-workspace--merge-swap (writer policy place old new)
"Swap POLICY's rules OLD, in PLACE, for NEW, for WRITER, keeping the first note."
(let ((note (seq-some (lambda (key)
(cdr (assoc key (konix/agent-shell-workspace--merge-entries
writer policy place))))
old)))
(with-current-buffer writer
(if (equal place "workspace")
(progn (dolist (key old)
(konix/agent-shell-workspace--policy-remove policy key))
(konix/agent-shell-workspace--policy-set policy new note))
(dolist (key old)
(konix/agent-shell-policy--remove-project policy key))
(konix/agent-shell-policy--set-project policy new note)))))
(defun konix/agent-shell-workspace--menu-writer ()
"Return the session the policy menu is about, whatever buffer it was opened from."
(with-current-buffer (konix/agent-shell-panel--origin-buffer)
(or (ignore-errors (konix/agent-shell-workspace--shell-here))
(current-buffer))))
(defun konix/agent-shell-policy-menu-ask-merges ()
"Ask the panel's session's writer to propose merges of the project's and the
workspace's rules, each place apart."
(interactive)
(let* ((policy (konix/agent-shell-panel-current-data))
(writer (konix/agent-shell-workspace--menu-writer))
(name (konix/agent-shell-policy-name policy))
(file (konix/agent-shell-workspace-file writer))
(keys (and file
(mapcar (lambda (place)
(cons place
(mapcar #'car (konix/agent-shell-workspace--merge-entries
writer policy place))))
konix/agent-shell-workspace-merge-places))))
(unless file
(user-error "This session is bound to no workspace to ask in"))
(unless (seq-some (lambda (place) (cddr place)) keys)
(user-error "Neither the project's %s nor the workspace's has two rules to merge"
name))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-add-subject
(format (concat "Propose merges of the %s rules, each with propose_rule_merge,"
" naming its place, one place a merge")
name)
(mapconcat (lambda (place)
(mapconcat (lambda (key) (format "- %s :: %s" (car place) key))
(cdr place) "\n"))
(seq-filter #'cdr keys) "\n")
nil nil nil nil nil nil nil konix/agent-shell-workspace-fresh-keyword)
(let ((id (konix/agent-shell-workspace--last-question-id file)))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(org-entry-put (point) konix/agent-shell-workspace-merge-request-property
name))))
(message "Asked the writer for merges of the %s rules: %s" name
(mapconcat (lambda (place) (format "%d of the %s's" (length (cdr place))
(car place)))
keys ", "))))
(defun konix/agent-shell-workspace--merge-moves (writer policy old new)
"Return (IN . OUT): the commands of WRITER's calls NEW lets in, and lets out.
In are those none of the OLD keys matched, out those one did that NEW does not."
(with-current-buffer writer
(let ((konix/agent-shell--regexp-any-command
(eq policy konix/agent-shell--blacklist))
in out)
(map-do (lambda (_id tool-call)
(let* ((haystack (konix/agent-shell--tool-haystack tool-call))
(said (replace-regexp-in-string
"[\n\t ]+" " "
(string-trim
(or (konix/agent-shell--tool-call-command tool-call)
(map-elt tool-call :title)
haystack))))
(by-new (konix/agent-shell--matching-entries
(list (list new)) tool-call haystack))
(by-old (konix/agent-shell--matching-entries
(mapcar #'list old) tool-call haystack)))
(cond ((and by-new (not by-old)) (cl-pushnew said in :test #'equal))
((and by-old (not by-new)) (cl-pushnew said out :test #'equal)))))
(map-elt (agent-shell--state) :tool-calls))
(cons (nreverse in) (nreverse out)))))
(defun konix/agent-shell-workspace--merge-said (word calls)
"Return a bullet saying the new rule lets WORD, in or out, CALLS, or nil."
(when calls
(truncate-string-to-width
(format "what :: lets %s %d of this session's calls: %s" word (length calls)
(mapconcat (lambda (call) (format "« %s »" call)) calls ", "))
(- konix/agent-shell-workspace-bullet-max 1) nil nil "…")))
(defun konix/mcp-server-propose-rule-merge (request old new &optional why place)
"Propose to the user one rule NEW for the rules OLD of PLACE, as REQUEST asks.
MCP Parameters:
request - Id of the user's question asking for merges, as the listing gives it
old - JSON array of the rules to replace, each written as that question lists it
new - The one rule replacing them, a regexp, $ glob, @evaluator or Lisp form
why - Optional JSON array of « intention :: text » bullets
place - Optional \"project\" or \"workspace\", where all the OLD rules live,
as that question lists them; \"project\" when not given"
(mcp-server-lib-with-error-handling
(let* ((file (konix/agent-shell-workspace--file-or-error))
(writer (or (konix/agent-shell-workspace--writer)
(error "No session to read the rules from")))
(name (konix/agent-shell-workspace--read-file file
(and (konix/agent-shell-workspace--goto-id request)
(org-entry-get (point)
konix/agent-shell-workspace-merge-request-property))))
(policy (or (and name (konix/agent-shell-workspace--policy-named name))
(error (concat "%s is no request for merges: only the user asks"
" for them, with M in the policy menu")
request)))
(place (if (and place (not (string-empty-p (string-trim place))))
(string-trim place)
"project"))
(old (konix/mcp-server-decode-json-list old))
(keys (progn
(unless (member place konix/agent-shell-workspace-merge-places)
(error "%s is no place: say project or workspace" place))
(mapcar #'car (konix/agent-shell-workspace--merge-entries
writer policy place))))
(new (string-trim (or new ""))))
(when (string-empty-p new)
(error "Name the one rule replacing them"))
(unless old
(error "Name the rules it replaces"))
(dolist (key old)
(unless (member key keys)
(error "%s is no rule of the %s's %s" key place name)))
(when (equal place "workspace")
(konix/agent-shell-workspace--refuse-the-sudo-key new))
(let* ((moves (konix/agent-shell-workspace--merge-moves writer policy old new))
(bullets (append
(konix/agent-shell-workspace--bullets why)
(or (delq nil (list (konix/agent-shell-workspace--merge-said
"in" (car moves))
(konix/agent-shell-workspace--merge-said
"out" (cdr moves))))
(list "what :: lets in and out the same of this session's calls")))))
(let ((konix/agent-shell-workspace--answering-merges t))
(konix/mcp-server-set-workspace-question
(format "Merge %d %s %s rules into one?" (length old) place name)
(json-encode bullets)))
(let ((proposal (konix/agent-shell-workspace--last-question-id file)))
(konix/agent-shell-workspace--edit
(lambda ()
(konix/agent-shell-workspace--goto-id proposal)
(org-entry-put (point) konix/agent-shell-workspace-merge-property name)
(org-entry-put (point) konix/agent-shell-workspace-merge-place-property place)
(let ((indent " "))
(org-end-of-meta-data t)
(insert (mapconcat (lambda (key) (concat indent "- old :: " key "\n")) old "")
indent "- new :: " new "\n")))))
"Put to the user; their yes swaps the rules."))))
(defun konix/agent-shell-workspace--merge-proposal (id)
"Return (POLICY-NAME OLD-KEYS NEW-KEY PLACE) the question ID proposes, or nil.
The rules are read off its old and new bullets, as the user sees them now."
(save-excursion
(when-let* ((id)
((konix/agent-shell-workspace--goto-id id))
(name (org-entry-get (point) konix/agent-shell-workspace-merge-property)))
(let ((end (save-excursion (outline-next-heading) (point)))
(place (or (org-entry-get (point)
konix/agent-shell-workspace-merge-place-property)
"project"))
old new)
(while (re-search-forward "^[ \t]*- \\(old\\|new\\) :: \\(.*?\\)[ \t]*$" end t)
(if (equal (match-string 1) "old")
(push (match-string-no-properties 2) old)
(setq new (match-string-no-properties 2))))
(when (and old new)
(list name (nreverse old) new place))))))
(defun konix/agent-shell-workspace--merge-on-yes (id)
"Where the question ID proposes a merge, swap the rules and drop it.
Return non-nil where it did."
(when-let* ((merge (konix/agent-shell-workspace--merge-proposal id)))
(pcase-let ((`(,name ,old ,new ,place) merge))
(konix/agent-shell-workspace--merge-swap
(or (konix/agent-shell-workspace--target-writer)
(user-error "No session to apply the merge in"))
(konix/agent-shell-workspace--policy-named name) place old new)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end)))
(message "%d %s %s rules merged into %s" (length old) place name new)
t)))
(defun konix/agent-shell-workspace--merge-on-no (id)
"Where the question ID proposes a merge, drop it. Return non-nil where it did."
(when (save-excursion
(and id (konix/agent-shell-workspace--goto-id id)
(org-entry-get (point) konix/agent-shell-workspace-merge-property)))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end)))
(message "Not merged, the proposal gone")
t))
- what
- a proposal with no request is refused; one under it says what the new rule
lets in and out;
yswaps the rules, keeping their note,nleaves them.
(require 'cl-lib)
(let ((file (make-temp-file "check-rule-merge-" nil ".ws.org"))
(writer (generate-new-buffer " check-rule-merge-writer"))
(rules (list (cons "$ sha256sum*" "sums") (cons "$ sha256sum -c*" nil)))
(calls `((a . ((:raw-input . ((command . "sha256sum a")))))
(b . ((:raw-input . ((command . "sha1sum b"))))))))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"* DISCUSS Propose merges?\n :PROPERTIES:\n :ID: r\n"
" :RULE-MERGE-REQUEST: whitelist\n :END:\n"
"* TODO Other?\n :PROPERTIES:\n :ID: o\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda (&rest _) writer))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda (&rest _) writer))
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--move-on) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list :tool-calls calls)))
((symbol-function 'konix/agent-shell-policy--project-entries)
(lambda (_) rules))
((symbol-function 'konix/agent-shell-policy--remove-project)
(lambda (_ key) (setq rules (assoc-delete-all key rules))))
((symbol-function 'konix/agent-shell-policy--set-project)
(lambda (_ key value) (setq rules (append rules (list (cons key value)))))))
(let* ((refused (condition-case err
(konix/mcp-server-propose-rule-merge
"o" "[\"$ sha256sum*\"]" "$ sha*")
(error (error-message-string err))))
(put (konix/mcp-server-propose-rule-merge
"r" "[\"$ sha256sum*\", \"$ sha256sum -c*\"]" "$ sha*"))
(proposal (konix/agent-shell-workspace--last-question-id file))
(said (konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id proposal)
(list (org-get-heading t t t t)
(konix/agent-shell-workspace--body-lines
(point) (konix/agent-shell-workspace--question-end))))))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(search-forward "- new :: $ sha*")
(replace-match "- new :: $ sha2*" t t)
(konix/agent-shell-workspace--merge-on-yes proposal))
(list (and (string-match-p "no request for merges" refused) t)
put said rules
(konix/agent-shell-workspace--read-file file
(and (konix/agent-shell-workspace--goto-id proposal) t)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads: refused under no request, put to
the user, its body naming the two old rules and the new, saying it lets in
sha1sum b, then, the user having made the new$ sha2*, the two rules become$ sha2*with their notesums, and the proposal gone. - what
- a workspace merge is headed so, takes only the workspace’s lines, and
yleaves one line for the two, its note kept; a new one naming the sudo rule’s key is refused.
(require 'cl-lib)
(let ((file (make-temp-file "check-rule-merge-ws-" nil ".ws.org"))
(writer (generate-new-buffer " check-rule-merge-ws-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"#+WHITELIST: $ sha256sum* :: sums\n#+WHITELIST: $ sha256sum -c* ::\n"
"* DISCUSS Propose merges?\n :PROPERTIES:\n :ID: r\n"
" :RULE-MERGE-REQUEST: whitelist\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell--current-shell-or-error)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda (&rest _) writer))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda (&rest _) writer))
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--move-on) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'agent-shell--state) (lambda () (list :tool-calls nil)))
((symbol-function 'konix/agent-shell-policy--project-entries)
(lambda (_) (list (cons "$ sha256sum*" nil)))))
(let* ((project (condition-case err
(konix/mcp-server-propose-rule-merge
"r" "[\"$ sha256sum*\", \"$ sha256sum -c*\"]" "$ sha*")
(error (error-message-string err))))
(sudo (condition-case err
(konix/mcp-server-propose-rule-merge
"r" "[\"$ sha256sum*\"]" "^sudo\\b" nil "workspace")
(error (error-message-string err))))
(put (konix/mcp-server-propose-rule-merge
"r" "[\"$ sha256sum*\", \"$ sha256sum -c*\"]" "$ sha*" nil
"workspace"))
(proposal (konix/agent-shell-workspace--last-question-id file))
(heading (konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id proposal)
(org-get-heading t t t t))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--merge-on-yes proposal))
(list (and (string-match-p "no rule of the project" project) t)
(and (string-match-p "refuses sudo" sudo) t)
put heading
(konix/agent-shell-workspace--declared file "WHITELIST"))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
(t t "Put to the user; their yes swaps the rules." "Merge 2 workspace whitelist rules into one?" (("$ sha*" . "sums"))): the project holds one of them only, the sudo key is refused, and the one line replaces the two. - what
Mleaves a task, not a subject to discuss, carrying the request.
(require 'cl-lib)
(let ((file (make-temp-file "check-merge-request-" nil ".ws.org"))
(writer (generate-new-buffer " check-merge-request-writer"))
told)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-panel-current-data)
(lambda () konix/agent-shell--whitelist))
((symbol-function 'konix/agent-shell-panel--origin-buffer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-policy--project-entries)
(lambda (_) (list (cons "^convert" nil) (cons "^magick" nil))))
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda (&rest _) writer))
((symbol-function 'konix/agent-shell-workspace-focus-question) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (&rest _) (setq told t))))
(konix/agent-shell-policy-menu-ask-merges)
(let ((id (konix/agent-shell-workspace--last-question-id file)))
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id id)
(list (org-get-todo-state)
(org-entry-get (point)
konix/agent-shell-workspace-merge-request-property)
told))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
("TODO" "whitelist" t). - what
- the writer proposes making a question a project:
non the proposal drops it alone, the question untouched;yon another makes it one and drops the proposal.
(require 'cl-lib)
(let ((file (make-temp-file "check-promote-proposal-" nil ".ws.org"))
(writer (generate-new-buffer " check-promote-proposal-writer"))
said)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"* DISCUSS Grow it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: big\n"
"* DISCUSS Keep it?\n :PROPERTIES:\n :ID: k\n :END:\n"
" - what :: small\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send)
(lambda (&rest _) (push 'sent said)))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(cl-flet ((propose (id)
(konix/mcp-server-workspace-project-promote
id "[\"why :: several pieces of work\"]")
(revert-buffer t t t)
(save-restriction
(widen)
(let ((proposal (konix/agent-shell-workspace--last-question-id
file)))
(konix/agent-shell-workspace--goto-id proposal)
(push (substring-no-properties (org-get-heading t t t t)) said)
proposal)))
(gone (id)
(save-restriction
(widen)
(if (konix/agent-shell-workspace--goto-id id) 'still-there 'dropped)))
(project (id)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id id)
(if (konix/agent-shell-workspace--project-at-point-p)
'project
'question))))
(let ((proposal (propose "k")))
(konix/agent-shell-workspace--goto-id proposal)
(konix/agent-shell-workspace-answer-no)
(push (gone proposal) said)
(push (project "k") said))
(let ((proposal (propose "q")))
(konix/agent-shell-workspace--goto-id proposal)
(konix/agent-shell-workspace-answer-yes)
(push (gone proposal) said)
(push (project "q") said))
(push (condition-case err
(progn (konix/mcp-server-workspace-project-promote
"q" "[\"why :: again\"]")
'accepted)
(error (if (string-match-p "a project already"
(error-message-string err))
'refused-again
(error-message-string err))))
said))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))
(nreverse said))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
("Project: « Keep it »?" dropped question "Project: « Grow it »?" dropped project refused-again), nothing sent to the writer. - rule
- and one command does by hand what the end of a turn does by itself.
- why: whatever the arrangement settles on its own, the user must be able to ask for on the spot.
- how: it is bound to no key, being reached by its name.
- rule: and with nothing the writer’s, it names the questions waiting on the user, rather than that nothing is left.
- what
- seeing to a writer with nothing of its own, two questions asking the user, names both.
(require 'cl-lib)
(let ((file (make-temp-file "check-seeto-" nil ".ws.org"))
(writer (generate-new-buffer " check-seeto-writer"))
said)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE One?\n :PROPERTIES:\n :ID: a\n :END:\n"
"* TOCHECK Two?\n :PROPERTIES:\n :ID: b\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--shell-here)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'message)
(lambda (format &rest args) (setq said (apply #'format format args)))))
(konix/agent-shell-workspace-see-to-the-writer)
said)
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
Waiting on you: « One? », « Two? ». - rule
- and a fact is never named there, being nobody’s turn.
- why: the user: « why would a fact wait on me? »
- what
- seeing to a writer with nothing of its own, a question asking the user and a fact beside it, names the question alone.
(require 'cl-lib)
(let ((file (make-temp-file "check-seeto-fact-" nil ".ws.org"))
(writer (generate-new-buffer " check-seeto-fact-writer"))
said)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE One?\n :PROPERTIES:\n :ID: a\n :END:\n"
"* A fact\n :PROPERTIES:\n :ID: f\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--shell-here)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'message)
(lambda (format &rest args) (setq said (apply #'format format args)))))
(konix/agent-shell-workspace-see-to-the-writer)
said)
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
Waiting on you: « One? ». - rule
- and a refused telling says the refusal, not that the writer was told.
- why: a refused writer was said to have been told.
- what
- seeing to a writer the telling refuses says the refusal.
(require 'cl-lib)
(let ((file (make-temp-file "check-seeto-refused-" nil ".ws.org"))
(writer (generate-new-buffer " check-seeto-refused-writer"))
said)
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--shell-here)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (&rest _)
(user-error "A@x has reached its limit, so it is left alone")))
((symbol-function 'message)
(lambda (format &rest args) (setq said (apply #'format format args)))))
(konix/agent-shell-workspace-see-to-the-writer)
said)
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
A@x has reached its limit, so it is left alone.
(defun konix/agent-shell-workspace-see-to-the-writer ()
"Do to this session's writer what the end of a turn does: steer, cut, or push it."
(declare (modes agent-shell-mode
agent-shell-viewport-view-mode
agent-shell-viewport-edit-mode
konix/agent-shell-workspace-mode))
(interactive)
(let* ((writer (konix/agent-shell-workspace--shell-here))
(file (konix/agent-shell-workspace--bound-file-or-error writer)))
(konix/agent-shell-workspace--steer writer)
(if (konix/agent-shell-workspace--writer-done-p file)
(let ((yours (konix/agent-shell-workspace--read-file file
(mapcar (lambda (id)
(format "« %s »"
(konix/agent-shell-workspace--heading-by-id-here
id)))
(konix/agent-shell-workspace--asking-here)))))
(konix/agent-shell-workspace--cut-short writer)
(if yours
(message "Waiting on you: %s" (string-join yours ", "))
(message "Nothing left, for the writer or for you")))
(let ((told (konix/agent-shell-workspace--tell-to-go-on writer)))
(if (stringp told)
(message "%s" told)
(message "%s was told to carry on" (buffer-name writer)))))))
what a question reaches
- what
- a question reaches a fact by an
id:link, and a fact reaches another the same way, so what a question reaches is a path and not a hop.- scope: an id merely named in a bullet’s words reaches nothing, being no link.
(defun konix/agent-shell-workspace--ids-linked-from (start limit)
"Return the ids linked from between START and LIMIT."
(let (ids)
(save-excursion
(goto-char start)
(while (re-search-forward "\\[\\[id:\\([^]]+\\)\\]" limit t)
(push (string-trim (match-string 1)) ids)))
ids))
- how
- one pass over the headings puts every question’s links on a list to follow and
every fact aside by its id.
- scope: a
DONEquestion is still a question, so a fact it reaches is reached, and the sweep takes it only once the user has cleared the question away.
- scope: a
(defun konix/agent-shell-workspace--gather-facts (facts queue)
"Fill FACTS with this buffer's facts by id, and return QUEUE with what a question links."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*+ " nil t)
(beginning-of-line)
(let* ((start (point))
(limit (konix/agent-shell-workspace--question-end))
(id (save-excursion
(end-of-line)
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(cond
((konix/agent-shell-workspace--part-at-point-p)
(setq limit (line-beginning-position 2)))
((org-get-todo-state)
(setq queue
(append (konix/agent-shell-workspace--ids-linked-from start limit)
queue)))
((konix/agent-shell-workspace--memos-at-point-p))
((konix/agent-shell-workspace--facts-at-point-p)
(end-of-line)
(while (re-search-forward "^\\*\\* " limit t)
(let ((start (line-beginning-position)))
(when-let ((id (org-entry-get (point) "ID")))
(puthash id (cons start (konix/agent-shell-workspace--fact-end))
facts)))))
((not (equal (org-current-level) 1))
(setq limit (line-beginning-position 2)))
(id (puthash id (cons start limit) facts)))
(goto-char (max limit (line-beginning-position 2))))))
queue)
- how
- then the list is drained, each id marked as reached, and a fact’s own links added to it, until nothing is left to follow.
(defun konix/agent-shell-workspace--follow-links (facts queue)
"Return the ids reached from QUEUE, following the links FACTS carry."
(let ((reached (make-hash-table :test 'equal)))
(while queue
(let ((id (pop queue)))
(unless (gethash id reached)
(puthash id t reached)
(when-let ((span (gethash id facts)))
(setq queue
(append (konix/agent-shell-workspace--ids-linked-from
(car span) (cdr span))
queue))))))
reached))
- what
- what the marking never reached is a fact no question stands behind.
- scope: facts pointing only at each other are reached by nothing, so they go too.
- rule
- and a fact the user has pinned is reached whatever the questions say, so no
sweep takes it.
- why: most of what the writer reports is cleared unread, and the few worth keeping have nothing holding them once their question is cleared away.
- how: a tag org itself carries, so which are pinned is read off the headings without opening anything.
- rule:
ppins the fact the user stands on, and takes the pin back off it.- scope: a question is no fact, and the key says so rather than pinning it.
(defconst konix/agent-shell-workspace-pinned-tag "pinned"
"Tag a fact the user wants kept wears, which no sweep takes.")
(defun konix/agent-shell-workspace--pinned-p ()
"Non-nil when the heading point stands on is one the user has pinned."
(member konix/agent-shell-workspace-pinned-tag (org-get-tags nil t)))
(defun konix/agent-shell-workspace-pin ()
"Pin the fact point stands on so no sweep takes it, or take the pin off."
(interactive)
(save-excursion
(konix/agent-shell-workspace--goto-question)
(unless (konix/agent-shell-workspace--fact-at-point-p)
(user-error "A question is no fact, and stands until you settle it"))
(let ((pinned (konix/agent-shell-workspace--pinned-p)))
(konix/agent-shell-workspace--write
(org-set-tags
(if pinned
(remove konix/agent-shell-workspace-pinned-tag (org-get-tags nil t))
(cons konix/agent-shell-workspace-pinned-tag (org-get-tags nil t)))))
(message (if pinned "Unpinned" "Pinned")))))
- rule
:puts a tag on the question the user stands in, or takes it back off, as it does on any org heading, from anywhere in the question.- why: the workspace is read only and saves itself, and org’s own
:works on neither, nor anywhere but on the stars. - how:
designis always offered, the tag that makes a drawing compulsory.
- why: the workspace is read only and saves itself, and org’s own
(defconst konix/agent-shell-workspace-design-tag "design"
"Tag of a question whose answer the writer has to draw.")
(defun konix/agent-shell-workspace--read-tag ()
"Ask for a tag to toggle on the question point stands in, its own tags shown."
(save-excursion
(konix/agent-shell-workspace--goto-question)
(completing-read
(format "Tags (%s): " (string-join (org-get-tags nil t) ":"))
(delete-dups (cons konix/agent-shell-workspace-design-tag
(mapcar #'car (org-get-buffer-tags)))))))
(defun konix/agent-shell-workspace-tag (tag)
"Put TAG on the question point stands in, or take it off, and save."
(interactive (list (konix/agent-shell-workspace--read-tag)))
(save-excursion
(konix/agent-shell-workspace--goto-question)
(let ((id (org-entry-get nil "ID"))
(had (member tag (org-get-tags nil t))))
(konix/agent-shell-workspace--write
(when id (konix/agent-shell-workspace--goto-id id))
(org-toggle-tag tag (if had 'off 'on)))
(message (if had "Took %s off" "Tagged %s") tag))))
- what
- on a read-only workspace,
:on a question’s body puts:design:on its heading, saved to disk, and a second:takes it off.
(let* ((file (expand-file-name "tag-check.ws.org"
"/home/sam/perso/perso/roam/.agent-shell/tmp/"))
(on-disk (lambda ()
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(if (re-search-forward "^\\* REFINE Draw it, Go\\? +:design:$" nil t)
'tagged
'bare)))))
(with-temp-file file
(insert "* REFINE Draw it, Go?\n :PROPERTIES:\n"
" :ID: 5f0c1d2e-0000-4000-8000-000000000002\n :END:\n"
" - what :: it tilts\n"))
(let ((buffer (find-file-noselect file)))
(unwind-protect
(with-current-buffer buffer
(setq buffer-read-only t)
(goto-char (point-min))
(search-forward "it tilts")
(let (seen)
(konix/agent-shell-workspace-tag "design")
(push (funcall on-disk) seen)
(konix/agent-shell-workspace-tag "design")
(push (funcall on-disk) seen)
(nreverse seen)))
(with-current-buffer buffer (set-buffer-modified-p nil))
(kill-buffer buffer))))
- what
- the check above is right when it reads
(tagged bare). - how
- what a sweep takes is every fact the marking never reached, the pinned ones left out.
(defun konix/agent-shell-workspace--unlinked-facts ()
"Return the ids of this buffer's facts no path from a question reaches."
(let* ((facts (make-hash-table :test 'equal))
(queue (konix/agent-shell-workspace--gather-facts facts nil))
(reached (konix/agent-shell-workspace--follow-links facts queue))
unlinked)
(maphash (lambda (id span)
(unless (or (gethash id reached)
(save-excursion
(goto-char (car span))
(konix/agent-shell-workspace--pinned-p)))
(push id unlinked)))
facts)
unlinked))
what the writer is held to
- what
- two holds: a question taken up before any work, and the file read only through the workspace’s own tools.
held to taking one up
- rule
- a writer holding no question is held back from every tool but the ones that
let it take one up.
- why: the user wants to know which one it is on so as to anticipate the question coming.
- scope: it reaches every call the writer makes, since the steering reads the
calls going by rather than the leave they ask for.
- therefore: a tool the session’s own settings wave through, asking Emacs nothing, is held back all the same.
- rule
- a few tools stay permitted, each named in full.
- what: they are reading the headings back, moving one across the states,
writing a question of its own, writing a plan, proposing a project’s done and
doing, and saying a project is done.
- scope: writing a question carries what the user has just said into the workspace, not a subject the writer found for itself with nothing left to do.
- rule: and whatever the session fetches a tool’s own schema with is permitted too.
- why: a writer that cannot reach for the tool that takes a question up cannot take one up, and the refusal becomes a wall rather than a door.
- rule: and so is talking with other writers: reading and answering.
- why: an answer owed to another writer is talk, not work, and asking the user for a question for each is their time spent on nothing.
- scope: the talking alone: what an answer needs looking up still wants a question taken up.
- what: they are reading the headings back, moving one across the states,
writing a question of its own, writing a plan, proposing a project’s done and
doing, and saying a project is done.
(defconst konix/agent-shell-workspace-taken-up-key "@workspace-nothing-taken-up"
"Steering key holding back a writer that holds no question.")
(defconst konix/agent-shell-workspace-schema-tool "ToolSearch"
"Tool a session fetches another tool's own schema with.")
(defun konix/agent-shell-workspace--permitted-tools ()
"Return the whole titles a writer holding no question may still call."
(let ((server (format "mcp__%s__" konix/agent-shell-workspace-server-name)))
(list (concat server konix/mcp-server-read-only-prefix
"list_workspace_questions")
(concat server "set_workspace_state")
(concat server "set_workspace_question")
(concat server "set_workspace_plan")
(concat server "workspace_project_define")
(concat server "workspace_project_done")
(concat server "workspace_project_promote")
(concat server "set_workspace_memo")
(concat server konix/mcp-server-read-only-prefix "list_workspace_memos")
konix/agent-shell-workspace-schema-tool
"mcp__konix-coord__coord_get_messages"
"mcp__konix-coord__coord_send_message"
"mcp__konix-coord__coord_complete_task")))
- rule
- and a writer holding a DoD
proposal is held as if it held nothing, the same few tools alone let through.
- why: answered, a DoD proposal comes back to the writer, which would otherwise set to work on the project before its done and doing stand.
- what
- a writer holding a DoD proposal is refused a shell command, the same call going through once it holds an ordinary question.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-dodheld-writer")))
(cl-flet (
(holds (heading property taking-up)
(let ((file (make-temp-file "check-dodheld-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO WORKING | DONE\n"
"* Writer's :writers:\n"
"** WORKING " heading "\n :PROPERTIES:\n :ID: q\n"
property " :END:\n"))
(unwind-protect
(with-current-buffer shell
(setq-local konix/agent-shell-workspace--taking-up taking-up)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(if (funcall (cdr (assoc "workspace-nothing-taken-up"
konix/agent-shell-tool-evaluators))
'((:title . "ls") (:kind . "execute")))
'refused
'let-through)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file))))
)
(unwind-protect
(list (holds "DoD: « p »?" " :PROJECT-DEFINE: p\n" nil)
(holds "Fix it?" "" nil))
(kill-buffer shell))))
- what
- the check above is right when it reads
(refused let-through). - rule
- and so is a writer holding a question for an open project that does not yet
say what done means and what doing looks like.
- why: the user’s own: nothing must be allowed to do on a project until its DoD is set.
- rule: and the writer is given the rest meanwhile: only the questions for that
project are set aside, and it is owed no plan.
- why: while there are things to do for the writer, it must be given work; one project waiting on its DoD stopped every other.
- what
- a writer holding a question for an open project lacking done and doing is refused a shell command, the same call going through once it has them, or when the question is for no such project.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-dodunset-writer"))
files)
(cl-flet ((holds (defined &optional for)
(let ((file (make-temp-file "check-dodunset-" nil ".ws.org")))
(push file files)
(with-temp-file file
(insert "#+TODO: TODO WORKING | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n"
" :ID: p\n :END:\n" defined
"* Writer's :writers:\n"
"** WORKING Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
(or for " - for :: [[id:p][the project]]\n")))
(with-current-buffer shell
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(if (funcall (cdr (assoc "workspace-nothing-taken-up"
konix/agent-shell-tool-evaluators))
'((:title . "ls") (:kind . "execute")))
'refused
'let-through))))))
(unwind-protect
(list (holds "")
(holds " - done :: it works\n - doing :: try it\n")
(holds "" ""))
(let ((kill-buffer-query-functions nil))
(dolist (file files)
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file))
(kill-buffer shell)))))
- what
- the check above is right when it reads
(refused let-through let-through).
(defun konix/agent-shell-workspace--undefined-project (file)
"Return (ID . WORDS) of the first open project of FILE lacking done and doing, or nil."
(and (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(let ((questions (konix/agent-shell-workspace--every-question))
found)
(while (and (not found)
(konix/agent-shell-workspace--next-open-project))
(let ((id (org-entry-get (point) "ID")))
(unless (or (konix/agent-shell-workspace--project-defined-p id)
(konix/agent-shell-workspace--holding-back id questions))
(setq found
(cons id (string-trim (substring-no-properties
(org-get-heading t t t t))))))))
found)))))
(defun konix/agent-shell-workspace--dod-proposal-held-p (file)
"Non-nil when the question the writer holds in FILE is a DoD proposal."
(and (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(and (re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
konix/agent-shell-workspace-working-keyword " ")
nil t)
(org-entry-get (point)
konix/agent-shell-workspace-define-property))))))
(defun konix/agent-shell-workspace--for-undefined-project-p (id)
"Non-nil when question ID of this buffer is for an open project lacking its DoD.
A DoD proposal is not, being how the project gets one."
(save-excursion
(and (konix/agent-shell-workspace--goto-id id)
(not (org-entry-get (point) konix/agent-shell-workspace-define-property))
(seq-some (lambda (project)
(save-excursion
(and (konix/agent-shell-workspace--goto-id project)
(not (org-entry-is-done-p))
(not (konix/agent-shell-workspace--project-defined-p
project)))))
(konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-for-said)))))
(defun konix/agent-shell-workspace--held-for-undefined-project-p (file)
"Non-nil when the question the writer holds in FILE is for a project lacking its DoD."
(and (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(and (re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
konix/agent-shell-workspace-working-keyword " ")
nil t)
(when-let* ((id (org-entry-get (point) "ID")))
(konix/agent-shell-workspace--for-undefined-project-p id)))))))
(defun konix/agent-shell-workspace--dod-held-p (file)
"Non-nil when the writer of FILE holds a DoD proposal, or a question for a project
lacking its DoD."
(or (konix/agent-shell-workspace--dod-proposal-held-p file)
(konix/agent-shell-workspace--held-for-undefined-project-p file)))
what it is told
- how
- what it is told names every way on, and the two ways in: the writer put its question down, or the user took it away underneath it.
- rule
- and it names what is left to the writer: every question of its own, with
what is written under each.
- why: the writer acts from the refusal itself, without a call to read the workspace back first.
- rule: and it is the listing itself, the same one the nudge and the tool give.
- scope: owed a plan, it says to make the plan or say the project is done, the two calls let through.
- scope: with none to take it says the turn is being cut short there, and that
only what the user has just said may become a question.
- why: the writer would otherwise say things the user does not read, and go on as if they had agreed to them.
- therefore: the refusal names no tool of its own to a writer whose turn is ending.
- rule
- and a writer holding a DoD proposal is told to rework it, not to take one up.
- rule
- and one with a
DISCUSSof its own is told to take it up to answer it, never to work on it. - what
- the refusal a writer holding nothing gets, a
DISCUSSits own, tells it to answer withrefine.
(let ((file (make-temp-file "check-discusstold-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(let ((said (konix/agent-shell-workspace--taken-up-said file)))
(if (string-match-p "act refine" said) 'told-answer said))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
told-answer. - what
- the nudge to a writer with a
DISCUSSof its own says it is to discuss, not to work on, and the refusal ofput-downon one says so too, never naming the user’s keys; taken up, the nudge tells it the news on it, not to take one up, and only after an answer of the user’s on it, once.- why: told « the user has just said more » at every nudge, a fact of its own written under it came back to the writer as the user’s news.
- what
- and a writer whose
WORKINGquestion the user answers is cut short with that answer quoted, once, and told to take it up again.- why: the user wants it told an answer came while it worked, and the cut is already there to carry it.
(require 'cl-lib)
(let ((file (make-temp-file "check-discussnudge-" nil ".ws.org"))
(writer (generate-new-buffer " check-discussnudge-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&optional buffer)
(when (eq (or buffer (current-buffer)) writer) file)))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer)))
(with-current-buffer writer
(let ((nudge (konix/agent-shell-workspace--nudge writer))
(refusal (condition-case err
(progn (konix/mcp-server-set-workspace-state "q" "put-down")
"")
(error (error-message-string err)))))
(konix/mcp-server-set-workspace-state "q" "work")
(let ((quiet (konix/agent-shell-workspace--nudge writer))
(thinking (progn
(with-current-buffer (find-buffer-visiting file)
(goto-char (point-min))
(re-search-forward "^\\*\\* THINKING")
(konix/agent-shell-workspace--hand-back))
(konix/agent-shell-workspace--nudge writer)))
(again (konix/agent-shell-workspace--nudge writer))
(answered (progn
(with-current-buffer (find-buffer-visiting file)
(goto-char (point-min))
(re-search-forward "^\\*\\* THINKING")
(org-todo konix/agent-shell-workspace-working-keyword)
(konix/agent-shell-workspace--hand-back nil "not that way"))
(konix/agent-shell-workspace--nudge writer)))
(answered-again (konix/agent-shell-workspace--nudge writer)))
(list (and (string-match-p "to discuss, not to work on" nudge) 'nudge-says)
(and (string-match-p "to discuss, not to work on" refusal)
(not (string-match-p "\\by\\b" refusal))
'refusal-says)
(and (string-match-p "act refine" quiet)
(not (string-match-p "just said more" quiet))
'quiet-without-news)
(and (string-match-p "the user has just said more" thinking)
(not (string-match-p "Take one up" thinking))
'thinking-told-news)
(and (not (string-match-p "just said more" again))
'news-told-once)
(and (string-match-p "you were working on: « not that way »" answered)
'working-told-answer)
(and (not (string-match-p "not that way" answered-again))
'answer-told-once))))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(nudge-says refusal-says quiet-without-news thinking-told-news news-told-once working-told-answer answer-told-once). - rule
- and a writer held by a project lacking done and doing is told to propose them, naming the project, or to stop there if a proposal already waits on the user.
- what
- the refusal a writer of a workspace with a project lacking done and doing gets names that project and workspace_project_define.
(let ((file (make-temp-file "check-dodunsettold-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO WORKING | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* Writer's :writers:\n"
"** WORKING Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n"))
(unwind-protect
(let ((said (konix/agent-shell-workspace--taken-up-said file)))
(and (string-match-p "« the project »" said)
(string-match-p "workspace_project_define" said)
'told-define))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
told-define. - what
- the refusal a writer holding a DoD proposal gets tells it to rework it.
(let ((file (make-temp-file "check-dodtold-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO WORKING | DONE\n"
"* Writer's :writers:\n"
"** WORKING DoD: « p »?\n :PROPERTIES:\n :ID: q\n"
" :PROJECT-DEFINE: p\n :END:\n"))
(unwind-protect
(and (string-match-p "Rework the proposal"
(konix/agent-shell-workspace--taken-up-said file))
'told-rework)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
told-rework.
(defconst konix/agent-shell-workspace-dod-held-said
(concat "You hold a DoD proposal: until the user's yes, its project has no done"
" nor doing, so work on nothing else. Rework the proposal from the user's"
" answer, with workspace_project_define or set_workspace_question, then"
" hand it back.")
"What a writer holding a DoD proposal is told when it reaches for anything else.")
(defconst konix/agent-shell-workspace-may-draw-said
(concat " You may write in .agent-shell/tmp and run plantuml there to draw your"
" answer.")
"What a writer on a question to discuss is told it may still do.")
(defconst konix/agent-shell-workspace-discuss-said
(concat "A DISCUSS is to discuss, not to work on. Take it up with set_workspace_state,"
" act work: it shows you all of it as it stands, and the user's answers"
" meanwhile reach you at once. Read what you"
" need, then answer it with set_workspace_question, act refine. Where"
" answering needs work, ask for the go, worded « <Action>, Go? »."
" What you find, write as facts with set_workspace_fact, about it."
konix/agent-shell-workspace-may-draw-said)
"What a writer is told of a question it is to discuss, not to work on.")
(defun konix/agent-shell-workspace--discuss-here-p (file)
"Non-nil when FILE holds a question the writer is to discuss, or is thinking through."
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(konix/agent-shell-workspace--search-state
(konix/agent-shell-workspace--keyword-regexp
(list konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-thinking-keyword))))))
(defconst konix/agent-shell-workspace-thinking-held-said
(concat "You hold a question to discuss, and what you just tried is work beyond it."
" Do not work around it, nor guess what it would have shown: ask the go for"
" it now, with set_workspace_question, act refine, worded « <Action>, Go? »."
konix/agent-shell-workspace-may-draw-said)
"What a writer thinking a question through is told when it reaches for work.")
(defun konix/agent-shell-workspace--thinking-here-p (file)
"Non-nil when FILE holds a question the writer is thinking through."
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(konix/agent-shell-workspace--search-state
(konix/agent-shell-workspace--keyword-regexp
(list konix/agent-shell-workspace-thinking-keyword))))))
(defconst konix/agent-shell-workspace-dod-unset-said
(concat "Nothing on the project « %s », %s, is allowed until it says what done means"
" and what doing looks like. Propose both with workspace_project_define, as"
" « done :: … » and « doing :: … »; if a proposal of yours already waits on"
" the user, put this question down and take up another.")
"What a writer is told while a project of its workspace lacks done and doing.")
(defconst konix/agent-shell-workspace-taken-up-guidance
(concat "Take a question up before you work on anything, and then act. If this"
" refusal arrived in the middle of a turn, you hold none: either you put"
" yours down, or the user took it away underneath you. The one you take up"
" is the only thing you work"
" on: whatever else you notice is a question to write, not work to do. And a"
" place is a link you pass file and line for, never directions in prose.")
"What a writer is told when it works while holding no question.")
(defconst konix/agent-shell-workspace-list-to-see-said
" List the questions to see what is yours: it will make things clearer."
"What a refusal says in place of the questions, the writer reading them itself.")
(defun konix/agent-shell-workspace--taken-up-said (file)
"Return what a writer holding no question is told, naming what in FILE is left to it."
(let ((left (when (and file (file-readable-p file))
(konix/agent-shell-workspace--listing file t))))
(cond
((and file (konix/agent-shell-workspace--dod-proposal-held-p file))
konix/agent-shell-workspace-dod-held-said)
((and file (konix/agent-shell-workspace--held-for-undefined-project-p file))
(let ((project (konix/agent-shell-workspace--undefined-project file)))
(format konix/agent-shell-workspace-dod-unset-said
(cdr project) (car project))))
((and file (konix/agent-shell-workspace--plan-owed-p file))
(konix/agent-shell-workspace--plan-next-text file))
((and file (konix/agent-shell-workspace--thinking-here-p file))
konix/agent-shell-workspace-thinking-held-said)
((and file (konix/agent-shell-workspace--discuss-here-p file))
(concat konix/agent-shell-workspace-discuss-said
konix/agent-shell-workspace-list-to-see-said))
(left
(concat konix/agent-shell-workspace-taken-up-guidance
konix/agent-shell-workspace-list-to-see-said))
(t
(concat "Nothing there is yours to take, so there is nothing to do"
" and this turn is being cut short for you. Do not invent a"
" question to have something to do — only what the user has just"
" told you belongs there.")))))
- rule
- a refusal names no question: it tells the writer to list them.
- why: it follows a nudge that named them already, and resent them every time.
- what
- a refusal on a question to discuss carries no listing, only the hint to list.
(let ((file (make-temp-file "check-refusalshort-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** DISCUSS Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(let ((said (konix/agent-shell-workspace--taken-up-said file)))
(list (and (string-match-p "List the questions" said) t)
(and (string-match-p "Explain it" said) t)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(t nil). - rule
- a writer thinking a question through, held back from work, is told to ask its go.
- why: told to take one up while it held one, a writer read a dead end and guessed.
- what
- a THINKING question gets the go told, not the taking up; a DISCUSS the taking up.
(cl-flet ((said-for (keyword)
(let ((file (make-temp-file "check-thinkinggo-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS THINKING WORKING | DONE\n"
"* Writer's :writers:\n"
"** " keyword " Explain it?\n"
" :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(let ((said (konix/agent-shell-workspace--taken-up-said file)))
(list (and (string-match-p "ask the go for it now" said) t)
(and (string-match-p "Take it up with" said) t)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))))
(list (said-for "THINKING") (said-for "DISCUSS")))
- what
- the check above is right when it reads
((t nil) (nil t)).
how a call is caught
- how
- each permitted tool is matched on its whole name, spelled out from the server’s own, so no
tool merely carrying one of those names is let through.
- how: the matching itself belongs to the steering engine, which knows nothing of workspaces; this one only names them and asks.
- how
- it catches a call and nothing else, prose being the other key’s to catch.
- scope: and a call that only thinks goes through, a session that thinks having
worked on nothing.
- why: the shell folds the conversation up through a call of that kind, and held back it loses the very turn it was making room to go on with.
- scope: the key keeping the file to itself lets one through as well, the conversation it folds up naming the workspace all through.
- scope: and once it has asked to take one up, the calls sent with that asking go
through, for the rest of the turn.
- why: a writer sends the taking up and its first call together; the calls are read as they go by, before the taking up is written, and holding them back would punish it for doing just what it is told.
- how: a call taking one up is told by the act it names, on one of the workspace’s own tools, those going by the server’s prefix on their name.
- scope: but not the calls sent with taking up a DoD proposal, which go no further than the few tools let through.
- scope: and a call that only thinks goes through, a session that thinks having
worked on nothing.
- what
- in the turn it took it up, a writer holding a DoD proposal is still refused a shell command.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-dodturn-writer")))
(cl-flet (
(holds (heading property taking-up)
(let ((file (make-temp-file "check-dodheld-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO WORKING | DONE\n"
"* Writer's :writers:\n"
"** WORKING " heading "\n :PROPERTIES:\n :ID: q\n"
property " :END:\n"))
(unwind-protect
(with-current-buffer shell
(setq-local konix/agent-shell-workspace--taking-up taking-up)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(if (funcall (cdr (assoc "workspace-nothing-taken-up"
konix/agent-shell-tool-evaluators))
'((:title . "ls") (:kind . "execute")))
'refused
'let-through)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file))))
)
(unwind-protect
(holds "DoD: « p »?" " :PROJECT-DEFINE: p\n" t)
(kill-buffer shell))))
- what
- the check above is right when it reads
refused.
(defun konix/agent-shell-workspace--own-tool-p (subject)
"Non-nil when SUBJECT is a call to one of the workspace's own tools."
(string-prefix-p (format "mcp__%s__" konix/agent-shell-workspace-server-name)
(or (map-elt subject :title) "")))
(defun konix/agent-shell-workspace--only-thinking-p (subject)
"Non-nil when SUBJECT is the session thinking rather than working."
(equal (map-elt subject :kind) "think"))
(defun konix/agent-shell-workspace--nothing-taken-up-p (file)
"Non-nil when FILE holds no question the writer has taken up."
(and (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(not (konix/agent-shell-workspace--working-p)))))
(defvar-local konix/agent-shell-workspace--taking-up nil
"Non-nil once this writer has asked, this turn, to take a question up.")
(defun konix/agent-shell-workspace--taking-up-call-p (subject &optional file)
"Non-nil when SUBJECT is a call taking a question up to work on it.
Taking up one to discuss, as FILE has it, is not: that frees nothing."
(and (konix/agent-shell-workspace--own-tool-p subject)
(string-suffix-p "set_workspace_state" (map-elt subject :title))
(let ((input (map-elt subject :raw-input)))
(and (equal (or (map-elt input 'act) (map-elt input "act" nil #'equal))
"work")
(not (member (konix/agent-shell-workspace--state-of
(or (map-elt input 'id) (map-elt input "id" nil #'equal))
file)
(list konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-thinking-keyword)))))))
(konix/agent-shell-define-tool-evaluator "workspace-nothing-taken-up" (subject)
"Hold back a writer calling a tool while it holds no question."
(konix/agent-shell-workspace--note-work-read subject)
(when (konix/agent-shell-workspace--taking-up-call-p
subject (konix/agent-shell-workspace-file (current-buffer)))
(setq-local konix/agent-shell-workspace--taking-up t))
(let* ((judged (and (map-elt subject :title)
(not (konix/agent-shell-workspace--only-thinking-p subject))))
(verdict
(and judged
(not (konix/agent-shell-tool-named-p
subject (konix/agent-shell-workspace--permitted-tools)))
(when-let ((file (konix/agent-shell-workspace-file (current-buffer))))
(or (konix/agent-shell-workspace--dod-held-p file)
(and (not konix/agent-shell-workspace--taking-up)
(konix/agent-shell-workspace--nothing-taken-up-p file)
(not (konix/agent-shell-workspace--reading-to-answer-p
subject file)))))
t)))
(when judged
(konix/agent-shell-workspace--debug
'steering (konix/agent-shell-workspace--debug-name (current-buffer))
"%s (%s, %s) %S -> %s"
(map-elt subject :title) (map-elt subject :kind) (map-elt subject :status)
(map-elt subject :raw-input) (if verdict "held back" "let through")))
verdict))
(defun konix/agent-shell-workspace--held-back-responder (permission)
"Refuse PERMISSION's call where the writer is held back from it, before it runs.
It is told why: a question to discuss is discussed, else one is to be taken up."
(let ((tool-call (map-elt permission :tool-call)))
(when-let* (((funcall (cdr (assoc "workspace-nothing-taken-up"
konix/agent-shell-tool-evaluators))
tool-call))
(file (konix/agent-shell-workspace-file (current-buffer)))
(reject (seq-find (lambda (option)
(equal (map-elt option :kind) "reject_once"))
(map-elt permission :options))))
(funcall (map-elt permission :respond) (map-elt reject :option-id))
(konix/agent-shell-workspace--debug
'steering (file-name-nondirectory file) "%s refused at its permission"
(map-elt tool-call :title))
(konix/agent-shell--interrupt-and-deliver
(konix/agent-shell-workspace--taken-up-said file) nil t)
t)))
(remove-hook 'konix/agent-shell-permission-responder-functions
'konix/agent-shell-workspace--discuss-responder)
(add-hook 'konix/agent-shell-permission-responder-functions
#'konix/agent-shell-workspace--held-back-responder -90)
(defcustom konix/agent-shell-workspace-scratch-commands
'("plantuml" "clk ipfs browse")
"Commands a writer may run on files under .agent-shell/tmp to answer a THINKING."
:type '(repeat string) :group 'konix)
(defun konix/agent-shell-workspace--in-scratch-p (subject)
"Non-nil when SUBJECT writes only under .agent-shell/tmp, or runs a scratch command there.
A scratch command is one of `konix/agent-shell-workspace-scratch-commands'."
(let* ((input (map-elt subject :raw-input))
(path (or (map-elt input 'file_path) (map-elt input "file_path" nil #'equal)))
(command (or (map-elt input 'command) (map-elt input "command" nil #'equal)))
(prefix (and command
(seq-find (lambda (scratch)
(string-prefix-p (concat scratch " ") command))
konix/agent-shell-workspace-scratch-commands))))
(pcase (map-elt subject :kind)
("edit" (and path (string-match-p "/\\.agent-shell/tmp/" path)))
("execute" (and prefix
(string-match-p "\\.agent-shell/tmp/" command)
(not (string-match-p "[;&|`$<>]" command))
(seq-every-p (lambda (word)
(or (string-prefix-p "-" word)
(string-match-p "\\.agent-shell/tmp\\(/\\|\\'\\)"
word)))
(split-string (substring command (length prefix)))))))))
- what
- the readers a shell command on a
THINKINGmay be made of arejq,head,tail,wc,lsandstrings;>,;,&,$and the backquote are refused it.
(define-obsolete-variable-alias 'konix/agent-shell-workspace-discuss-readers
'konix/agent-shell-workspace-thinking-readers "2026-10-23")
(defcustom konix/agent-shell-workspace-thinking-readers
'("jq" "head" "tail" "wc" "ls" "strings")
"Commands a writer may pipe together in the shell to answer a THINKING."
:type '(repeat string) :group 'konix)
(defun konix/agent-shell-workspace--only-reading-p (subject)
"Non-nil when SUBJECT is a shell command piping listed readers, nothing else."
(let ((command (or (map-elt (map-elt subject :raw-input) 'command)
(map-elt (map-elt subject :raw-input) "command" nil #'equal))))
(and (equal (map-elt subject :kind) "execute")
command
(not (string-match-p "[<>;&`$]" command))
(seq-every-p (lambda (part)
(member (car (split-string part)) konix/agent-shell-workspace-thinking-readers))
(split-string command "|")))))
- what
- beside reads, searches and fetches, the tools that read to answer a
THINKINGarereadonly_grep,readonly_function_source,readonly_library_source,readonly_variable_value,readonly_package_locationandreadonly_list_workspace_memos, no otherreadonly_one but the buddies’ below. - what
- to discuss with other buddies,
coord_ask_and_wait,readonly_coord_list_buddiesandreadonly_list_potential_buddiesgo through too.- scope: spawning, tasks, rooms and broadcast stay held: those hand work out.
- what
- and
set_workspace_fact, so what answering finds is reported as a fact on the question, without waiting on a go.- why: facts are part of the discussion between the writer and the user.
- what
- and
set_workspace_memoandpropose_rule_merge.
(define-obsolete-variable-alias 'konix/agent-shell-workspace-discuss-tools
'konix/agent-shell-workspace-thinking-tools "2026-10-23")
(defcustom konix/agent-shell-workspace-thinking-tools
'("mcp__konix-files__readonly_grep"
"mcp__konix-emacs-workspace__set_workspace_fact"
"mcp__konix-emacs-workspace__set_workspace_memo"
"mcp__konix-emacs-workspace__readonly_list_workspace_memos"
"mcp__konix-emacs-workspace__propose_rule_merge"
"mcp__konix-emacs-elisp__readonly_function_source"
"mcp__konix-emacs-elisp__readonly_library_source"
"mcp__konix-emacs-elisp__readonly_variable_value"
"mcp__konix-emacs-elisp__readonly_package_location"
"mcp__konix-coord__coord_ask_and_wait"
"mcp__konix-coord__readonly_coord_list_buddies"
"mcp__konix-emacs-agents__readonly_list_potential_buddies")
"Whole titles of the tools a writer may call to answer a THINKING, beside reads."
:type '(repeat string) :group 'konix)
(defun konix/agent-shell-workspace--thinking-here-p (file)
"Non-nil when FILE holds a question the writer took up to answer."
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(konix/agent-shell-workspace--search-state
(konix/agent-shell-workspace--keyword-regexp
(list konix/agent-shell-workspace-thinking-keyword))))))
(defun konix/agent-shell-workspace--reading-to-answer-p (subject file)
"Non-nil when SUBJECT only reads or draws to answer, FILE holding one taken up."
(and (or (member (map-elt subject :kind) '("read" "search" "fetch"))
(konix/agent-shell-tool-named-p
subject konix/agent-shell-workspace-thinking-tools)
(konix/agent-shell-workspace--in-scratch-p subject)
(konix/agent-shell-workspace--only-reading-p subject))
(konix/agent-shell-workspace--thinking-here-p file)))
held off reading the file itself
- rule
- a call that reads the bound workspace file is held back, whatever tool it
comes through.
- why: writers tend to do that and it’s annoying, the tools being supposed to provide everything they need.
- what: the listing gives back every heading, what is written under it and whose turn it is, in the form the tools mean.
- scope: the workspace’s own tools are let through, naming the file being how they are asked at all.
- how: it matches the path anywhere in what the call asks for, so a shell command naming it is caught as readily as a read.
(defconst konix/agent-shell-workspace-read-directly-key "@workspace-read-directly"
"Steering key holding back a call that reads the workspace file itself.")
(defconst konix/agent-shell-workspace-read-directly-guidance
(concat "Do not read the workspace file yourself. Every heading in it, what is"
" written under each and whose turn it is, comes back from"
" list_workspace_questions in the form these tools mean, so reading the"
" file raw spends the turn on markup you would have to unpick. Read it"
" back with the tool instead.")
"What a writer is told when it goes for the workspace file itself.")
(konix/agent-shell-define-tool-evaluator "workspace-read-directly" (subject)
"Hold back a call reading the bound workspace file rather than asking for it."
(and (map-elt subject :title)
(not (konix/agent-shell-workspace--only-thinking-p subject))
(not (konix/agent-shell-workspace--own-tool-p subject))
(when-let ((file (konix/agent-shell-workspace-file (current-buffer))))
(konix/agent-shell-tool-mentions-p subject file))
t))
what the steering is made of
- what
- a key names each piece of the arrangement, so binding can put those on and
unbinding can take those off without touching whatever else steers the session.
- what: there are five of the arrangement’s own — the writer wrote prose, the writer works holding no question, the writer reads the file itself, the user’s own rule against the background, reworded while bound, and the writer sleeping through the coordination tools — and whatever steering the workspace names itself.
(defconst konix/agent-shell-workspace-bound-key "@workspace-bound"
"Steering key holding back the prose a writer writes while a workspace is bound.")
(defconst konix/agent-shell-workspace-filler-regexp "No response"
"What a writer with nothing to say is made to write anyway.")
(defun konix/agent-shell-workspace--talking-p (subject)
"Non-nil when SUBJECT carries words the writer wrote since the user last spoke.
A dot or a filler says nothing, so it is no talking."
(string-match-p "[[:alnum:]]"
(replace-regexp-in-string
konix/agent-shell-workspace-filler-regexp ""
(or (cdr (assq :agent-said subject)) ""))))
(konix/agent-shell-define-tool-evaluator "workspace-bound" (subject)
"Match the writer's prose while a workspace is bound."
(and (konix/agent-shell-workspace--talking-p subject)
(konix/agent-shell-workspace-file (current-buffer))
t))
(defconst konix/agent-shell-workspace-bound-guidance
(concat konix/agent-shell-workspace-talking-harms-said
". Shut up and work: only the workspace is read.")
"What a writer is told when it writes prose while a workspace is bound.")
- rule
- and the refusal of prose is the user’s own words, and nothing more.
- why: the user insisted on « shut up! ».
- rule: and it opens by saying talking harms the user, the nudge’s last line too.
- why: the user wanted it harder, worded « talking in the session does harm to the user ».
(defconst konix/agent-shell-workspace-background-key "@background"
"The user's own steering key against running a command in the background.")
(defconst konix/agent-shell-workspace-background-guidance
(concat "A command: await it if needed, set_workspace_state with act await, passing"
" the command, rather than running it in the background. Helpers: they run"
" unseen. Put this question down and take up another, or keep working on"
" it. Never just wait, and above all, don't talk.")
"What a bound writer is told instead when it runs a command in the background.")
(defconst konix/agent-shell-workspace-coord-sleep-key "@workspace-coord-sleep"
"Steering key holding back a bound writer sleeping through the coordination tools.")
(defconst konix/agent-shell-workspace-coord-sleep-guidance
(concat "Do not sleep: await instead, with set_workspace_state, act await, passing"
" a command that ends when what you wait for holds, and take up another"
" meanwhile.")
"What a bound writer is told when it reaches for the coordination tools' sleep.")
(konix/agent-shell-define-tool-evaluator "workspace-coord-sleep" (subject)
"Match a bound writer calling the coordination tools' sleep."
(and (equal (map-elt subject :title) "mcp__konix-coord__coord_sleep")
(konix/agent-shell-workspace-file (current-buffer))
t))
(defconst konix/agent-shell-workspace-steering-keys
(list konix/agent-shell-workspace-bound-key
konix/agent-shell-workspace-taken-up-key
konix/agent-shell-workspace-read-directly-key
konix/agent-shell-workspace-background-key
konix/agent-shell-workspace-coord-sleep-key)
"Steering keys the workspace installs on a bound session.")
- rule
- and the user’s own rule against running in the background says, while bound,
to await instead, whatever it says otherwise.
- rule: and of helper agents started in the background, that they run unseen: put
the question down for another, or keep working on it, never wait, never talk.
- why: nothing tells the workspace when they report, and a writer waiting on them idles, talks and is cut, over and over.
- rule: and of helper agents started in the background, that they run unseen: put
the question down for another, or keep working on it, never wait, never talk.
- what
- the words of the background rule tell of helpers as well as commands.
(and (string-match-p "Helpers: they run unseen" konix/agent-shell-workspace-background-guidance)
(string-match-p "don't talk" konix/agent-shell-workspace-background-guidance)
t)
- what
- the check above is right when it reads
t.- why: a bound writer has a better way to wait on a long command than sleeping.
- how: the session carries the same key with the workspace’s words, which shadow the user’s own, and unbinding takes them off again.
- rule
- and so is the coordination tools’ sleep refused a bound writer, which is told to await instead.
- rule
- but their wait is let through: a writer waiting on a buddy just waits.
- why: the user asked « if you have to wait, why don’t you just wait? ».
- how
- each key carries what the writer is told, the workspace’s projects after it,
and the rules the workspace names itself come after them.
- why: the writer reads why it was stopped first, and the projects to go back to next.
- scope: bar the one catching prose, which says its words and nothing else, neither projects nor workspace.
(defconst konix/agent-shell-workspace-steering-guidance
(list
(cons konix/agent-shell-workspace-bound-key
konix/agent-shell-workspace-bound-guidance)
(cons konix/agent-shell-workspace-taken-up-key
konix/agent-shell-workspace-taken-up-guidance)
(cons konix/agent-shell-workspace-read-directly-key
konix/agent-shell-workspace-read-directly-guidance)
(cons konix/agent-shell-workspace-background-key
konix/agent-shell-workspace-background-guidance)
(cons konix/agent-shell-workspace-coord-sleep-key
konix/agent-shell-workspace-coord-sleep-guidance))
"What a writer is steered with, per key.")
(defun konix/agent-shell-workspace--steering-guidance (shell)
"Return what SHELL is steered with, the workspace's projects after each."
(let* ((file (konix/agent-shell-workspace-file shell))
(project (string-trim (if file (konix/agent-shell-workspace--project-line file) "")))
(said konix/agent-shell-workspace-steering-guidance))
(append
(mapcar
(lambda (entry)
(cons (car entry)
(if (equal (car entry) konix/agent-shell-workspace-bound-key)
(cdr entry)
(concat (if (equal (car entry) konix/agent-shell-workspace-taken-up-key)
(konix/agent-shell-workspace--taken-up-said file)
(cdr entry))
(unless (string-empty-p project) (concat "\n\n" project))))))
said)
(konix/agent-shell-workspace--its-own-steering file))))
- how
- putting them on replaces what the session carried of them, its other rules left alone.
(defvar-local konix/agent-shell-workspace--its-own-keys nil
"Steering keys this session carries because its workspace named them.")
(defun konix/agent-shell-workspace--install-steering (shell)
"Put the workspace's own steering rules on SHELL, replacing any it had."
(let ((guidance (konix/agent-shell-workspace--steering-guidance shell)))
(with-current-buffer shell
(let ((rules (copy-alist konix/agent-shell-steering-rules)))
(dolist (key (append konix/agent-shell-workspace-steering-keys
konix/agent-shell-workspace--its-own-keys
(mapcar #'car guidance)))
(setq rules (assoc-delete-all key rules)))
(setq-local konix/agent-shell-workspace--its-own-keys
(seq-remove
(lambda (key)
(member key konix/agent-shell-workspace-steering-keys))
(mapcar #'car guidance)))
(setq-local konix/agent-shell-steering-rules
(append guidance rules))))))
- how
- steering a session puts every hold on at once: these keys, the lists the workspace names itself, and the watch on its turns that tells it to carry on.
(defun konix/agent-shell-workspace--steer (shell)
"Make SHELL steer itself back to the workspace rather than talk to the user."
(konix/agent-shell-workspace--install-steering shell)
(konix/agent-shell-workspace--install-its-own shell)
(with-current-buffer shell
(konix/agent-shell-workspace--watch-turns)))
rules the workspace names itself
- rule
- a workspace names its own steering, its own whitelist and its own blacklist
in its front matter, and they go on the writer with the arrangement’s own.
- why: what a writer must be held to differs from one piece of work to the next.
- how: one
#+STEERING:line each, naming what it matches and then what it says, as many as wanted. - how: the whitelist and blacklist rules sit the same way in the file’s property
drawer, the first
:WHITELIST:or:BLACKLIST:, the others with a+.- why: org keeps that drawer folded, and the user found the lines polluted the view.
- how: a file’s old
#+WHITELIST:and#+BLACKLIST:lines are still read, and go into the drawer at its next write.
- rule: and the arrangement’s own keys come first, a workspace naming one of them
saying nothing.
- why: the user must not lock a writer out of the very keys that hold it to the workspace.
- rule: a line naming nothing before its
::, a bare::say, declares no rule.- why: an empty key is an empty regexp, which matches every call: in a whitelist it let a writer edit ~/.steam unasked.
(let ((file (expand-file-name ".agent-shell/tmp/declared-check.ws.org")))
(with-temp-file file
(insert ":PROPERTIES:\n:WHITELIST: ::\n:WHITELIST+: ^Read x :: note\n"
":WHITELIST+: :: only a note\n:END:\n"))
(mapcar #'car (konix/agent-shell-workspace--declared file "WHITELIST")))
- what
- the check above is right when it reads
("^Read x").
(defun konix/agent-shell-workspace--declared (file key)
"Return the (WHAT . SAID) each `#+KEY:' line of FILE declares."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(seq-remove
(lambda (one) (string-empty-p (car one)))
(mapcar (lambda (line)
(if-let ((split (string-search "::" line)))
(cons (string-trim (substring line 0 split))
(string-trim (substring line (+ split 2))))
(cons (string-trim line) "")))
(if (member key konix/agent-shell-workspace-drawer-lists)
(konix/agent-shell-workspace--list-values key)
(cdr (car (org-collect-keywords (list key))))))))))
(defun konix/agent-shell-workspace--its-own-steering (file)
"Return the steering rules FILE names itself, the arrangement's own left alone."
(seq-remove (lambda (one)
(member (car one) konix/agent-shell-workspace-steering-keys))
(konix/agent-shell-workspace--declared file "STEERING")))
put on the writer
- rule
- they are read afresh at binding and at every rewrite, so editing the file is
how they change.
- rule: and put on silently, where the panels’ own edits echo each rule.
- why: this runs on every bind, respawns included, and a line for each would only be noise.
- rule: and put on silently, where the panels’ own edits echo each rule.
- rule
- and every bound session is refused
sudoin its own shell, told to await the command withrootinstead.- why: its shell has no one to type the password, where an await as root asks the user.
- scope: a line of the workspace’s own naming that rule’s key is left out, so nothing the file says replaces it, and the panels refuse to write one.
(defconst konix/agent-shell-workspace-sudo-rule
(cons "^sudo\\b"
(concat "Never sudo in your shell: await the command with set_workspace_state,"
" root true and the command without sudo; the user gives the password."))
"The blacklist rule every bound session carries, pointing root runs to await.")
(defun konix/agent-shell-workspace--refuse-the-sudo-key (line)
"Refuse LINE, a workspace rule, where it names the sudo rule's key."
(when (and line (string-prefix-p (car konix/agent-shell-workspace-sudo-rule)
(string-trim line)))
(user-error "Every bound session refuses sudo; a workspace cannot change that")))
- rule
- and every bound session is refused
sleepin its own shell, told to ask a question instead, unbinding giving back the user’s own words.- why: a bound writer that sleeps waits on nothing the workspace tells it of, where a question brings the user’s guidance.
- scope: a line of the workspace’s own naming
^sleepstill replaces it.
(defconst konix/agent-shell-workspace-sleep-rule
(cons "^sleep"
"Don't ever call sleep: ask for guidance with a question instead.")
"The blacklist rule every bound session carries, pointing waits to a question.")
(defun konix/agent-shell-workspace--install-its-own (shell)
"Put, silently, the sudo and sleep rules on SHELL, bound to a workspace."
(when-let ((file (konix/agent-shell-workspace-file shell)))
(with-current-buffer shell
(dolist (rule (list konix/agent-shell-workspace-sudo-rule
konix/agent-shell-workspace-sleep-rule))
(ignore-errors
(konix/agent-shell-policy--set-session
konix/agent-shell--blacklist (car rule) (cdr rule)))))))
- what
- a bound session says the workspace’s words on
sleep, and once unbound carries them no more.
(require 'cl-lib)
(let ((file (make-temp-file "check-sleep-" nil ".ws.org"
":PROPERTIES:\n:WHITELIST: ^ls :: l\n:END:\n")))
(unwind-protect
(with-temp-buffer
(cl-letf* ((shell (current-buffer))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell--current-shell-or-error)
(lambda () shell)))
(konix/agent-shell-workspace--install-its-own (current-buffer))
(list (cdr (assoc "^sleep" konix/agent-shell-tool-blacklist))
(assoc "^ls" konix/agent-shell-tool-whitelist)
(cdr (assoc "^ls" (konix/agent-shell-policy--effective
konix/agent-shell--whitelist)))
(progn (konix/agent-shell-workspace--unsteer (current-buffer))
(assoc "^sleep" konix/agent-shell-tool-blacklist)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("Don't ever call sleep: ask for guidance with a question instead." nil "l" nil): the workspace’s^lsdecides without being copied into the session.
the agent’s own panels
- rule
S,BandWopen the agent’s own steering, blacklist and whitelist panels, on the workspace’s writer.- scope: the workspace has no panel of its own.
- what
WandBin the workspace open the agent’s whitelist and blacklist panels from its writer.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-panels-writer"))
opened)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell/whitelist-menu)
(lambda () (push (list 'whitelist (current-buffer)) opened)))
((symbol-function 'konix/agent-shell/blacklist-menu)
(lambda () (push (list 'blacklist (current-buffer)) opened))))
(with-temp-buffer
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "W"))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "B"))
(setq-local konix/agent-shell-workspace--writer-buffer nil))
(mapcar (lambda (one) (list (car one) (eq (cadr one) writer)))
(nreverse opened)))
(kill-buffer writer)))
- what
- the check above is right when it reads
((whitelist t) (blacklist t)). - rule
Wpressed on aPERMquestion hasaoffer the command it waits on, keyed as the writer’s own shell command would be.- how:
Whands the writer that command as the call its panels offer, whichareads before the writer’s own waiting permission. - scope:
B, orWanywhere else, takes it back, andaoffers the writer’s own waiting permission again.
- how:
(defun konix/agent-shell-workspace-steering-menu ()
"Open the agent's steering panel on this workspace's writer."
(interactive)
(with-current-buffer (konix/agent-shell-workspace--target-writer)
(konix/agent-shell-steering/menu)))
(defun konix/agent-shell-workspace-blacklist-menu ()
"Open the agent's blacklist panel on this workspace's writer."
(interactive)
(with-current-buffer (konix/agent-shell-workspace--target-writer)
(setq-local konix/agent-shell--offered-tool-call nil)
(konix/agent-shell/blacklist-menu)))
(defun konix/agent-shell-workspace--leave-asked-at-point ()
"Return the tool call the PERM question point stands in waits on, or nil."
(unless (org-before-first-heading-p)
(save-excursion
(konix/agent-shell-workspace--goto-question)
(when-let* (((equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-permission-keyword))
(command (org-entry-get (point) "PENDING-RUN")))
(list (cons :title command) (cons :kind "execute")
(cons :raw-input (list (cons 'command command))))))))
(defun konix/agent-shell-workspace-whitelist-menu ()
"Open the agent's whitelist panel on this workspace's writer.
On a PERM question, its `a' offers the command the question waits on."
(interactive)
(let ((call (konix/agent-shell-workspace--leave-asked-at-point)))
(with-current-buffer (konix/agent-shell-workspace--target-writer)
(setq-local konix/agent-shell--offered-tool-call call)
(konix/agent-shell/whitelist-menu))))
the lines written from those panels
- rule
- what those panels write for the workspace is the line of the file itself.
- rule: and the writer is steered again as each edit lands, so a rule bites without waiting for a rewrite.
- rule: and each write leaves that key’s lines sorted, together where the first
stood.
- why: the user curates them, and a sorted list is read at a glance.
- what
- a rule written among two others, out of order and apart, leaves the three sorted and together.
(require 'cl-lib)
(let ((file (make-temp-file "check-sorted-" nil ".ws.org")))
(with-temp-file file
(insert "#+TITLE: w\n#+WHITELIST: ^zz :: z\n#+STEERING: s :: t\n"
"#+WHITELIST: @a :: a\n\n* TODO q\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
#'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(konix/agent-shell-workspace--rule-write "WHITELIST" nil "^mm :: m")
(prog1 (format "%S" (list (save-restriction
(widen)
(buffer-substring-no-properties (point-min) (point-max)))
(mapcar (lambda (rule)
(cons (substring-no-properties (car rule))
(substring-no-properties (cdr rule))))
(konix/agent-shell-workspace--declared
file "WHITELIST"))))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when the file holds the three
WHITELISTrules@a,^mm,^zzin a row in its property drawer, the first as:WHITELIST:, the others as:WHITELIST+:, no#+WHITELIST:line left,TITLEandSTEERINGas they were; and the three rules read back, in that order.
(defun konix/agent-shell-workspace--rule-write (key what now)
"Make this workspace's KEY line for WHAT read NOW, or drop it when NOW is nil."
(unless (equal key "STEERING")
(konix/agent-shell-workspace--refuse-the-sudo-key now))
(konix/agent-shell-workspace--write
(if (member key konix/agent-shell-workspace-drawer-lists)
(let ((kept (seq-remove
(lambda (value)
(and what
(string-match-p
(format "\\`%s *\\(?:::.*\\)?\\'" (regexp-quote what))
value)))
(konix/agent-shell-workspace--list-values key))))
(konix/agent-shell-workspace--put-list key (if now (cons now kept) kept)))
(save-excursion
(goto-char (point-min))
(if (and what
(re-search-forward
(format "^#\\+%s: *%s *\\(?:::.*\\)?$" key (regexp-quote what))
nil t))
(progn
(delete-region (line-beginning-position)
(min (point-max) (1+ (line-end-position))))
(when now (insert (format "#+%s: %s\n" key now))))
(when now
(konix/agent-shell-workspace--goto-front-matter)
(insert (format "#+%s: %s\n" key now))))
(konix/agent-shell-workspace--sort-lines key))))
(konix/agent-shell-workspace--steer
(konix/agent-shell-workspace--target-writer)))
(defconst konix/agent-shell-workspace-drawer-lists '("WHITELIST" "BLACKLIST")
"The keys a workspace keeps in its file's property drawer, which org keeps folded.")
(defun konix/agent-shell-workspace--front-end ()
"Where this buffer's front matter ends: its first heading, or its end."
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^\\*+ " nil t) (match-beginning 0) (point-max))))
(defun konix/agent-shell-workspace--list-values (key &optional take)
"This buffer's KEY values, from its drawer and from any old =#+KEY:= line.
TAKE removes the lines they stood on."
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(let ((end (copy-marker (konix/agent-shell-workspace--front-end)))
values)
(while (re-search-forward
(format "^\\(?:#\\+%s\\|[ \t]*:%s\\+?\\):[ \t]*\\(.*\\)\n?" key key)
end t)
(push (string-trim (match-string 1)) values)
(when take (replace-match "")))
(nreverse values)))))
(defun konix/agent-shell-workspace--put-list (key values)
"Make this buffer's KEY values VALUES, sorted, in its file's property drawer.
The first reads =:KEY:=, the others =:KEY+:=, as org adds values up."
(konix/agent-shell-workspace--list-values key t)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(if-let* ((sorted (sort (seq-uniq values) #'string<)))
(progn
(org-entry-put nil key (car sorted))
(goto-char (point-min))
(re-search-forward (format "^[ \t]*:%s:.*\n" key))
(dolist (value (cdr sorted))
(insert (format ":%s+: %s\n" key value))))
(when (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n[ \t]*:END:[ \t]*\n?"
(konix/agent-shell-workspace--front-end) t)
(replace-match ""))))))
(defun konix/agent-shell-workspace--lists-into-drawer ()
"Move this buffer's old =#+WHITELIST:= and =#+BLACKLIST:= lines into its drawer."
(dolist (key konix/agent-shell-workspace-drawer-lists)
(when (save-excursion
(goto-char (point-min))
(re-search-forward (format "^#\\+%s:" key)
(konix/agent-shell-workspace--front-end) t))
(konix/agent-shell-workspace--put-list
key (konix/agent-shell-workspace--list-values key)))))
(defun konix/agent-shell-workspace--sort-lines (key)
"Gather this buffer's KEY lines, sorted, where the first of them stood."
(save-excursion
(goto-char (point-min))
(let ((line (format "^#\\+%s: .*\n" key)) lines start)
(while (re-search-forward line nil t)
(push (match-string 0) lines)
(replace-match "")
(unless start (setq start (copy-marker (point)))))
(when start
(goto-char start)
(apply #'insert (sort lines #'string<))))))
a column in the agent’s own panels
- rule
- the agent’s own whitelist and blacklist panels have a
Workspacecolumn besideGlobal,Project(the repository’s) andSession,wits key.- why: a rule meant to last the workspace is added once, not to the session and again here.
- how: ticking it writes the workspace’s line; deciding reads that axis itself, so the session never carries a copy.
(defun konix/agent-shell-workspace--policy-key (policy)
"Return the line a workspace names POLICY's rules on, or nil."
(cond ((eq policy konix/agent-shell--whitelist) "WHITELIST")
((eq policy konix/agent-shell--blacklist) "BLACKLIST")))
(defun konix/agent-shell-workspace--policy-file ()
"Return the workspace the shell here is bound to, or nil."
(when-let* ((shell (ignore-errors (konix/agent-shell--current-shell-or-error))))
(konix/agent-shell-workspace-file shell)))
(defun konix/agent-shell-workspace--policy-entries (policy)
"Return POLICY's rules the shell here's workspace names itself."
(when-let* ((key (konix/agent-shell-workspace--policy-key policy)))
(konix/agent-shell-workspace--declared
(konix/agent-shell-workspace--policy-file) key)))
(defun konix/agent-shell-workspace--policy-write (policy what now)
"Make the workspace's POLICY line for WHAT read NOW, or drop it where NOW is nil."
(with-current-buffer (find-file-noselect
(or (konix/agent-shell-workspace--policy-file)
(user-error "This shell is bound to no workspace")))
(konix/agent-shell-workspace--rule-write
(konix/agent-shell-workspace--policy-key policy) what now)))
- how
- the column is one more axis the agent’s panels are handed, offered only from a
shell bound to a workspace.
- why: unbound, it has nowhere to write, and offering it is a trap.
(defun konix/agent-shell-workspace--policy-set (policy what said)
"Name WHAT, told SAID, among the workspace's POLICY rules."
(konix/agent-shell-workspace--refuse-the-sudo-key what)
(konix/agent-shell-workspace--policy-write
policy (car (assoc what (konix/agent-shell-workspace--policy-entries policy)))
(format "%s :: %s" what (or said ""))))
(defun konix/agent-shell-workspace--policy-remove (policy what)
"Take WHAT off the workspace's POLICY rules."
(konix/agent-shell-workspace--policy-write policy what nil))
(setq konix/agent-shell-policy-extra-axes
(list (list :header "Workspace" :key "w"
:available #'konix/agent-shell-workspace--policy-file
:entries #'konix/agent-shell-workspace--policy-entries
:set #'konix/agent-shell-workspace--policy-set
:remove #'konix/agent-shell-workspace--policy-remove)))
unbinding
- how
- unbinding reaches the session from either side, since the user may call it from the shell or from the workspace itself.
- rule
- and unbinding takes off the steering binding put on, and tells the writer nothing.
(defun konix/agent-shell-workspace--shell-here ()
"Return the session this buffer is about: the shell, or the workspace's writer."
(if (bound-and-true-p konix/agent-shell-workspace-mode)
(konix/agent-shell-workspace--target-writer)
(konix/agent-shell--current-shell-or-error)))
(defun konix/agent-shell-workspace--unsteer (shell)
"Take the workspace's steering back off SHELL."
(with-current-buffer shell
(let ((rules (copy-alist konix/agent-shell-steering-rules)))
(dolist (key (append konix/agent-shell-workspace-steering-keys
konix/agent-shell-workspace--its-own-keys))
(setq rules (assoc-delete-all key rules)))
(setq-local konix/agent-shell-workspace--its-own-keys nil)
(setq-local konix/agent-shell-steering-rules rules))
(ignore-errors
(konix/agent-shell-policy--remove-session
konix/agent-shell--blacklist (car konix/agent-shell-workspace-sleep-rule)))))
(defun konix/agent-shell-workspace-unbind ()
"Drop this shell's workspace and its steering, back to plain conversation."
(declare (modes agent-shell-mode
agent-shell-viewport-view-mode
agent-shell-viewport-edit-mode
konix/agent-shell-workspace-mode))
(interactive)
(konix/agent-shell-workspace--forget (konix/agent-shell-workspace--shell-here))
(message "Workspace unbound"))
a bound session says so
- rule
- a session writing into a document says so where the user talks to it.
- how
- the theme’s own background is kept, at its own lightness, with its hue turned two hundred and twenty degrees round the wheel.
- how
- and a grey is lifted to two hundredths of saturation first, since turning the hue of a grey leaves it grey.
(defun konix/agent-shell-workspace--tint-colour ()
"Return the tint a bound session's background carries."
(let ((base (face-background 'default nil t)))
(when (and base (color-defined-p base))
(pcase-let* ((`(,r ,g ,b) (color-name-to-rgb base))
(`(,h ,s ,l) (color-rgb-to-hsl r g b))
(`(,r2 ,g2 ,b2)
(color-hsl-to-rgb
(mod (+ h (/ konix/agent-shell-workspace-tint-degrees 360.0))
1.0)
(max s konix/agent-shell-workspace-tint-saturation)
l)))
(color-rgb-to-hex r2 g2 b2 2)))))
- rule
- a viewport is tinted for the session behind it, not for itself.
(defun konix/agent-shell-workspace--file-here ()
"Return the document the session of this buffer writes into, or nil."
(when-let ((shell (ignore-errors
(konix/agent-shell--current-shell-or-error))))
(konix/agent-shell-workspace-file shell)))
- how
- the shell and the viewport it talks through are both tinted, each as it is set up.
(defun konix/agent-shell-workspace--tint (buffer)
"Tint BUFFER when the session it belongs to writes into a document."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(buffer-face-set
(when (konix/agent-shell-workspace--file-here)
(list :background (konix/agent-shell-workspace--tint-colour)))))))
(defun konix/agent-shell-workspace--tint-here ()
"Tint the buffer being set up, for `agent-shell' and its viewport modes."
(konix/agent-shell-workspace--tint (current-buffer)))
(defun konix/agent-shell-workspace--tint-session (shell)
"Tint everything SHELL shows through."
(konix/agent-shell-workspace--tint shell)
(when (fboundp 'agent-shell-viewport--buffer)
(konix/agent-shell-workspace--tint
(agent-shell-viewport--buffer :shell-buffer shell :existing-only t))))
(add-hook 'agent-shell-mode-hook #'konix/agent-shell-workspace--tint-here)
(add-hook 'agent-shell-viewport-view-mode-hook
#'konix/agent-shell-workspace--tint-here)
(add-hook 'agent-shell-viewport-edit-mode-hook
#'konix/agent-shell-workspace--tint-here)
- how
- the rotation and that least saturation are settings, and changing either tints every session again on the spot.
(defun konix/agent-shell-workspace--retint (symbol value)
"Set SYMBOL to VALUE, then tint every session again."
(set-default symbol value)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (derived-mode-p 'agent-shell-mode
'agent-shell-viewport-view-mode
'agent-shell-viewport-edit-mode)
(konix/agent-shell-workspace--tint buffer)))))
(defcustom konix/agent-shell-workspace-tint-degrees 220
"How far round the wheel a bound session's background hue is turned."
:type 'integer :group 'konix
:set #'konix/agent-shell-workspace--retint)
(defcustom konix/agent-shell-workspace-tint-saturation 0.02
"Least colour a bound session's background carries."
:type 'number :group 'konix
:set #'konix/agent-shell-workspace--retint)
what binding tells the writer
what it is told
- how
- the writer is not merely handed a path, it is told how the two of them work
and what they are working on, riding the first thing it is told, which reaches it
even mid-turn.
- rule: and it puts a question in
WORKINGbefore it acts on it.- why: the user wants to know which one it is on so as to anticipate the question coming.
- how: it is told first how to write into the workspace, and within what limits.
- rule: and it puts a question in
(defconst konix/agent-shell-workspace-briefing
"You are now bound to a workspace. What this implies for you:
- Nobody reads this chat: the user reads the workspace alone, so whatever you write
here is lost. Put your questions there. One heading per question, each ending in a
question mark, bar a closed one: a question that asks nothing is refused.
- What only tells them something is a fact, never a question with a mark tacked on.
Write it with set_workspace_fact, passing about with the id of the question it
reports on, so that question links to it.
- What you need to remember, a log, where you stand, what you tried, goes in a memo
with set_workspace_memo, never in the user's notes or files. They are your memory:
read them back, all or searched, with readonly_list_workspace_memos.
- At work on a question, to ask a buddy, post with coord_post_task and wait for the
answer with coord_wait.
- Write a question with set_workspace_question, or several with their order at once
with set_workspace_plan. A question you have just made
comes back to the user: you cannot make one and take it up yourself.
- A body is bullets in intention :: text form, %d characters each and %d per
question. Past that the call is refused, so say less rather than shorter.
"
"What a writer is told about writing, bound to a workspace.")
- how
- then how to read the questions back, and where each stands.
- rule: and that only a run of minutes is awaited.
- why: writers awaited runs of seconds they could have run themselves.
- rule: and that only a run of minutes is awaited.
(defconst konix/agent-shell-workspace-briefing-reading
"- Address a question by its id, which %s gives you. A call naming none writes a
new question, so pass the id whenever you mean to rewrite one.
- Read %s rather than assuming how far the user has got.
- Each comes back saying where it stands: yours, held, awaiting, asked, permission,
finished, settled or later. Only the first two are ones you may act on. A heading
marked project is the user's alone: no act of yours reaches it.
- When the one you hold waits on a long run of yours, a test suite say, await it,
passing the run as command, or as on the id of a question already awaiting that
run, and take up another meanwhile. Once the run ends it is yours again, a line
under it saying how the run went. Await only a run of minutes: one of seconds, run
it yourself, with Bash.
- A command needing root is awaited the same way with root true, never with sudo:
it waits on the user's leave, and they give the password. No other way runs as root.
- A priority may follow it, [#A] the highest. You are shown, and may take up, only
your highest-standing ones; you never write a priority yourself.
- later is one the user has put off. No act of yours reaches it: leave it where it
stands, and work on something else.
- When the user answers, the question comes back to you on its own. That is your
signal to act, not to reply.
"
"What a writer is told about reading the questions back and where each stands.")
- how
- then the acts it names, and when to name each.
- rule: and among them, that a question never asks whether the writer’s own work is
done, which is closed instead.
- why: the writer asks « is work W done? » where it should ask « can I do work W? ».
- scope: a question may still propose the writer’s work, ask the user to act, or ask about a thing, all of which the user finds useful.
- how: told, not refused.
- why: nothing in a heading tells those from a question whether the writer’s own work is done.
- rule: and among them, that a question never asks whether the writer’s own work is
done, which is closed instead.
- what
- the briefing a bound writer gets tells it never to ask whether its own work is done.
(and (string-match-p "Never ask whether your own work is[[:space:]]+done"
(konix/agent-shell-workspace-binding-briefing))
'told)
- what
- the check above is right when it reads
told.
(defconst konix/agent-shell-workspace-briefing-acts
"- You name an act, each named after where it leaves the question: work, refine,
put-down, await, close. %s performs one, touching nothing else, refine
aside: refine is the question written again, asking what you need to know.
- work before you act on anything. Until you do, every other tool is refused you.
- The one you hold is the only thing you work on. Anything else you notice on the way
is a question to write and leave with them, never a thing to go and do.
- A place is a link, never directions. Pass file and line and the tool writes the link;
a path spelled out in prose, or « look under x/y », is something they will not follow.
- A question may propose your work, worded as the action, « fix the tilt? », never
« shall I fix the tilt? »; ask the user to act, « can you W? »; or ask about a
thing, « is tilt broken? ». Never ask whether your own work is done: close it.
- close it once the work is done and tested, with a « proof :: … » bullet saying how
you know, its heading then a claim of what was done, with no question mark: they
read the proof and settle it. That is how a question ends, and it is
the act you will forget: refine asks them, and hands it back to you once they
answer. No proof you can write means it is not done.
- a question whose last word from them asks you something is not done once you
answer it: the answer hands it back, so refine it.
- DISCUSS is one still being worked out, yours to answer: take it up with work, which
shows it whole and holds it as thinking, read what you need, then answer by
rewriting it with act refine. Change nothing for it: their y makes it TODO, your go.
- refine as soon as what the one you hold asks is unclear, and do not hesitate: a
guess costs both of you the work it sends you off to do, where one refined question
costs them a sentence. The question you hold is the whole of what you are doing.
"
"What a writer is told about the acts it names.")
- how
- and last, what is the user’s alone, and what ends its turn.
(defconst konix/agent-shell-workspace-briefing-rest
"- Settling is the user's own move, refused you, and so is dropping a question.
- Several things to decide are one question each, written at once with
set_workspace_plan. A choice within one is numbered 1, 2, 3, never lettered: the
user answers it with the digit.
- One question is held at a time, so put down the one you hold before you take up
another.
- Work on something else while the user reads. Neither waits for the other.
- With nothing left that is yours, the turn is cut short for you, so do not invent a
question to have something to do. Their next word starts you again with the
workspace in hand. Never wait inside Emacs, which would stop it reading their keys.
- Never read the workspace file yourself; %s gives you everything in it."
"What a writer is told about what is left to the user and to its turn.")
- rule
- and a writer bound to a workspace with nothing in it is told nothing at all,
the briefing riding whatever it is first told instead.
- why: a briefing alone is the only thing there to answer, so the writer sets about answering it, with no work in the workspace to be had.
- how: it is owed until it is given, so the first word the workspace has for the writer carries it, whichever word that turns out to be.
- therefore: binding costs a turn only where there is a turn’s work to do.
- rule: and the user is left in the workspace instead, which is where the first
subject is raised.
- why: they bound it to start work, and nothing is going to happen until they say what the work is.
- rule
- and nothing the writer is told names where the workspace is.
- why: its path is noise that nudges the writer into going to look at the file, which the tools are there to spare it.
- rule
- and the projects are worded once, wherever the writer is told them, and name
the tool that asks.
- why: « in case of doubt, ask the user » is what a writer answers in the chat, having nothing there telling it where asking happens.
(defconst konix/agent-shell-workspace-project-said
(concat "Our projects: %s"
"\n\nWhatever you and the user do must get them closer to done."
" In case of doubt, ask the user with set_workspace_question.")
"What a writer is told about the projects, the ones that concern it filled in.")
(defun konix/agent-shell-workspace-binding-briefing (&optional project)
"Return what a writer is told when it is bound to a workspace.
PROJECT is the open projects it works toward, said as one line."
(let ((listing (concat konix/mcp-server-read-only-prefix
"list_workspace_questions"))
(acting "set_workspace_state"))
(concat (format konix/agent-shell-workspace-briefing
konix/agent-shell-workspace-bullet-max
konix/agent-shell-workspace-body-max)
(format konix/agent-shell-workspace-briefing-reading listing listing)
(format konix/agent-shell-workspace-briefing-acts acting)
(format konix/agent-shell-workspace-briefing-rest listing)
(when (and project (not (string-empty-p (string-trim project))))
(concat "\n\n"
(format konix/agent-shell-workspace-project-said
(string-trim project)))))))
the project that travels with it
- rule
- a project of the user’s travels with it, when the user has one to give.
- why: a session that starts here needs to know what the work is, or its first questions are aimed at nothing.
- scope: a writer already worked with for a while needs only the process, so an empty one is taken as none.
- rule
- the project is written into the workspace as well, where the writer reads it.
- why: when the writer slips, the user wants to say « read the projects again ».
- rule
- a workspace may have several projects, each a heading on a state of
its own like any question’s, tagged
project, standing in theProjectspart.- why: the user loses track of which question advances what, one project per file being too coarse.
- rule: and a project is put off as
MAYBEand settled asDONE, as a question is, the tag saying it is a project still.- why: no state is added.
- rule: and the user’s alone: no act of the writer’s reaches one, nor a rewrite.
- scope: a project’s state says how far it has got, never whose move it is: a
project in
TODOis no work of the writer’s.
- scope: a project’s state says how far it has got, never whose move it is: a
project in
(defconst konix/agent-shell-workspace-project-tag "project"
"Tag every project carries, open, put off or settled.")
(defun konix/agent-shell-workspace--project-at-point-p ()
"Non-nil when the heading at point is a project, open, put off or settled."
(member konix/agent-shell-workspace-project-tag (org-get-tags nil t)))
(defun konix/agent-shell-workspace--next-open-project ()
"Move to the next open project after point, neither put off nor settled; nil if none."
(let (found)
(while (and (not found)
(re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
(format ".*:%s:" konix/agent-shell-workspace-project-tag))
nil t))
(let ((state (org-get-todo-state)))
(setq found (and state
(not (member state
(list konix/agent-shell-workspace-later-keyword
konix/agent-shell-workspace-done-keyword)))))))
found))
(defun konix/agent-shell-workspace--projects-here ()
"Return the words of every open project of this buffer, in the order they stand."
(let (projects)
(save-excursion
(goto-char (point-min))
(while (konix/agent-shell-workspace--next-open-project)
(push (string-trim (substring-no-properties (org-get-heading t t t t))) projects)))
(nreverse projects)))
(defun konix/agent-shell-workspace--ensure-project (project)
"Make PROJECT one of this buffer's projects, at the end of its Projects part, or ahead of
the questions in a file without parts; nothing when empty.
Its first line names it, the others go in its body."
(when-let* ((lines (and project (split-string (string-trim project) "\n")))
(project (string-trim (car lines)))
(body (mapconcat (lambda (line) (concat " " line "\n")) (cdr lines) ""))
((not (string-empty-p project)))
((not (member project (konix/agent-shell-workspace--projects-here)))))
(save-excursion
(goto-char (point-min))
(if (re-search-forward
(format "^\\* .*:%s:[ \t]*$"
(regexp-quote konix/agent-shell-workspace-projects-part-tag))
nil t)
(goto-char (konix/agent-shell-workspace--ends-at 1))
(unless (re-search-forward "^\\* " nil t)
(goto-char (point-max)))
(beginning-of-line))
(unless (bolp) (insert "\n"))
(insert (konix/agent-shell-workspace--stars) " "
konix/agent-shell-workspace-fresh-keyword " " project
" :" konix/agent-shell-workspace-project-tag ":\n"
" :PROPERTIES:\n :ID: "
(konix/agent-shell-workspace--new-question-id) "\n"
" :" konix/agent-shell-workspace-by-hand-property ": user\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
body))))
- rule
wis the user adding a project, on a workspace already bound.- why: the user sets the projects, not the writer.
- how: it reads the project at the prompt and writes it as a heading of its own, at the end of the Projects part.
- scope: a project goes as a question does, as
the keys drop and settle one:
k,t. - rule: and it finds the writer
there and then, which starts it when it is not, and tells it what an idle writer
owed a plan is told: a new project saying no done nor doing yet, to propose them.
- why: the user, opening a workspace and setting a project, expects the writer to start on it.
- what
- setting a project tells the workspace’s idle writer to propose its done and
doing.
- how: the writer is reached the one way the workspace has, the way that starts an unstarted one, so the check pins that way taken, the starting being the linked section’s.
(require 'cl-lib)
(let ((file (make-temp-file "check-w-" nil ".ws.org")) asked told)
(with-temp-file file (insert "#+TITLE: t\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (setq asked t) (current-buffer)))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text &rest _) (setq told text))))
(konix/agent-shell-workspace-set-project "the project"))
(prog1 (format "asked for its writer %S, told to propose done and doing %S" asked
(and told (string-match-p "workspace_project_define" told) t))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
asked for its writer t, told to propose done and doing t. - rule
- and a project typed over several lines is named by the first, the rest its
body, as a question is.
- why: written raw, its tag and drawer fell under the first line, and the project read as a question with no id.
- what
wwith two lines makes a project named by the first, the second in its body.
(require 'cl-lib)
(let ((file (make-temp-file "check-w-lines-" nil ".ws.org")))
(with-temp-file file (insert "#+TITLE: t\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--plan-next) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(konix/agent-shell-workspace-set-project "the name\nthe details"))
(prog1 (save-excursion
(goto-char (point-min))
(re-search-forward "^\\*+ .*the name")
(list (and (konix/agent-shell-workspace--project-at-point-p) t)
(and (org-entry-get (point) "ID") t)
(and (re-search-forward "^ the details$"
(save-excursion (org-end-of-subtree t t))
t)
t)))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
(t t t). - rule
lsays the question the user stands in is for a project, picked by its words, and picking it again says it no longer is.- why: a question may move several projects forward, and the user sees it before the writer does.
- what
lis checked by pressing it on a question, the project picked, then reading whether the question names the project on itsforline.
(press-l ()
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*\\* .*a question"))
(cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "the project")))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "l"))))
(linked ()
(save-restriction
(widen)
(goto-char (point-min))
(if (re-search-forward "ID: +q\n :END:\n - for :: \\[\\[id:p\\]" nil t)
"linked" "not linked")))
(require 'cl-lib)
(let ((file (make-temp-file "check-l-" nil ".ws.org")))
(with-temp-file file
(insert "* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* TODO a question\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(cl-flet (
(press-l ()
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*\\* .*a question"))
(cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "the project")))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "l"))))
(linked ()
(save-restriction
(widen)
(goto-char (point-min))
(if (re-search-forward "ID: +q\n :END:\n - for :: \\[\\[id:p\\]" nil t)
"linked" "not linked")))
)
(prog1 (list (progn (press-l) (linked)) (progn (press-l) (linked)))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
linked, thennot linked. - rule
@shows only what belongs to the heading the user stands in, the rest folded away; pressed again it folds back as the user had it.- why: the user said « When going back, all is unfolded, it must keep the folding ».
- why: the user likes to filter only the relevant stuff.
- rule: on a project, its tree: the project, the questions for it, and every fact
they reach.
- why: the user, with a writer free, wants what moves which project at a glance.
- rule: on a question, the question and every fact it reaches.
- rule: and it stays through every write, until its heading is gone.
- rule: and while a view stands, @’s or /’s, the header line opens on it and on the
key that leaves it.
- why: the user said « the buffer should show somehow that I’m in a “view” ».
- why: the user said « the view must remain accross writes unless the write makes it irrelevant ».
- what
@is checked in a world of a project, a question for it reaching a fact that reaches another, and a question for none, with a fact of its own.
(insert "* Projects :projects:\n"
"** TODO the parent :project:\n :PROPERTIES:\n :ID: pp\n :END:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - for :: [[id:pp][the parent]]\n"
"* Writer's :writers:\n"
"** TODO a question for it\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n - what :: [[id:f1][a fact]]\n"
"** TODO another question\n :PROPERTIES:\n :ID: q2\n :END:\n"
" - what :: [[id:f2][its fact]]\n"
"* Facts :facts:\n"
"** a fact\n :PROPERTIES:\n :ID: f1\n :END:\n"
" - what :: [[id:f3][a fact of the fact]]\n"
"** a fact of the fact\n :PROPERTIES:\n :ID: f3\n :END:\n"
"** its fact\n :PROPERTIES:\n :ID: f2\n :END:\n")
- what
@is checked by pressing it on a heading, or again where it stands, then reading which headings show.
(shown ()
(let ((low (point-min)) (high (point-max)) seen)
(save-excursion
(save-restriction
(widen)
(dolist (id '("pp" "p" "q" "q2" "f1" "f3" "f2"))
(goto-char (point-min))
(re-search-forward (concat ":ID: +" id "$"))
(org-back-to-heading t)
(unless (or (< (point) low) (> (point) high) (org-invisible-p (point)))
(push id seen)))))
(string-join (nreverse seen) " ")))
(cookie ()
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\* \\(\\[[^]]*\\]\\) Writer's")
(concat (match-string 1) ">"
(or (seq-some (lambda (o) (overlay-get o 'display))
(overlays-at (match-beginning 1)))
"-")))))
(press-at (heading &optional again)
(unless again
(save-restriction (widen) (org-fold-show-all))
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*\\* .*" heading))))
(let ((command (lookup-key konix/agent-shell-workspace-mode-map "@")))
(setq last-command (and again command) this-command command)
(call-interactively command)))
(require 'cl-lib)
(let ((file (make-temp-file "check-at-" nil ".ws.org")))
(with-temp-file file
(insert "* Projects :projects:\n"
"** TODO the parent :project:\n :PROPERTIES:\n :ID: pp\n :END:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - for :: [[id:pp][the parent]]\n"
"* Writer's :writers:\n"
"** TODO a question for it\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n - what :: [[id:f1][a fact]]\n"
"** TODO another question\n :PROPERTIES:\n :ID: q2\n :END:\n"
" - what :: [[id:f2][its fact]]\n"
"* Facts :facts:\n"
"** a fact\n :PROPERTIES:\n :ID: f1\n :END:\n"
" - what :: [[id:f3][a fact of the fact]]\n"
"** a fact of the fact\n :PROPERTIES:\n :ID: f3\n :END:\n"
"** its fact\n :PROPERTIES:\n :ID: f2\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace--put-opened '("facts"))
(save-buffer)
(cl-flet (
(shown ()
(let ((low (point-min)) (high (point-max)) seen)
(save-excursion
(save-restriction
(widen)
(dolist (id '("pp" "p" "q" "q2" "f1" "f3" "f2"))
(goto-char (point-min))
(re-search-forward (concat ":ID: +" id "$"))
(org-back-to-heading t)
(unless (or (< (point) low) (> (point) high) (org-invisible-p (point)))
(push id seen)))))
(string-join (nreverse seen) " ")))
(cookie ()
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\* \\(\\[[^]]*\\]\\) Writer's")
(concat (match-string 1) ">"
(or (seq-some (lambda (o) (overlay-get o 'display))
(overlays-at (match-beginning 1)))
"-")))))
(press-at (heading &optional again)
(unless again
(save-restriction (widen) (org-fold-show-all))
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*\\* .*" heading))))
(let ((command (lookup-key konix/agent-shell-workspace-mode-map "@")))
(setq last-command (and again command) this-command command)
(call-interactively command)))
(tint () (if (assq 'default face-remapping-alist) "tinted" "plain"))
)
(prog1 (list (progn (press-at "the project") (concat "project: " (shown) " " (tint)))
(concat "tree of pp: "
(string-join (sort (konix/agent-shell-workspace--project-tree "pp")
#'string<)
" "))
(progn (press-at "a question for it") (concat "question: " (shown) " " (cookie)))
(progn (setq-local konix/agent-shell-workspace--context 'fresh)
(revert-buffer t t t)
(konix/agent-shell-workspace--focus-standing-still)
(concat "written: " (shown) " | "
(format-mode-line header-line-format nil nil
(current-buffer))))
(progn (press-at nil t)
(concat "again: " (shown) " " (cookie) " " (tint) " | "
(format-mode-line header-line-format nil nil
(current-buffer)))))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
project: pp p f1 f3 tinted, the background tinted while @ is on, the parent shown up the « for » chain,tree of pp: f1 f3 p pp q, the child’s tree taken down, q staying in its folded part,question: q f1 f3 [2]>[1],written: q f1 f3 | fresh @ a question for it, thenagain: q q2 f1 f3 f2 [2]>- plain | fresh, the tint gone on leaving, the Writer’s cookie showing [1] over its [2] in the view only, the header line naming the view last, while on, and leaving folding back to the opened Facts and the cursor’s part. - rule
^makes the question the user stands in a project.- why: the user finds a question is more than a question, a piece of work of its own.
- rule: and the project is TODO, whatever state the question was in.
- why: no other state makes sense for a project yet.
- what
^on a DISCUSS question leaves a TODO project.
(let ((file (make-temp-file "check-promote-" nil ".ws.org")))
(with-temp-file file
(insert (format "* %s Grow it?\n :PROPERTIES:\n :ID: q\n :END:\n"
konix/agent-shell-workspace-discuss-keyword)))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace--goto-id "q")
(konix/agent-shell-workspace-promote-to-project)
(konix/agent-shell-workspace--goto-id "q")
(prog1 (list (org-get-todo-state)
(and (konix/agent-shell-workspace--project-at-point-p) t))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("TODO" t). - rule
^asks the project’s name, offering the question’s heading as it stands.- why: a question’s words seldom name the work it grows into.
- how:
RETkeeps the heading; a name of blanks only is refused. - scope: a yes to the writer’s proposal makes the project without asking.
- what
^offers the heading and the project bears the name typed.
(require 'cl-lib)
(let ((file (make-temp-file "check-promote-name-" nil ".ws.org"))
offered)
(with-temp-file file
(insert (format "* %s Grow it?\n :PROPERTIES:\n :ID: q\n :END:\n"
konix/agent-shell-workspace-discuss-keyword)))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace--goto-id "q")
(cl-letf (((symbol-function 'read-string)
(lambda (_prompt &optional initial &rest _)
(setq offered initial)
"Grown")))
(call-interactively #'konix/agent-shell-workspace-promote-to-project))
(konix/agent-shell-workspace--goto-id "q")
(prog1 (list offered
(substring-no-properties (org-get-heading t t t t))
(org-get-todo-state)
(and (konix/agent-shell-workspace--project-at-point-p) t))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("Grow it?" "Grown" "TODO" t). - rule
- a name given on several lines is joined into one.
- why: a newline in the headline pushed the drawer off it: the project lost its ID, and the tooling crashed on it.
- what
^given « first\nsecond » names the project « first second », its ID kept.
(let ((file (make-temp-file "check-promote-line-" nil ".ws.org")))
(with-temp-file file
(insert (format "* %s Grow it?\n :PROPERTIES:\n :ID: q\n :END:\n"
konix/agent-shell-workspace-discuss-keyword)))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace--goto-id "q")
(konix/agent-shell-workspace-promote-to-project "first\nsecond" "q")
(goto-char (point-min))
(re-search-forward "first")
(org-back-to-heading t)
(prog1 (list (substring-no-properties (org-get-heading t t t t))
(org-entry-get (point) "ID")
(count-matches ":PROPERTIES:" (point) (point-max)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("first second" "q" 1). - rule
- a key asking the user something settles the question it acts on by its id
as it is pressed, and acts on that id once answered, wherever point went meanwhile.
- why: the user said « everything you do must make sure to record what i was on
before interacting with me »: a rewrite while they typed a name moved point onto a
fact, and
^refused. - scope:
^and rejecting a plan read point again after their prompt; the others already kept the id.
- why: the user said « everything you do must make sure to record what i was on
before interacting with me »: a rewrite while they typed a name moved point onto a
fact, and
- what
^and rejecting a plan, the question moved by a rewrite while they ask, point left on the facts, still act on the question they were pressed on.
(require 'cl-lib)
(cl-flet ((on-fresh (command result)
(let ((file (make-temp-file "check-prompt-keeps-" nil ".ws.org")))
(with-temp-file file
(insert (format "* %s Grow it?\n :PROPERTIES:\n :ID: q\n :PLAN: p\n :END:\n"
konix/agent-shell-workspace-discuss-keyword)
(format "* %s Another?\n :PROPERTIES:\n :ID: o\n :PLAN: other\n :END:\n"
konix/agent-shell-workspace-discuss-keyword)
"* Facts :facts:\n** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace--goto-id "q")
(prog1 (condition-case err
(cl-letf (((symbol-function 'read-string)
(lambda (&rest _)
(save-excursion
(konix/agent-shell-workspace--goto-id "q")
(let* ((start (point))
(text (buffer-substring
start
(konix/agent-shell-workspace--question-end))))
(delete-region start (+ start (length text)))
(konix/agent-shell-workspace--goto-id "f")
(insert text)))
"Grown"))
((symbol-function 'y-or-n-p) #'always)
((symbol-function
'konix/agent-shell-workspace-add-subject)
#'ignore))
(call-interactively command)
(funcall result))
(user-error (error-message-string err)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file)))))
(list (on-fresh #'konix/agent-shell-workspace-promote-to-project
(lambda ()
(list (and (konix/agent-shell-workspace--goto-id "q")
(konix/agent-shell-workspace--project-at-point-p)
'q-promoted)
(and (konix/agent-shell-workspace--goto-id "o")
(konix/agent-shell-workspace--project-at-point-p)
'o-promoted))))
(on-fresh #'konix/agent-shell-workspace-reject-plan
(lambda ()
(list (if (konix/agent-shell-workspace--goto-id "q") 'q-kept 'q-rejected)
(if (konix/agent-shell-workspace--goto-id "o") 'o-kept 'o-rejected))))))
- what
- the check above is right when it reads
((q-promoted nil) (q-rejected o-kept)). - rule
C-wis the user sending the writer back to its projects.- scope: a workspace naming no project refuses the key, there being nothing to send the writer back to.
- scope: on a writer at work it goes over at the turn’s end rather than waiting to be read back, being in no file to read.
- how: the echo area says whether it was sent or is queued for the turn’s end.
(defconst konix/agent-shell-workspace-project-guidance
"Read the projects again, the headings the listing calls project, and pick up from there."
"What a writer is told when it has slipped off its projects.")
(defun konix/agent-shell-workspace-set-project (project)
"Add PROJECT to the projects of this workspace, and tell its writer to plan where owed."
(interactive (list (read-from-minibuffer "New project: ")))
(when (string-empty-p (string-trim project))
(user-error "A project is what it says — there is none"))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-project project))
(konix/agent-shell-workspace--plan-next (konix/agent-shell-workspace--target-writer))
(message "A project now: %s" (string-trim project)))
- how
- following a link wants the heading it names: where it stands, and whether it is a fact, a heading with no state; so every heading is listed with those.
(defun konix/agent-shell-workspace--headings-by-id ()
"Return (ID START END STATE) for each question and each fact."
(let (headings)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*+ " nil t)
(when (pcase (org-current-level)
(2 (or (konix/agent-shell-workspace--state-at-point)
(equal (konix/agent-shell-workspace--part-at)
konix/agent-shell-workspace-facts-tag)))
(_ (konix/agent-shell-workspace--state-at-point)))
(let ((start (line-beginning-position)))
(push (list (org-entry-get start "ID") start
(save-excursion (org-end-of-subtree t t) (point))
(org-get-todo-state))
headings)))
(end-of-line)))
headings))
- how
- what
@keeps is walked from its roots, through that list: each heading’s links are followed to the facts they name, and on from those.
(defun konix/agent-shell-workspace--reached-from (roots)
"Return ROOTS, ids of headings, and the ids of every fact they reach."
(let* ((headings (konix/agent-shell-workspace--headings-by-id))
(kept roots)
(queue roots))
(while queue
(when-let* ((heading (assoc (pop queue) headings)))
(dolist (linked (konix/agent-shell-workspace--ids-linked-from
(nth 1 heading) (nth 2 heading)))
(let ((target (assoc linked headings)))
(when (and target (null (nth 3 target)) (not (member linked kept)))
(push linked kept)
(push linked queue))))))
kept))
(defun konix/agent-shell-workspace--project-tree (project &optional above)
"Return the ids of PROJECT, its questions, its child projects' trees, and their facts.
ABOVE are the projects already walked down from."
(let* ((children (delq nil
(mapcar (lambda (heading)
(save-excursion
(goto-char (nth 1 heading))
(when (re-search-forward
(konix/agent-shell-workspace--said-line-regexp
konix/agent-shell-workspace-for-said project)
(nth 2 heading) t)
(car heading))))
(konix/agent-shell-workspace--headings-by-id))))
(kept (konix/agent-shell-workspace--reached-from (cons project children))))
(dolist (child children)
(when (and (not (member child (cons project above)))
(save-excursion
(and (konix/agent-shell-workspace--goto-id child)
(konix/agent-shell-workspace--project-at-point-p))))
(setq kept (append (konix/agent-shell-workspace--project-tree
child (cons project above))
kept))))
(seq-uniq kept)))
- how
- every heading not kept is folded away, its newline before it with it, so not even its heading line shows.
(defvar-local konix/agent-shell-workspace--belonging nil
"The id of the heading `@' shows what belongs to, or nil.")
(put 'konix/agent-shell-workspace--belonging 'permanent-local t)
(defun konix/agent-shell-workspace--show-only (kept)
"Show the headings whose ids are KEPT alone, the rest folded away."
(dolist (heading (seq-filter #'car (konix/agent-shell-workspace--headings-by-id)))
(unless (member (car heading) kept)
(org-fold-region (max (point-min) (1- (nth 1 heading)))
(max (point-min) (1- (nth 2 heading)))
t 'outline)))
(konix/agent-shell-workspace--cookies-of kept))
(defun konix/agent-shell-workspace--cookies-of (kept)
"Display over each part's cookie how many of KEPT it holds, the file untouched."
(remove-overlays (point-min) (point-max) 'konix-view-cookie t)
(save-excursion
(goto-char (point-min))
(while (and kept (re-search-forward konix/agent-shell-workspace--part-cookie-regexp nil t))
(let ((cookie (make-overlay (1- (match-beginning 1)) (1+ (match-end 1))))
(width (length (match-string 1)))
(end (save-excursion (org-end-of-subtree t t)))
(count 0) (done 0))
(save-excursion
(while (re-search-forward "^\\*\\* " end t)
(when (member (org-entry-get nil "ID") kept)
(cl-incf count)
(when (member (org-get-todo-state) org-done-keywords)
(cl-incf done)))))
(overlay-put cookie 'konix-view-cookie t)
(overlay-put cookie 'display
(konix/agent-shell-workspace--count-cookie count done width))))))
(defun konix/agent-shell-workspace--fold-to-belonging ()
"Show only what belongs to the heading `@' was pressed on; forget it once gone."
(konix/agent-shell-workspace--cookies-of nil)
(when-let* ((id konix/agent-shell-workspace--belonging))
(if-let* ((project (save-excursion
(save-restriction
(widen)
(when (konix/agent-shell-workspace--goto-id id)
(list (konix/agent-shell-workspace--project-at-point-p)))))))
(konix/agent-shell-workspace--show-only
(append (konix/agent-shell-workspace--projects-above id)
(if (car project)
(konix/agent-shell-workspace--project-tree id)
(konix/agent-shell-workspace--reached-from (list id)))))
(setq konix/agent-shell-workspace--belonging nil))))
(defun konix/agent-shell-workspace--projects-above (id)
"Return the projects ID's « for » lines name, theirs, and so on up."
(save-excursion
(save-restriction
(widen)
(let ((queue (list id)) found)
(while queue
(when (konix/agent-shell-workspace--goto-id (pop queue))
(dolist (project (konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-for-said))
(unless (member project found)
(push project found)
(push project queue)))))
found))))
(defun konix/agent-shell-workspace-show-belonging ()
"Show only what belongs to the heading at point, the rest folded; again to fold back.
On a project, it, the questions for it and their facts; on a question, it and its facts."
(interactive)
(setq konix/agent-shell-workspace--belonging
(unless (eq last-command this-command)
(save-excursion (konix/agent-shell-workspace--goto-question)
(org-entry-get (point) "ID"))))
(unless konix/agent-shell-workspace--belonging
(setq this-command #'ignore))
(konix/agent-shell-workspace-focus-question))
- how
loffers the open projects by their words, and writes the question’sforline to the one picked, or takes it out where it was there.- rule: and on a project too, offering every open one but itself.
- why: projects nest.
- rule: and on a project too, offering every open one but itself.
- what
lon a project offers the other one alone, and writes theforline.
(require 'cl-lib)
(let ((file (make-temp-file "check-l-" nil ".ws.org")) offered)
(with-temp-file file
(insert "* Projects :projects:\n"
"** TODO first :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"** TODO second :project:\n :PROPERTIES:\n :ID: o\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-letf (((symbol-function 'completing-read)
(lambda (_prompt choices &rest _)
(setq offered (mapcar #'car choices))
(car offered))))
(goto-char (point-min))
(re-search-forward "^\\*\\* TODO second")
(konix/agent-shell-workspace-toggle-project-of-question))
(prog1 (list offered
(save-excursion
(goto-char (point-min))
(re-search-forward "^\\*\\* TODO second")
(and (re-search-forward "for :: \\[\\[id:p\\]" nil t) t)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("first") t).
(defun konix/agent-shell-workspace-toggle-project-of-question ()
"Say the question at point is for a project picked by its words, or no longer is."
(interactive)
(let* ((question (save-excursion
(konix/agent-shell-workspace--goto-question)
(unless (org-get-todo-state)
(user-error "A fact is for no project"))
(org-entry-get (point) "ID")))
(projects (save-excursion
(goto-char (point-min))
(let (found)
(while (konix/agent-shell-workspace--next-open-project)
(unless (equal (org-entry-get (point) "ID") question)
(push (cons (string-trim (substring-no-properties
(org-get-heading t t t t)))
(org-entry-get (point) "ID"))
found)))
(or (nreverse found)
(user-error "This workspace has no open project")))))
(picked (completing-read "Project: " projects nil t))
(project (cdr (assoc picked projects))))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id question)
(if (re-search-forward
(konix/agent-shell-workspace--said-line-regexp
konix/agent-shell-workspace-for-said project)
(konix/agent-shell-workspace--question-end) t)
(delete-region (line-beginning-position)
(min (point-max) (1+ (line-end-position))))
(konix/agent-shell-workspace--link-under
question project picked konix/agent-shell-workspace-for-said)))))
(defun konix/agent-shell-workspace--goto-promotable ()
"Go to the question point stands in, refusing one that cannot be made a project."
(konix/agent-shell-workspace--goto-question)
(unless (org-get-todo-state)
(user-error "A fact is no question to make a project of"))
(when (konix/agent-shell-workspace--project-at-point-p)
(user-error "That is a project already")))
(defun konix/agent-shell-workspace-promote-to-project (&optional name id)
"Make the question point stands in a project of the workspace, named NAME where given.
ID, settled as the key was pressed, names the question wherever point went since."
(interactive
(pcase-let ((`(,id ,heading)
(save-excursion
(konix/agent-shell-workspace--goto-promotable)
(list (org-entry-get (point) "ID")
(substring-no-properties (org-get-heading t t t t))))))
(list (read-string "Project: " heading) id)))
(when (and name (string-empty-p (string-trim name)))
(user-error "A project needs a name"))
(save-excursion
(unless (and id (konix/agent-shell-workspace--goto-id id))
(when id (user-error "That question is gone from under you")))
(konix/agent-shell-workspace--goto-promotable)
(konix/agent-shell-workspace--write
(when name
(org-edit-headline
(replace-regexp-in-string "[ \t\n\r]+" " " (string-trim name))))
(org-toggle-tag konix/agent-shell-workspace-project-tag 'on)
(org-todo konix/agent-shell-workspace-fresh-keyword)))
(message "A project now"))
(defun konix/agent-shell-workspace-project-again ()
"Tell the writer to read the projects again."
(interactive)
(unless (konix/agent-shell-workspace--projects-here)
(user-error "This workspace names no project"))
(let ((writer (konix/agent-shell-workspace--target-writer)))
(message
(if (eq t (konix/agent-shell-workspace--submit
writer konix/agent-shell-workspace-project-guidance))
"Sent the writer back to the projects"
"Queued — the writer goes back to the projects at the turn's end"))))
what can be bound
- rule
- a session without the workspace tools cannot be bound at all.
- why: binding a session that has no way to write there would make no sense.
- rule: binding whitelists the server for the session.
- why: answering must not stop at a permission dialog.
- scope: awaiting a command too.
- how: matched on the tool’s name alone, the policy reading a call that carries a command by that command rather than by its name.
- what
- a bound writer’s call to the state tool goes unasked, awaiting a command included.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-await-writer")))
(unwind-protect
(with-current-buffer shell
(setq major-mode 'agent-shell-mode)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--tint-session) #'ignore))
(funcall (konix/agent-shell-session-binding-on-bind
konix/agent-shell-workspace--binding)
shell "/tmp/bound.ws.org"))
(mapcar (lambda (input)
(and (konix/agent-shell-policy--match
konix/agent-shell--whitelist
(list (cons :title (format "mcp__%s__set_workspace_state"
konix/agent-shell-workspace-server-name))
(cons :kind "other")
(cons :raw-input input)))
'unasked))
'(((id . "x") (act . "work"))
((id . "x") (act . "await") (command . "make test")))))
(kill-buffer shell))))
- what
- the check above is right when it reads
(unasked unasked).
(defconst konix/agent-shell-workspace-server-name "konix-emacs-workspace"
"MCP server holding the tools a bound writer answers with.")
(defun konix/agent-shell-workspace--answering-tool-p (call)
"Non-nil when CALL is to one of the tools a bound writer answers with."
(string-prefix-p (format "mcp__%s__" konix/agent-shell-workspace-server-name)
(or (map-elt call :title) "")))
(defun konix/agent-shell-workspace--whitelist-answering-tools (shell)
"Auto-approve the server's tools in SHELL, on its ephemeral session axis."
(with-current-buffer shell
(konix/agent-shell-policy--set-session
konix/agent-shell--whitelist
#'konix/agent-shell-workspace--answering-tool-p
"the workspace tools a bound writer answers with")))
- rule
- naming a file that is not there yet makes it, so a workspace can be bound
before there is one.
- rule: and the directory it goes in is made with it.
- why: the place the prompt offers is one a working directory has no reason to have yet.
- rule: and the directory it goes in is made with it.
(defun konix/agent-shell-workspace--make-unless-there (file)
"Make FILE an empty workspace, and its directory, unless they are there."
(unless (file-readable-p file)
(make-directory (file-name-directory file) t)
(write-region "" nil file)))
- rule
- the prompt offers a
.wsdirectory under the working directory of the session, with the name left to type and.ws.orgalready there.- why: a workspace is of the working directory, and the one place for all of them is one decision the user does not have to take again.
- how: the cursor waits before
.ws.org, so the whole of what is typed is the name. - rule: and the bind refuses any other name.
(defconst konix/agent-shell-workspace-directory ".ws"
"Where under a working directory the prompt offers to put a workspace.")
(defconst konix/agent-shell-workspace-suffix ".ws.org"
"What a workspace's name ends in, which is what opens it as one.")
(defun konix/agent-shell-workspace--read-file-name ()
"Read where a workspace goes, offering this working directory's own place for it."
(let ((where (file-name-as-directory
(expand-file-name
konix/agent-shell-workspace-directory
(konix/agent-shell-workspace--working-directory-of (current-buffer))))))
(expand-file-name
(minibuffer-with-setup-hook
(lambda () (search-backward konix/agent-shell-workspace-suffix nil t))
(read-file-name "Workspace: " where nil nil
konix/agent-shell-workspace-suffix)))))
- rule
- and the prompt reads a project to add, the ones already there staying.
- scope: an empty answer adds none.
(defun konix/agent-shell-workspace--refuse-toolless (shell)
"Refuse SHELL a workspace when its session holds no workspace tools to answer with."
(unless (seq-find (lambda (server)
(equal (alist-get 'name server) konix/agent-shell-workspace-server-name))
(buffer-local-value 'agent-shell-mcp-servers shell))
(user-error "%s has no %s tools to answer with"
(buffer-name shell) konix/agent-shell-workspace-server-name)))
(defun konix/agent-shell-workspace--read-what-to-bind ()
"Read the workspace to bind and its project, refusing a name that cannot."
(konix/agent-shell-workspace--refuse-toolless (konix/agent-shell--current-shell-or-error))
(let ((file (konix/agent-shell-workspace--read-file-name)))
(unless (string-suffix-p konix/agent-shell-workspace-suffix file)
(user-error "A workspace is named *%s, which opens it as one: %s"
konix/agent-shell-workspace-suffix file))
(list file
(read-string "A project to add (empty for none): "))))
- how
- binding makes the file sound, links the session from it, and remembers the
binding so the session comes back bound.
- rule: a session with no id yet is linked as soon as it has one.
- why: a fresh writer
Fstarts in place of another would leave the old one named, the header line and a resume reading the old big context.
- why: a fresh writer
- rule: a session with no id yet is linked as soon as it has one.
- what
- the file names the old session until the new one has its id, then the new.
(require 'cl-lib)
(let ((file (make-temp-file "check-link-" nil ".ws.org"))
(spec nil) on-event)
(with-temp-file file
(insert "#+SESSION: [[agent-shell:old-id?cwd=/x/][old]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/org-agent-shell--session-spec)
(lambda (_) spec))
((symbol-function 'konix/org-agent-shell--shell-label)
(lambda (_) "new"))
((symbol-function 'agent-shell-subscribe-to)
(lambda (&rest args) (setq on-event (plist-get args :on-event)) 'token))
((symbol-function 'agent-shell-unsubscribe) #'ignore))
(with-temp-buffer
(let ((shell (current-buffer))
(named (lambda ()
(with-temp-buffer
(insert-file-contents file)
(and (re-search-forward "agent-shell:\\([^?]+\\)" nil t)
(match-string 1))))))
(konix/agent-shell-workspace--link-session-when-known shell file)
(let ((before (funcall named)))
(setq spec "new-id?cwd=/x/")
(when on-event (funcall on-event nil))
(list before (funcall named))))))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil))
(let ((kill-buffer-query-functions nil)) (kill-buffer visiting)))
(delete-file file)))
- what
- the check above is right when it reads
("old-id" "new-id").
(defun konix/agent-shell-workspace--link-session-when-known (shell file)
"Have FILE name SHELL's session as soon as it has an id, now if it has one."
(if (konix/org-agent-shell--session-spec shell)
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--ensure-session-link shell))
(let (token)
(setq token
(agent-shell-subscribe-to
:shell-buffer shell
:event 'init-finished
:on-event
(lambda (_event)
(agent-shell-unsubscribe :subscription token)
(when (buffer-live-p shell)
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--ensure-session-link shell)))))))))
(defun konix/agent-shell-workspace-bind (file &optional project)
"Bind FILE as the workspace of the agent-shell this is called from, on PROJECT."
(declare (modes agent-shell-mode
agent-shell-viewport-view-mode
agent-shell-viewport-edit-mode))
(interactive (konix/agent-shell-workspace--read-what-to-bind))
(let ((shell (konix/agent-shell--current-shell-or-error))
(file (expand-file-name file)))
(konix/agent-shell-workspace--refuse-toolless shell)
(konix/agent-shell-workspace--make-unless-there file)
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--ensure-well-formed)
(konix/agent-shell-workspace--ensure-session-link shell)
(konix/agent-shell-workspace--ensure-project project))
(konix/agent-shell-workspace--link-session-when-known shell file)
(konix/agent-shell-workspace--remember shell file)
(let ((buffer (konix/agent-shell-workspace--show file shell t)))
(if (konix/agent-shell-workspace--writer-done-p file)
(progn
(pop-to-buffer buffer)
(message "Workspace: %s — nothing in it yet, so raise the first subject"
file))
(konix/agent-shell-workspace--submit shell)
(message "Workspace: %s" file)))))
coming back to it
- rule
- a session that comes back — reloaded, or resumed days later — comes back bound the way it was: the tools whitelisted again, the steering installed again, the document open and tinted again.
- scope
- everything binding does except telling the writer about it, which it was
told once and carries in the conversation it is resuming.
- how: a shell resuming a session the store holds a workspace for starts briefed.
- why: a new shell started unbriefed, and the briefing, ~1.5k tokens, went again.
- how: a shell resuming a session the store holds a workspace for starts briefed.
- what
- a shell resuming a session with a workspace starts briefed; one resuming a session without, or starting new, does not.
(require 'cl-lib)
(cl-letf (((symbol-function 'konix/agent-shell-session-binding-restore) #'ignore)
((symbol-function 'konix/agent-shell-session-store-get)
(lambda (_store id) (and (equal id "bound") "/x/w.ws.org"))))
(mapcar (lambda (resumed)
(with-temp-buffer
(cl-letf (((symbol-function 'agent-shell--state)
(lambda () (list (cons :resume-session-id resumed)))))
(konix/agent-shell-workspace--restore))
konix/agent-shell-workspace--briefed))
'("bound" "loose" nil)))
- what
- the check above is right when it reads
(t nil nil). - how
- binding a workspace is what puts all of that around a session, so coming back is binding it again to what the store held.
(defun konix/agent-shell-workspace--restore ()
"Bind this shell back to the workspace of the session it settles on.
A session resumed that had a workspace was briefed then, and is not again."
(when-let* ((id (map-elt (agent-shell--state) :resume-session-id))
((konix/agent-shell-session-store-get
(konix/agent-shell-session-binding-store
konix/agent-shell-workspace--binding)
id)))
(setq-local konix/agent-shell-workspace--briefed t))
(konix/agent-shell-session-binding-restore
konix/agent-shell-workspace--binding))
(add-hook 'agent-shell-mode-hook
#'konix/agent-shell-workspace--restore)
how the user walks them
- rule
- walking to a question folds the bodies of every one, so nothing nudges the
user into reading them.
- why: focusing on one question at a time, with the noise gone, is what makes answering efficient.
- rule: their headings stay in view, so the whole set is still there at a glance.
the view a key leaves behind
- rule
- everything folds, the top headings and the questions under the parts alone in view, whatever waits on the user.
settled from nothing
- rule
- the view is settled by folding the whole workspace to its top headings, each
part then opened onto its questions.
- why: folding heading by heading turns on what each already is, so the same keystroke would fold one time and not the next.
- how: everything is shown before it is folded, since folding to an overview reads the folds already there and inherits whatever they got wrong.
- therefore: one call settles it from nothing, and every gesture ends in that call.
- rule
- and every change the user’s keys make goes through one write, which shows the
workspace whole before it touches a character and folds it again after.
- why: writing into a folded workspace leaves folds org cannot make sense of afterwards, and no amount of folding after the fact repairs them.
- therefore: the fold state is never something a write has to be careful about, and no keystroke can leave the workspace open behind it.
- how: and that write labels the writer again, as its label follows the question it is on.
- how: and it tells an idle writer with work left to carry on, as told to carry on says.
- how: shown whole as a file written is.
- what
- narrowed to the
Minepart,yon a project’s closing question settles the project, its question gone, the view kept, nothing sent.
(require 'cl-lib)
(let ((file (make-temp-file "check-write-view-" nil ".ws.org")) sent)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - done :: it ships\n"
"* Mine :mine:\n"
"** REFINE Is the project « the project » done?\n :PROPERTIES:\n :ID: d\n"
" :PROJECT-CHECK: p\n :END:\n - what :: it is\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send)
(lambda (&rest args) (push (nth 1 args) sent))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(konix/agent-shell-workspace-cycle-view)
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Is the project")
(prog1 (list (buffer-narrowed-p)
(and (ignore-errors (konix/agent-shell-workspace-answer-yes) t))
(save-excursion
(goto-char (point-min))
(re-search-forward "^\\*\\* \\([A-Z]+\\) the project")
(match-string 1))
(save-excursion
(goto-char (point-min))
(and (re-search-forward "^\\*\\* REFINE Is the project" nil t) t))
konix/agent-shell-workspace--view
(buffer-narrowed-p)
sent)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(t t "DONE" nil "mine" nil nil): theMinepart left empty, the workspace widened, the view still naming it.
(defun konix/agent-shell-workspace--cut-if-done ()
"Cut the writer this workspace talks to, where nothing there is its own."
(when (buffer-live-p konix/agent-shell-workspace--writer-buffer)
(konix/agent-shell-workspace--cut-short
konix/agent-shell-workspace--writer-buffer)))
(defun konix/agent-shell-workspace--holding-here-p ()
"Non-nil when the writer holds a question of this workspace, narrowed or not."
(konix/agent-shell-workspace--unnarrowed
(konix/agent-shell-workspace--holding-p)))
(defun konix/agent-shell-workspace--cut-if-taken-back (held)
"Cut the writer this workspace talks to where it HELD a question and holds none now.
Return non-nil where it was cut."
(and held
(not (konix/agent-shell-workspace--holding-here-p))
(buffer-live-p konix/agent-shell-workspace--writer-buffer)
(konix/agent-shell-workspace--cut-taken-back
konix/agent-shell-workspace--writer-buffer (buffer-file-name))))
(defmacro konix/agent-shell-workspace--write (&rest body)
"Change the workspace by running BODY on it shown whole, then save and fold it."
(declare (indent 0) (debug t))
(let ((held (make-symbol "held"))
(spots (make-symbol "spots")))
`(let ((inhibit-read-only t)
(,held (konix/agent-shell-workspace--holding-here-p)))
(konix/agent-shell-workspace--note-unfolded)
(org-fold-show-all)
(condition-case failure
(konix/agent-shell-workspace--unnarrowed
(let ((,spots (konix/agent-shell-workspace--spots)))
(konix/agent-shell-workspace--sort-keeping-point)
(konix/agent-shell-workspace--lists-into-drawer)
(konix/agent-shell-workspace--closing-into-tocheck)
(konix/agent-shell-workspace--folded-into-opened)
,@body
(save-excursion (konix/agent-shell-workspace--sort-questions))
(konix/agent-shell-workspace--spots-back ,spots)))
(t (ignore-errors (konix/agent-shell-workspace-focus-question))
(signal (car failure) (cdr failure))))
(save-buffer)
(konix/agent-shell-workspace-focus-question)
(unless (konix/agent-shell-workspace--cut-if-taken-back ,held)
(konix/agent-shell-workspace--cut-if-done))
(when (buffer-live-p konix/agent-shell-workspace--writer-buffer)
(konix/agent-shell-workspace--label-writer
konix/agent-shell-workspace--writer-buffer (current-buffer)))
(konix/agent-shell-workspace--go-on-soon))))
what settling the view keeps, and what it adds
- rule
TABis org’s own, taken over for nothing.- why: taking it over costs every other thing org’s cycling does: a block, a drawer, a list.
- therefore: the answers do come back into view on it, and settling the view folds them away again.
- rule
- and every property drawer is folded as the view is settled.
- why: ids, revisions, stamps and who made a heading are the tools’ to read, the age shown ahead of the heading being what the user reads of the stamp, and opening a question opens its drawer with it.
- rule
- and the pictures are shown again as the view is settled.
- why: the file says it opens with them shown, and a rewrite read back under the user keeps the modes, so nothing opens it afresh to show the new ones.
- rule
- and the cursor standing in an answer comes back to the question it sits under.
- why: a fold cannot hide the line the cursor is on, so the answer it stands in would stay in view however well it is folded.
- therefore: the view settled by the user is about a question, which is the only thing there is to walk to or to answer.
(defun konix/agent-shell-workspace--users-turn-p (&optional questions)
"Non-nil when the heading point stands in is the user's turn just now.
A question asking them, held back by nothing; a fact never is.
QUESTIONS, as `konix/agent-shell-workspace--every-question' gives them, spare
reading them again."
(and (member (org-get-todo-state)
konix/agent-shell-workspace-users-keywords)
(not (konix/agent-shell-workspace--holding-back
(org-entry-get (point) "ID")
(or questions (konix/agent-shell-workspace--every-question))))))
(defun konix/agent-shell-workspace--in-an-answer-p ()
"Non-nil when point stands in something the user said under a question."
(and (not (org-before-first-heading-p))
(equal (1+ konix/agent-shell-workspace-question-level)
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(org-current-level)))))
settled in one command
- rule
- the user may narrow the view with one key: to the
Minepart, then to theWriter'spart, then to everything.- why: in a large workspace the user gets lost among the questions.
- how: org’s own narrowing to the part’s heading and the questions under it.
- why: the user’s « make sure the code of “/” is simple ».
- rule: and each write narrows it again to the part the view names, widened where
that part is gone; an empty part narrows to its bare heading.
- why: the sort makes the part headings anew on every write.
- what
- cycling narrows to
Mine, empty here, then toWriter's, then widens.
(let ((file (make-temp-file "check-onlymine-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"* Writer's :writers:\n"
"** TODO The writer's?\n :PROPERTIES:\n :ID: t\n :END:\n"
"* Later :later:\n"
"** REFINE Held back?\n :PROPERTIES:\n :ID: h\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-flet ((seen ()
(list (buffer-narrowed-p)
(save-excursion
(goto-char (point-min))
(and (org-at-heading-p) (org-get-heading t t t t))))))
(prog1 (list (progn (konix/agent-shell-workspace-cycle-view) (seen))
(progn (konix/agent-shell-workspace-cycle-view) (seen))
(progn (konix/agent-shell-workspace-cycle-view) (seen)))
(set-buffer-modified-p nil))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
((t "Mine") (t "Writer's") (nil nil)).
(defvar-local konix/agent-shell-workspace--view nil
"The tag of the part the view is narrowed to, or nil for everything.")
(defun konix/agent-shell-workspace--narrow-to-view ()
"Narrow to the part the view names; widen where it names none."
(widen)
(when-let* ((tag konix/agent-shell-workspace--view)
(part (save-excursion
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:[ \t]*$" tag) nil t))))
(save-excursion
(goto-char part)
(org-narrow-to-subtree))))
(defun konix/agent-shell-workspace-cycle-view ()
"Narrow to the user's part, then the writer's part, then widen."
(interactive)
(setq-local konix/agent-shell-workspace--view
(pcase konix/agent-shell-workspace--view
('nil konix/agent-shell-workspace-mine-part-tag)
((pred (equal konix/agent-shell-workspace-mine-part-tag))
konix/agent-shell-workspace-writers-part-tag)))
(konix/agent-shell-workspace--narrow-to-view)
(konix/agent-shell-workspace--context-shown))
- how
- settling the view is one command doing every rule above, the cursor in an answer taken back to its question first.
- rule
- a top heading keeps the fold the user last chose for it with
TAB, across every rewrite, by the writer or by the user; one never opened stays folded, but for the one holding the cursor, which opens to its questions so a write folds none away.- why: the user folds away a part they are done reading,
Donesay, and every rewrite opened it again; a choice read back from the view was lost as the view changed. - how:
TABon a top heading writes the choice in the file’sOPENEDproperty, the heading named by its tag, saved at once; the view only ever reads it from there. - how: an older
FOLDEDproperty, naming the parts folded, turns intoOPENEDat the file’s next write.- why: a part’s heading is made afresh every write: a choice kept on it would go with it.
- why: the user folds away a part they are done reading,
- what
Doneopened withTAB, a write and a revert each leave it open andMine, never opened, folded.
(let ((file (make-temp-file "check-folded-kept-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Asks you?\n :PROPERTIES:\n :ID: r\n :END:\n"
"* Writer's :writers:\n"
"** TODO The writer's?\n :PROPERTIES:\n :ID: t\n :END:\n"
"* Done :done:\n"
"** DONE Settled?\n :PROPERTIES:\n :ID: d\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace-focus-question)
(cl-flet ((folded (tag)
(save-excursion
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:" tag))
(and (invisible-p (line-end-position)) t))))
(goto-char (point-min))
(re-search-forward "^\\* .*Done")
(let ((this-command 'org-cycle) (last-command nil)) (org-cycle))
(goto-char (point-min))
(prog1 (list (progn (konix/agent-shell-workspace--write-file file)
(list (folded "done") (folded "mine")))
(progn (revert-buffer t t t)
(list (folded "done") (folded "mine"))))
(set-buffer-modified-p nil))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
((nil t) (nil t)). - what
Mineopened withTAB, emptied by a write, a question added back: it comes back open; folded withTABagain, the same: it comes back folded.
(let ((file (make-temp-file "check-chosen-fold-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Asks you?\n :PROPERTIES:\n :ID: r\n :END:\n"
"* Writer's :writers:\n"
"** TODO The writer's?\n :PROPERTIES:\n :ID: t\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace-focus-question)
(cl-flet ((tab-on-mine ()
(goto-char (point-min))
(re-search-forward "^\\* .*Mine")
(let ((this-command 'org-cycle) (last-command nil)) (org-cycle)))
(emptied-and-back (heading)
(konix/agent-shell-workspace--write-file file
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE ")
(org-cut-subtree))
(konix/agent-shell-workspace--write-file file
(goto-char (point-min))
(re-search-forward "^\\* .*Mine")
(org-end-of-meta-data t)
(insert "** REFINE " heading "\n"))
(goto-char (point-min))
(re-search-forward (concat "^\\*\\* REFINE " (regexp-quote heading)))
(and (invisible-p (match-beginning 0)) t)))
(prog1 (list (progn (tab-on-mine) (emptied-and-back "Back open?"))
(progn (tab-on-mine) (emptied-and-back "Back folded?")))
(set-buffer-modified-p nil))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(nil t). - rule
S-TABfolding all leaves no top heading opened; showing their contents or all opens every one.- why: the user folded all, and the next write opened again what
TABhad opened.
- why: the user folded all, and the next write opened again what
- what
Doneopened withTAB,S-TABto fold all, a write: every part folded, nothing opened;S-TABtwice more, a write: every part opened.
(let ((file (make-temp-file "check-shifttab-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Asks you?\n :PROPERTIES:\n :ID: r\n :END:\n"
"* Writer's :writers:\n"
"** TODO The writer's?\n :PROPERTIES:\n :ID: t\n :END:\n"
"* Done :done:\n"
"** DONE Settled?\n :PROPERTIES:\n :ID: d\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace-focus-question)
(cl-flet ((folded (tag)
(save-excursion
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:" tag))
(and (invisible-p (line-end-position)) t)))
(shifttab (last)
(goto-char (point-min))
(let ((this-command 'org-shifttab) (last-command last)) (org-shifttab))))
(goto-char (point-min))
(re-search-forward "^\\* .*Done")
(let ((this-command 'org-cycle) (last-command nil)) (org-cycle))
(prog1 (list (progn (shifttab nil)
(konix/agent-shell-workspace--write-file file)
(list (folded "done") (folded "mine")
(org-entry-get (point-min) "OPENED")))
(progn (shifttab nil)
(shifttab 'org-shifttab)
(konix/agent-shell-workspace--write-file file)
(list (folded "done") (folded "mine")
(org-entry-get (point-min) "OPENED"))))
(set-buffer-modified-p nil))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
((t t nil) (nil nil "done facts later memos mine projects reviews writers")). - what
Factsopened withTAB, a write and a revert leave it open andMine, never opened, folded; a file still sayingFOLDED: donereads, at its next write,OPENEDwith its other parts.
(let ((file (make-temp-file "check-opened-kept-" nil ".ws.org"))
(old (make-temp-file "check-opened-old-" nil ".ws.org"))
(body (concat "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Facts :facts:\n"
"** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"
"* Mine :mine:\n"
"** REFINE Asks you?\n :PROPERTIES:\n :ID: r\n :END:\n"
"* Done :done:\n"
"** DONE Settled?\n :PROPERTIES:\n :ID: d\n :END:\n")))
(with-temp-file file (insert body))
(with-temp-file old (insert ":PROPERTIES:\n:FOLDED: done\n:END:\n" body))
(unwind-protect
(list
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace-focus-question)
(cl-flet ((folded (tag)
(save-excursion
(goto-char (point-min))
(re-search-forward (format "^\\* .*:%s:" tag))
(and (invisible-p (line-end-position)) t))))
(goto-char (point-min))
(re-search-forward "^\\* Facts")
(let ((this-command 'org-cycle) (last-command nil)) (org-cycle))
(goto-char (point-min))
(prog1 (list (progn (konix/agent-shell-workspace--write-file file)
(list (folded "facts") (folded "mine")))
(progn (revert-buffer t t t)
(list (folded "facts") (folded "mine")))
(org-entry-get (point-min) "OPENED"))
(set-buffer-modified-p nil))))
(progn (konix/agent-shell-workspace--write-file old)
(with-current-buffer (find-file-noselect old)
(list (org-entry-get (point-min) "OPENED")
(org-entry-get (point-min) "FOLDED")))))
(let ((kill-buffer-query-functions nil))
(dolist (f (list file old))
(when-let* ((visiting (find-buffer-visiting f)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer)))
(delete-file f)))))
- what
- the check above is right when it reads
(((nil t) (nil t) "facts") ("later mine projects reviews writers" nil)), every part butDonehaving been open. - rule
- a question the user unfolded to read stays unfolded across a rewrite, a
revert or a settle, in the buffer only; only their own focus folds it.
- why: the rewrite folding it back took the text from under their eyes.
- how: the headings shown open are noted by id before the rewrite shows all, and opened again as the view is settled.
- what
- a question unfolded, a write, a revert and a settle alone each leave its body in view.
(let ((file (make-temp-file "check-unfolded-kept-" nil ".ws.org")))
(with-temp-file file
(insert ":PROPERTIES:\n:OPENED: mine\n:END:\n"
"#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Read me?\n :PROPERTIES:\n :ID: r\n :END:\n"
" - what :: the body read\n"
"** REFINE Not me?\n :PROPERTIES:\n :ID: n\n :END:\n"
" - what :: the body unread\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace-focus-question)
(cl-flet ((shown (text)
(save-excursion
(goto-char (point-min))
(search-forward text)
(not (invisible-p (match-beginning 0))))))
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Read me")
(org-fold-show-entry)
(goto-char (point-min))
;; Run by a key, the write would count as the user's own.
(prog1 (let ((this-command nil))
(list (progn (konix/agent-shell-workspace--write-file file)
(list (shown "the body read") (shown "the body unread")))
(progn (revert-buffer t t t)
(list (shown "the body read") (shown "the body unread")))
(progn (konix/agent-shell-workspace-focus-question)
(list (shown "the body read") (shown "the body unread")))))
(set-buffer-modified-p nil))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
((t nil) (t nil) (t nil)). - rule
- but a rewrite one of the user’s keys started folds it back like the rest.
- why: the user asked it: only what comes on its own keeps their reading open.
- how: nothing is noted while
this-commandis set; a writer’s call or a timer runs with none.
- what
- a question unfolded, then a write run as the user’s key, leaves its body folded.
(let ((file (make-temp-file "check-user-rewrite-folds-" nil ".ws.org")))
(with-temp-file file
(insert ":PROPERTIES:\n:OPENED: mine\n:END:\n"
"#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n"
"** REFINE Read me?\n :PROPERTIES:\n :ID: r\n :END:\n"
" - what :: the body read\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace-focus-question)
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Read me")
(org-fold-show-entry)
(goto-char (point-min))
(let ((this-command 'some-key-of-the-user))
(konix/agent-shell-workspace--write-file file))
(prog1 (save-excursion
(goto-char (point-min))
(search-forward "the body read")
(if (invisible-p (match-beginning 0)) 'folded 'shown))
(set-buffer-modified-p nil)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
folded.
(defvar-local konix/agent-shell-workspace--unfolded nil
"(noted . IDS), the headings below the top the user had open, till the view is settled.")
(put 'konix/agent-shell-workspace--unfolded 'permanent-local t)
(defvar-local konix/agent-shell-workspace--settled nil
"Non-nil once the view was settled: what shows open is then what the user opened.")
(put 'konix/agent-shell-workspace--settled 'permanent-local t)
(defun konix/agent-shell-workspace--note-unfolded ()
"Note by id the headings below the top shown open, unless they are noted already.
Nothing is noted while a key of the user's runs: its rewrite folds them back."
(unless (or this-command konix/agent-shell-workspace--unfolded)
(setq konix/agent-shell-workspace--unfolded
(cons 'noted
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(let (ids)
(while (re-search-forward "^\\*\\*+ " nil t)
(when-let* (((not (invisible-p (line-end-position))))
(id (org-entry-get (point) "ID")))
(push id ids))
(end-of-line))
ids)))))))
(defun konix/agent-shell-workspace--open-unfolded ()
"Open again the headings noted open, forgetting them."
(pcase-let ((`(noted . ,ids) konix/agent-shell-workspace--unfolded))
(setq konix/agent-shell-workspace--unfolded nil)
(dolist (id (reverse ids))
(save-excursion
(when (konix/agent-shell-workspace--goto-id id)
(org-fold-show-entry))))))
(defconst konix/agent-shell-workspace-opened-property "OPENED"
"File property naming, by their tags, the top headings the user last opened with TAB.")
(defun konix/agent-shell-workspace--opened-tops ()
"The tags of the top headings the user last opened with TAB, as the file keeps them.
A file still keeping the parts folded in FOLDED opens its other parts."
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(if-let* ((folded (org-entry-get nil "FOLDED")))
(let ((folded (split-string folded)) opened)
(while (re-search-forward "^\\* " nil t)
(when (konix/agent-shell-workspace--part-at-point-p)
(let ((tag (car (org-get-tags nil t))))
(unless (member tag folded) (push tag opened)))))
(sort opened #'string<))
(split-string (or (org-entry-get nil konix/agent-shell-workspace-opened-property) ""))))))
(defun konix/agent-shell-workspace--put-opened (opened)
"Keep OPENED as the file's top headings opened, FOLDED gone."
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(let ((inhibit-read-only t))
(org-entry-delete nil "FOLDED")
(if opened
(org-entry-put nil konix/agent-shell-workspace-opened-property
(string-join (sort (copy-sequence opened) #'string<) " "))
(org-entry-delete nil konix/agent-shell-workspace-opened-property))))))
(defun konix/agent-shell-workspace--folded-into-opened ()
"Turn a file's FOLDED into OPENED, for every write to leave OPENED alone."
(when (save-excursion (save-restriction (widen) (org-entry-get (point-min) "FOLDED")))
(konix/agent-shell-workspace--put-opened (konix/agent-shell-workspace--opened-tops))))
(defun konix/agent-shell-workspace--keep-part-fold (state)
"Keep in the file the fold the user just gave a top heading with TAB, or all with S-TAB,
STATE as org says. Saved at once, for no rewrite to come before it."
(when (memq this-command '(org-cycle org-shifttab))
(let* ((before (konix/agent-shell-workspace--opened-tops))
(tag (and (memq state '(folded children subtree))
(save-excursion
(org-back-to-heading t)
(and (equal (org-current-level) 1)
(car (org-get-tags nil t))))))
(after (pcase state
('overview nil)
((or 'contents 'all) (konix/agent-shell-workspace--part-tags))
((guard (not tag)) before)
('folded (remove tag before))
(_ (seq-uniq (cons tag before))))))
(unless (equal before after)
(konix/agent-shell-workspace--put-opened after)
(org-fold-hide-drawer-all)
(save-buffer)))))
(defun konix/agent-shell-workspace-focus-question ()
"Fold the workspace to its top headings and its questions, opening nothing under any.
A part the user folded with TAB stays folded."
(interactive)
(when (konix/agent-shell-workspace--in-an-answer-p)
(konix/agent-shell-workspace--goto-question))
(when konix/agent-shell-workspace--view
(widen))
(unless (or (eq this-command 'konix/agent-shell-workspace-focus-question)
(not konix/agent-shell-workspace--settled))
(konix/agent-shell-workspace--note-unfolded))
(setq konix/agent-shell-workspace--settled t)
(org-cycle-overview)
(let ((opened (konix/agent-shell-workspace--opened-tops)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\* " nil t)
(when (seq-intersection (org-get-tags nil t) opened)
(org-fold-show-children))))
(save-excursion
(when (and (not (org-before-first-heading-p)) (> (org-current-level) 1))
(while (> (org-current-level) 1) (outline-up-heading 1 t))
(org-fold-show-children))))
(konix/agent-shell-workspace--open-unfolded)
(org-link-preview-region)
(org-fold-hide-drawer-all)
(konix/agent-shell-workspace--show-what-waits)
(konix/agent-shell-workspace--show-ages)
(konix/agent-shell-workspace--fold-to-belonging)
(when konix/agent-shell-workspace--view
(konix/agent-shell-workspace--narrow-to-view))
(konix/agent-shell-workspace--context-shown)
(konix/agent-shell-workspace--debug-fold))
(defun konix/agent-shell-workspace--debug-fold ()
"Write down how the view was just settled: by what, OPENED, the cursor's part, what is open."
(konix/agent-shell-workspace--debug
'fold (buffer-name)
"%s settled; OPENED %S, cursor in %s, open %S, unfolded %S"
this-command
(konix/agent-shell-workspace--opened-tops)
(save-excursion
(if (org-before-first-heading-p)
"no part"
(while (> (org-current-level) 1) (outline-up-heading 1 t))
(or (car (org-get-tags nil t)) "no part")))
(save-excursion
(goto-char (point-min))
(let (open)
(while (re-search-forward "^\\* " nil t)
(unless (invisible-p (line-end-position))
(push (car (org-get-tags nil t)) open)))
(nreverse open)))
(cdr konix/agent-shell-workspace--unfolded)))
a question held back, dimmed
- rule
- a question another is holding back is dimmed, the words of its heading
going grey.
- why: the user reads down the workspace looking for what can be got on with, and a held-back one reads as though it were one of those.
- scope: never a finished one, waiting on the user’s settling: that is done work.
- rule: and the keyword keeps its own colour, the words after it dimming instead.
- why: that colour is what says whose turn a question is, and it is the one thing still worth reading at a glance on a held-back one.
- scope: the dimming is the display’s alone, nothing of it in the file, so a rewrite
cannot leave it behind.
- scope: and what waits on what is not the display’s: it is written in the file, where the user can put the cursor on it.
- rule: and the faces the dimming takes after are ones the theme is sure to have
said something about: what it dims a task with, falling back on Emacs’s own shadow;
and, for an after, that shadow itself.
- therefore: dim means dimmer than what is around it, whatever the theme, rather than a grey chosen here and hoped for.
- how: and each is set as well as declared, since a face already made keeps what it
was made with however often the note is loaded again.
- why: a colour changed here shows as soon as the note is loaded again.
- scope: it sets what the face is by default, so a theme or a customisation of the user’s still has the last word.
(defface konix/agent-shell-workspace-blocked-face
'((t :inherit (org-agenda-dimmed-todo-face shadow)))
"Face of a question another is holding back."
:group 'agent-shell)
(face-spec-set 'konix/agent-shell-workspace-blocked-face
'((t :inherit (org-agenda-dimmed-todo-face shadow)))
'face-defface-spec)
- how
- what holds one back is read off the questions: those it waits on still open,
those it comes after not yet closed by the writer.
- scope: one it comes after put off,
MAYBE, holds nothing back. - rule: and one of the user’s comes after another of the user’s too.
- why: the order holds for whoever’s turn both are, so the user answers them in it.
- scope: one it comes after put off,
- rule
- and a question scheduled is held back until its time, from the user as from
the writer, whatever its state.
- why: the writer sometimes needs a refine the user cannot give now, and it must not annoy them before the schedule.
- how: org’s own
SCHEDULED, read with the rest of the question; a day given without a time counts from its midnight.
(defun konix/agent-shell-workspace--heading-if-open (id questions)
"Return the heading ID goes by in QUESTIONS, or nothing where it is settled."
(when-let* ((one (assoc id questions))
((not (equal (nth 2 one)
konix/agent-shell-workspace-done-keyword))))
(nth 1 one)))
(defun konix/agent-shell-workspace--holding-back (id questions)
"Return the ids of QUESTIONS holding ID back just now, of either kind.
A schedule still to come holds it back too, standing in the list as its timestamp."
(let ((one (assoc id questions)))
(append
(when-let* ((scheduled (nth 5 one))
((time-less-p nil (org-time-string-to-time scheduled))))
(list scheduled))
(seq-filter (lambda (need)
(konix/agent-shell-workspace--heading-if-open need questions))
(nth 3 one))
(seq-filter (lambda (before)
(let ((its (nth 2 (assoc before questions))))
(or (member its (seq-difference
konix/agent-shell-workspace-open-keywords
(list konix/agent-shell-workspace-closing-keyword
konix/agent-shell-workspace-later-keyword)))
(and (member (nth 2 one) konix/agent-shell-workspace-users-keywords)
(member its konix/agent-shell-workspace-users-keywords)))))
(nth 4 one)))))
- rule
C-c C-sschedules the question the user stands on, org’s own command let through the read-only buffer.- rule
- and every minute, a workspace whose schedules have let one go is dimmed
again and its idle writer told to go on.
- scope: only a writer already live, as every telling to go on.
(defun konix/agent-shell-workspace-schedule (arg)
"Schedule the question at point with org's own command, passing it ARG."
(interactive "P")
(save-excursion
(konix/agent-shell-workspace--goto-question)
(konix/agent-shell-workspace--write
(org-schedule arg))))
(defvar-local konix/agent-shell-workspace--scheduled-ahead nil
"Ids of the questions a schedule still held back at the last look.")
(defun konix/agent-shell-workspace--scheduled-ahead ()
"Return the ids of this workspace's questions a schedule still holds back."
(mapcar #'car
(seq-filter (lambda (one)
(and (nth 5 one)
(time-less-p nil (org-time-string-to-time (nth 5 one)))))
(konix/agent-shell-workspace--every-question))))
(defun konix/agent-shell-workspace--let-scheduled-go ()
"In every workspace whose schedules let a question go, dim again and wake the writer."
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (bound-and-true-p konix/agent-shell-workspace-mode)
(with-demoted-errors "Letting a scheduled question go: %S"
(let ((ahead (konix/agent-shell-workspace--scheduled-ahead)))
(when (seq-difference konix/agent-shell-workspace--scheduled-ahead ahead)
(konix/agent-shell-workspace--show-what-waits)
(konix/agent-shell-workspace--go-on-soon))
(setq konix/agent-shell-workspace--scheduled-ahead ahead)))))))
(defvar konix/agent-shell-workspace--schedule-timer
(run-with-timer 60 60 #'konix/agent-shell-workspace--let-scheduled-go)
"What lets a scheduled question go once its time has come.")
waiting on itself
- rule
- one waiting, however far round, on itself is coloured as an alarm, the
theme’s error colour, rather than dimmed.
- why: a ring is not a thing waiting its turn but a thing that will never come, and reading down the workspace it must not look like every other held-back one.
- scope: the way round is followed through the open ones alone, a settled one in the way being no ring at all.
- how: a face of its own, so which colour it is stays the theme’s to say.
(defface konix/agent-shell-workspace-ringed-face
'((t :inherit error))
"Face of a question waiting, however far round, on itself."
:group 'agent-shell)
(face-spec-set 'konix/agent-shell-workspace-ringed-face
'((t :inherit error))
'face-defface-spec)
(defun konix/agent-shell-workspace--reaches-p (from to questions seen)
"Non-nil when FROM reaches TO by what it waits on or comes after, open alone.
SEEN keeps it from going round."
(seq-some
(lambda (need)
(or (equal need to)
(and (not (member need seen))
(konix/agent-shell-workspace--reaches-p
need to questions (cons need seen)))))
(seq-filter (lambda (other)
(konix/agent-shell-workspace--heading-if-open other questions))
(append (nth 3 (assoc from questions))
(nth 4 (assoc from questions))))))
(defun konix/agent-shell-workspace--ringed-p (id questions)
"Non-nil when ID waits, however far round, on itself."
(konix/agent-shell-workspace--reaches-p id id questions (list id)))
held back only by what it comes after
- rule
- one held back only by what it comes after is dimmed a look of its own,
apart from one waiting on what the user has still to settle, and from every keyword.
- how: Emacs’s own shadow, slanted: the slant tells it from
MAYBE’s shadow and from the other dimming. - why: the one comes loose as soon as the writer closes the other, the other only when the user says so, and the user reads down for which is which.
- scope: a ring is a ring whichever kind it is made of, and takes the ring’s colour over either.
- rule: and an after goes into a ring whoever’s the other is just now.
- why: a ring through one handed over to the user locks the moment that one comes back, and must read as a ring on both sides already.
- how: Emacs’s own shadow, slanted: the slant tells it from
(defface konix/agent-shell-workspace-after-face
'((t :inherit shadow :slant italic))
"Face of a question held back only by what it comes after."
:group 'agent-shell)
(face-spec-set 'konix/agent-shell-workspace-after-face
'((t :inherit shadow :slant italic))
'face-defface-spec)
dimmed as the mode comes on
- rule
- the dimming is put on as the mode comes on, not only as the view settles.
- why: a workspace opened by hand settles no view until something happens in it, and would stand undimmed however much of it is held back.
(defun konix/agent-shell-workspace--show-what-waits ()
"Dim the words of every open question another is holding back."
(remove-overlays (point-min) (point-max)
'konix/agent-shell-workspace-waits t)
(let ((questions (konix/agent-shell-workspace--every-question)))
(save-excursion
(goto-char (point-min))
(while (konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-state-regexp)
(when-let* ((words (point))
(id (org-entry-get (point) "ID"))
((not (equal (nth 2 (assoc id questions))
konix/agent-shell-workspace-closing-keyword)))
((konix/agent-shell-workspace--heading-if-open id questions))
((or (konix/agent-shell-workspace--holding-back id questions)
(konix/agent-shell-workspace--ringed-p id questions)))
(overlay (make-overlay words (line-end-position))))
(overlay-put overlay 'konix/agent-shell-workspace-waits t)
(overlay-put overlay 'face
(cond
((konix/agent-shell-workspace--ringed-p id questions)
'konix/agent-shell-workspace-ringed-face)
((seq-some
(lambda (need)
(konix/agent-shell-workspace--heading-if-open
need questions))
(nth 3 (assoc id questions)))
'konix/agent-shell-workspace-blocked-face)
(t 'konix/agent-shell-workspace-after-face))))))))
the keys
- rule
- the buffer is read-only.
- rule: and it is claimed again after a rewrite has read the file back.
- why: reading it back keeps the modes, so nothing settles them afresh, and it would come back writable.
- rule: and it is claimed again after a rewrite has read the file back.
- rule
- the keys are the ones the user already presses to read a conversation with a
writer, key for key.
- scope: wherever the workspace has something of its own to do, the key runs its command; the others are left as they are.
- rule
SPCleaves a question by reading past it, andM-nandM-pstep to whatever waits on the user next.- rule: and
fandbstep the same way, forwards and back.- why: stepping is what the user does most here, and it wants a key rather than a chord.
- rule: and
- rule
- and some keys are a second name for another:
agoes to the writer asOdoes,Ranswers asrdoes. - rule
- and some reach past the workspace, to what the user looks at around the
writers:
Ppops to any session,Ushows the usage left,Tthe tree of sessions. - rule
- the map is one object, emptied and filled in place, so loading the note
again is what refreshes the keys, and a key the note stops binding stops being bound.
- why: fast iterations: a binding edited in the note is tried at once, with no restart.
- how: the mode holds on to that same object, so a buffer already in the mode has the new keys as well.
(defvar konix/agent-shell-workspace-mode-map (make-sparse-keymap)
"Keymap of `konix/agent-shell-workspace-mode'.")
(setcdr konix/agent-shell-workspace-mode-map nil)
each key, by what it does
- what
- reading and stepping.
(let ((map konix/agent-shell-workspace-mode-map))
(define-key map (kbd "SPC") #'konix/agent-shell-workspace-scroll-or-track)
(define-key map (kbd "DEL") #'scroll-down-command)
(define-key map "<" #'beginning-of-buffer)
(define-key map "G" #'end-of-buffer)
(define-key map ">" #'end-of-buffer)
(define-key map (kbd "M-n") #'konix/agent-shell-workspace-next-question)
(define-key map (kbd "M-p") #'konix/agent-shell-workspace-previous-question)
(define-key map "f" #'konix/agent-shell-workspace-next-question)
(define-key map "b" #'konix/agent-shell-workspace-previous-question)
(define-key map "/" #'konix/agent-shell-workspace-cycle-view)
(define-key map "q" #'quit-window))
- what
- answering, rewording, raising a subject, being through with one.
(let ((map konix/agent-shell-workspace-mode-map))
(define-key map "y" #'konix/agent-shell-workspace-answer-yes)
(define-key map (kbd "M-B") #'konix/agent-shell-workspace-answer-bullshit)
(define-key map (kbd "M-i") #'konix/agent-shell-workspace-answer-look-it-up)
(define-key map "n" #'konix/agent-shell-workspace-answer-no)
(define-key map "c" #'konix/agent-shell-workspace-cancel-run)
(define-key map "?" #'konix/agent-shell-workspace-answer-what)
(define-key map "g" #'konix/agent-shell-workspace-answer-go)
(define-key map "." #'konix/agent-shell-workspace-answer-done)
(dolist (digit (number-sequence ?1 ?9))
(define-key map (string digit) #'konix/agent-shell-workspace-answer-choice))
(define-key map "r" #'konix/agent-shell-workspace-answer)
(define-key map "R" #'konix/agent-shell-workspace-answer)
(define-key map "e" #'konix/agent-shell-workspace-edit)
(define-key map (kbd "M-RET") #'konix/agent-shell-workspace-add-subject)
(define-key map "+" #'konix/agent-shell-workspace-add-subject-first)
(define-key map "=" #'konix/agent-shell-workspace-add-subject-after)
(define-key map "t" #'konix/agent-shell-workspace-done-with-it)
(define-key map "m" #'konix/agent-shell-workspace-put-off)
(define-key map (kbd "C-c C-s") #'konix/agent-shell-workspace-schedule))
- what
- going where a heading points.
(let ((map konix/agent-shell-workspace-mode-map))
(define-key map "o" #'org-open-at-point)
(define-key map (kbd "RET") #'konix/agent-shell-workspace-open-at-point)
(define-key map "d" #'konix/agent-shell-workspace-goto-diff)
(define-key map "O" #'konix/agent-shell-workspace-goto-writer)
(define-key map "a" #'konix/agent-shell-workspace-goto-writer)
(define-key map "P" #'konix/agent-shell-pop-to-buffer))
- what
- dropping, clearing out, pinning.
(let ((map konix/agent-shell-workspace-mode-map))
(define-key map "k" #'konix/agent-shell-workspace-drop)
(define-key map (kbd "C-k") #'konix/agent-shell-workspace-drop)
(define-key map "K" #'konix/agent-shell-workspace-clean)
(define-key map "p" #'konix/agent-shell-workspace-pin)
(define-key map ":" #'konix/agent-shell-workspace-tag))
- what
- the order of the work.
(let ((map konix/agent-shell-workspace-mode-map))
(define-key map "D" #'konix/agent-shell-workspace-needs)
(define-key map "X" #'konix/agent-shell-workspace-take-back)
(define-key map (kbd "M-<left>") #'konix/agent-shell-workspace-goto-waited-on)
(define-key map (kbd "M-<right>") #'konix/agent-shell-workspace-goto-holding-back)
(define-key map (kbd "M-<up>") #'konix/agent-shell-workspace-move-up)
(define-key map (kbd "M-<down>") #'konix/agent-shell-workspace-move-down)
(define-key map "," #'konix/agent-shell-workspace-set-priority))
- what
- what the writer is held to — its rules, its projects, its runs — the review, and what lies past the workspace.
(let ((map konix/agent-shell-workspace-mode-map))
(define-key map "S" #'konix/agent-shell-workspace-steering-menu)
(define-key map "B" #'konix/agent-shell-workspace-blacklist-menu)
(define-key map "W" #'konix/agent-shell-workspace-whitelist-menu)
(define-key map "w" #'konix/agent-shell-workspace-set-project)
(define-key map "^" #'konix/agent-shell-workspace-promote-to-project)
(define-key map "@" #'konix/agent-shell-workspace-show-belonging)
(define-key map "l" #'konix/agent-shell-workspace-toggle-project-of-question)
(define-key map (kbd "C-w") #'konix/agent-shell-workspace-project-again)
(define-key map "C" #'konix/agent-shell-workspace-set-run-cap)
(define-key map "V" #'konix/agent-shell-workspace-review)
(define-key map "v" #'konix/agent-shell-workspace-show-review)
(define-key map "U" #'konix/claude-code-usage)
(define-key map "T" #'konix/mcp-server-show-spawn-tree)
(define-key map "N" #'konix/agent-shell-workspace-bind-governing-note)
(define-key map "Z" #'konix/agent-shell-workspace-ask-to-compact)
(define-key map "F" #'konix/agent-shell-workspace-fresh-writer))
- rule
Nbinds a governing note to the workspace’s writer, from the workspace.- why: the user wants the writer to follow a governing note while they talk with it through the workspace.
- how: it prompts for the note and binds it as binding one from the writer’s shell does, the note sent to the writer.
- rule: and the prompt starts where notes are, the directory the
agent-shell-with-notelinks complete from. - what: a governing note has its writer start an auditor, another agent checking each change against the note.
- rule: and it writes the writer a question of its own, to start that auditor and
run the audit of what the writer changed.
- rule: every change since the last such question was asked, or every change in
the workspace where none was.
- why: « what you changed » named no starting point, and the writer audited its latest change alone.
- how: each question is stamped with when it was asked, the latest stamp read.
- how: the writer takes the question up like any other, which the steering asks of it before it may start anything.
- rule: every change since the last such question was asked, or every change in
the workspace where none was.
- what
- after
N, the prompt having started in the notes’ directory, the writer reads back the note picked as its governing note, and a question of its own asks to start its auditor and run the audit of what it changed.- scope: the sending of the note is the shell binding’s own, not checked here.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-note-writer"))
(file (make-temp-file "check-note-" nil ".ws.org"))
started-in)
(with-current-buffer writer (setq major-mode 'agent-shell-mode))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(konix/agent-shell-workspace-mode 1)
(cl-letf (((symbol-function 'read-file-name)
(lambda (_prompt dir &rest _)
(setq started-in dir)
"/tmp/the-note.org"))
((symbol-function 'konix/agent-shell-workspace--cut-if-done) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--go-on-soon) #'ignore)
((symbol-function 'konix/mcp-server-render-note)
(lambda (&rest _) "the note"))
((symbol-function 'agent-shell--insert-to-shell-buffer) #'ignore)
((symbol-function 'konix/agent-shell--shell-session-id)
(lambda (&rest _) "id"))
((symbol-function 'konix/agent-shell-session-store-put) #'ignore)
((symbol-function 'konix/agent-shell-mcp-apply-note-servers) #'ignore))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "N"))
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward ":AUDIT-ASKED: +.*$")
(replace-match ":AUDIT-ASKED: [2026-01-02 Fri 03:04]"))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "N")))
(prog1 (list (and (equal started-in konix/org-agent-shell-note-directory)
'started-in-notes)
(konix/agent-shell-governing-note writer)
(save-restriction
(widen)
(goto-char (point-min))
(and (re-search-forward
"^\\*\\* TODO .*auditor.* audit every change in this workspace\\?$"
nil t)
(re-search-forward
"^\\*\\* TODO .*auditor.* audit every change since \\[2026-01-02 Fri 03:04\\]\\?$"
nil t)
'audits-asked)))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
(started-in-notes "/tmp/the-note.org" audits-asked): the first asks for every change, the second for every change since the first was asked. - rule
C-u Nunbinds the writer’s governing note and kills its auditor, the writer told.- why: the user ends a note’s rule over the writer as they began it, from the workspace.
- scope: the auditor killed is the one
spawn_auditornames by default.
- what
- after
C-u N, no note governs the writer, its auditor is gone, and it was told.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-unbind-writer"))
(auditor (generate-new-buffer " check-unbind-auditor"))
(file (make-temp-file "check-unbind-" nil ".ws.org"))
told)
(with-current-buffer writer
(setq major-mode 'agent-shell-mode)
(setq-local konix/mcp-server--buddy-name "w"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell--shell-session-id)
(lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-session-store-put) #'ignore)
((symbol-function 'konix/agent-shell-session-store-remove) #'ignore)
((symbol-function 'konix/mcp-server--coord-deregister) #'ignore)
((symbol-function 'read-file-name)
(lambda (&rest _) (error "Prompted for a note")))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text &rest _) (setq told text))))
(with-current-buffer writer
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(konix/agent-shell-workspace-mode 1)
(let ((current-prefix-arg '(4)))
(ignore-errors
(call-interactively
(lookup-key konix/agent-shell-workspace-mode-map "N"))))
(prog1 (list (konix/agent-shell-governing-note writer)
(buffer-live-p auditor)
(and told t))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(when (buffer-live-p auditor) (kill-buffer auditor))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
(nil nil t). - rule
- the writer refreshes its auditor with
spawn_auditorandfreshtrue: the standing one killed, a new one spawned on the note as it now reads. - what
freshkills the standing auditor and spawns another; without it, the standing one is reused.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-fresh-writer"))
(auditor (generate-new-buffer " check-fresh-auditor"))
spawned)
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w")
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(unwind-protect
(cl-letf (((symbol-function 'konix/mcp-server--coord-deregister) #'ignore)
((symbol-function 'konix/mcp-server-render-note)
(lambda (&rest _) "the note"))
((symbol-function 'konix/agent-shell-mcp-note-server-names) #'ignore)
((symbol-function 'konix/agent-shell-mcp-servers-for) #'ignore)
((symbol-function 'konix/mcp-server-spawn-agent)
(lambda (&rest _) (push 'spawned spawned) "spawned")))
(let ((konix/mcp-server--calling-buffer writer))
(list (progn (konix/mcp-server-spawn-auditor "/tmp")
(list (buffer-live-p auditor) spawned))
(condition-case err
(progn (konix/mcp-server-spawn-auditor "/tmp" nil nil "true")
(list (buffer-live-p auditor) spawned))
(error (error-message-string err))))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(when (buffer-live-p auditor) (kill-buffer auditor))
(kill-buffer writer)))
The auditor only reads and returns verdicts; it never edits. It audits SUBSTANCE against the principles and ignores tooling-owned mechanics (CUSTOM_ID, :ID:, espaces insécables, wrapping, slugs). The governing note is the one bound to the CALLING session, carried across resume/reload/fork; its whole text is read and inlined into the boot prompt, and the MCP servers it declares with `#+MCP_SERVERS:’ are enabled in the auditor too.
The auditor’s coordination name is DERIVED, not chosen: `<caller>::<label>’ (LABEL defaults to \“auditor\”). Two different callers can never collide, and one caller can run several auditors by using distinct labels. Re-calling with a label whose auditor already exists returns that standing auditor instead of spawning another. Send it a draft with coord_ask_and_wait (to_buddy = the returned name); it returns a cited verdict (PASS or NEEDS-WORK + findings). Kill it with kill_buddy when done; to pick up edits to the principles, kill it and spawn a fresh one.
MCP Parameters: directory - The working directory for the session label - Short role label, unique WITHIN your session (e.g. \“auditor\”, \“style\”). Defaults to \“auditor\”. The coordination name is \"<your-session>::<label>\"; the tool returns the exact name to pass as to_buddy. respawn-threshold - Context-usage percentage (0-100) at which it respawns. Defaults to 80."], 4 |
- what
- the check above is right when it reads
((t nil) (nil (spawned))). - rule
- while a note governs the writer, a question it refines goes to its auditor
first, and reaches the user as REFINE only once the auditor passed it.
- why: the auditor audits every state that goes back to the user; auditing the take-up made a go wait on the auditor for nothing the user reads.
- how: Emacs posts it to
<writer>::auditorthrough coord, with the writer’s transcript since it took the question up, and leaves it awaiting; coord pushes the verdict back the moment it lands. - how: on PASS it turns REFINE and the writer is told so; otherwise it goes back where it was, the findings sent to the writer.
- scope: taking a question up, discussion or work, goes straight.
- rule: and a new question the governed writer asks goes to its auditor too,
awaiting; on PASS it takes the state it was asked in, otherwise it is taken out of
the workspace, the findings and its heading sent to the writer.
- why: TODO means ready to work: a refused question left there would reach the user as if passed.
- rule: and one refined with no auditor standing is refused, the writer told to spawn one.
- rule
- and a question the governed writer closes goes to its auditor too, with the
writer’s transcript since it went WORKING, and reaches the user only once passed.
- why: the auditor is expected to audit WORKING → TOCHECK, with the transcript.
- how: the transcript is read off the writer’s session file, from its last taking up of the question on; tool calls and outputs cut short, the user’s words too.
- how: on PASS it waits on the user’s settling; otherwise it goes back to WORKING.
- rule: the auditor answers in JSON, {verdict, findings}; Emacs reads the verdict,
never guesses it from prose.
- why: better to have a proper structure than guess the PASS.
- how: an answer not that JSON goes back to the auditor once; a second is taken as NEEDS-WORK, its raw text the findings.
- rule: a question the auditor did not pass shows its answer, quoted under
« audited :: needs work »; a later rejection’s quote takes its place.
- why: when not passing the gate, the user wants to see the auditor’s answer in the question.
- what
- a take-up goes straight; a refine awaits the auditor, posted to it; PASS makes it REFINE, the writer told; NEEDS-WORK puts it back THINKING, the writer told its findings, quoted in the question; prose goes back to the auditor once, the writer not told; prose twice puts it back, the writer told the prose, quoted too; a second rejection’s quote replaces the first; no auditor is refused; no note, no gate.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(writer (generate-new-buffer " check-gate-writer"))
(auditor (generate-new-buffer " check-gate-auditor"))
(seq 0) posts told)
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* Writer's :writers:\n"
"** TODO Go now?\n :PROPERTIES:\n :ID: q0\n :END:\n - what :: one\n")
(dolist (q '(("q1" . "Ship it?") ("q4" . "Ship free?")))
(insert "** DISCUSS " (cdr q) "\n :PROPERTIES:\n :ID: " (car q)
"\n :END:\n - what :: one\n"
"*** me: go on " (car q) "\n :PROPERTIES:\n :ID: a" (car q)
"\n :END:\n")))
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w")
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(cl-labels ((at (label)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(when (re-search-forward
(format "^\\*+ \\([A-Z]+\\) %s$" (regexp-quote label)) nil t)
(match-string 1))))
(quoted (label)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(re-search-forward (format "^\\*\\* [A-Z]+ %s$" (regexp-quote label)))
(let ((body (buffer-substring (point) (if (re-search-forward "^\\*" nil t)
(point)
(point-max))))
quotes)
(with-temp-buffer
(insert body)
(goto-char (point-min))
(while (re-search-forward
"- audited :: needs work\n *#\\+BEGIN_QUOTE\n\\(\\(?:.*\n\\)*?\\) *#\\+END_QUOTE"
nil t)
(push (string-trim (match-string 1)) quotes)))
quotes)))
(refine (label &optional id)
(condition-case err
(progn (konix/mcp-server-set-workspace-question
label (json-encode ["what :: one"]) nil nil nil nil "refine" id)
'sent)
(error (if (string-match-p "spawn_auditor" (error-message-string err))
'refused
(error-message-string err))))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--writer-of) (lambda (&rest _) writer))
((symbol-function 'konix/agent-shell--shell-session-id) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text &rest _) (setq told text)))
((symbol-function 'plz)
(lambda (method url &rest args)
(if (eq method 'post)
(progn (push (list url (plist-get args :body)) posts)
`((id . ,(cl-incf seq))))
'((w::auditor (status . "idle")))))))
(with-current-buffer writer
(append
(progn (remhash "w::auditor" konix/mcp-server--buddy-buffers)
(konix/mcp-server-set-workspace-state "q1" "work")
(prog1 (list (at "Ship it?") (refine "Ship it, really?" "q1")
(at "Ship it?"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)))
(progn (refine "Ship it now?" "q1")
(list (at "Ship it now?")
(with-temp-buffer
(insert-file-contents file)
(and (search-forward "task #1, from THINKING" nil t) t))
(and (string-match-p "w::auditor" (url-unhex-string (car (car posts))))
(string-match-p "Ship it now" (cadr (car posts)))
t)))
(progn (konix/mcp-server--gate-verdict
1 "{\"verdict\": \"NEEDS-WORK\", \"findings\": [{\"what\": \"the plan lies\", \"passage\": \"\", \"rule\": \"\"}]}")
(list (at "Ship it now?")
(and told (string-match-p "the plan lies" told) t)
(quoted "Ship it now?")))
(progn (setq told nil)
(refine "Ship it today?" "q1")
(konix/mcp-server--gate-verdict 2 "{\"verdict\": \"PASS\", \"findings\": []}")
(list (at "Ship it today?")
(and told (string-match-p "passed your answer to q1" told) t)))
(progn (setq told nil)
(konix/mcp-server-set-workspace-state "q4" "work")
(refine "Ship free now?" "q4")
(konix/mcp-server--gate-verdict 3 "fine\nPASS")
(list (at "Ship free now?")
(length posts)
(and (string-match-p "w::auditor" (url-unhex-string (car (car posts))))
(string-match-p "Ship free now" (cadr (car posts)))
t)
told))
(progn (konix/mcp-server--gate-verdict 4 "still prose")
(list (at "Ship free now?")
(and told (string-match-p "still prose" told) t)
(quoted "Ship free now?")))
(progn (refine "Ship free today?" "q4")
(konix/mcp-server--gate-verdict
5 "{\"verdict\": \"NEEDS-WORK\", \"findings\": [{\"what\": \"second look\", \"passage\": \"\", \"rule\": \"\"}]}")
(list (quoted "Ship free today?")))
(progn (setq-local konix/agent-shell--governing-note nil)
(refine "Ship free at last?" "q4")
(list (at "Ship free at last?") (length posts)))
(progn (setq-local konix/agent-shell--governing-note "/tmp/the-note.org")
(konix/mcp-server-set-workspace-state "q0" "work")
(list (at "Go now?") (length posts)))
(list (at "me: go on q1")))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer auditor)
(kill-buffer writer))
(delete-file file))))
- what
- the check above is right when it reads
(THINKING refused THINKING AWAITING t t THINKING t ("- what :: the plan lies") REFINE t AWAITING 4 t nil THINKING t ("still prose") ("- what :: second look") REFINE 5 WORKING 5 nil): a DISCUSS taken up with no auditor standing, and a go taken up, both go straight. - what
- a new question awaits the auditor, posted to it; PASS makes it REFINE, the writer told; a new refine NEEDS-WORK is taken out, the writer told its findings and its heading; with no auditor standing it is refused and not written; no note, no gate.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-new-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(writer (generate-new-buffer " check-gate-new-writer"))
(auditor (generate-new-buffer " check-gate-new-auditor"))
(seq 0) posts told)
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"))
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w")
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(cl-labels ((at (label)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(when (re-search-forward
(format "^\\*+ \\([A-Z]+\\) %s$" (regexp-quote label)) nil t)
(match-string 1))))
(ask (label &optional act)
(condition-case err
(progn (konix/mcp-server-set-workspace-question
label (json-encode ["what :: one"]) nil nil nil nil act)
'sent)
(error (if (string-match-p "spawn_auditor" (error-message-string err))
'refused
(error-message-string err))))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--writer-of) (lambda (&rest _) writer))
((symbol-function 'konix/agent-shell--shell-session-id) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text &rest _) (setq told text)))
((symbol-function 'plz)
(lambda (method url &rest args)
(if (eq method 'post)
(progn (push (list url (plist-get args :body)) posts)
`((id . ,(cl-incf seq))))
'((w::auditor (status . "idle")))))))
(with-current-buffer writer
(append
(progn (ask "Ship it?")
(list (at "Ship it?")
(with-temp-buffer
(insert-file-contents file)
(and (search-forward "task #1, asked anew" nil t) t))
(length posts)
(and (car posts)
(string-match-p "w::auditor" (url-unhex-string (car (car posts))))
(string-match-p "Ship it" (cadr (car posts)))
t)))
(progn (konix/mcp-server--gate-verdict 1 "{\"verdict\": \"PASS\", \"findings\": []}")
(list (at "Ship it?")
(and told (string-match-p "passed" told) t)))
(progn (setq told nil)
(ask "Talk it?" "refine")
(konix/mcp-server--gate-verdict
2 "{\"verdict\": \"NEEDS-WORK\", \"findings\": [{\"what\": \"too vague\", \"passage\": \"\", \"rule\": \"\"}]}")
(list (at "Talk it?")
(with-temp-buffer
(insert-file-contents file)
(and (search-forward "Talk it?" nil t) t))
(and told (string-match-p "too vague" told) t)
(and told (string-match-p "Talk it\\?" told) t)))
(progn (remhash "w::auditor" konix/mcp-server--buddy-buffers)
(prog1 (list (ask "Ask it?") (at "Ask it?"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)))
(progn (setq-local konix/agent-shell--governing-note nil)
(ask "Free it?")
(list (at "Free it?") (length posts))))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer auditor)
(kill-buffer writer))
(delete-file file))))
- what
- the check above is right when it reads
("AWAITING" t 1 t "REFINE" t nil nil t t refused nil "REFINE" 2), its awaiting line saying it was asked anew. - rule
- and a refine coord cannot take is refused in words saying so, the question
left as it was.
- how: the writer is told to ask the user to restart coord.
- what
- with coord failing the post, the refine is refused naming a restart, and the question stays THINKING.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-down-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(writer (generate-new-buffer " check-gate-down-writer"))
(auditor (generate-new-buffer " check-gate-down-auditor")))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* THINKING Ship it?\n :PROPERTIES:\n :ID: q1\n :END:\n - what :: one\n"))
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w")
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-session-store-get) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'plz)
(lambda (&rest _) (signal 'plz-error '("HTTP error" "<html>404</html>")))))
(with-current-buffer writer
(list (condition-case err
(progn (konix/mcp-server-set-workspace-question
"Ship it now?" (json-encode ["what :: one"])
nil nil nil nil "refine" "q1")
'sent)
(error (if (string-match-p "restart" (error-message-string err))
'refused-naming-restart
(error-message-string err))))
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(goto-char (point-min))
(search-forward "Ship it?")
(org-get-todo-state)))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer auditor)
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(refused-naming-restart "THINKING"). - rule
- a question awaiting an auditor coord does not list goes back to the state it
came from as the writer’s turn ends, saying so, and is no longer awaited; one asked
anew is taken out.
- why: coord restarted forgets every name; an auditor not registering again is never handed its task, and the question would wait for good.
- why: TODO means ready to work, and it was never audited.
- how: read off the question’s « auditing » line, « from THINKING » or « asked anew », not from memory, which a restart of Emacs loses too; a line naming neither goes back to TODO.
- scope: coord not answering frees nothing: it cannot say who it lists.
- rule: and refining or closing while coord does not list the auditor is refused,
the writer told to refresh it with
spawn_auditor.- why: posted again to that name, it would be stranded again.
- what
- as the turn ends, each question awaiting an unlisted auditor goes back where
its line says, saying it was lost, its gate dropped: one naming nothing to TODO, one
from THINKING to THINKING, one asked anew out; the one awaiting a listed auditor stays,
an unlisted one named in its old wording notwithstanding; refining it is refused
naming
spawn_auditor; coord down, nothing is freed.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-stranded-" nil ".ws.org"))
(writer (generate-new-buffer " check-gate-stranded-writer"))
(auditor (generate-new-buffer " check-gate-stranded-auditor"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(coord '((v::auditor (status . "idle")))))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* AWAITING Ship it?\n :PROPERTIES:\n :ID: q1\n :END:\n"
" - auditing :: w::auditor, task #7\n - what :: one\n"
"* AWAITING Ship that?\n :PROPERTIES:\n :ID: q2\n :END:\n"
" - auditing :: v::auditor, task #8\n - what :: two\n"
"** writer: Ship that before?\n - auditing :: x::auditor, task #3\n"
"* AWAITING Ship more?\n :PROPERTIES:\n :ID: q3\n :END:\n"
" - auditing :: u::auditor, task #9\n - what :: three\n"
"* AWAITING Ship back?\n :PROPERTIES:\n :ID: q4\n :END:\n"
" - auditing :: u::auditor, task #11, from THINKING\n - what :: four\n"
"* AWAITING Ship anew?\n :PROPERTIES:\n :ID: q5\n :END:\n"
" - auditing :: u::auditor, task #12, asked anew\n - what :: five\n"))
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w")
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(puthash 7 (list "q1" "WORKING" file writer "TODO" "w::auditor" nil)
konix/agent-shell-workspace--gates)
(cl-labels ((state (label)
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(goto-char (point-min))
(search-forward label)
(org-get-todo-state)))
(says (label what)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(search-forward label)
(let ((end (save-excursion (if (re-search-forward "^\\*" nil t)
(point)
(point-max)))))
(and (search-forward what end t) t))))
(turn-ends ()
(with-current-buffer writer
(konix/agent-shell-workspace--turn-ended-as-ever
'((:data . ((:stop-reason . "end_turn")))) nil))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell--shell-session-id) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--say-cut) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'plz)
(lambda (method &rest _)
(cond ((eq coord 'down) (signal 'plz-error '("down")))
((eq method 'get) coord)
(t '((id . 10)))))))
(list (progn (setq coord 'down)
(turn-ends)
(state "Ship it?"))
(progn (setq coord '((v::auditor (status . "idle"))))
(turn-ends)
(list (state "Ship it?")
(says "Ship it?" "lost")
(says "Ship it?" "auditing ::")
(gethash 7 konix/agent-shell-workspace--gates)
(state "Ship that?")
(state "Ship more?")
(state "Ship back?")
(with-temp-buffer
(insert-file-contents file)
(and (search-forward "Ship anew?" nil t) t))))
(with-current-buffer writer
(condition-case err
(progn (konix/mcp-server-set-workspace-question
"Ship it now?" (json-encode ["what :: one"])
nil nil nil nil "refine" "q1")
'sent)
(error (if (string-match-p "spawn_auditor" (error-message-string err))
'refused-naming-spawn
(error-message-string err)))))
(state "Ship it?")))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer auditor)
(kill-buffer writer))
(delete-file file))))
- what
- the check above is right when it reads
("AWAITING" ("TODO" t nil nil "AWAITING" "TODO" "THINKING" nil) refused-naming-spawn "TODO"). - rule
- a verdict moves the question’s keyword alone, its history left without one,
whatever region the user left active in the workspace.
- why: org changes the keyword of every heading in an active region, and a history line turned WORKING reads as a question of its own.
- what
- with the whole workspace selected, a PASS makes the question WORKING and leaves its two history lines with no keyword.
(require 'cl-lib)
(let ((file (make-temp-file "check-verdict-history-" nil ".ws.org"))
(writer (generate-new-buffer " check-verdict-history-writer"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql)))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* AWAITING Ship it?\n :PROPERTIES:\n :ID: q1\n :END:\n"
" - auditing :: w::auditor, task #1\n - what :: one\n"
"** writer: Ship it now?\n** me: go on\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(let ((transient-mark-mode t))
(goto-char (point-min))
(push-mark (point-max) t t)
(puthash 1 (list "q1" "WORKING" file writer "TODO" "w::auditor" nil)
konix/agent-shell-workspace--gates)
(konix/mcp-server--gate-verdict 1 "{\"verdict\": \"PASS\", \"findings\": []}")))
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(goto-char (point-min))
(let (states)
(while (re-search-forward "^\\*+ " nil t)
(push (org-get-todo-state) states))
(nreverse states))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(deactivate-mark)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(nil nil "WORKING" nil nil), the two part headings first. - rule
- each finding of the auditor opens on one short line, its passage and rule
under it.
- why: the user reads the quote at a glance, and only then the passages and rules it quotes.
- how: a finding is
{"what": …, "passage": …, "rule": …}, its what one line under konix/agent-shell-workspace-finding-what-most characters. - rule :: and the quote follows the mechanics: each finding a « what: » bullet, its passage a « what :: » bullet under it, the rule it breaks a « rule :: » one.
- rule: and a verdict whose findings are not so goes back to the auditor once, as
one not JSON does; the second is taken as it came, verdict and words.
- why: a verdict holding is worth more than its form; forcing it NEEDS-WORK would make an honest PASS a refusal.
- what
- a prose finding goes back to the auditor, the writer not told; the same again is quoted as it came; a well-formed one is quoted as bullets, its passage and rule under its what; a what too long goes back.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-form-" nil ".ws.org"))
(writer (generate-new-buffer " check-gate-form-writer"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(seq 10) posts told)
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* AWAITING Ship it?\n :PROPERTIES:\n :ID: q1\n :END:\n"
" - auditing :: w::auditor, task #1\n - what :: one\n"))
(cl-labels ((state ()
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(goto-char (point-min))
(search-forward "Ship it?")
(org-get-todo-state)))
(quoted ()
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(when (re-search-forward
"#\\+BEGIN_QUOTE\n\\(\\(?:.*\n\\)*?\\) *#\\+END_QUOTE" nil t)
(match-string 1))))
(verdict (task findings)
(puthash task (list "q1" "WORKING" file writer "TODO" "w::auditor" nil)
konix/agent-shell-workspace--gates)
(konix/mcp-server--gate-verdict
task (json-encode `((verdict . "NEEDS-WORK") (findings . ,findings))))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (_writer text &rest _) (setq told text)))
((symbol-function 'plz)
(lambda (method url &rest args)
(when (eq method 'post)
(push (list url (plist-get args :body)) posts)
`((id . ,(cl-incf seq)))))))
(list (progn (verdict 1 ["a long prose"])
(list (state) (length posts) told (quoted)))
(progn (konix/mcp-server--gate-verdict
11 (json-encode '((verdict . "NEEDS-WORK")
(findings . ["a long prose"]))))
(list (state) (and told t)
(and (string-search " a long prose\n" (or (quoted) "")) t)))
(progn (verdict 2 [((what . "the plan lies")
(passage . "« ship it »")
(rule . "« rule »"))])
(list (and (string-search
(concat " - what :: the plan lies\n"
" - what :: « ship it »\n"
" - rule :: « rule »")
(or (quoted) ""))
t)
(length posts)))
(progn (verdict 3 (vector `((what . ,(make-string 120 ?x))
(passage . "p") (rule . "r"))))
(list (length posts)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file))))
- what
- the check above is right when it reads
(("AWAITING" 1 nil nil) ("TODO" t t) (t 1) (2)). - rule
- the last refusal’s quote stays on the question through the writer’s rewrites,
and the old wording keeps no copy of it.
- why: when not passing the gate, the user wants to see the auditor’s answer in the question.
- what
- refused, then rewritten with a new heading, the question still shows the quote, and the wording kept under it does not.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-quote-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(writer (generate-new-buffer " check-gate-quote-writer")))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* Writer's :writers:\n"
"** AWAITING Ship it?\n :PROPERTIES:\n :ID: q1\n :END:\n - what :: one\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-session-store-get) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(cl-flet ((quoted (start)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(re-search-forward start)
(forward-line 1)
(let ((end (save-excursion (if (re-search-forward "^\\*" nil t)
(point)
(point-max)))))
(and (search-forward "the plan lies" end t) t))))
(rewrite (heading)
(with-current-buffer writer
(konix/mcp-server-set-workspace-question
heading (json-encode ["what :: one"]) nil nil nil nil "refine" "q1")))
(shape ()
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(re-search-forward "#\\+BEGIN_QUOTE\n")
(let ((lines (split-string
(buffer-substring
(point) (progn (re-search-forward "^ *#\\+END_QUOTE")
(match-beginning 0)))
"\n" t)))
(list (<= (apply #'max (mapcar #'length lines)) 100)
(> (length lines) 1)
(seq-every-p (lambda (line) (string-prefix-p " " line))
(cdr lines)))))))
(puthash 1 (list "q1" "WORKING" file writer "TODO")
konix/agent-shell-workspace--gates)
(konix/mcp-server--gate-verdict
1 (json-encode
`((verdict . "NEEDS-WORK")
(findings . [((what . "the plan lies")
(passage . ,(mapconcat #'identity (make-list 60 "again") " "))
(rule . "« rule »"))]))))
(list (shape)
(progn (rewrite "Ship it now?") (quoted "^\\*\\* [A-Z]+ Ship it now\\?"))
(quoted "^\\*\\*\\* writer: Ship it\\?"))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
((t t t) t nil): a long finding quoted within 100 columns, its later lines under its « - ». - rule
- each verdict short of a pass is counted on the question, and its keyword
shows the count as « [N] ».
- how: the count is a property, shown by display: the heading’s words stay as written.
- rule: and a rewrite keeps the count.
- what
- two rejects read 2, show « TODO [2] » on the keyword, and a rewrite keeps 2.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-rejects-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(writer (generate-new-buffer " check-gate-rejects-writer")))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* Writer's :writers:\n"
"** AWAITING Ship it?\n :PROPERTIES:\n :ID: q1\n :END:\n - what :: one\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-session-store-get) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(cl-flet ((reject (task)
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id "q1")
(org-todo "AWAITING")))
(puthash task (list "q1" "WORKING" file writer "TODO")
konix/agent-shell-workspace--gates)
(konix/mcp-server--gate-verdict task "{\"verdict\": \"NEEDS-WORK\"}"))
(count ()
(with-current-buffer (find-file-noselect file)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id "q1")
(org-entry-get (point) "AUDIT-REJECTS"))))
(shown ()
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(save-restriction
(widen)
(font-lock-ensure)
(konix/agent-shell-workspace--goto-id "q1")
(get-text-property (+ (point) 3) 'display)))))
(reject 1)
(reject 2)
(list (count)
(and (shown) (substring-no-properties (shown)))
(with-current-buffer writer
(konix/mcp-server-set-workspace-question
"Ship it now?" (json-encode ["what :: one"]) nil nil nil nil "refine" "q1")
(count)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
("2" "TODO [2]" "2"). - what
- a governed close awaits the auditor, posted with the transcript from the writer’s taking up on and nothing before; PASS makes it TOCHECK; a close NEEDS-WORK puts it back WORKING, the answer quoted.
(require 'cl-lib)
(let ((file (make-temp-file "check-gate-close-" nil ".ws.org"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(session (make-temp-file "check-gate-close-" nil ".jsonl"))
(writer (generate-new-buffer " check-gate-close-writer"))
(auditor (generate-new-buffer " check-gate-close-auditor"))
(seq 0) posts)
(with-temp-file file
(insert "#+TODO: TODO DISCUSS THINKING REFINE WORKING AWAITING TOCHECK | DONE\n"
"* Writer's :writers:\n"
"** WORKING Fix the tilt?\n :PROPERTIES:\n :ID: q5\n :END:\n"
" - what :: it tilts\n"
"** WORKING Fix the wobble?\n :PROPERTIES:\n :ID: q6\n :END:\n"
" - what :: it wobbles\n"))
(with-temp-file session
(dolist (entry `(((type . "assistant")
(message (role . "assistant")
(content . [((type . "text") (text . "long before"))])))
((type . "assistant")
(message (role . "assistant")
(content . [((type . "tool_use")
(name . "mcp__ws__set_workspace_state")
(input (id . "q5") (act . "work")))])))
((type . "assistant")
(message (role . "assistant")
(content . [((type . "text") (text . "levelled it"))])))
((type . "assistant")
(message (role . "assistant")
(content . [((type . "tool_use")
(name . "mcp__ws__set_workspace_state")
(input (id . "q6") (act . "work")))])))))
(insert (json-encode entry) "\n")))
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w")
(setq-local konix/agent-shell--governing-note "/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(cl-labels ((state (what)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(and (re-search-forward (format "^\\*\\* \\([A-Z]+\\) %s" what) nil t)
(match-string 1))))
(close (id what)
(konix/mcp-server-set-workspace-question
what (json-encode ["proof :: the level reads 0"])
nil nil nil nil "close" id)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (&rest _) session))
((symbol-function 'konix/agent-shell--shell-session-id) (lambda (&rest _) nil))
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'plz)
(lambda (method url &rest args)
(if (eq method 'post)
(progn (push (list url (plist-get args :body)) posts)
`((id . ,(cl-incf seq))))
'((w::auditor (status . "idle")))))))
(with-current-buffer writer
(append
(progn (close "q5" "Levelled the tilt")
(let ((body (or (cadr (car posts)) "")))
(list (state "Levelled")
(length posts)
(and (string-search "levelled it" body) t)
(and (string-search "long before" body) t))))
(progn (konix/mcp-server--gate-verdict 1 "{\"verdict\": \"PASS\", \"findings\": []}")
(list (state "Levelled")))
(progn (close "q6" "Steadied the wobble")
(konix/mcp-server--gate-verdict
2 "{\"verdict\": \"NEEDS-WORK\", \"findings\": [{\"what\": \"no level shown\", \"passage\": \"\", \"rule\": \"\"}]}")
(list (state "Steadied")
(with-temp-buffer
(insert-file-contents file)
(and (search-forward "no level shown" nil t) t)))))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer auditor)
(kill-buffer writer))
(delete-file file)
(delete-file session))))
- what
- the check above is right when it reads
("AWAITING" 1 t nil "TOCHECK" "WORKING" t). - rule
- every check of this file runs at once, and says which ones read other than
their recorded result.
- how: each check runs without touching its result; what it reads goes through the same table its result is written as, to compare like with like.
- scope: a check is a block named
check-…reading:results value; the pieces other checks put together, worlds and helpers, are not run alone. - rule: and it names each check leaving behind a buffer of its own, a temp
check-…file it visits or acheck-…buffer it made.- why: the user’s Emacs is not a place for the checks to dump their buffers.
- rule: and what it reads is written on one line, a check’s own lines escaped.
- how: a line of a check’s result starting with
*otherwise becomes a heading of this file.
- how: a line of a check’s result starting with
- rule: and it names each check leaving in org-id’s tables an id it put there for a
temp
check-…file.- how: such an entry is saved to the user’s own table when Emacs quits.
(require 'org-id)
(let ((count 0) differ)
(cl-flet ((check-ids ()
(let (found)
(when (hash-table-p org-id-locations)
(maphash (lambda (id file)
(when (string-prefix-p "check-" (file-name-nondirectory file))
(push id found)))
org-id-locations))
found)))
(save-excursion
(dolist (name (org-babel-src-block-names))
(goto-char (org-babel-find-named-block name))
(when (and (string-prefix-p "check-" name) (not (equal name "check-suite"))
(string-search ":results value" (thing-at-point 'line t)))
(let* ((before (buffer-list))
(ids-before (check-ids))
(recorded (save-excursion
(when-let* ((at (org-babel-where-is-src-block-result)))
(goto-char at)
(org-babel-read-result))))
(got (condition-case err
(org-babel-execute-src-block
nil nil '((:results . "silent")))
(error (list 'error (error-message-string err)))))
(read (with-temp-buffer
(org-mode)
(insert "#+begin_src emacs-lisp\n#+end_src\n")
(goto-char (point-min))
(org-babel-insert-result got '("replace" "value"))
(goto-char (point-min))
(goto-char (org-babel-where-is-src-block-result))
(org-babel-read-result)))
(left (seq-filter
(lambda (buffer)
(and (not (memq buffer before))
(string-prefix-p
"check-"
(string-trim-left
(if (buffer-file-name buffer)
(file-name-nondirectory (buffer-file-name buffer))
(buffer-name buffer))))))
(buffer-list)))
(ids-left (seq-difference (check-ids) ids-before)))
(setq count (1+ count))
(unless (equal recorded read)
(push (list name recorded read) differ))
(when left
(push (list name 'left (mapcar #'buffer-name left)) differ))
(when ids-left
(push (list name 'ids-left (length ids-left)) differ)))))))
(let ((print-escape-newlines t))
(prin1-to-string (list count (length differ) (nreverse differ)))))
(defvar konix/agent-shell-workspace--gates (make-hash-table :test #'eql)
"For each coord task an auditor gates a question by, (ID KEYWORD FILE WRITER WAS AUDITOR RESENT).")
(defconst konix/agent-shell-workspace-auditing-said "auditing"
"What the line of a question its auditor has yet to pass opens on.")
(defconst konix/agent-shell-workspace-rejects-property "AUDIT-REJECTS"
"Property counting the verdicts short of a pass a question drew.")
(defun konix/agent-shell-workspace--rejects-matcher (limit)
"Find the next keyword, before LIMIT, of a question its auditor rejected."
(let (found)
(while (and (not found)
(re-search-forward
(concat (konix/agent-shell-workspace--heading-re) "\\([A-Z]+\\) ")
limit t))
(when (save-match-data
(org-entry-get (match-beginning 0)
konix/agent-shell-workspace-rejects-property))
(setq found t)))
found))
(defun konix/agent-shell-workspace--rejects-shown ()
"Return the face and display showing the keyword just matched with its count."
(let ((keyword (match-string 1)))
(list 'face nil
'display (concat (propertize keyword 'face (org-get-todo-face keyword))
" ["
(save-match-data
(org-entry-get (match-beginning 0)
konix/agent-shell-workspace-rejects-property))
"]"))))
(defconst konix/agent-shell-workspace-rejects-font-lock
'((konix/agent-shell-workspace--rejects-matcher
(1 (konix/agent-shell-workspace--rejects-shown) prepend)))
"What shows a rejected question's count after its keyword.")
(defconst konix/agent-shell-workspace-audited-said "audited"
"What the line of a question its auditor gave its verdict on opens on.")
(defconst konix/agent-shell-workspace-no-auditor-error
(concat "A note governs you, so what you take up goes through your auditor first,"
" and you have none: spawn_auditor first, then take it up again.")
"What a governed writer is told when it takes a question up with no auditor standing.")
(defconst konix/agent-shell-workspace-coord-down-error
(concat "coord unreachable or outdated, so your auditor cannot be asked and the"
" question stays as it was: ask the user to restart coord.")
"What a governed writer is told when coord cannot take its take-up to the auditor.")
(defconst konix/agent-shell-workspace-finding-what-most 100
"Characters a finding's what, the line the user reads at a glance, holds at most.")
(defconst konix/agent-shell-workspace-verdict-form
(format (concat "Complete this task with nothing but JSON: {\"verdict\": \"PASS\" or"
" \"NEEDS-WORK\", \"findings\": [{\"what\": \"the flaw in one line under"
" %d characters\", \"passage\": \"where, and the passage word for word\","
" \"rule\": \"the rule it breaks, word for word\"}]}.")
konix/agent-shell-workspace-finding-what-most)
"How the auditor is told to give its verdict.")
(defconst konix/agent-shell-workspace-gate-refine-ask
(concat "The writer answers the user with the question below; its transcript since it"
" took the question up follows it. Audit the answer, and what it rests on,"
" against your note. "
konix/agent-shell-workspace-verdict-form)
"What the auditor is asked about each refine it gates.")
(defconst konix/agent-shell-workspace-gated-refine-said
(concat "Sent your answer to your auditor %s as task #%d: end your turn. Once it passes,"
" the question goes to the user; otherwise its findings come back to you.")
"What a governed writer is told once the question it refined went to its auditor.")
(defconst konix/agent-shell-workspace-gate-dropped-said
(concat "Your auditor did not pass your new question « %s », taken out of the"
" workspace:\n\n%s\n\nAsk it anew with set_workspace_question if it still holds.")
"What a governed writer is told when its auditor did not pass a question it asked anew.")
(defconst konix/agent-shell-workspace-refine-passed-said
"Your auditor passed your answer to %s: it waits on the user."
"What a governed writer is told when its auditor passed what it refined.")
(defconst konix/agent-shell-workspace-gate-close-ask
(concat "The writer closes the question below, saying its work is done; its transcript"
" since it took the question up follows it. Audit the work done and its proofs"
" against your note. "
konix/agent-shell-workspace-verdict-form)
"What the auditor is asked about each close it gates.")
(defconst konix/agent-shell-workspace-gated-close-said
(concat "Sent your close to your auditor %s as task #%d: end your turn. Once it passes,"
" the question goes to the user; otherwise its findings come back to you.")
"What a governed writer is told once the question it closed went to its auditor.")
(defconst konix/agent-shell-workspace-close-passed-said
"Your auditor passed your close of %s: it waits on the user's settling."
"What a governed writer is told when its auditor passed what it closed.")
(defconst konix/agent-shell-workspace-transcript-cut 300
"Chars kept of each tool call, tool output and user text a close is audited on.")
(defconst konix/agent-shell-workspace-gate-resend-ask
(concat "Your verdict on the question below was not the JSON asked, or a finding of it"
" lacked its short what, so it was not read. "
konix/agent-shell-workspace-verdict-form)
"What the auditor is asked when its verdict was not the JSON asked.")
(defconst konix/agent-shell-workspace-gate-failed-said
(concat "Your auditor did not pass the question %s, put back where it was:\n\n%s\n\n"
"Rewrite it with set_workspace_question, act refine, for the user to agree.")
"What a governed writer is told when its auditor did not pass what it took up.")
(defun konix/agent-shell-workspace--gate-of (writer)
"Return the coord name of WRITER's auditor where a note governs WRITER, else nil.
Refuse where a note governs WRITER and no auditor of its stands."
(when (and writer (konix/agent-shell-governing-note writer))
(let ((name (concat (buffer-local-value 'konix/mcp-server--buddy-name writer)
konix/mcp-server--caller-delimiter "auditor")))
(unless (konix/mcp-server--buffer-for-buddy name)
(error "%s" konix/agent-shell-workspace-no-auditor-error))
(unless (konix/agent-shell-workspace--coord-lists-p name)
(error konix/agent-shell-workspace-auditor-unlisted-error name))
name)))
(defconst konix/agent-shell-workspace-auditor-unlisted-error
(concat "Your auditor %s lives, but coord does not list it, so it would never be"
" handed this: refresh it with spawn_auditor, fresh true, then take it up again.")
"What a governed writer is told when it takes a question up for an auditor coord lost.")
(defconst konix/agent-shell-workspace-auditor-lost-said
"lost: %s, unknown to coord, was never handed task #%s"
"What a question freed from an auditor coord does not list says of it.")
(defun konix/agent-shell-workspace--coord-lists-p (name)
"Return t when coord lists NAME, nil when it does not, `down' when it cannot say."
(condition-case nil
(let ((buddies (plz 'get (format "%s/coord/buddies" konix/mcp-server-coord-url)
:as #'json-read :timeout 5)))
(if (assq (intern name) buddies) t nil))
(error 'down)))
(defconst konix/agent-shell-workspace-asked-anew-said "asked anew"
"What the auditing line of a question asked anew, with no state to go back to, ends on.")
(defun konix/agent-shell-workspace--auditing-line (auditor task was)
"The line saying AUDITOR audits the question as TASK, coming from WAS, nil when new."
(format " - %s :: %s, task #%d, %s\n" konix/agent-shell-workspace-auditing-said
auditor task
(if was (concat "from " was) konix/agent-shell-workspace-asked-anew-said)))
(defun konix/agent-shell-workspace--free-stranded (file)
"Put back each question of FILE awaiting an auditor coord does not list.
It goes back where its auditing line says it came from, out when asked anew, and to
TODO when the line says neither."
(let (stranded)
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(while (re-search-forward
(format "^ *- %s :: \\(.+?\\), task #\\([0-9]+\\)\\(?:, \\(?:from \\([A-Z]+\\)\\|\\(%s\\)\\)\\)?$"
(regexp-quote konix/agent-shell-workspace-auditing-said)
(regexp-quote konix/agent-shell-workspace-asked-anew-said))
nil t)
(let ((auditor (match-string 1))
(task (match-string 2))
(back (cond ((match-string 4) 'out)
((match-string 3))
(t konix/agent-shell-workspace-fresh-keyword)))
(under (save-excursion (org-back-to-heading t) (point))))
(save-excursion
(konix/agent-shell-workspace--goto-question)
(when (and (= (point) under)
(equal (org-get-todo-state)
konix/agent-shell-workspace-awaiting-keyword)
(not (konix/agent-shell-workspace--coord-lists-p auditor)))
(push (list (org-entry-get (point) "ID") auditor task back)
stranded)))))))
(when stranded
(konix/agent-shell-workspace--write-file file
(pcase-dolist (`(,id ,auditor ,task ,back) stranded)
(maphash (lambda (old gate)
(when (equal (car gate) id)
(remhash old konix/agent-shell-workspace--gates)))
konix/agent-shell-workspace--gates)
(konix/agent-shell-workspace--goto-id id)
(if (eq back 'out)
(delete-region (point) (save-excursion (org-end-of-subtree t t) (point)))
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-auditing-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match ""))
(konix/agent-shell-workspace--goto-id id)
(org-todo back)
(konix/agent-shell-workspace--goto-id id)
(org-end-of-meta-data)
(insert (format " - %s :: %s\n" konix/agent-shell-workspace-audited-said
(format konix/agent-shell-workspace-auditor-lost-said
auditor task)))))))
(mapcar #'car stranded)))
(defun konix/agent-shell-workspace--post-to-auditor (auditor ask id &optional more)
"Post to AUDITOR the question ID at point's buffer, with ASK, MORE after it.
Return the coord task."
(konix/agent-shell-workspace--goto-id id)
(let* ((text (concat (buffer-substring-no-properties
(point) (konix/agent-shell-workspace--question-end))
(if more (concat "\n" more) "")))
(task (alist-get 'id (condition-case nil
(plz 'post (format "%s/coord/tasks/%s"
konix/mcp-server-coord-url
(url-hexify-string auditor))
:headers '(("Content-Type" . "application/json"))
:body (json-encode
`((description . ,ask)
(context . ,text)))
:as #'json-read :timeout 5)
(error
(error "%s" konix/agent-shell-workspace-coord-down-error))))))
(unless (integerp task)
(error "coord took no task for %s" auditor))
task))
(defun konix/agent-shell-workspace--send-to-gate
(id auditor writer file keyword was &optional transcript)
"Post the question ID of FILE, which WRITER takes up, to AUDITOR, leaving it awaiting.
It goes to KEYWORD once passed, back to WAS otherwise. A close goes with TRANSCRIPT.
Return the coord task it went as."
(let ((task (konix/agent-shell-workspace--post-to-auditor
auditor
(if (equal keyword konix/agent-shell-workspace-closing-keyword)
konix/agent-shell-workspace-gate-close-ask
konix/agent-shell-workspace-gate-refine-ask)
id transcript)))
(maphash (lambda (old gate)
(when (equal (car gate) id)
(remhash old konix/agent-shell-workspace--gates)))
konix/agent-shell-workspace--gates)
(org-todo konix/agent-shell-workspace-awaiting-keyword)
(konix/agent-shell-workspace--goto-id id)
(org-end-of-meta-data)
(insert (konix/agent-shell-workspace--auditing-line auditor task was))
(puthash task (list id keyword file writer was auditor nil)
konix/agent-shell-workspace--gates)
task))
(defun konix/agent-shell-workspace--gated-p (id)
"Non-nil when the question ID awaits its auditor's verdict."
(let (gated)
(maphash (lambda (_task gate) (when (equal (car gate) id) (setq gated t)))
konix/agent-shell-workspace--gates)
gated))
(defun konix/agent-shell-workspace--gated-was (id)
"The state the question ID was in before awaiting its auditor, nil when not awaiting."
(let (was)
(maphash (lambda (_task gate) (when (equal (car gate) id) (setq was (nth 4 gate))))
konix/agent-shell-workspace--gates)
was))
(defun konix/agent-shell-workspace--quote-wrapped (text)
"TEXT as the lines of a quote under a question, filled to 100 columns.
A finding's later lines go under its « - », an indented line's under its first."
(mapconcat
(lambda (line)
(with-temp-buffer
(insert " " line)
(let* ((indent (progn (string-match "\\` *" line) (match-string 0 line)))
(fill-column 100)
(fill-prefix (concat " " indent
(if (string-prefix-p "- " (substring line (length indent)))
" "
"")))
(adaptive-fill-mode nil))
(fill-region (point-min) (point-max)))
(string-trim-right (buffer-string))))
(split-string (string-trim text) "\n")
"\n"))
(defun konix/agent-shell-workspace--transcript-cut (text)
"TEXT, cut past the transcript's length with a mark saying how much went."
(let ((most konix/agent-shell-workspace-transcript-cut))
(if (<= (length text) most)
text
(format "%s […%d chars cut]" (substring text 0 most) (- (length text) most)))))
(defun konix/agent-shell-workspace--transcript-since-work (writer id)
"Return WRITER's transcript from its last taking up of the question ID, or nil."
(when-let* ((session (konix/agent-shell-workspace--session-file-of writer))
((file-readable-p session)))
(with-temp-buffer
(insert-file-contents session)
(goto-char (point-max))
(let (start)
(while (and (not start) (search-backward "set_workspace_state" nil t))
(let ((line (buffer-substring (line-beginning-position) (line-end-position))))
(if (and (string-search "\"tool_use\"" line)
(string-search (format "\"id\":\"%s\"" id) line)
(string-search "\"act\":\"work\"" line))
(setq start (line-beginning-position))
(goto-char (line-beginning-position)))))
(when start
(goto-char start)
(let (sections)
(while (not (eobp))
(let* ((entry (ignore-errors
(json-parse-string
(buffer-substring (point) (line-end-position))
:object-type 'alist :array-type 'list
:null-object nil :false-object nil)))
(message (alist-get 'message entry))
(who (alist-get 'role message))
(content (alist-get 'content message)))
(when (member (alist-get 'type entry) '("user" "assistant"))
(dolist (part (if (stringp content)
(list `((type . "text") (text . ,content)))
content))
(pcase (alist-get 'type part)
("text"
(push (format "## %s\n%s\n" who
(if (equal who "user")
(konix/agent-shell-workspace--transcript-cut
(alist-get 'text part))
(alist-get 'text part)))
sections))
("tool_use"
(push (format "## tool call %s\n%s\n" (alist-get 'name part)
(konix/agent-shell-workspace--transcript-cut
(json-encode (alist-get 'input part))))
sections))
("tool_result"
(let ((output (alist-get 'content part)))
(push (format "## tool output\n%s\n"
(konix/agent-shell-workspace--transcript-cut
(if (stringp output) output (json-encode output))))
sections)))))))
(forward-line 1))
(mapconcat #'identity (nreverse sections) "\n")))))))
(defun konix/agent-shell-workspace--finding-well-formed-p (finding)
"Non-nil when FINDING is a short one-line what with its passage and its rule."
(and (consp finding)
(stringp (alist-get 'what finding))
(stringp (alist-get 'passage finding))
(stringp (alist-get 'rule finding))
(<= (length (alist-get 'what finding)) konix/agent-shell-workspace-finding-what-most)
(not (string-search "\n" (alist-get 'what finding)))))
(defun konix/agent-shell-workspace--finding-said (finding)
"FINDING as the quote says it: its what a bullet, its passage and rule bullets under it."
(if (and (consp finding) (alist-get 'what finding))
(concat (format "- what :: %s" (alist-get 'what finding))
(mapconcat
(lambda (said)
(if-let* ((text (alist-get (cdr said) finding))
((not (string-blank-p (format "%s" text)))))
(format "\n - %s :: %s" (car said)
(replace-regexp-in-string
"\n" " " (string-trim (format "%s" text))))
""))
'(("what" . passage) ("rule" . rule))
""))
(format "%s" finding)))
(defun konix/agent-shell-workspace--verdict-read (verdict)
"Return (PASSED FINDINGS WELL-FORMED) read from the JSON VERDICT, nil when not JSON.
WELL-FORMED is non-nil when each finding is a short what with its proof."
(let ((read (condition-case nil
(json-parse-string (string-trim verdict) :object-type 'alist
:array-type 'list :null-object nil)
(error nil))))
(when (and (consp read) (member (alist-get 'verdict read) '("PASS" "NEEDS-WORK")))
(let ((findings (alist-get 'findings read)))
(list (equal (alist-get 'verdict read) "PASS")
(if (listp findings)
(mapconcat #'konix/agent-shell-workspace--finding-said findings "\n")
(format "%s" findings))
(and (listp findings)
(seq-every-p #'konix/agent-shell-workspace--finding-well-formed-p
findings)))))))
(defun konix/agent-shell-workspace--gate-verdict (task verdict)
"Give the question TASK gated its auditor's VERDICT, telling its writer.
PASS puts it in the state it was asked in; NEEDS-WORK puts it back where it was, the
answer quoted under « audited :: needs work » in place of any earlier quote, or takes
it out of the workspace when it was asked anew, the answer and its heading sent to
the writer. A
VERDICT not the JSON asked, or a finding of it not a short what with its proof, goes
back to the auditor once; the second is NEEDS-WORK when not JSON, else taken as it came.
Nil when TASK gates nothing."
(when-let* ((gate (gethash task konix/agent-shell-workspace--gates)))
(remhash task konix/agent-shell-workspace--gates)
(pcase-let* ((`(,id ,keyword ,file ,writer ,was ,auditor ,resent) gate)
(read (konix/agent-shell-workspace--verdict-read verdict))
(passed (car read)))
(if (and (not (nth 2 read)) (not resent))
(konix/agent-shell-workspace--write-file file
(let ((again (konix/agent-shell-workspace--post-to-auditor
auditor konix/agent-shell-workspace-gate-resend-ask id)))
(puthash again (list id keyword file writer was auditor t)
konix/agent-shell-workspace--gates)
(konix/agent-shell-workspace--goto-id id)
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-auditing-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match (konix/agent-shell-workspace--auditing-line
auditor again was)
t t))))
(if (and (not passed) (null was))
(let (heading)
(konix/agent-shell-workspace--write-file file
(when (konix/agent-shell-workspace--goto-id id)
(setq heading (org-get-heading t t t t))
(delete-region (point) (save-excursion (org-end-of-subtree t t) (point)))))
(when (buffer-live-p writer)
(konix/agent-shell-workspace--submit
writer (format konix/agent-shell-workspace-gate-dropped-said
heading (if read (cadr read) verdict)))))
(progn
(konix/agent-shell-workspace--write-file file
(when (konix/agent-shell-workspace--goto-id id)
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-auditing-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match ""))
(konix/agent-shell-workspace--goto-id id)
(when (equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-awaiting-keyword)
(org-todo (if passed keyword was)))
(unless passed
(konix/agent-shell-workspace--goto-id id)
(org-entry-put (point) konix/agent-shell-workspace-rejects-property
(number-to-string
(1+ (string-to-number
(or (org-entry-get (point)
konix/agent-shell-workspace-rejects-property)
"0"))))))
(konix/agent-shell-workspace--goto-id id)
(org-end-of-meta-data)
(unless passed
(save-excursion
(when (re-search-forward
"^ *#\\+BEGIN_QUOTE\n\\(?:.*\n\\)*? *#\\+END_QUOTE\n"
(save-excursion (outline-next-heading) (point)) t)
(replace-match ""))))
(insert (format " - %s :: %s\n" konix/agent-shell-workspace-audited-said
(if passed "passed" "needs work")))
(unless passed
(insert " #+BEGIN_QUOTE\n"
(konix/agent-shell-workspace--quote-wrapped
(if read (cadr read) verdict))
"\n #+END_QUOTE\n"))))
(when (buffer-live-p writer)
(konix/agent-shell-workspace--submit
writer (if passed
(format (if (equal keyword konix/agent-shell-workspace-closing-keyword)
konix/agent-shell-workspace-close-passed-said
konix/agent-shell-workspace-refine-passed-said)
id)
(format konix/agent-shell-workspace-gate-failed-said id
(if read (cadr read) verdict))))))))
t)))
(add-hook 'konix/mcp-server-gate-verdict-functions
#'konix/agent-shell-workspace--gate-verdict)
(defun konix/agent-shell-workspace-unbind-governing-note ()
"Unbind the governing note of this workspace's writer, and kill its auditor."
(interactive)
(let* ((writer (konix/agent-shell-workspace--target-writer))
(auditor (konix/mcp-server--buffer-for-buddy
(concat (buffer-local-value 'konix/mcp-server--buddy-name writer)
konix/mcp-server--caller-delimiter "auditor"))))
(unless (konix/agent-shell-governing-note writer)
(user-error "No note governs the writer"))
(konix/agent-shell-session-binding-unbind
konix/agent-shell--governing-note-binding writer)
(when auditor
(konix/mcp-server--kill-buffers (list auditor)))
(konix/agent-shell-workspace--submit
writer "The user unbound your governing note: no note governs you now, and your auditor is gone.")
(force-mode-line-update)
(message "Note unbound, its auditor killed")))
(defun konix/agent-shell-workspace-bind-governing-note (note)
"Bind NOTE as the governing note of this workspace's writer, asking it to start its auditor.
With a prefix argument, unbind it instead."
(interactive
(list (unless current-prefix-arg
(read-file-name
"Governing note: " konix/org-agent-shell-note-directory
(konix/agent-shell-governing-note
(konix/agent-shell-workspace--target-writer))
t))))
(if (null note)
(konix/agent-shell-workspace-unbind-governing-note)
(konix/agent-shell-workspace--bind-governing-note note)))
(defun konix/agent-shell-workspace--bind-governing-note (note)
"Bind NOTE as the governing note of this workspace's writer, asking it to start its auditor."
(with-current-buffer (konix/agent-shell-workspace--target-writer)
(konix/agent-shell-bind-governing-note note))
(let ((since (konix/agent-shell-workspace--last-audit-asked)))
(konix/agent-shell-workspace--write
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert (konix/agent-shell-workspace--stars) " "
konix/agent-shell-workspace-fresh-keyword
" Start the auditor of « " (file-name-base note)
" » and audit every change "
(if since (concat "since " since) "in this workspace") "?\n"
" :PROPERTIES:\n :ID: "
(konix/agent-shell-workspace--new-question-id) "\n"
" :AUDIT-ASKED: " (format-time-string "[%Y-%m-%d %a %H:%M]") "\n"
" :END:\n"
" - what :: this note now governs you: send each change to its auditor,"
" and act on its verdict.\n")))
(konix/agent-shell-workspace--context-shown)
(message "« %s » governs the writer, asked to start its auditor" (file-name-base note)))
(defun konix/agent-shell-workspace--last-audit-asked ()
"Return when the latest audit of this workspace was asked, or nil."
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(let (latest)
(while (re-search-forward "^[ \t]*:AUDIT-ASKED: +\\(\\[.*\\]\\)[ \t]*$" nil t)
(let ((stamp (match-string-no-properties 1)))
(when (or (null latest)
(time-less-p (org-time-string-to-time latest)
(org-time-string-to-time stamp)))
(setq latest stamp))))
latest))))
- rule
Zhas the writer compact its conversation, keeping what the whole workspace needs, every one of its questions.- why: past 150k tokens every reply rereads it all, and a cold start resends it all.
- why: the workspace moves forward as a whole, and is kept clean, so none of it is left out.
- rule: and below 150k it asks first, the 1M window being headroom worth keeping.
- how: sent as
/compactwith its own instructions, never wrapped in a briefing, a slash command being read only at the start of what the writer is told.
- what
- compacting at once sends
/compactasking for the whole workspace, after a yes below 150k, and leaves every question as it stood.
(require 'cl-lib)
(let ((file (make-temp-file "check-compact-" nil ".ws.org")) said asked)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"* TODO Ship it :project:\n :PROPERTIES:\n :ID: p0\n :END:\n"
"* TODO Steady :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - for :: [[id:p0][Ship it]]\n"
"* WORKING Fix the tilt?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][Steady]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell--current-shell-or-error)
(lambda () (current-buffer)))
((symbol-function 'yes-or-no-p) (lambda (prompt) (push prompt asked) t)))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(re-search-forward "^\\* WORKING Fix")
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_writer) 300000)))
(konix/agent-shell-workspace-compact))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_writer) 90000)))
(konix/agent-shell-workspace-compact))
(prog1 (list (length said)
(and (string-prefix-p "/compact " (car said))
(string-search "whole workspace" (car said))
(not (string-search "Fix the tilt?" (car said)))
t)
(length asked)
(progn (goto-char (point-min))
(re-search-forward "^\\* \\([A-Z]+\\) Fix")
(match-string 1))
(with-temp-buffer
(insert-file-contents file)
(re-search-forward "^\\* \\([A-Z]+\\) Fix")
(match-string 1)))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(2 t 1 "WORKING" "WORKING"): both sent, asking for the whole workspace and naming no question, only the small one asked about, the question left as it stood in the buffer and on disk. - rule
- and
Zasks the user what else to keep, added to the instructions; nothing said, nothing added.- why: the user knows what matters that the summary may drop.
- what
Zasked to keep « the tilt » says it; asked nothing more, it says no more.
(require 'cl-lib)
(let (said (answer " the tilt "))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_writer) 300000))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t))
((symbol-function 'konix/agent-shell-workspace--work) #'ignore)
((symbol-function 'konix/agent-shell-workspace--forget-session-grants) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'read-string) (lambda (&rest _) answer)))
(with-temp-buffer
(konix/agent-shell-workspace-compact t)
(setq answer "")
(konix/agent-shell-workspace-compact t)
(mapcar (lambda (text) (and (string-suffix-p " Also keep: the tilt" text) t))
(nreverse said)))))
- what
- the check above is right when it reads
(t nil). - rule
- a
#+WORK:line names the file the work lives in, andZandF, which cut the writer’s context, tell it to read that file first.- why: a writer whose context was cut forgets where the work is, and goes looking for it where it may not look.
- scope: only those two, setting it, and the first briefing: a writer that kept its
context, told once, still knows.
- why: a writer newly bound was never told where the work is.
- how:
M-x konix/agent-shell-workspace-set-worksets it, no key of its own, its prompt starting on the work already named.- rule: and tells the writer there and then, at its turn’s end if it is busy.
- why: the user set it and expected the writer to know, which it did not.
- rule: and tells the writer there and then, at its turn’s end if it is busy.
- how:
Zhas the summary end on it, word for word;Ftells the fresh writer ahead of the handover.
(defun konix/agent-shell-workspace--work (file)
"Return the file the workspace FILE says the work lives in, or nil."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--keyword "WORK"))))
(defun konix/agent-shell-workspace--work-said (work)
"Return what a writer whose context was cut is told of WORK, where the work lives."
(format "The work lives in %s: read it first. " work))
(defun konix/agent-shell-workspace-set-work (work)
"Name WORK as the file the work of this workspace lives in."
(interactive
(let ((work (konix/agent-shell-workspace--work buffer-file-name)))
(list (abbreviate-file-name
(expand-file-name
(read-file-name "The work lives in: "
(and work (file-name-directory work))
work t
(and work (file-name-nondirectory work))))))))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-keyword "WORK" work))
(when-let* ((writer (ignore-errors (konix/agent-shell-workspace--target-writer)))
(said (string-trim (konix/agent-shell-workspace--work-said work))))
(if (with-current-buffer writer (shell-maker-busy))
(konix/agent-shell-workspace--say-at-turn-end writer said)
(konix/agent-shell-workspace--say-now writer said)))
(message "The work lives in %s" work))
- rule
- and
Ztakes off the whitelist the writer’s session was granted, the workspace’s own#+WHITELIST:lines put back on at once.- rule: and the grant binding gave the workspace tools is put back with them.
- why: without it, every answer the writer makes stops at a permission dialog.
- why: a session grant was given for what the writer knew then, and compacting takes that away.
- scope: the workspace’s lines say what is safe in this work, whoever runs it, so
they stay;
Fneeds nothing, its fresh session having no grant. - scope: the blacklist stays whole, a refusal being no trust to take back.
- rule: and the grant binding gave the workspace tools is put back with them.
(defun konix/agent-shell-workspace--forget-session-grants (writer)
"Take WRITER's session whitelist off, its workspace's own lines put back."
(with-current-buffer writer
(setq konix/agent-shell-tool-whitelist nil))
(konix/agent-shell-workspace--whitelist-answering-tools writer)
(konix/agent-shell-workspace--install-its-own writer))
- what
Zleaves the session whitelist holding the workspace tools and the workspace’s own line alone.
(require 'cl-lib)
(let ((file (make-temp-file "check-grants-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"#+WHITELIST: ^safe :: kept\n"
"* WORKING Fix the tilt?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(let ((here (current-buffer)))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--say-now) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell--current-shell-or-error)
(lambda () here)))
(setq-local konix/agent-shell-tool-whitelist '(("^granted" . "once")))
(goto-char (point-min))
(re-search-forward "^\\* WORKING Fix")
(konix/agent-shell-workspace--send-compact here)
(prog1 (mapcar #'car konix/agent-shell-tool-whitelist)
(set-buffer-modified-p nil)
(kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
("^safe" konix/agent-shell-workspace--answering-tool-p). - rule
- and a writer told to read the work first is refused refining, closing and
writing a fact until one of its calls has named the work file.
- why: a fresh writer, told « read it first » among the many lines of its briefing, refined three times without opening the work, and the user had to catch it: « it seems like you are proposing stuff without knowing what you are talking about ».
- scope: reading stays free, and so do taking one up and writing a new question: only answering waits.
- how: told at the briefing or by
Z, the writer owes the reading; any call of its naming the work file, its path written out or with~, pays it.- how: the calls are read as they go by, where the steering reads them.
(defvar-local konix/agent-shell-workspace--work-unread nil
"The work file this writer was told to read first and has not read yet.")
(defun konix/agent-shell-workspace--owe-reading (writer work)
"Have WRITER owe the reading of WORK before it may answer."
(when (and work (buffer-live-p writer))
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--work-unread work))))
(defun konix/agent-shell-workspace--reads-work-p (subject work)
"Non-nil when SUBJECT, a call, names WORK, however the path is written."
(and (not (konix/agent-shell-workspace--own-tool-p subject))
(seq-some (lambda (path) (konix/agent-shell-tool-mentions-p subject path))
(delete-dups
(list work (expand-file-name work)
(abbreviate-file-name (expand-file-name work)))))
t))
(defun konix/agent-shell-workspace--note-work-read (subject)
"Pay the reading this writer owes when SUBJECT, a call of its, names the work."
(when (and konix/agent-shell-workspace--work-unread
(konix/agent-shell-workspace--reads-work-p
subject konix/agent-shell-workspace--work-unread))
(setq-local konix/agent-shell-workspace--work-unread nil)))
(defun konix/agent-shell-workspace--refuse-unread-work ()
"Refuse the calling writer's answer while it owes the reading of the work."
(when-let* ((writer (ignore-errors (konix/agent-shell-workspace--writer)))
((buffer-live-p writer))
(work (buffer-local-value 'konix/agent-shell-workspace--work-unread
writer)))
(error (concat "Read the work first: %s. You were told to and have not opened it;"
" what you would answer without it is a guess. Read what bears on"
" the question you hold, then answer.")
work)))
- what
- told the work with its briefing, a writer is refused a fact; a read of
another file changes nothing; a read of the work, written with
~, lets the fact through.
(require 'cl-lib)
(let ((file (make-temp-file "check-work-unread-" nil ".ws.org"))
(writer (generate-new-buffer " check-work-unread-writer"))
(work (abbreviate-file-name
(expand-file-name "check-work-unread-work.org" "~/"))))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS THINKING WORKING | DONE\n"
"#+WORK: " work "\n"
"* Mine :mine:\n"
"** WORKING Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING"))
((symbol-function 'konix/agent-shell-workspace--projects-in) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(cl-flet ((fact ()
(condition-case err
(progn (konix/mcp-server-set-workspace-fact
"It tilts" "[\"what :: found\"]" nil "q")
'written)
(error (if (string-match-p "Read the work first"
(error-message-string err))
'refused
(error-message-string err)))))
(read (path)
(with-current-buffer writer
(funcall (cdr (assoc "workspace-nothing-taken-up"
konix/agent-shell-tool-evaluators))
`((:title . "Read") (:kind . "read")
(:raw-input . ((file_path . ,path))))))))
(konix/agent-shell-workspace--briefing-owed writer "A")
(list (fact)
(progn (read (expand-file-name "other.org" "~/")) (fact))
(progn (read (expand-file-name work)) (fact)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer)))
(kill-buffer writer)
(delete-file file))))
- what
- the check above is right when it reads
(refused refused written). - what
- with a
#+WORK:line,Z’s/compactends on it, and a fresh writer’s handover opens on it; without one, neither says a word of it.
(require 'cl-lib)
(let ((file (make-temp-file "check-work-" nil ".ws.org")) said)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"* WORKING Fix the tilt?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell--current-shell-or-error)
(lambda () (current-buffer))))
(with-current-buffer (find-file-noselect file)
(let ((here (current-buffer)))
(goto-char (point-min))
(re-search-forward "^\\* WORKING Fix")
(konix/agent-shell-workspace--send-compact here)
(konix/agent-shell-workspace--ensure-keyword "WORK" "/x/the-work.org")
(save-buffer)
(goto-char (point-min))
(re-search-forward "^\\* [A-Z]+ Fix")
(konix/agent-shell-workspace--send-compact here)
(prog1 (list (and (not (string-search "the-work" (cadr said))) 'none-without)
(and (string-suffix-p
(konix/agent-shell-workspace--work-said "/x/the-work.org")
(car said))
'compact-ends-on-it)
(and (string-prefix-p
"The work lives in /x/the-work.org"
(konix/agent-shell-workspace--handover-said
"s.md" (konix/agent-shell-workspace--work file)))
'handover-opens-on-it)
(and (not (string-search
"work lives"
(konix/agent-shell-workspace--handover-said "s.md")))
'handover-none-without))
(set-buffer-modified-p nil)
(kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
(none-without compact-ends-on-it handover-opens-on-it handover-none-without). - what
- setting the line tells the writer, word for word what
Zwould.
(require 'cl-lib)
(let ((file (make-temp-file "check-set-work-" nil ".ws.org")) said)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(let ((here (current-buffer)))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () here))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t)))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(konix/agent-shell-workspace-set-work "/x/the-work.org")
(prog1 (list (konix/agent-shell-workspace--work file) said)
(set-buffer-modified-p nil)
(kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
("/x/the-work.org" ("The work lives in /x/the-work.org: read it first.")). - rule
set-work’s prompt starts in the work’s directory, its name typed in.- why: the whole path given as text to start with was read relative to the current
directory:
/:~/perso/perso/roam/~/perso/perso/roam/….
- why: the whole path given as text to start with was read relative to the current
directory:
(require 'cl-lib)
(let ((file (make-temp-file "check-set-work-prompt-" nil ".ws.org")) asked)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"#+WORK: ~/x/the-work.org\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-letf (((symbol-function 'read-file-name)
(lambda (_prompt &rest args) (setq asked args) "/y"))
((symbol-function 'konix/agent-shell-workspace--target-writer)
#'ignore))
(call-interactively #'konix/agent-shell-workspace-set-work)
(prog1 asked
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("~/x/" "~/x/the-work.org" t "the-work.org").
(defconst konix/agent-shell-workspace-compact-worth 150000
"Context, in tokens, below which compacting is asked about first.")
(defconst konix/agent-shell-workspace-compact-said
(concat "/compact Keep what the whole workspace needs, every one of its questions,"
" not the latest alone: for each, the files, the decisions, what is left.")
"What Z has the writer compact on.")
(defun konix/agent-shell-workspace--writer-context (writer)
"Return the tokens WRITER's context holds, or nil before it is known."
(with-current-buffer writer
(map-nested-elt (agent-shell--state) '(:usage :context-used))))
(defun konix/agent-shell-workspace--also-keep ()
"Ask the user what else to keep, nil when they say nothing."
(let ((keep (string-trim (read-string "Also keep (empty for none): "))))
(unless (string-empty-p keep) keep)))
(defun konix/agent-shell-workspace-compact (&optional ask)
"Have the writer compact its conversation, keeping what the whole workspace needs.
ASK, as from the key, asks the user what else to keep."
(interactive (list t))
(let* ((writer (konix/agent-shell-workspace--target-writer))
(context (konix/agent-shell-workspace--writer-context writer)))
(when (or (null context)
(>= context konix/agent-shell-workspace-compact-worth)
(yes-or-no-p (format "Only %dk of context: compact anyway? "
(round context 1000))))
(konix/agent-shell-workspace--send-compact
writer (and ask (konix/agent-shell-workspace--also-keep)))
(message "Asked the writer to compact"))))
(defun konix/agent-shell-workspace--compact-text (file &optional keep)
"Return the /compact the workspace FILE has its writer compact on, KEEP kept too."
(let ((work (konix/agent-shell-workspace--work file)))
(concat
konix/agent-shell-workspace-compact-said
(when keep (concat " Also keep: " keep))
(when-let* ((memos (konix/agent-shell-workspace--memos-said file)))
(concat " Carry these word for word: " memos))
(when work
(concat " End the summary on this, word for word: "
(konix/agent-shell-workspace--work-said work))))))
(defun konix/agent-shell-workspace--send-compact (writer &optional keep)
"Have WRITER compact, keeping what the whole workspace needs, and KEEP, the user's."
(let ((text (konix/agent-shell-workspace--compact-text buffer-file-name keep)))
(konix/agent-shell-workspace--owe-reading
writer (konix/agent-shell-workspace--work buffer-file-name))
(if (with-current-buffer writer (shell-maker-busy))
(konix/agent-shell-workspace--say-at-turn-end writer text)
(konix/agent-shell-workspace--say-now writer text))
(konix/agent-shell-workspace--forget-session-grants writer)))
- rule
Zputs a question first in line rather than compacting at once, and the writer taking it up is what compacts it: its turn is cut there, and/compactsent.- why: waiting for the writer to be idle to press
Zis annoying. - how: the highest priority the file allows, and a property naming what else to keep, which no writer’s tool sets, so that no question a writer writes compacts it.
- how: the question goes as it is taken up, the writer told to end its turn.
- why: once the writer takes the question, it must be interrupted and compact: that is the purpose of taking a question, and it interrupts no other work.
- scope: below 150k it still asks before putting it there.
- scope:
C-uon a subject, andM-x konix/agent-shell-workspace-compact, still compact at once.
- why: waiting for the writer to be idle to press
(defconst konix/agent-shell-workspace-compact-property "COMPACT-REQUEST"
"Property of the question Z puts first in line: what else to keep, or t.")
(defconst konix/agent-shell-workspace-compact-subject "Compact your conversation?"
"What the question Z puts first in line asks.")
(defconst konix/agent-shell-workspace-compact-taken-said
(concat "That one is the user's compact: it is gone, your turn is cut and /compact"
" sent. End your turn now.")
"What a writer taking up Z's question is told.")
(defun konix/agent-shell-workspace-ask-to-compact ()
"Put a question first in line whose taking up has the writer compact.
Below the worth of compacting, ask first; ask what else to keep."
(interactive)
(let* ((writer (konix/agent-shell-workspace--target-writer))
(context (konix/agent-shell-workspace--writer-context writer)))
(when (or (null context)
(>= context konix/agent-shell-workspace-compact-worth)
(yes-or-no-p (format "Only %dk of context: compact anyway? "
(round context 1000))))
(let ((keep (konix/agent-shell-workspace--also-keep)))
(konix/agent-shell-workspace-add-subject
(format "[#%c] %s" org-priority-highest konix/agent-shell-workspace-compact-subject)
(when keep (concat "- what :: also keep: " keep))
nil nil nil nil nil nil nil konix/agent-shell-workspace-fresh-keyword)
(let ((id (konix/agent-shell-workspace--last-question-id buffer-file-name)))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(org-entry-put (point) konix/agent-shell-workspace-compact-property
(or keep "t")))))
(message "Asked the writer to compact once it takes the question up"))))
(defun konix/agent-shell-workspace--compact-request (file id)
"Return what else Z's question ID in FILE keeps, t for nothing, or nil for none such."
(let ((keep (konix/agent-shell-workspace--read-file file
(and (konix/agent-shell-workspace--goto-id id)
(org-entry-get (point)
konix/agent-shell-workspace-compact-property)))))
(cond ((null keep) nil)
((equal keep "t") t)
(t keep))))
(defun konix/agent-shell-workspace--compact-on-take-up (file id writer keep)
"Drop Z's question ID from FILE, then cut WRITER's turn to compact, KEEP kept too."
(let ((text (konix/agent-shell-workspace--compact-text
file (and (stringp keep) keep))))
(konix/agent-shell-workspace--write-file file
(when (konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end))))
(with-current-buffer writer
(setq konix/agent-shell-workspace--quiet t))
(konix/agent-shell-workspace--once-calls-done
writer
(lambda ()
(when (buffer-live-p writer)
(konix/mcp-server--interrupt-and-submit
writer text
(lambda (insert)
(konix/agent-shell-workspace--note-compact
:prompt text :shell-buffer writer)
(funcall insert)))
(konix/agent-shell-workspace--forget-session-grants writer))))
konix/agent-shell-workspace-compact-taken-said))
(defun konix/agent-shell-workspace--once-calls-done (writer function)
"Call FUNCTION once none of WRITER's calls is in flight, or its turn has ended.
At once where none is in flight already."
(if (with-current-buffer writer
(not (konix/agent-shell-workspace--call-in-flight-p)))
(funcall function)
(let (tokens)
(cl-flet ((done ()
(dolist (token tokens)
(agent-shell-unsubscribe :subscription token))
(setq tokens nil)
(funcall function)))
(setq tokens
(list (agent-shell-subscribe-to
:shell-buffer writer :event 'tool-call-update
:on-event (lambda (_event)
(when (and tokens
(buffer-live-p writer)
(with-current-buffer writer
(not (konix/agent-shell-workspace--call-in-flight-p))))
(done))))
(agent-shell-subscribe-to
:shell-buffer writer :event 'turn-complete
:on-event (lambda (_event)
(when tokens (done))))))))))
(defvar-local konix/agent-shell-workspace--quiet nil
"Non-nil while this writer's turn ends add it to no tracking, from Z taken up.
compact-sent once its /compact goes out, compacting once that is submitted; the next
prompt submitted ends it.")
(defun konix/agent-shell-workspace--quiet-on-submit (&rest _)
"Move this shell's quiet on by one prompt submitted: the /compact, then the next."
(setq konix/agent-shell-workspace--quiet
(pcase konix/agent-shell-workspace--quiet
('compact-sent 'compacting)
('compacting nil)
(quiet quiet))))
(advice-add 'shell-maker-submit :before #'konix/agent-shell-workspace--quiet-on-submit)
- what
Zadds the question at the highest priority, keeping what the user typed; taking it up drops it, cuts the writer and sends/compactwith that kept, noted as any/compactis; a question the writer wrote with the same words compacts nothing.
(require 'cl-lib)
(let ((file (make-temp-file "check-Z-asks-" nil ".ws.org"))
(writer (generate-new-buffer " check-Z-asks-writer"))
sent)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n#+PRIORITIES: A Z P\n"
"* TODO Compact your conversation?\n :PROPERTIES:\n :ID: w\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_) 300000))
((symbol-function 'konix/agent-shell-workspace--also-keep)
(lambda () "the probe"))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace-focus-question) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--forget-session-grants)
#'ignore)
((symbol-function 'agent-shell--state) #'ignore)
((symbol-function 'run-at-time)
(lambda (_time _repeat function) (funcall function)))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--context-say) #'ignore)
((symbol-function 'konix/mcp-server--interrupt-and-submit)
(lambda (_buffer text around)
(funcall around (lambda () (push text sent))))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-ask-to-compact)
(let* ((id (konix/agent-shell-workspace--last-question-id file))
(heading (konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id id)
(org-get-heading t t nil t)))
(taken (konix/mcp-server-set-workspace-state id "work"))
(forged (konix/mcp-server-set-workspace-state "w" "work")))
(list heading
(and (string-search "user's compact" forged) t)
(and (string-search "user's compact" taken) t)
(konix/agent-shell-workspace--read-file file
(and (konix/agent-shell-workspace--goto-id id) t))
(length sent)
(and (string-prefix-p "/compact " (car sent))
(string-search "Also keep: the probe" (car sent))
t)
(with-current-buffer writer
(list konix/agent-shell-workspace--compacting
(konix/agent-shell-workspace--spared-p writer)))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
("[#A] Compact your conversation?" nil t nil 1 t (t t)): the writer is marked compacting, and its turn spared. - rule
- the writer taking up
Z’s question gets its answer before its turn is cut: the cut waits for no call of it to be in flight, or for its turn to end.- why: cut while the call is in flight, Claude logs the call as rejected by the user, which the writer reads as the user refusing it.
- what
- with no timer, taking up Z’s question cuts nothing while the call is in
flight, and sends
/compactonce it completes.
(require 'cl-lib)
(let ((file (make-temp-file "check-Z-waits-" nil ".ws.org"))
(writer (generate-new-buffer " check-Z-waits-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers sent)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n#+PRIORITIES: A Z P\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_) 300000))
((symbol-function 'konix/agent-shell-workspace--also-keep) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace-focus-question) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--forget-session-grants)
#'ignore)
((symbol-function 'run-at-time) #'ignore)
((symbol-function 'run-with-timer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--session-file-of)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--context-say) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'konix/mcp-server--interrupt-and-submit)
(lambda (_buffer text around)
(funcall around (lambda () (push text sent))))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-ask-to-compact)
(let ((id (konix/agent-shell-workspace--last-question-id file)))
(with-current-buffer writer
(konix/mcp-server-set-workspace-state id "work"))
(list (length sent)
(progn
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed")
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) 'tool-call-update)
(funcall (cdr handler) nil)))
(length sent))
(length handlers)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(0 1 0): nothing sent while the call is in flight, the/compactonce it completes, no subscription left behind. - rule
Zadds no tracking: neither the end of the turn it cuts nor the end of its/compactturn tracks the shell, nor is it ever untracked.- why: just don’t track the compaction, don’t toggle tracking off.
- how: taking up
Z’s question makes the writer quiet; the/compactgoing out marks it, and the first prompt after it ends the quiet.
- what
- from an untracked shell,
Ztaken up ends the cut turn and the/compactturn with the shell still untracked; the next prompt’s turn tracks it as ever.
(require 'cl-lib)
(let ((file (make-temp-file "check-Z-untracked-" nil ".ws.org"))
(writer (generate-new-buffer " check-Z-untracked-writer"))
tracked)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n#+PRIORITIES: A Z P\n"))
(cl-flet ((turn-ends () (with-current-buffer writer
(konix/shell-maker-finish-output/notify)))
(submits () (with-current-buffer writer
(konix/shell-maker-submit/record-time)
(when (fboundp 'konix/agent-shell-workspace--quiet-on-submit)
(konix/agent-shell-workspace--quiet-on-submit)))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_) 300000))
((symbol-function 'konix/agent-shell-workspace--also-keep) #'ignore)
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace-focus-question) #'ignore)
((symbol-function 'agent-shell--state) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--forget-session-grants)
#'ignore)
((symbol-function 'run-at-time)
(lambda (_time _repeat function) (funcall function)))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--context-say) #'ignore)
((symbol-function 'konix/get-notification-level) #'ignore)
((symbol-function 'konix/shell-maker--idle-since-input-p) #'ignore)
((symbol-function 'tracking-add-buffer)
(lambda (buffer &rest _) (push buffer tracked)))
((symbol-function 'konix/mcp-server--interrupt-and-submit)
(lambda (_buffer _text around)
(turn-ends)
(funcall around #'submits))))
(with-current-buffer writer
(setq-local konix/shell-maker--input-time (current-time)))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-ask-to-compact)
(konix/mcp-server-set-workspace-state
(konix/agent-shell-workspace--last-question-id file) "work")
(turn-ends)
(list (length tracked)
(progn (submits) (turn-ends) (length tracked))
(and (advice-member-p 'konix/agent-shell-workspace--quiet-on-submit
'shell-maker-submit)
t))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file))))
- what
- the check above is right when it reads
(0 1 t): no tracking throughZ, the next turn tracked, the quiet hooked on every prompt sent. - rule
- a subject the user raises with
C-ucompacts; without, it nudges, never asking, whatever the writer holds.- why: a new subject seldom needs the old context, which every reply rereads.
- how: the
/compactofZ, in place of the plain nudge. - why: the question past 150k was asked at every subject, and the user had it gone.
- what
- raising a subject nudges at 300k and at 90k, unasked, and compacts with
C-u, unasked.
(require 'cl-lib)
(let ((file (make-temp-file "check-raisecompacts-" nil ".ws.org"))
done asked answer)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text)
(push (if (string-prefix-p "/compact" text) 'compact text) done) t))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (&rest _) (push 'nudge done) t))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell--current-shell-or-error)
(lambda () (current-buffer)))
((symbol-function 'y-or-n-p)
(lambda (prompt) (push prompt asked) answer)))
(with-current-buffer (find-file-noselect file)
(cl-flet ((raise (context yes prefix heading)
(cl-letf (((symbol-function
'konix/agent-shell-workspace--writer-context)
(lambda (_writer) context)))
(setq answer yes)
(let ((current-prefix-arg prefix))
(konix/agent-shell-workspace-add-subject heading)))))
(raise 300000 t nil "Sub one")
(raise 300000 nil nil "Sub two")
(raise 90000 t nil "Sub three")
(raise 90000 nil '(4) "Sub four"))
(prog1 (list (reverse done) (length asked))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
((nudge nudge nudge compact) 0). - rule
- the workspace’s header line shows its writer’s context alone, « 290k », what
starting it again would resend, set as each of its turns ends.
- rule: and on opening the workspace, from the last reply of the session it names,
before any writer runs.
- why: the user sees what starting the writer costs before starting it.
- rule: and from the last reply the model gave, past those Claude Code makes up
itself, a limit hit or « No response requested. », which record no usage.
- why: a session ending on its weekly limit showed 0k, and the user resumed it at 950k.
- scope: a workspace naming no session has no header line.
- rule: the mode line no longer says it.
- rule: after it comes the model that last real reply ran on, « model? » in red
where none names one.
- why: a writer left on Haiku wrote important files, and nothing showed it.
- rule: and on opening the workspace, from the last reply of the session it names,
before any writer runs.
- what
- a session file’s last real reply gives the context, made-up ones ending it passed, and the header line says it, the mode line not.
(let ((file (make-temp-file "check-context-" nil ".jsonl")))
(with-temp-file file
(insert "{\"message\":{\"usage\":{\"input_tokens\":2,\"cache_creation_input_tokens\":1000,\"cache_read_input_tokens\":5000}}}\n"
"{\"message\":{\"usage\":{\"input_tokens\":3,\"cache_creation_input_tokens\":9000,\"cache_read_input_tokens\":281000}}}\n"
"{\"type\":\"assistant\",\"message\":{\"model\":\"<synthetic>\",\"usage\":{\"input_tokens\":0,\"cache_creation_input_tokens\":0,\"cache_read_input_tokens\":0}},\"isApiErrorMessage\":true}\n"
"{\"type\":\"assistant\",\"message\":{\"model\":\"<synthetic>\",\"usage\":{\"input_tokens\":0}}}\n"
"{\"type\":\"ai-title\",\"aiTitle\":\"x\"}\n"))
(unwind-protect
(with-temp-buffer
(setq-local konix/agent-shell-workspace--context
(konix/agent-shell-workspace--context-in file))
(let ((before header-line-format))
(konix/agent-shell-workspace--context-shown)
(list konix/agent-shell-workspace--context
(format-mode-line header-line-format nil nil (current-buffer))
before
(string-search "290k" (format-mode-line mode-line-misc-info
nil nil (current-buffer))))))
(delete-file file)))
- what
- the check above is right when it reads
(290003 "290k model?" nil nil): its replies are all made up, so none names a model. - rule
- and a /compact after that last reply gives what it left, not the count from
before it.
- why: the stale warning said 260k would be resent when the compacted session held 8k.
- how: its compact_boundary line’s postTokens; a reply after it counts again.
- what
- a session ending on a compaction counts what it left; one replied to since counts that reply.
(let ((file (make-temp-file "check-compacted-" nil ".jsonl"))
(reply "{\"message\":{\"usage\":{\"input_tokens\":2,\"cache_creation_input_tokens\":1000,\"cache_read_input_tokens\":%d}}}\n"))
(unwind-protect
(list (progn
(with-temp-file file
(insert (format reply 259000)
"{\"type\":\"system\",\"subtype\":\"compact_boundary\",\"compactMetadata\":{\"trigger\":\"manual\",\"preTokens\":260432,\"postTokens\":8122}}\n"))
(konix/agent-shell-workspace--context-in file))
(progn
(with-temp-file file
(insert (format reply 259000)
"{\"type\":\"system\",\"subtype\":\"compact_boundary\",\"compactMetadata\":{\"trigger\":\"manual\",\"preTokens\":260432,\"postTokens\":8122}}\n"
(format reply 9000)))
(konix/agent-shell-workspace--context-in file)))
(delete-file file)))
- what
- the check above is right when it reads
(8122 10002). - rule
- and it is coloured by size: green under 150k, orange to 500k, red past it.
- why: 150k is where Claude’s own hints count usage as big; 500k is half the window.
- what
- the three sizes come out in their three colours.
(mapcar (lambda (context)
(with-temp-buffer
(setq-local konix/agent-shell-workspace--context context)
(plist-get (get-text-property
0 'face (konix/agent-shell-workspace--context-header-line))
:foreground)))
'(90000 290000 700000))
- what
- the check above is right when it reads
("green3" "orange" "red3"). - rule
- the header line opens on the writer’s tokens; while a note governs the
writer, it closes on « ⚖ » and that note’s name, in a colour of its own, greyed while
no auditor of the writer’s stands.
- why: the user binds a note with
Nand wants to see at a glance that it took. - why: the user wants the tokens always at the left, where they do not move.
- why: the user binds a note with
- what
- no note shows nothing; a note shows its name in the governed face, and in the shadow face once its auditor is gone, after the tokens and ending the line.
(let ((writer (generate-new-buffer " check-gov-writer"))
(auditor (generate-new-buffer " check-gov-auditor")))
(with-current-buffer writer
(setq-local konix/mcp-server--buddy-name "w"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-session-store-get)
(lambda (&rest _) nil)))
(with-temp-buffer
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(setq-local konix/agent-shell-workspace--context 90000)
(cl-flet ((shown ()
(let ((line (format-mode-line
'(:eval (konix/agent-shell-workspace--header-line))
nil nil (current-buffer))))
(and (string-match "⚖ \\([^ ]+\\)" line)
(list (match-string 1 line)
(get-text-property (match-beginning 1) 'face line)
(string-prefix-p "90k" line)
(string-suffix-p "⚖ the-note" line))))))
(list (shown)
(progn (with-current-buffer writer
(setq-local konix/agent-shell--governing-note
"/tmp/the-note.org"))
(puthash "w::auditor" auditor konix/mcp-server--buddy-buffers)
(shown))
(progn (remhash "w::auditor" konix/mcp-server--buddy-buffers)
(shown))))))
(remhash "w::auditor" konix/mcp-server--buddy-buffers)
(kill-buffer auditor)
(kill-buffer writer)))
- what
- the check above is right when it reads
(nil ("the-note" konix/agent-shell-workspace-governed-face t t) ("the-note" shadow t t)): the twotsay the line opens on the tokens and ends on the note.
(defvar-local konix/agent-shell-workspace--context nil
"Tokens the writer's context last held, or nil when unknown.
compacted once a /compact turn ended, fresh from F until the new writer's first turn ends.")
(put 'konix/agent-shell-workspace--context 'permanent-local t)
(defvar-local konix/agent-shell-workspace--model nil
"Model the writer's last real reply ran on, or nil when unknown.")
(defun konix/agent-shell-workspace--context-header-line ()
"Return what the header line says of the writer's context and model, or nothing."
(when-let* ((context konix/agent-shell-workspace--context))
(if (eq context 'fresh)
(propertize "fresh" 'face '(:foreground "green3"))
(concat
(pcase context
('compacted (propertize "compacted" 'face '(:foreground "green3")))
('compacting (propertize "compacting…" 'face '(:foreground "orange")))
(_
(propertize (format "%dk" (round context 1000))
'face (list :foreground (cond ((< context 150000) "green3")
((< context 500000) "orange")
(t "red3"))))))
" "
(if konix/agent-shell-workspace--model
konix/agent-shell-workspace--model
(propertize "model?" 'face '(:foreground "red3")))
(if-let* ((idle (konix/agent-shell-workspace--idle)))
(propertize (concat " · idle " (konix/agent-shell-workspace--age-said idle))
'face (cond ((konix/agent-shell-workspace--stale-p)
'(:foreground "red3"))
((>= idle (- konix/agent-shell-tokens-cache-lifetime 600))
'(:foreground "orange"))
(t 'konix/agent-shell-workspace-age-face)))
"")))))
(defface konix/agent-shell-workspace-governed-face
'((t :foreground "magenta3" :weight bold))
"Face of the note governing the writer, on the workspace's header line.")
(defvar-local konix/agent-shell-workspace--view-tint nil
"The face remapping tinting this buffer while a view is on.")
(defun konix/agent-shell-workspace--governed-header-line ()
"Return « ⚖ » and the name of the note governing this workspace's writer, or nothing."
(when-let* ((writer (and (buffer-live-p konix/agent-shell-workspace--writer-buffer)
konix/agent-shell-workspace--writer-buffer))
(note (konix/agent-shell-governing-note writer)))
(concat "⚖ "
(propertize (file-name-base note)
'face (if (konix/mcp-server--buffer-for-buddy
(concat (buffer-local-value 'konix/mcp-server--buddy-name
writer)
konix/mcp-server--caller-delimiter "auditor"))
'konix/agent-shell-workspace-governed-face
'shadow)))))
(defun konix/agent-shell-workspace--view-header-line ()
"Return what the header line says of the view on, @'s or /'s, and how to leave it, or nothing."
(when-let* ((said (cond
(konix/agent-shell-workspace--belonging
(save-excursion
(save-restriction
(widen)
(when (konix/agent-shell-workspace--goto-id
konix/agent-shell-workspace--belonging)
(concat "@ " (org-get-heading t t t t))))))
(konix/agent-shell-workspace--view
(concat "/ " konix/agent-shell-workspace--view)))))
(propertize said 'face 'warning)))
(defun konix/agent-shell-workspace--header-line ()
"Return what this workspace's header line says: the context, the governing note, then the view."
(string-join (delq nil (list (konix/agent-shell-workspace--context-header-line)
(konix/agent-shell-workspace--governed-header-line)
(konix/agent-shell-workspace--view-header-line)))
" "))
(defun konix/agent-shell-workspace--turn-ended-in (file)
"Return when FILE, a session's JSONL, was last written to, or nil."
(when (and file (file-readable-p file))
(with-temp-buffer
(let ((size (file-attribute-size (file-attributes file))))
(insert-file-contents file nil (max 0 (- size 1048576)) size))
(goto-char (point-max))
(when (re-search-backward "\"timestamp\":\"\\([^\"]+\\)\"" nil t)
(ignore-errors (parse-iso8601-time-string (match-string 1)))))))
(defun konix/agent-shell-workspace--model-in (file)
"Return the model the last real reply FILE, a session's JSONL, ran on, or nil."
(when (and file (file-readable-p file))
(with-temp-buffer
(let ((size (file-attribute-size (file-attributes file))))
(insert-file-contents file nil (max 0 (- size 1048576)) size))
(goto-char (point-max))
(let (model)
(while (and (not model)
(re-search-backward "\"model\":\"\\([^\"]+\\)\"" nil t))
(unless (equal (match-string 1) "<synthetic>")
(setq model (match-string 1))))
model))))
(defun konix/agent-shell-workspace--context-in (file)
"Return the context the last real reply FILE, a session's JSONL, records, or nil.
Replies Claude Code makes up itself, errors and the like, count nothing and are passed.
A compaction after that reply gives what it left instead."
(when (and file (file-readable-p file))
(with-temp-buffer
(let ((size (file-attribute-size (file-attributes file))))
(insert-file-contents file nil (max 0 (- size 1048576)) size))
(goto-char (point-max))
(let (context)
(while (and (not context)
(re-search-backward "\"usage\":{\\|\"postTokens\":\\([0-9]+\\)" nil t))
(if (match-beginning 1)
(setq context (string-to-number (match-string 1)))
(let* ((usage (buffer-substring-no-properties (point) (line-end-position)))
(sum (apply #'+ (mapcar (lambda (kind)
(if (string-match
(format "\"%s\":\\([0-9]+\\)" kind) usage)
(string-to-number (match-string 1 usage))
0))
'("input_tokens" "cache_creation_input_tokens"
"cache_read_input_tokens")))))
(unless (or (zerop sum)
(string-search "\"model\":\"<synthetic>\""
(buffer-substring-no-properties
(line-beginning-position) (line-end-position))))
(setq context sum)))))
context))))
(defun konix/agent-shell-workspace--context-shown ()
"Have this workspace's header line say the writer's context, once it is known."
(when (local-variable-p 'mode-line-misc-info)
(kill-local-variable 'mode-line-misc-info))
(if (or konix/agent-shell-workspace--belonging konix/agent-shell-workspace--view)
(unless konix/agent-shell-workspace--view-tint
(setq konix/agent-shell-workspace--view-tint
(face-remap-add-relative
'default :background
(apply #'color-rgb-to-hex
(append (color-blend '(0 0 1)
(color-name-to-rgb
(face-background 'default nil t))
0.03)
'(2))))))
(when konix/agent-shell-workspace--view-tint
(face-remap-remove-relative konix/agent-shell-workspace--view-tint)
(setq konix/agent-shell-workspace--view-tint nil)))
(let ((ours '(:eval (konix/agent-shell-workspace--header-line))))
(cond ((or konix/agent-shell-workspace--context
konix/agent-shell-workspace--belonging
konix/agent-shell-workspace--view
(konix/agent-shell-workspace--governed-header-line))
(setq-local header-line-format ours))
((equal header-line-format ours)
(kill-local-variable 'header-line-format)))))
(defun konix/agent-shell-workspace--context-at-open ()
"Show the context of the session this workspace names, read off its file.
Not while F's fresh writer is coming, nor before its first turn ends: the session named
is the one it replaces."
(when-let* (((not (bound-and-true-p konix/agent-shell-workspace--fresh-coming)))
(spec (konix/agent-shell-workspace--named-session-spec)))
(unless (eq konix/agent-shell-workspace--context 'fresh)
(let ((session-file (ignore-errors
(konix/agent-shell--claude-session-file
(car (split-string spec "\\?cwd="))))))
(setq konix/agent-shell-workspace--context
(ignore-errors (konix/agent-shell-workspace--context-in session-file)))
(setq konix/agent-shell-workspace--model
(ignore-errors (konix/agent-shell-workspace--model-in session-file)))
(setq konix/agent-shell-workspace--turn-ended
(ignore-errors (konix/agent-shell-workspace--turn-ended-in session-file)))))
(konix/agent-shell-workspace--context-shown)))
(add-hook 'konix/agent-shell-workspace-mode-hook
#'konix/agent-shell-workspace--context-at-open)
(defun konix/agent-shell-workspace--session-file-of (shell)
"Return the JSONL of SHELL's session, or nil."
(ignore-errors
(konix/agent-shell--claude-session-file
(with-current-buffer shell
(map-nested-elt (agent-shell--state) '(:session :id))))))
(defun konix/agent-shell-workspace--compacted-since-p (compacting)
"Non-nil where COMPACTING, (FILE . SIZE), has its compaction ended in FILE past SIZE.
`compacted' for a compact_boundary, `canceled' for Claude Code saying it canceled it.
t, the file unknown, counts as compacted, as nothing better can be told."
(pcase compacting
(`(,file . ,size)
(when (file-readable-p file)
(let ((now (file-attribute-size (file-attributes file))))
(when (> now size)
(with-temp-buffer
(insert-file-contents-literally file nil size now)
(cond ((search-forward "\"subtype\":\"compact_boundary\"" nil t) 'compacted)
((search-forward "<local-command-stdout>Compaction canceled." nil t)
'canceled)))))))
(_ 'compacted)))
(defun konix/agent-shell-workspace--context-say (shell context)
"Have SHELL's workspace header say CONTEXT, a count or a word."
(when-let* ((file (konix/agent-shell-workspace-file shell))
(workspace (find-buffer-visiting file)))
(with-current-buffer workspace
(setq konix/agent-shell-workspace--context context)
(konix/agent-shell-workspace--context-shown)
(force-mode-line-update))))
(defvar-local konix/agent-shell-workspace--compact-watch nil
"File watch on the session file for the compaction a turn ended before, or nil.")
(defun konix/agent-shell-workspace--watch-compaction (shell)
"Watch SHELL's session file for its compaction done, then say it compacted."
(with-current-buffer shell
(when-let* (((not (and konix/agent-shell-workspace--compact-watch
(ignore-errors
(file-notify-valid-p konix/agent-shell-workspace--compact-watch)))))
(compacting konix/agent-shell-workspace--compacting)
((consp compacting)))
(let (watch)
(setq watch
(file-notify-add-watch
(car compacting) '(change)
(lambda (_event)
(let ((compacting (and (buffer-live-p shell)
(buffer-local-value
'konix/agent-shell-workspace--compacting shell))))
(when (or (not compacting)
(konix/agent-shell-workspace--compacted-since-p compacting))
(file-notify-rm-watch watch)
(when (buffer-live-p shell)
(with-current-buffer shell
(setq konix/agent-shell-workspace--compact-watch nil))
(when compacting
(konix/agent-shell-workspace--context-at-turn-end shell))))))))
(setq konix/agent-shell-workspace--compact-watch watch)))))
(defun konix/agent-shell-workspace--context-at-turn-end (shell)
"Show SHELL's context in its workspace, as its turn ends.
A compacting turn leaves the count it found, so that count is dropped; ended before
its compaction shows in the session file, it says compacting and watches for it."
(when-let* ((file (konix/agent-shell-workspace-file shell))
(workspace (find-buffer-visiting file))
(context (with-current-buffer shell
(pcase (and konix/agent-shell-workspace--compacting
(konix/agent-shell-workspace--compacted-since-p
konix/agent-shell-workspace--compacting))
((guard (not konix/agent-shell-workspace--compacting))
(map-nested-elt (agent-shell--state) '(:usage :context-used)))
('compacted
(setq konix/agent-shell-workspace--compacting nil)
(map-put! (map-elt (agent-shell--state) :usage)
:context-used nil)
'compacted)
('canceled
(setq konix/agent-shell-workspace--compacting nil)
(map-nested-elt (agent-shell--state) '(:usage :context-used)))
(_ (konix/agent-shell-workspace--watch-compaction shell)
'compacting)))))
(let ((model (ignore-errors
(konix/agent-shell-workspace--model-in
(konix/agent-shell--claude-session-file
(with-current-buffer shell
(map-nested-elt (agent-shell--state) '(:session :id))))))))
(with-current-buffer workspace
(setq konix/agent-shell-workspace--context context)
(setq konix/agent-shell-workspace--model model)
(setq konix/agent-shell-workspace--turn-ended (current-time))
(konix/agent-shell-workspace--context-shown)
(force-mode-line-update))
(konix/agent-shell-workspace--tell-held shell))))
- rule
- once a /compact turn ends, the header says « compacted », not the count from
before, until the next turn brings the true one.
- why: a /compact turn sends no new count, so the old one stayed.
- rule
- from the /compact sent until its compact_boundary line is in the session’s
file, the header says « compacting… », a turn ending meanwhile included.
- why: « compacted » showed before the compaction ended, and the user nearly closed the writer, which would have broken it.
- how: the file’s size as /compact is sent; a boundary past it is the compaction done, looked for at each turn end and at each change of the file after one.
- what
- a /compact turn ends on « compacted » and drops the shell’s count; the next turn shows its count again.
(let ((file (make-temp-file "check-compacted-" nil ".ws.org"))
(state (list (cons :usage (list (cons :context-used 290000))))))
(unwind-protect
(cl-letf (((symbol-function 'agent-shell--state) (lambda () state))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--model-in) (lambda (_) "opus")))
(let ((workspace (find-file-noselect file)))
(with-temp-buffer
(let ((shell (current-buffer)))
(konix/agent-shell-workspace--note-compact :prompt "/compact" :shell-buffer shell)
(konix/agent-shell-workspace--context-at-turn-end shell)
(prog1 (list (with-current-buffer workspace
(konix/agent-shell-workspace--context-header-line))
(map-nested-elt state '(:usage :context-used))
(progn (map-put! (map-elt state :usage) :context-used 40000)
(konix/agent-shell-workspace--context-at-turn-end shell)
(with-current-buffer workspace
(konix/agent-shell-workspace--context-header-line))))
(kill-buffer workspace))))))
(delete-file file)))
- what
- the check above is right when it reads
("compacted opus · idle 0m" nil "40k opus · idle 0m"), each turn end stamping the idle. - what
- sent, then a turn ending with no boundary in the session’s file, say « compacting… »; once the boundary is written, « compacted ».
(let ((file (make-temp-file "check-compacting-" nil ".ws.org"))
(jsonl (make-temp-file "check-compacting-" nil ".jsonl" "{\"usage\":{}}\n"))
(state (list (cons :usage (list (cons :context-used 290000))))))
(unwind-protect
(cl-letf (((symbol-function 'agent-shell--state) (lambda () state))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (_) jsonl))
((symbol-function 'konix/agent-shell-workspace--watch-compaction) #'ignore)
((symbol-function 'konix/agent-shell-workspace--model-in) (lambda (_) "opus")))
(let ((workspace (find-file-noselect file))
(said (lambda (workspace)
(with-current-buffer workspace
(car (split-string
(konix/agent-shell-workspace--context-header-line)))))))
(with-temp-buffer
(let ((shell (current-buffer)))
(prog1 (list (progn (konix/agent-shell-workspace--note-compact
:prompt "/compact" :shell-buffer shell)
(funcall said workspace))
(progn (konix/agent-shell-workspace--context-at-turn-end shell)
(funcall said workspace))
(progn (write-region "{\"type\":\"system\",\"subtype\":\"compact_boundary\"}\n"
nil jsonl t 'quiet)
(konix/agent-shell-workspace--context-at-turn-end shell)
(funcall said workspace))
konix/agent-shell-workspace--compacting)
(kill-buffer workspace))))))
(delete-file file)
(delete-file jsonl)))
- what
- the check above is right when it reads
("compacting…" "compacting…" "compacted" nil). - what
- a turn ended on « compacting… », the boundary written to the session’s file turns it to « compacted » with no turn ending and no timer.
(require 'cl-lib)
(let ((file (make-temp-file "check-compactseen-" nil ".ws.org"))
(jsonl (make-temp-file "check-compactseen-" nil ".jsonl" "{\"usage\":{}}\n"))
(state (list (cons :usage (list (cons :context-used 290000)))))
watched)
(unwind-protect
(cl-letf (((symbol-function 'agent-shell--state) (lambda () state))
((symbol-function 'file-notify-add-watch)
(lambda (file _flags callback) (setq watched (cons file callback)) 'w))
((symbol-function 'file-notify-rm-watch) #'ignore)
((symbol-function 'run-with-timer) #'ignore)
((symbol-function 'run-at-time) #'ignore)
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (_) jsonl))
((symbol-function 'konix/agent-shell-workspace--model-in) (lambda (_) "opus")))
(let ((workspace (find-file-noselect file))
(said (lambda (workspace)
(with-current-buffer workspace
(car (split-string
(konix/agent-shell-workspace--context-header-line)))))))
(with-temp-buffer
(let ((shell (current-buffer)))
(konix/agent-shell-workspace--note-compact :prompt "/compact" :shell-buffer shell)
(konix/agent-shell-workspace--context-at-turn-end shell)
(prog1 (list (funcall said workspace)
(progn (write-region
"{\"type\":\"system\",\"subtype\":\"compact_boundary\"}\n"
nil jsonl t 'quiet)
(cl-loop repeat 50
until (equal (funcall said workspace) "compacted")
do (when (equal (car watched) jsonl)
(funcall (cdr watched) nil)))
(funcall said workspace)))
(when (bound-and-true-p konix/agent-shell-workspace--compact-watch)
(ignore-errors
(file-notify-rm-watch konix/agent-shell-workspace--compact-watch)))
(kill-buffer workspace))))))
(delete-file file)
(delete-file jsonl)))
- what
- the check above is right when it reads
("compacting…" "compacted"). - rule
- a compaction Claude Code cancels ends the « compacting… » too, the count
from before shown again.
- why: canceled, it writes no boundary, only « Compaction canceled. », and the header said « compacting… » for good.
- scope: and a watch left from an older load of this file, a timer, is no watch.
- why: it stood in the place of the file watch and nothing looked any more.
- what
- a turn ended on « compacting… » over a timer left from before, the cancellation written to the session’s file brings the count back.
(require 'cl-lib)
(let ((file (make-temp-file "check-compactcancel-" nil ".ws.org"))
(jsonl (make-temp-file "check-compactcancel-" nil ".jsonl" "{\"usage\":{}}\n"))
(state (list (cons :usage (list (cons :context-used 290000)))))
watched)
(unwind-protect
(cl-letf (((symbol-function 'agent-shell--state) (lambda () state))
((symbol-function 'file-notify-add-watch)
(lambda (file _flags callback) (setq watched (cons file callback)) 'w))
((symbol-function 'file-notify-rm-watch) #'ignore)
((symbol-function 'file-notify-valid-p) (lambda (watch) (eq watch 'w)))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (_) jsonl))
((symbol-function 'konix/agent-shell-workspace--model-in) (lambda (_) "opus")))
(let ((workspace (find-file-noselect file))
(said (lambda (workspace)
(with-current-buffer workspace
(car (split-string
(konix/agent-shell-workspace--context-header-line)))))))
(with-temp-buffer
(let ((shell (current-buffer)))
(setq-local konix/agent-shell-workspace--compact-watch (timer-create))
(konix/agent-shell-workspace--note-compact :prompt "/compact" :shell-buffer shell)
(konix/agent-shell-workspace--context-at-turn-end shell)
(prog1 (list (funcall said workspace)
(progn (write-region
(concat "{\"type\":\"system\",\"subtype\":\"local_command\","
"\"content\":\"<local-command-stdout>Compaction canceled."
"</local-command-stdout>\"}\n")
nil jsonl t 'quiet)
(when (equal (car watched) jsonl)
(funcall (cdr watched) nil))
(funcall said workspace))
konix/agent-shell-workspace--compacting)
(kill-buffer workspace))))))
(delete-file file)
(delete-file jsonl)))
- what
- the check above is right when it reads
("compacting…" "290k" nil). - rule
- from F until the new writer’s first turn ends, the header says « fresh », not
the count of the session it replaces.
- why: the writer starts some time after Haiku ends; meanwhile the old count came back.
- how: the context is fresh, kept through a mode re-run, and left alone by the read of the session the workspace still names; a turn end replaces it.
- what
- fresh shows, survives a mode re-run over an old session of 290k, then gives way to the first turn’s count.
(let ((file (make-temp-file "check-fresh-" nil ".ws.org"))
(state (list (cons :usage (list (cons :context-used 40000))))))
(unwind-protect
(cl-letf (((symbol-function 'agent-shell--state) (lambda () state))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--named-session-spec)
(lambda () "old-id?cwd=/tmp/"))
((symbol-function 'konix/agent-shell--claude-session-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--context-in) (lambda (_) 290000))
((symbol-function 'konix/agent-shell-workspace--model-in) (lambda (_) "opus")))
(let ((workspace (find-file-noselect file)))
(with-current-buffer workspace
(setq konix/agent-shell-workspace--context 'fresh)
(konix/agent-shell-workspace--context-shown))
(with-temp-buffer
(let ((shell (current-buffer)))
(prog1 (list (with-current-buffer workspace
(format-mode-line header-line-format nil nil workspace))
(with-current-buffer workspace
(kill-all-local-variables)
(konix/agent-shell-workspace--context-at-open)
(format-mode-line header-line-format nil nil workspace))
(progn (konix/agent-shell-workspace--context-at-turn-end shell)
(with-current-buffer workspace
(format-mode-line header-line-format nil nil workspace))))
(with-current-buffer workspace (set-buffer-modified-p nil))
(kill-buffer workspace))))))
(delete-file file)))
- what
- the check above is right when it reads
("fresh" "fresh" "40k opus · idle 0m").
what the mode carries
- rule
- the mode keeps org from logging a state change here.
- why: the log lands after the keystroke, when the buffer is read-only again, so it errors there rather than where the key ran.
(defun konix/agent-shell-workspace--no-logging ()
"Keep org from logging a state change in this buffer."
(setq-local org-todo-log-states nil))
- rule
- and killing the workspace offers to kill its writer with it, and all the
writer spawned.
- why: the two are done with together, and the writer left behind is a session nobody is reading.
- how: the spawn tree’s own kill of a subtree asks, naming each buffer, as the workspace goes, its kill no longer refusable.
- scope: it only offers, the workspace going whatever the answer is.
- rule
- but a writer holding 150k or more is first asked about: « Sure not to Z
before? », whose
nkeeps the workspace open.- why: past that, what the session knows is worth compacting before it goes.
- how: the bound is Z’s own, below which compacting is asked about.
(defun konix/agent-shell-workspace--maybe-kill-writer ()
"Offer to kill this workspace's writer, and all it spawned, along with it.
A writer holding enough to compact asks first, nil keeping the workspace;
otherwise t whatever the answer, the workspace going either way."
(let* ((writer konix/agent-shell-workspace--writer-buffer)
(context (and (buffer-live-p writer)
(konix/agent-shell-workspace--writer-context writer))))
(if (and (numberp context)
(>= context konix/agent-shell-workspace-compact-worth)
(not (y-or-n-p (format "%dk of context: sure not to Z before? "
(round context 1000)))))
nil
(when (buffer-live-p writer)
(add-hook 'kill-buffer-hook #'konix/agent-shell-workspace--kill-writer-along nil t))
t)))
(defun konix/agent-shell-workspace--kill-writer-along ()
"Offer to kill this workspace's writer, and all it spawned, as the workspace goes."
(let ((writer konix/agent-shell-workspace--writer-buffer))
(when (buffer-live-p writer)
(konix/mcp-server-kill-agent-subtree writer))))
- what
- at 200k, n keeps the workspace, asking nothing more; at 90k, only the kill of the writer’s subtree is offered.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-kill-z-writer")))
(unwind-protect
(mapcar (lambda (context)
(let (asked)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_) context))
((symbol-function 'y-or-n-p)
(lambda (prompt) (push prompt asked) nil))
((symbol-function 'konix/mcp-server-kill-agent-subtree)
(lambda (_) (push "subtree offered" asked))))
(with-temp-buffer
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(list (konix/agent-shell-workspace--maybe-kill-writer)
(progn (run-hooks 'kill-buffer-hook)
(mapcar (lambda (prompt) (car (split-string prompt ":")))
asked)))))))
'(200000 90000))
(kill-buffer writer)))
- what
- the check above is right when it reads
((nil ("200k of context")) (t ("subtree offered"))).- scope: the asking, and the kill, are the spawn tree’s own, not checked here.
- what
- the workspace killed, the kill of its writer’s subtree is offered as it goes, no timer.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-kill-goes-writer"))
offered)
(unwind-protect
(cl-letf (((symbol-function 'run-with-timer) #'ignore)
((symbol-function 'run-at-time) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer-context)
(lambda (_) 90000))
((symbol-function 'konix/mcp-server-kill-agent-subtree)
(lambda (buffer) (setq offered (eq buffer writer)))))
(with-current-buffer (generate-new-buffer " check-kill-goes-workspace")
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(add-hook 'kill-buffer-query-functions
#'konix/agent-shell-workspace--maybe-kill-writer nil t)
(kill-buffer))
offered)
(kill-buffer writer)))
- what
- the check above is right when it reads
t. - rule
- and the other way round the writer killed leaves its workspace standing.
- what
- killing a writer steered to its workspace leaves the workspace open.
(require 'cl-lib)
(let* ((file (make-temp-file "check-killwriter-" nil ".ws.org"))
(workspace (find-file-noselect file))
(shell (generate-new-buffer " check-killwriter-writer")))
(unwind-protect
(progn
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--install-steering)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--install-its-own)
#'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore))
(konix/agent-shell-workspace--steer shell)
(kill-buffer shell))
(sit-for 0.1)
(if (buffer-live-p workspace) 'stays 'killed))
(when (buffer-live-p workspace)
(with-current-buffer workspace
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
stays. - rule
- the workspace keeps no undo.
- why: the user would rather not have it than use a broken feature.
- scope: the workspace alone: the mode turned off, the buffer has its undo back.
- what
- in a workspace, undo records nothing, even after the writer’s rewrite is read back; out of the mode, undo records again.
(let ((file (make-temp-file "check-undo-" nil ".ws.org")))
(with-temp-file file
(insert "* TODO a question\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(with-temp-file file
(insert "* TODO rewritten\n :PROPERTIES:\n :ID: q\n :END:\n"))
(revert-buffer t t t)
(prog1 (list (format "records %S" (not (eq buffer-undo-list t)))
(progn (konix/agent-shell-workspace-mode -1)
(format "off: records %S" (not (eq buffer-undo-list t)))))
(set-buffer-modified-p nil)
(kill-buffer)))
(delete-file file)))
- what
- the check above is right when it reads
records nil, thenoff: records t. - rule
- the workspace’s directory is the writer’s working directory, so a relative
path read in it opens with
find-file.- why: the file sits in
.ws, where no path the writer gives matches. - how: the cwd
#+SESSION:names; failing it, the project root the file is in; failing both, the file’s own directory. - scope: the buffer alone: the file stays where it is, and the mode turned off gives its own directory back.
- why: the file sits in
(defun konix/agent-shell-workspace--root-directory ()
"Make this workspace's directory the one its writer works in."
(when-let* ((root (or (when-let* ((spec (ignore-errors
(konix/agent-shell-workspace--named-session-spec)))
(rest (cadr (split-string spec "\\?cwd="))))
(car (split-string rest "&line=")))
(when-let* ((project (ignore-errors (project-current nil))))
(project-root project))))
((file-directory-p root)))
(setq default-directory (file-name-as-directory (expand-file-name root)))))
- what
- a workspace naming a cwd reads paths from there, and from its own directory once out of the mode.
(let* ((top (make-temp-file "check-root-" t))
(ws (expand-file-name ".ws/" top))
(file (expand-file-name "w.ws.org" ws)))
(make-directory ws)
(with-temp-file file
(insert (format "#+SESSION: [[agent-shell:id?cwd=%s][w]]\n" (file-name-as-directory top))
"#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(prog1 (list (equal default-directory (file-name-as-directory top))
(progn (konix/agent-shell-workspace-mode -1)
(equal default-directory ws)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-directory top t)))
- what
- the check above is right when it reads
(t t). - rule
- a workspace read in another coding than utf-8 is written down in the debug
log, with what read it so.
- why: a buffer read as raw-text showed « as \302\253, the file itself sound.
- rule
- a workspace is saved in utf-8, the raw bytes in it turned back into the
characters they spell first, each run written down in the debug log.
- why: two raw bytes standing for « made every save ask the user for a coding.
(defun konix/agent-shell-workspace--decode-raw-bytes ()
"Turn each run of raw bytes in this workspace into the characters it spells in utf-8.
The buffer is then saved in utf-8."
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t))
(while (re-search-forward "[\200-\377]+" nil t)
(let ((start (match-beginning 0))
(decoded (decode-coding-string (string-to-unibyte (match-string 0)) 'utf-8)))
(konix/agent-shell-workspace--debug
'coding (buffer-name) "raw bytes %S under « %s » by %s, saved as %S"
(match-string-no-properties 0)
(save-excursion (if (org-before-first-heading-p) "no heading"
(org-back-to-heading t) (org-get-heading t t t t)))
this-command decoded)
(delete-region start (point))
(insert decoded)))))
(unless (eq (coding-system-base buffer-file-coding-system) 'utf-8)
(setq buffer-file-coding-system 'utf-8-unix
buffer-file-coding-system-explicit (cons 'utf-8-unix nil))))
(defun konix/agent-shell-workspace--debug-coding ()
"Log this workspace when read in another coding than utf-8, and the calls that read it."
(unless (memq (coding-system-base buffer-file-coding-system) '(utf-8 undecided))
(konix/agent-shell-workspace--debug
'coding (buffer-name) "read as %s by %s, last coding used %s, through %S"
buffer-file-coding-system this-command last-coding-system-used
(seq-take (cdr (memq 'konix/agent-shell-workspace--debug-coding
(seq-filter #'symbolp (mapcar #'cadr (backtrace-frames)))))
15))))
(define-minor-mode konix/agent-shell-workspace-mode
"Walk the questions a writer has put to you.
\\{konix/agent-shell-workspace-mode-map}"
:lighter " Workspace"
:keymap konix/agent-shell-workspace-mode-map
(setq buffer-read-only konix/agent-shell-workspace-mode)
(if konix/agent-shell-workspace-mode
(progn
(setq buffer-undo-list t)
(konix/agent-shell-workspace--closing-into-tocheck-saved)
(konix/agent-shell-workspace--debug-coding)
(konix/agent-shell-workspace--root-directory)
(konix/agent-shell-workspace--no-logging)
(konix/agent-shell-workspace--colour-keywords)
(konix/agent-shell-workspace--show-what-waits)
(konix/agent-shell-workspace--show-ages)
(add-hook 'org-cycle-hook
#'konix/agent-shell-workspace--keep-part-fold nil t)
(add-hook 'before-save-hook
#'konix/agent-shell-workspace--decode-raw-bytes nil t)
(add-hook 'before-revert-hook
#'konix/agent-shell-workspace--note-unfolded nil t)
(add-hook 'after-revert-hook
#'konix/agent-shell-workspace--after-revert nil t)
(add-hook 'kill-buffer-query-functions
#'konix/agent-shell-workspace--maybe-kill-writer nil t)
(add-hook 'window-buffer-change-functions
#'konix/agent-shell-workspace--land-in-window nil t)
(add-hook 'window-selection-change-functions
#'konix/agent-shell-workspace--land-in-window nil t))
(when (eq buffer-undo-list t)
(setq buffer-undo-list nil))
(when buffer-file-name
(setq default-directory (file-name-directory buffer-file-name)))
(remove-hook 'org-cycle-hook
#'konix/agent-shell-workspace--keep-part-fold t)
(remove-hook 'before-save-hook
#'konix/agent-shell-workspace--decode-raw-bytes t)
(remove-hook 'before-revert-hook
#'konix/agent-shell-workspace--note-unfolded t)
(remove-hook 'after-revert-hook
#'konix/agent-shell-workspace--after-revert t)
(remove-hook 'kill-buffer-query-functions
#'konix/agent-shell-workspace--maybe-kill-writer t)
(remove-hook 'window-buffer-change-functions
#'konix/agent-shell-workspace--land-in-window t)
(remove-hook 'window-selection-change-functions
#'konix/agent-shell-workspace--land-in-window t)))
opened by hand or by the writer
- rule
- opening the file by hand gives the same buffer as the writer writing it out does.
- rule
- and a workspace is never the user’s to type in, whatever its name and however
it was opened.
- why: what the user changes there by hand nothing tells the writer about, so it would sit unread.
- how: the claim is made wherever a major mode is settled, not only where a file is
opened, so a mode set again over the top claims it again.
- therefore: a plain revert, which settles the mode afresh and takes every local thing off with it, leaves the buffer read-only all the same.
- scope: it keys on the file saying it is a workspace, so a name of the user’s choosing is claimed as readily as the default one.
- rule: and the session it answers survives that, being marked to outlive a mode.
- why: otherwise the workspace forgets which writer it talks to and asks.
- rule
- and one opened before anything of agent-shell is loaded opens as a workspace
all the same.
- why: the user goes to one straight after starting Emacs, before anything has loaded the module.
- how: a workspace is named
*.ws.org, and that name alone opens it in a function that loads agent-shell, then calls the workspace’s org mode.- why: the name is known before any file is read, where reading the file for what it says of itself needs the module that knows how.
- how: that org mode is autoloaded from the module, so calling it loads the module.
- how: those few lines go to a file of their own, read as Emacs starts, the module itself waiting to be wanted.
- rule: and seeing to the writer, and picking a workspace, are reached from there too, loading the module as they are called.
(defun konix/agent-shell-workspace-org-mode ()
"Org, plus `konix/agent-shell-workspace-mode'.
What a workspace file opens as."
(org-mode)
(konix/agent-shell-workspace-mode 1))
(defun konix/agent-shell-workspace--claim-if-workspace ()
"Turn the workspace mode on where this file says it is one."
(when (and (derived-mode-p 'org-mode)
(not (bound-and-true-p konix/agent-shell-workspace-mode))
(save-excursion
(goto-char (point-min))
(re-search-forward "^#\\+WORKSPACE:" nil t)))
(konix/agent-shell-workspace-mode 1)))
(add-hook 'find-file-hook #'konix/agent-shell-workspace--claim-if-workspace)
(add-hook 'after-change-major-mode-hook
#'konix/agent-shell-workspace--claim-if-workspace)
;;; 990-KONIX_agent-shell-workspace.el --- a workspace opens as one -*- lexical-binding: t; -*-
;;; Commentary:
;; Tangled from an_agent_shell_workspace.org.
;;; Code:
(defun konix/agent-shell-workspace-open ()
"Open this file as a workspace, loading agent-shell, and the module, first."
(require 'agent-shell)
(konix/agent-shell-workspace-org-mode))
(add-to-list 'auto-mode-alist
'("\\.ws\\.org\\'" . konix/agent-shell-workspace-open))
(autoload 'konix/agent-shell-workspace-org-mode
"KONIX_agent-shell-workspace")
(autoload 'konix/agent-shell-workspace-see-to-the-writer
"KONIX_agent-shell-workspace" nil t)
(autoload 'konix/agent-shell-workspace-pick
"KONIX_agent-shell-workspace" nil t)
(keymap-global-set "M-g l p" #'konix/agent-shell-workspace-pick)
(provide '990-KONIX_agent-shell-workspace)
;;; 990-KONIX_agent-shell-workspace.el ends here
- rule
- the mode restores the reading view after a rewrite, rather than leaving it to
the writer’s good manners, the cursor
left where it was.
- how: org reads the file’s keywords again on the way and works the logging out from them, so the logging is switched off once more each time.
(defun konix/agent-shell-workspace--after-revert ()
"Read the file's own keywords again, take the logging back off, restore the view."
(org-set-regexps-and-options)
(konix/agent-shell-workspace-mode 1)
(konix/agent-shell-workspace--no-logging)
(konix/agent-shell-workspace--colour-keywords)
(konix/agent-shell-workspace--focus-standing-still))
stepping from one to the next
- rule
- walking to the next thing passes over whatever is not the user’s — a question
handed back, a fact — and wraps round rather than stopping at the end.
- scope: it puts the one it lands on at the top of the window only where the workspace is on screen, landing in a buffer nothing shows yet being a landing too.
(defun konix/agent-shell-workspace--land-on (position)
"Stand on POSITION, the view settled, and put it at the top of the window."
(goto-char position)
(konix/agent-shell-workspace-focus-question)
(when-let ((window (get-buffer-window (current-buffer))))
(with-selected-window window (recenter 0)))
position)
(defun konix/agent-shell-workspace--facts ()
"Return where each fact begins, in the order they stand in the workspace."
(let (facts)
(save-excursion
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(while (org-at-heading-p)
(when (konix/agent-shell-workspace--fact-at-point-p)
(push (point) facts))
(outline-next-heading)))
(nreverse facts)))
- rule
- the walk goes in the user’s own order: what asks them first, then what waits
on their agreement.
- why: answering is what unblocks the writer, so it comes before agreeing.
- how: within each of the two they stand in the order they stand in the file.
- rule: and what another holds back comes after everything that is free, whatever
its run.
- why: the user is moved on to get on with something, and a held-back one is what they cannot get on with yet.
(defun konix/agent-shell-workspace--waiting-rank ()
"Return where the heading at point comes in the user's own order, or nil."
(let ((state (konix/agent-shell-workspace--state-at-point)))
(cond
((member state (list konix/agent-shell-workspace-refine-keyword
konix/agent-shell-workspace-permission-keyword))
0)
((equal state konix/agent-shell-workspace-closing-keyword) 1))))
(defun konix/agent-shell-workspace--waiting-on-the-user ()
"Return where each heading that is the user's turn begins, in the user's own order."
(let ((questions (konix/agent-shell-workspace--every-question))
found)
(save-excursion
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(while (org-at-heading-p)
(when-let* (((konix/agent-shell-workspace--users-turn-p questions))
(rank (konix/agent-shell-workspace--waiting-rank)))
(push (cons rank (point)) found))
(outline-next-heading)))
(mapcar #'cdr
(sort (nreverse found)
(lambda (a b)
(if (/= (car a) (car b))
(< (car a) (car b))
(< (cdr a) (cdr b))))))))
- how
- a step goes to the next in that order from where the user stands, or the one
before going back, and wraps round.
- therefore: everything that ends on a landing — stepping, answering, settling, dropping an open one — leaves them on whatever waits next in that order.
(defun konix/agent-shell-workspace--goto-waiting (&optional backwards)
"Move to what waits on the user next, wrapping round, and open it.
BACKWARDS looks the other way. Return where it landed, nil where nothing waits."
(let* ((all (konix/agent-shell-workspace--waiting-on-the-user))
(here (save-excursion
(unless (org-before-first-heading-p)
(org-back-to-heading t))
(point)))
(standing (seq-position all here))
(next (cond
((and standing backwards)
(nth (mod (1- standing) (length all)) all))
(standing
(nth (mod (1+ standing) (length all)) all))
(backwards (car (last all)))
(t (car all)))))
(when next
(konix/agent-shell-workspace--land-on next))))
- rule
- and the user puts the headings in the order they want them read,
M-<up>andM-<down>moving the one they stand in past its neighbour.- why: the walk goes down the file within each run, so the order they are in is the order they come up in.
- how: it moves whichever heading the user stands in, from anywhere inside it, as every other key here acts on the one the user stands in.
- scope: it is a change of the user’s own, so it is written and saved the way their every other change is.
(defun konix/agent-shell-workspace-move-up ()
"Move what point stands in up past the heading before it."
(interactive)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-heading)
(org-move-subtree-up)))
(defun konix/agent-shell-workspace-move-down ()
"Move what point stands in down past the heading after it."
(interactive)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-heading)
(org-move-subtree-down)))
(defun konix/agent-shell-workspace-next-question ()
"Move to what waits on the user next, in their own order."
(interactive)
(konix/agent-shell-workspace--goto-waiting))
(defun konix/agent-shell-workspace-previous-question ()
"Move back to what waited on the user before this one, in their own order."
(interactive)
(konix/agent-shell-workspace--goto-waiting t))
- rule
RETopens where the cursor stands: on a line of a block a heading carries, the file at the line that line stands for.- why: reading the code in the question, the user wants the file itself, and the link above the block is not where they are looking.
- how: a hunk says where it starts in its header and counts the way the change counts, a removed line advancing nothing; plain lines carry their own numbering.
- how: the file is the one the place above the block names, so a heading naming several places opens the right one for each.
- scope: anywhere else it follows the link on the line, as
odoes, below a block as much as above it.
- rule
ois bound toorg-open-at-pointitself, with nothing of this note’s in between.- therefore: it follows whatever link the cursor is on — a place, a fact by its id, a note, a page — and on a heading it offers the ones that heading holds.
- therefore: reaching a fact from the question and the question back from the fact is the same key as reaching the code, and no code of this note’s decides any of it.
(defun konix/agent-shell-workspace--place-here ()
"Return (FILE . LINE) for the file line the block line point is on stands for."
(save-excursion
(let ((here (line-beginning-position))
(heading (save-excursion (konix/agent-shell-workspace--goto-heading) (point)))
switches indent body file line)
(when (and (re-search-backward "^\\([ \t]*\\)#\\+begin_src\\([^\n]*\\)$" heading t)
(setq indent (match-string 1)
switches (match-string 2))
(save-excursion
(re-search-forward "^[ \t]*#\\+end_src" nil t)
(> (line-beginning-position) here)))
(setq body (save-excursion (forward-line 1) (point))
file (save-excursion
(when (re-search-backward
konix/agent-shell-workspace-link-regexp nil t)
(match-string 1))))
(cond
((string-match "-n +\\([0-9]+\\)" switches)
(setq line (string-to-number (match-string 1 switches)))
(goto-char body)
(while (< (point) here)
(setq line (1+ line))
(forward-line 1)))
((string-match-p "diff" switches)
(goto-char body)
(when (looking-at (concat "\\(" indent "\\)?"
"@@ -[0-9]+\\(?:,[0-9]+\\)? \\+\\([0-9]+\\)"))
(setq line (string-to-number (match-string 2))
indent (if (match-beginning 1) indent ""))
(forward-line 1)
(while (< (point) here)
(unless (looking-at (concat indent "-"))
(setq line (1+ line)))
(forward-line 1)))))
(when (and file line) (cons file line))))))
(defun konix/agent-shell-workspace-open-at-point ()
"Open where point stands: the file line a block's line stands for, or the link on it."
(interactive)
(if-let ((place (konix/agent-shell-workspace--place-here)))
(let ((buffer (find-file-noselect (car place))))
(pop-to-buffer buffer)
(goto-char (point-min))
(forward-line (1- (cdr place)))
(recenter))
(org-open-at-point)))
which question is next
- rule
- reading past the last question takes the user to whichever writer is waiting next, the way it does in a conversation.
- rule
- and arriving at a workspace lands the user on a question that is theirs,
however they got there.
- why: they come to a workspace for what is theirs in it, so landing anywhere else is landing on the wrong thing.
- scope: the cursor is left alone where it already stands on one of theirs, so coming
back mid-answer picks up where it was.
- scope: and standing above every question is standing in none, so arriving at the top of the file lands all the same.
- how: it hangs off a window coming to show the workspace, or coming to be the one
the user is in — between them, every way of arriving.
- why: hung off the step itself, it moves the cursor before the window does, and the window puts it back where it was.
- why: and a workspace already on screen changes no window’s buffer, so arriving at one is the window being selected and nothing else.
- rule: and a rewrite settling under the user is no arrival, so it lands nobody.
- why: the one they were reading stops being theirs the moment the writer takes it back, and hunting for another then takes the page from under them.
- how: a rewrite says so until the user’s next keystroke, which is what tells a window stirred by the writer from one the user came to.
- rule: and it says which workspace it is settling in, so the others land as ever.
- why: the user keeps several writers at work, and one of them rewriting must not hold every workspace still.
- rule: nor is a prompt opening or closing over it an arrival, as the user asked.
- how: no landing while the prompt holds the selection, nor as the window gets it back from one.
- scope: with nothing of theirs there it moves nothing.
- what
- a window giving the selection to a prompt, then getting it back, leaves the cursor where it was both times.
(require 'cl-lib)
(let ((file (make-temp-file "check-land-" nil ".ws.org")))
(with-temp-file file
(insert "* TODO the writer's\n :PROPERTIES:\n :ID: a\n :END:\n"
"* REFINE the user's?\n :PROPERTIES:\n :ID: b\n :END:\n"))
(unwind-protect
(save-window-excursion
(switch-to-buffer (find-file-noselect file))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace-mode 1)
(setq konix/agent-shell-workspace--settling nil)
(save-restriction (widen) (org-fold-show-all))
(goto-char (point-min))
(re-search-forward "^\\*\\* TODO the writer's")
(let ((window (selected-window)) seen)
(cl-letf (((symbol-function 'selected-window) #'minibuffer-window)
((symbol-function 'old-selected-window) (lambda () window)))
(konix/agent-shell-workspace--land-in-window window))
(push (org-get-heading t t t t) seen)
(goto-char (point-min))
(re-search-forward "^\\*\\* TODO the writer's")
(cl-letf (((symbol-function 'old-selected-window) #'minibuffer-window))
(konix/agent-shell-workspace--land-in-window window))
(push (org-get-heading t t t t) seen)
(prog1 (nreverse seen)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("the writer's" "the writer's"). - rule
- and a window left that is gone since is no prompt, so coming from it lands.
- why: Emacs refuses to ask a deleted window whether it was the minibuffer, and the landing then failed with an error.
(require 'cl-lib)
(let ((file (make-temp-file "check-land-" nil ".ws.org")))
(with-temp-file file
(insert "* TODO the writer's\n :PROPERTIES:\n :ID: a\n :END:\n"
"* REFINE the user's?\n :PROPERTIES:\n :ID: b\n :END:\n"))
(unwind-protect
(save-window-excursion
(switch-to-buffer (find-file-noselect file))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-front-matter))
(konix/agent-shell-workspace-mode 1)
(setq konix/agent-shell-workspace--settling nil)
(save-restriction (widen) (org-fold-show-all))
(goto-char (point-min))
(re-search-forward "^\\*\\* TODO the writer's")
(let ((window (selected-window))
(gone (split-window)))
(delete-window gone)
(prog1 (condition-case err
(progn
(cl-letf (((symbol-function 'old-selected-window)
(lambda () gone)))
(konix/agent-shell-workspace--land-in-window window))
(org-get-heading t t t t))
(error (car err)))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
the user's?.
(defun konix/agent-shell-workspace--land-on-a-users-question (&rest _)
"Put point on a question of the user's, unless it already stands on one."
(when (bound-and-true-p konix/agent-shell-workspace-mode)
(unless (and (not (org-before-first-heading-p))
(save-excursion
(konix/agent-shell-workspace--goto-question)
(and (konix/agent-shell-workspace--state-at-point)
(konix/agent-shell-workspace--users-turn-p))))
(when-let ((first (seq-find
(lambda (at)
(save-excursion
(goto-char at)
(konix/agent-shell-workspace--state-at-point)))
(konix/agent-shell-workspace--waiting-on-the-user))))
(konix/agent-shell-workspace--land-on first)))))
(defvar konix/agent-shell-workspace--settling nil
"The workspace a rewrite is settling in, until the user's next keystroke.")
(defun konix/agent-shell-workspace--settling-now (buffer)
"Say that a rewrite is settling in BUFFER, so no window it stirs is an arrival."
(setq konix/agent-shell-workspace--settling buffer))
(defun konix/agent-shell-workspace--done-settling ()
"Let a window coming to a workspace count as an arrival again."
(setq konix/agent-shell-workspace--settling nil))
(add-hook 'pre-command-hook #'konix/agent-shell-workspace--done-settling)
(defun konix/agent-shell-workspace--land-in-window (window)
"Land on a question of the user's, WINDOW having come to this workspace."
(when (and (not (eq konix/agent-shell-workspace--settling (current-buffer)))
(not (and (window-live-p (old-selected-window))
(window-minibuffer-p (old-selected-window))))
(not (window-minibuffer-p (selected-window)))
(window-live-p window)
(eq (window-buffer window) (current-buffer)))
(with-selected-window window
(konix/agent-shell-workspace--land-on-a-users-question))))
(defun konix/agent-shell-workspace--track-next ()
"Leave the workspace for whichever writer is waiting next."
(when (buffer-live-p konix/agent-shell-workspace--writer-buffer)
(with-current-buffer konix/agent-shell-workspace--writer-buffer
(setq konix/agent-shell--seen t)))
(when (and (not (bound-and-true-p tracking-buffers))
(not (bound-and-true-p tracking-start-buffer)))
(konix/agent-shell-track-ready-buffers t))
(let ((old (current-buffer)))
(tracking-next-buffer)
(bury-buffer (unless (equal (current-buffer) old) old))))
(defun konix/agent-shell-workspace-scroll-or-track ()
"Scroll a page, and past the end move on to the next writer waiting."
(interactive)
(cond
((and (= (window-end) (point-max)) (= (point) (point-max)))
(konix/agent-shell-workspace--track-next))
((= (window-end) (point-max))
(goto-char (point-max)))
(t
(scroll-up-command))))
- rule
- settling one wakes nobody, unless it frees work for a writer that had none.
- why: settling says the user is done reading, which is news to no one, so a writer left alone stays left alone.
- why: but a question held back by that one is free to take up the moment it is settled, and nothing else tells the writer, which would wait for the user’s next word.
- how: what the workspace leaves the writer is weighed before and after, and it is
told only where there was nothing and now there is something.
- therefore: a gesture that frees nothing still wakes nobody, and one that frees several says it once.
(defun konix/agent-shell-workspace--tell-if-freed (had)
"Tell the writer where the workspace holds work of its own and HAD none before."
(when (and (not had)
(konix/agent-shell-workspace--anything-left-p)
(buffer-live-p konix/agent-shell-workspace--writer-buffer))
(konix/agent-shell-workspace--submit
konix/agent-shell-workspace--writer-buffer)))
- rule
- settling a question leaves the user in the part they settled it from.
- rule:
ton one already settled is refused: reopening is answering it, withr, which hands it back.
- rule:
- rule
- and
ton a fact is refused: a fact is never read nor settled.- why: the user dropped facts being read: « why would a fact wait on me? »
- rule
- and
yon a question the writer closed settles it too.- why: the user presses
yto confirm a closing. - scope: on any other question
yanswers it, a settled one handed back.
- why: the user presses
- what
yon a question the writer closed settles it.
(require 'cl-lib)
(let ((file (make-temp-file "check-yclose-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING TOCHECK | DONE\n"
"* TOCHECK Fixed the tilt?\n :PROPERTIES:\n :ID: c\n :END:\n"
" - done :: it holds\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(konix/agent-shell-workspace-mode 1)
(cl-flet ((y-on (id)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id id))
(ignore-errors
(call-interactively
(lookup-key konix/agent-shell-workspace-mode-map "y")))
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id id)
(org-get-todo-state))))
(prog1 (y-on "c")
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
"DONE". - rule
- and settling one folds it away, the walk doing it where there is one of theirs
to walk to and the view being settled where it stands otherwise.
- why: with none of theirs left there is no walk, and the question would stay open under them.
- rule
ton a question asking whether a project is done does whatydoes there: the project settled, the question gone.- why: settling the question alone left the project open, the user’s yes lost.
- what
ton « Is the project done? » settles the project and drops the question.
(require 'cl-lib)
(let ((file (make-temp-file "check-tproject-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING TOCHECK | DONE\n"
"* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* REFINE Is the project done?\n :PROPERTIES:\n :ID: d\n"
" :PROJECT-CHECK: p\n :END:\n - done :: it is\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(konix/agent-shell-workspace-mode 1)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id "d"))
(ignore-errors
(call-interactively
(lookup-key konix/agent-shell-workspace-mode-map "t")))
(prog1 (save-restriction
(widen)
(list (progn (konix/agent-shell-workspace--goto-id "p")
(org-get-todo-state))
(and (konix/agent-shell-workspace--goto-id "d") t)))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("DONE" nil).
(defun konix/agent-shell-workspace--settle-question ()
"Move the question at point to done, refusing one already there."
(when (equal (org-get-todo-state) konix/agent-shell-workspace-done-keyword)
(user-error "Already settled: answer it with r to reopen it"))
(let ((had (konix/agent-shell-workspace--anything-left-p)))
(konix/agent-shell-workspace--write
(org-todo konix/agent-shell-workspace-done-keyword))
(konix/agent-shell-workspace--tell-if-freed had)
(konix/agent-shell-workspace--move-on)))
(defun konix/agent-shell-workspace-done-with-it ()
"Be through with the question point stands in: settle it."
(interactive)
(konix/agent-shell-workspace--goto-question)
(cond
((konix/agent-shell-workspace--fact-at-point-p)
(user-error "A fact is never settled: drop it with k"))
((konix/agent-shell-workspace--project-agreed (org-entry-get (point) "ID"))
(konix/agent-shell-workspace--move-on))
((org-get-todo-state)
(konix/agent-shell-workspace--settle-question))
(t (user-error "This is no question to settle"))))
archiving its thread
- rule
M-x konix/agent-shell-workspace-archivemoves the thread of the question point stands in, its answers, old wordings and links, into a fact of its own; the question keeps its heading, its bullets and one link to that fact.- why: the user’s own: a question drifting over many turns « has become a mess of old links and old answers »; they want it clean, the thread one link away « in case we need it ».
- scope: no key: the user wanted none.
- how: the fact is called « archive of: « <heading> » », and links back to the question as any fact does.
- therefore: what the old links reach stays reached through the archive, the sweep
following a fact’s links; dropping the archive lets
Ktake them. - scope: a question with nothing under it but its bullets and a link to an archive
is refused, there being nothing to archive.
- how: archived again once it drifted further, the old archive’s link goes into the new one with the rest.
(defconst konix/agent-shell-workspace-archive-said "archive of: "
"What a fact archiving a question's thread opens on.")
(defun konix/agent-shell-workspace--archive-heading (heading)
"Return what the fact archiving the thread of the question HEADING is called."
(format "%s« %s »" konix/agent-shell-workspace-archive-said heading))
(defun konix/agent-shell-workspace--take-link-lines (id ids)
"Take out the link lines under question ID linking one of IDS, its body only."
(dolist (there ids)
(konix/agent-shell-workspace--goto-id id)
(let ((limit (save-excursion (outline-next-heading) (point))))
(when (re-search-forward
(format "^ *- [^:\n]+ :: \\[\\[id:%s\\]\\[[^]]*\\]\\]$"
(regexp-quote there))
limit t)
(delete-region (line-beginning-position)
(min (point-max) (1+ (line-end-position))))))))
(defun konix/agent-shell-workspace-archive ()
"Move the thread of the question point stands in into a fact of its own.
Its answers, old wordings and links go there; the question keeps its heading, its
bullets and one link to that fact."
(interactive)
(konix/agent-shell-workspace--goto-question)
(when (konix/agent-shell-workspace--fact-at-point-p)
(user-error "A fact has no thread to archive"))
(unless (org-get-todo-state)
(user-error "This is no question"))
(let* ((id (or (org-entry-get (point) "ID")
(user-error "This question has no id")))
(heading (string-trim (org-get-heading t t t t)))
(limit (konix/agent-shell-workspace--question-end))
(answers (konix/agent-shell-workspace--answers-under (point) limit))
(links (konix/agent-shell-workspace--links-under (point) limit))
(fact (org-id-new))
(label (konix/agent-shell-workspace--archive-heading heading)))
(unless (or answers
(seq-remove (lambda (link)
(string-prefix-p
konix/agent-shell-workspace-archive-said (cadr link)))
links))
(user-error "Nothing to archive under this question"))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(let ((end (konix/agent-shell-workspace--question-end)))
(forward-line 1)
(when (re-search-forward (konix/agent-shell-workspace--heading-re 1) end t)
(delete-region (match-beginning 0) end)))
(konix/agent-shell-workspace--take-link-lines id (mapcar #'car links))
(konix/agent-shell-workspace--put-fact
nil
(concat "** " label "\n"
" :PROPERTIES:\n :ID: " fact "\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(mapconcat (lambda (link)
(format " - %s :: [[id:%s][%s]]\n"
konix/agent-shell-workspace-link-said
(car link) (cadr link)))
links "")
(if answers
(if (string-suffix-p "\n" answers) answers (concat answers "\n"))
"")))
(konix/agent-shell-workspace--link-both id fact label))
(message "Archived into « %s »" label)))
- what
- archived, a question keeps its bullet and one link, to the archive; the archive holds the old link and both turns; the fact the old link reached is still reached; a second archive on the bare question is refused.
(let ((file (make-temp-file "check-archive-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS THINKING WORKING | DONE\n"
"* Facts :facts:\n"
"** It tilts\n :PROPERTIES:\n :ID: f\n :END:\n"
"* Mine :mine:\n"
"** REFINE Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - link :: [[id:f][It tilts]]\n"
" - how :: level it\n"
"*** writer: Look at it?\n :PROPERTIES:\n :ID: w\n :END:\n"
"*** me: go on\n :PROPERTIES:\n :ID: m\n :END:\n"))
(let ((buffer (find-file-noselect file)))
(unwind-protect
(with-current-buffer buffer
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Fix")
(konix/agent-shell-workspace-archive)
(konix/agent-shell-workspace--goto-id "q")
(let* ((end (konix/agent-shell-workspace--question-end))
(body (buffer-substring-no-properties (point) end))
(archive (save-excursion
(goto-char (point-min))
(re-search-forward "^\\*\\* archive of: « Fix it\\? »")
(buffer-substring-no-properties
(line-beginning-position)
(konix/agent-shell-workspace--fact-end)))))
(list (mapcar #'cadr (konix/agent-shell-workspace--links-under (point) end))
(and (string-search "- how :: level it" body)
(not (string-search "*** " body)) 'bullet-kept-turns-gone)
(and (string-search "[[id:f][It tilts]]" archive)
(string-search "*** writer: Look at it?" archive)
(string-search "*** me: go on" archive)
(string-search "[[id:q][Fix it?]]" archive) 'archive-whole)
(konix/agent-shell-workspace--unlinked-facts)
(condition-case err
(progn (konix/agent-shell-workspace-archive) 'archived-again)
(user-error (error-message-string err))))))
(with-current-buffer buffer (set-buffer-modified-p nil))
(let ((kill-buffer-query-functions nil)) (kill-buffer buffer))
(delete-file file))))
- what
- the check above is right when it reads
(("archive of: « Fix it? »") bullet-kept-turns-gone archive-whole nil "Nothing to archive under this question").
dropping one
- rule
- two keys take away what the user stands in — a question, a fact, or an answer
of the user’s.
- scope: the question that answer sat under keeps its state, its turn unchanged by the answer going.
- rule: either of them takes a question whatever state it stands in.
- rule: and a question dropped takes its run with it: killed where it goes, taken
out of the queue where it waits.
- why: a run nobody awaits any more still holds its room, and the queued ones behind it never start.
- how
- the waking says what changed, in words the key that woke it sets, an interruption on its own telling the writer nothing.
- how
- the cursor then stands on the heading below the one taken away, as every write
leaves it, else above, else on its part’s heading.
- why: settled ones are dropped in a run, and the next one to drop is right there.
- therefore
- taking away and waking are one gesture, and a key that took only part of it would leave the user somewhere no key leaves them.
(defun konix/agent-shell-workspace--stop-run (id)
"Kill the run the question ID awaits, or take it out of the queue it waits in."
(dolist (process (process-list))
(when (and (process-live-p process)
(equal (process-get process 'konix/agent-shell-workspace-id) id))
(kill-process process)))
(maphash (lambda (file runs)
(puthash file (seq-remove (lambda (run) (equal (car run) id)) runs)
konix/agent-shell-workspace--queued))
konix/agent-shell-workspace--queued))
(defun konix/agent-shell-workspace--take-away (confirm guidance)
"Take away what point stands in, and tell the writer GUIDANCE.
CONFIRM asks the user first. Only a writer working on the question is told."
(when (org-before-first-heading-p)
(user-error "Point stands in no heading, so there is nothing here to drop"))
(konix/agent-shell-workspace--goto-heading)
(let* ((on-answer (equal (org-current-level)
(1+ konix/agent-shell-workspace-question-level)))
(named (org-entry-get (point) "ID"))
(start (point-marker))
(words (org-get-heading t t t t))
(state (save-excursion
(when on-answer (org-up-heading-safe))
(org-get-todo-state)))
(worked-on (konix/agent-shell-workspace--held-state-p state))
(id (unless on-answer named)))
(when (or (not confirm)
(y-or-n-p (format "Drop \"%s\"? " words)))
(konix/agent-shell-workspace--write
(unless (if named
(konix/agent-shell-workspace--goto-id named)
(goto-char start)
(and (org-at-heading-p)
(equal (org-get-heading t t t t) words)))
(user-error "That heading went or was reworded meanwhile, so nothing was dropped"))
(delete-region (point) (if on-answer
(konix/agent-shell-workspace--answer-end)
(konix/agent-shell-workspace--question-end))))
(set-marker start nil)
(when id
(konix/agent-shell-workspace--stop-run id))
(when-let* ((worked-on)
(writer (konix/agent-shell-workspace--target-writer))
(file (konix/agent-shell-workspace-file writer))
((not (konix/agent-shell-workspace--writer-done-p file))))
(konix/agent-shell-workspace--submit writer guidance t)))))
- rule
kis the plain one of the two keys: it drops what the user stands in.- why: after a long working session the user has a bunch of
DONEentries and wants to clean them up. - why: and having sent something they finally want to retract, the user wants to simply remove the entry.
- why: and the user believes a fact is not relevant any more, or was a mistake.
- rule: and above every heading, in the file’s own front matter, it drops nothing.
- why: what the user stands in there is no heading, and the first question is not what the user pointed at.
- rule: it drops at once, asking first only for a question not settled yet,
TODO,REFINE,AWAITINGand the like, naming what it is about to take away.- why: clearing out what is settled is a run of drops, and being asked each time is the keystroke doing nothing.
- why: the user drops with
C-k, never with akasking each time. - rule: and
C-kdrops just askdoes. - rule: and what it drops is the heading it named, found again once the user says
yes, wherever the workspace moved it meanwhile.
- why: the writer rewrites the workspace while the user reads the prompt, so the place the heading stood may hold another entry by then.
- how: found by its id, else where it stood, followed as the text moved.
- scope: one found where it stood is checked by its words too, nothing else saying it is still the one named.
- scope: a heading gone meanwhile, or found where it stood but reworded, is dropped by no one, and the user is told so.
- rule: and
Kdrops what is settled and the facts nothing reaches, all of it, in one go, asking nothing.- why: a run of drops is still a run, and clearing out is one gesture.
- why: what it drops is what the user already settled or never needs again.
- rule: and
C-u Kdeletes every fact instead, at once, asking nothing, then says how many went.
- rule: and it wakes the writer only when it is working on the question, whether
that question went or an answer under it did.
- why: the writer must be woken only when it needs to read the new information.
- why: after a long working session the user has a bunch of
- what
- the drop is checked as the writer meets it: its rewrite lands in the file while the prompt waits, and the workspace reads it back; then which headings are left.
(drop-at (heading change)
(save-restriction (widen) (goto-char (point-min)) (re-search-forward heading))
(cl-letf (((symbol-function 'y-or-n-p)
(lambda (&rest _)
(let ((text (with-temp-buffer (insert-file-contents file)
(funcall change) (buffer-string))))
(with-temp-file file (insert text)))
(revert-buffer t t t)
t)))
(condition-case nil (konix/agent-shell-workspace-drop) (user-error nil))))
(left ()
(string-join (seq-filter (lambda (word)
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*+ .*\\_<" word "\\_>")
nil t)))
'("first" "said" "unnamed" "second" "third" "other"
"meanwhile"))
" "))
(insert "* Writer's :writers:\n"
"** TODO first\n :PROPERTIES:\n :ID: a\n :END:\n"
"*** - me: said\n :PROPERTIES:\n :ID: a1\n :END:\n"
"*** - me: unnamed\n"
"** TODO second\n :PROPERTIES:\n :ID: b\n :END:\n"
"** TODO third\n :PROPERTIES:\n :ID: d\n :END:\n"
"*** - me: other\n")
(require 'cl-lib)
(let ((file (make-temp-file "check-drop-" nil ".ws.org"))
(above (lambda () (goto-char (point-min))
(insert "** TODO meanwhile\n :PROPERTIES:\n :ID: c\n :END:\n")))
(reword (lambda (heading)
(lambda () (goto-char (point-min))
(re-search-forward heading) (insert " reworded"))))
(away (lambda () (goto-char (point-min))
(re-search-forward "^\\*\\* TODO first")
(delete-region (line-beginning-position)
(progn (re-search-forward "^\\*\\* TODO third")
(line-beginning-position))))))
(with-temp-file file
(insert "* Writer's :writers:\n"
"** TODO first\n :PROPERTIES:\n :ID: a\n :END:\n"
"*** - me: said\n :PROPERTIES:\n :ID: a1\n :END:\n"
"*** - me: unnamed\n"
"** TODO second\n :PROPERTIES:\n :ID: b\n :END:\n"
"** TODO third\n :PROPERTIES:\n :ID: d\n :END:\n"
"*** - me: other\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(cl-flet (
(drop-at (heading change)
(save-restriction (widen) (goto-char (point-min)) (re-search-forward heading))
(cl-letf (((symbol-function 'y-or-n-p)
(lambda (&rest _)
(let ((text (with-temp-buffer (insert-file-contents file)
(funcall change) (buffer-string))))
(with-temp-file file (insert text)))
(revert-buffer t t t)
t)))
(condition-case nil (konix/agent-shell-workspace-drop) (user-error nil))))
(left ()
(string-join (seq-filter (lambda (word)
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward (concat "^\\*+ .*\\_<" word "\\_>")
nil t)))
'("first" "said" "unnamed" "second" "third" "other"
"meanwhile"))
" "))
)
(prog1 (list (progn (drop-at "^\\*\\* TODO second" above) (left))
(progn (drop-at "^\\*\\*\\* - me: said" above) (left))
(progn (drop-at "^\\*\\*\\* - me: unnamed" above) (left))
(progn (drop-at "^\\*\\*\\* - me: other"
(funcall reword "^\\*\\*\\* - me: other"))
(left))
(progn (drop-at "^\\*\\* TODO first" away) (left))
(progn (drop-at "^\\*\\* TODO third"
(funcall reword "^\\*\\* TODO third"))
(left)))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when each drop takes the heading named and nothing
else, none going once it is gone, or reworded with no id to find it by:
first said unnamed third other meanwhile,first unnamed third other meanwhile,first third other meanwhile,first third meanwhile,third meanwhile, thenmeanwhile.- scope: the answer
othergoes at once, no prompt asking for it, so nothing rewords it meanwhile.
- scope: the answer
(defconst konix/agent-shell-workspace-dropped-guidance
"What you are working on in the workspace changed under you. Read it back."
"What a writer at work is told when what it is on changed under it.")
(defun konix/agent-shell-workspace--unsettled-question-here-p ()
"Non-nil when point stands on a question, not an answer, that is not settled yet."
(and (not (org-before-first-heading-p))
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(and (equal (org-current-level) konix/agent-shell-workspace-question-level)
(when-let* ((state (org-get-todo-state)))
(not (equal state konix/agent-shell-workspace-done-keyword)))))))
(defun konix/agent-shell-workspace-drop ()
"Drop what point stands in, asking only for a question not settled yet."
(interactive)
(konix/agent-shell-workspace--take-away
(konix/agent-shell-workspace--unsettled-question-here-p)
konix/agent-shell-workspace-dropped-guidance))
- rule
- a plan the user rejects goes whole, with one yes, and the writer finds a subject
telling it so, with the user’s reason.
- why: dropping twenty questions one by one, a yes each, is cumbersome.
- how: a command, no key, it being seldom needed; the plan is the
PLANthe question at point carries.
- what
- rejecting a plan drops every question of its
PLAN, nothing else, and leaves a subject with the reason. - rule
- the subject names the project the plan was for, in its heading and its « for »
line, a plan for none keeping the bare heading.
- why: the steps being gone, nothing else tells the writer what to plan again.
(require 'cl-lib)
(let ((file (make-temp-file "check-rejectplan-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Proj\n :PROPERTIES:\n :ID: p\n :END:\n"
"* TODO First?\n :PROPERTIES:\n :ID: a\n :PLAN: x\n :END:\n"
" - for :: [[id:p][Proj]]\n"
"* TODO Kept?\n :PROPERTIES:\n :ID: k\n :END:\n"
"* TODO Second?\n :PROPERTIES:\n :ID: b\n :PLAN: x\n :END:\n"
" - for :: [[id:p][Proj]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--stop-run) #'ignore))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(search-forward "Second?")
(konix/agent-shell-workspace-reject-plan "too big")
(let (headings)
(org-map-entries (lambda () (push (org-get-heading t t t t) headings)))
(goto-char (point-min))
(search-forward "rejected")
(list (nreverse headings)
(and (string-match-p "too big" (buffer-string)) t)
(and (konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-for-said)
t)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("Proj" "Memos" "Facts" "[0/0] Projects" "[0/0] Review" "[0/0] Mine" "[0/2] Writer's" "Kept?" "The plan for Proj was rejected: plan again?" "[0/0] Later" "[0/0] Done") t t).
(defun konix/agent-shell-workspace-reject-plan (reason &optional plan)
"Drop the whole plan the question at point belongs to, telling the writer REASON.
PLAN, settled as the key was pressed, names it wherever point went since."
(interactive
(let ((plan (konix/agent-shell-workspace--plan-here)))
(list (read-string "Why reject it (optional): ") plan)))
(let* ((plan (or plan (konix/agent-shell-workspace--plan-here)))
(ids (org-map-entries (lambda () (org-entry-get nil "ID"))
(format "PLAN=\"%s\"" plan)))
(project (seq-some (lambda (id)
(save-excursion
(and (konix/agent-shell-workspace--goto-id id)
(car (konix/agent-shell-workspace--named-at-point
konix/agent-shell-workspace-for-said)))))
ids))
(name (and project (konix/agent-shell-workspace--heading-by-id-here project))))
(when (y-or-n-p (format "Reject the %d questions of this plan? " (length ids)))
(konix/agent-shell-workspace--write
(dolist (id ids)
(when (konix/agent-shell-workspace--goto-id id)
(delete-region (point) (konix/agent-shell-workspace--question-end)))))
(mapc #'konix/agent-shell-workspace--stop-run ids)
(konix/agent-shell-workspace-add-subject
(if name
(format "The plan for %s was rejected: plan again?" (string-trim name))
"The plan was rejected: plan again?")
(if (string-empty-p (string-trim reason)) nil (format "- why :: %s" reason))
nil nil nil nil nil nil (and name project)))))
(defun konix/agent-shell-workspace--plan-here ()
"Return the PLAN of the question at point, or refuse where it has none."
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(while (> (org-current-level) konix/agent-shell-workspace-question-level)
(org-up-heading-safe))
(or (org-entry-get (point) "PLAN")
(user-error "This question came from no plan, so there is no plan to reject"))))
(defun konix/agent-shell-workspace--drop-unreached-facts ()
"Drop every fact no question reaches, and return how many went."
(let ((ids (konix/agent-shell-workspace--unlinked-facts)))
(when ids
(konix/agent-shell-workspace--write
(dolist (id ids)
(when (konix/agent-shell-workspace--goto-id id)
(delete-region (point)
(konix/agent-shell-workspace--fact-end))))))
(length ids)))
(defun konix/agent-shell-workspace--settled-questions ()
"Return where each question the user has settled begins."
(let (found)
(save-excursion
(goto-char (point-min))
(while (konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-settled-regexp)
(push (match-beginning 0) found)))
found))
(defun konix/agent-shell-workspace-clean (&optional all-facts)
"Drop what is settled: see `konix/agent-shell-workspace--clean-settled'.
With ALL-FACTS, the prefix argument, delete every fact instead, asking nothing."
(interactive "P")
(if all-facts
(konix/agent-shell-workspace--delete-facts-where #'ignore "facts" t)
(konix/agent-shell-workspace--clean-settled)))
(defun konix/agent-shell-workspace--clean-settled ()
"Drop every question the user has settled, and every fact nothing reaches."
(let ((settled (length (konix/agent-shell-workspace--settled-questions)))
(orphans (length (konix/agent-shell-workspace--unlinked-facts))))
(if (zerop (+ settled orphans))
(message "Nothing to clean: none settled, and every fact is reached")
(konix/agent-shell-workspace--write
(dolist (where (konix/agent-shell-workspace--settled-questions))
(goto-char where)
(delete-region (point)
(konix/agent-shell-workspace--question-end))))
(let ((gone (konix/agent-shell-workspace--drop-unreached-facts)))
(message "%d settled and %d fact%s gone"
settled gone (if (= gone 1) "" "s"))))))
- rule
- a command deletes every fact whole, whatever links to them.
- how: it says how many it is about to delete and asks first.
- what: a question linking a deleted fact keeps a link leading nowhere.
(defun konix/agent-shell-workspace--delete-facts-where (keep-p what &optional no-ask)
"Delete every fact but those KEEP-P says to keep, calling them WHAT.
Ask first, unless NO-ASK."
(cl-flet ((facts () (seq-remove (lambda (where)
(save-excursion (goto-char where) (funcall keep-p)))
(konix/agent-shell-workspace--facts))))
(let ((count (length (facts))))
(if (zerop count)
(message "No %s to delete" what)
(when (or no-ask
(y-or-n-p (format "Delete the %d %s? " count what)))
(konix/agent-shell-workspace--write
;; Found again here: the write may have moved them, nesting the file.
(dolist (where (reverse (facts)))
(goto-char where)
(delete-region (point) (konix/agent-shell-workspace--fact-end))))
(message "%d %s deleted" count what))))))
(defun konix/agent-shell-workspace-delete-facts ()
"Delete every fact of the workspace, once asked."
(interactive)
(konix/agent-shell-workspace--delete-facts-where #'ignore "facts"))
- what
- with two facts, deleting them all leaves none.
(require 'cl-lib)
(let ((file (make-temp-file "check-delete-facts-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO Kept?\n :PROPERTIES:\n :ID: q\n :END:\n"
"* One\n :PROPERTIES:\n :ID: f1\n :END:\n"
"* Another\n :PROPERTIES:\n :ID: f2\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-delete-facts)
(let (found)
(org-map-entries
(lambda () (push (org-get-heading t t t t) found)))
(nreverse found))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("Memos" "Facts" "[0/0] Projects" "[0/0] Review" "[0/0] Mine" "[0/1] Writer's" "Kept?" "[0/0] Later" "[0/0] Done"). - what
C-u Kon two facts leaves the question alone, no prompt raised.
(require 'cl-lib)
(let ((file (make-temp-file "check-prefix-K-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO Kept?\n :PROPERTIES:\n :ID: q\n :END:\n"
"* One\n :PROPERTIES:\n :ID: f1\n :END:\n"
"* Another\n :PROPERTIES:\n :ID: f2\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) (error "Asked")))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(let ((current-prefix-arg '(4)))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "K")))
(let (found)
(org-map-entries (lambda () (push (org-get-heading t t t t) found)))
(nreverse found))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("Memos" "Facts" "[0/0] Projects" "[0/0] Review" "[0/0] Mine" "[0/1] Writer's" "Kept?" "[0/0] Later" "[0/0] Done"). - what
Kkeeps the fact an open question links to, and takes the settled question with its fact.
(require 'cl-lib)
(let ((file (make-temp-file "check-K-settled-" nil ".ws.org")) said)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Kept?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: [[id:f1][Linked one]]\n"
"* Done :done:\n"
"** DONE Settled?\n :PROPERTIES:\n :ID: d\n :END:\n"
" - what :: [[id:f4][Settled's]]\n"
"* Linked one\n :PROPERTIES:\n :ID: f1\n :END:\n"
"* Settled's\n :PROPERTIES:\n :ID: f4\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) (error "Asked")))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(let ((current-prefix-arg nil))
(cl-letf (((symbol-function 'message)
(lambda (format &rest args) (setq said (apply #'format format args)))))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map "K"))))
(let (found)
(org-map-entries (lambda () (push (org-get-heading t t t t) found)))
(list (nreverse found) said))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("Memos" "Facts" "[0/0] Projects" "[0/0] Review" "[0/0] Mine" "[0/1] Writer's" "Kept?" "[0/0] Later" "[0/0] Done" "Linked one") "1 settled and 1 fact gone"), the part headings every write makes standing first.
what the user raises
a heading of the user’s, and what goes under it
- what
- what the user types is a heading, and whatever runs past its first line is
the body under it.
- why: what the user has to say does not always fit the one line a heading allows.
- how: it is one prompt, and the blank lines between the two are trimmed away.
- rule
M-RETstarts the body inside the prompt, andRETsends what was typed.- why: it is the same key everywhere, in an answer as in a subject.
- rule
- a heading with nothing in it is refused.
(defconst konix/agent-shell-workspace-prompt-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map (kbd "M-RET") #'newline)
map)
"Keymap of a workspace prompt, where a second line is reached.")
(defun konix/agent-shell-workspace--read-heading-and-body (prompt &optional initial)
"Read at PROMPT a heading and, past its first line, the body going under it.
INITIAL fills the prompt with something to edit rather than an empty line."
(let* ((text (string-trim
(read-from-minibuffer
prompt initial konix/agent-shell-workspace-prompt-map)))
(break (string-search "\n" text))
(heading (string-trim (if break (substring text 0 break) text)))
(body (if break (string-trim (substring text (1+ break))) "")))
(when (string-empty-p heading)
(user-error "A heading is what you are saying — there is none"))
(list heading body)))
(defun konix/agent-shell-workspace--body-under (body indent)
"Return BODY as the lines under a heading, each carrying INDENT, or nothing."
(if (or (null body) (string-empty-p (string-trim body)))
""
(concat (replace-regexp-in-string "^" indent (string-trim body)) "\n")))
- rule
- and
etakes the heading the user stands in back to the prompt, its words already there to be worked on.- why: the user types a subject at speed and reads it back full of typos, and rewriting it by hand means making the buffer writable to do it.
- scope: the heading’s own words: the keyword it opens on, the standing the user gave it and what is written under it are none of its business.
- scope: and whatever heading they stand in, a question of the writer’s as readily as a subject of their own, since it is their reading it has to suit.
- rule: and a heading left saying nothing is refused, as one typed empty is.
- rule: and which heading it is editing is settled as the key is pressed, not as
the words are typed, so it is named by its id and reached by it after.
- why: the writer rewrites the workspace while the user types, and what stood where they were standing is another heading by the time they press return.
- rule: and one gone from under them while they typed is refused rather than guessed at.
- rule: and rewording the one the writer holds tells it so, in the words it now
asks.
- why: it is working on what the question said, and nothing else would tell it that what it said has changed.
- scope: only the one it holds: any other it reads afresh when it takes it up.
- how: it hears it at once, or as its turn ends under
C-u, as the answering keys have it.
(defconst konix/agent-shell-workspace-reworded-said
(concat "The user has reworded the question you hold. It asks this now:"
" « %s ». Work on what it says now, not on what it said before.")
"What a writer is told when the user rewords the question it holds.")
(defun konix/agent-shell-workspace-edit (&optional later)
"Edit the words of the heading point stands in, the ones it has filled in.
Where the writer holds the one reworded, it is cut short with the news, unless
LATER leaves it to hear it as its turn ends."
(interactive "P")
(pcase-let* ((`(,id ,was)
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(list (org-entry-get (point) "ID")
(org-get-heading t t t t))))
(said (string-trim (read-string "Heading: " was))))
(when (string-empty-p said)
(user-error "A heading is what it says — there is none"))
(unless (and id (save-excursion
(konix/agent-shell-workspace--goto-id id)))
(user-error "That heading is gone from under you"))
(unless (equal said was)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(org-edit-headline said)
(konix/agent-shell-workspace--touch))
(konix/agent-shell-workspace--tell-reworded id said later))))
(defun konix/agent-shell-workspace--tell-reworded (id said later)
"Tell the writer holding the question ID that it asks SAID now, at once unless LATER."
(when (save-excursion
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--held-state-p
(konix/agent-shell-workspace--state-at-point)))
(message
(if (eq t (konix/agent-shell-workspace--submit
(konix/agent-shell-workspace--target-writer)
(format konix/agent-shell-workspace-reworded-said said)
(not later)))
"Woke the writer"
"Queued — the writer reads it as its turn ends"))))
- rule
- a heading the user did not type — the words a keystroke quotes back — is
refused past its first line.
- why: a heading keeps the first line and drops the rest.
(defun konix/agent-shell-workspace--one-line-or-error (heading)
"Refuse HEADING unless it is exactly one line."
(unless (string-match-p "\\`[^\n]+\\'" (string-trim heading))
(user-error "A heading is one line — select less")))
a subject of the user’s own
- rule
M-RETputs a subject of the user’s own at the end, in the writer’s state, with whatever the user wants to say under it and none of the bounds the writer answers to.- why: it is the writer that needs holding short, not the user.
- rule
- and it leaves the view settled, the subject it wrote folded like anything
else of the writer’s.
- why: what it writes arrives unfolded, being written rather than read.
(defun konix/agent-shell-workspace-add-subject
(subject &optional body file line quoted needs loose held project keyword)
"Put SUBJECT, and BODY under it, at the end of this workspace.
FILE and LINE, when given, come out under it as the place it is about, and
QUOTED as what was selected there. NEEDS are the ids of the questions it
waits on, or merely comes after where LOOSE; HELD those that wait on it.
PROJECT is the id of the project it is for. KEYWORD is the state it starts
in, to discuss by default."
(interactive (konix/agent-shell-workspace--read-heading-and-body "Subject: "))
(konix/agent-shell-workspace--write
(let ((id (konix/agent-shell-workspace--new-question-id)))
(save-excursion
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert (konix/agent-shell-workspace--stars) " "
(or keyword konix/agent-shell-workspace-discuss-keyword)
" " subject "\n"
" :PROPERTIES:\n :ID: " id "\n"
" :" konix/agent-shell-workspace-by-hand-property ": user\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(konix/agent-shell-workspace--body-under body " ")
(konix/agent-shell-workspace--subject-place file line quoted)))
(konix/agent-shell-workspace--wait-on-each id needs loose)
(dolist (waiting held)
(konix/agent-shell-workspace--say-waiting waiting id))
(when project
(save-excursion
(konix/agent-shell-workspace--link-under
id project (konix/agent-shell-workspace--heading-by-id-here project)
konix/agent-shell-workspace-for-said)))))
(konix/agent-shell-workspace-focus-question)
(let ((writer (konix/agent-shell-workspace--target-writer)))
(if current-prefix-arg
(konix/agent-shell-workspace--send-compact writer)
(konix/agent-shell-workspace--submit writer))))
- rule
- work another agent hands a bound writer comes in as a question to discuss, its
message quoted, so the writer answers it and the user decides whether it is taken on.
- why: holding nothing, the writer could neither act on the request nor ask about it, its turn cut before a word.
- how: coord runs a hook as it feeds the writer the message, and the workspace hangs this there, coord knowing nothing of workspaces.
- rule
- and a buddy’s answer to a task of the writer’s comes in the same way, « X
answers: … », saying the task it answers.
- rule: but one that is not the answer says so: an interim leaves the task open, and a task coord gave up on will never be answered.
- what
- a buddy’s message fed to a bound writer leaves a question to discuss, « X asks: … », the message quoted under it.
(require 'cl-lib)
(let ((file (make-temp-file "check-buddyasks-" nil ".ws.org"))
(writer (generate-new-buffer " check-buddyasks-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (shell) (when (eq shell writer) file))))
(konix/agent-shell-workspace--buddy-asks
writer
(concat "Tasks:\n"
(json-encode '[((id . 7) (from . "ann") (description . "Review Z.") (context . "the z part"))])
"\n\nMessages:\n"
(json-encode '[((from . "bob") (message . "Please fix X\nin the y file"))])
"\n\nCOORD_DEADLINE: none")
"bob")
;; A result fed beside coord's notice, then beside a message.
(konix/agent-shell-workspace--buddy-asks
writer
(concat "Results:\n"
(json-encode '[((id . 3) (from . "me") (to . "aud") (description . "Say pong.")
(result . "pong"))])
"\n\nMessages:\n"
(json-encode '[((from . "coord") (question . "q9") (ended . "timeout")
(message . "Your wait ran out"))]))
"coord")
(konix/agent-shell-workspace--buddy-asks
writer
(concat "Results:\n"
(json-encode '[((id . 4) (from . "me") (to . "aud") (description . "Say pang.")
(result . "pang"))])
"\n\nMessages:\n"
(json-encode '[((from . "cy") (message . "Hello"))]))
"aud")
(with-temp-buffer
(insert-file-contents file)
(list (and (re-search-forward "^\\*\\* DISCUSS ann asks: Review Z\\?$" nil t) t)
(and (search-forward "the z part" nil t) t)
(and (search-forward "coord_complete_task, task 7" nil t) t)
(and (re-search-forward "^\\*\\* DISCUSS bob asks: Please fix X\\?$" nil t) t)
(and (search-forward "in the y file" nil t) t)
(and (re-search-forward "^\\*\\* DISCUSS aud answers: pong\\?$" nil t) t)
(and (search-forward "task 3: Say pong." nil t) t)
(and (re-search-forward "^\\*\\* DISCUSS aud answers: pang\\?$" nil t) t)
(progn
(konix/agent-shell-workspace--buddy-asks
writer
(concat "Results:\n"
(json-encode '[((id . 5) (from . "me") (to . "aud") (status . "interim")
(description . "Say pung.") (result . "need more time"))
((id . 6) (from . "me") (to . "aud") (status . "abandoned")
(description . "Say pyng.") (result . "aud went stale"))]))
"aud")
(with-temp-buffer
(insert-file-contents file)
(list (and (re-search-forward
"^\\*\\* DISCUSS aud has not answered yet: need more time\\?$" nil t)
t)
(and (search-forward "Task 5 is still open: Say pung." nil t) t)
(and (re-search-forward
"^\\*\\* DISCUSS aud will never answer: aud went stale\\?$" nil t)
t)
(and (search-forward "Task 6 will never be answered: Say pyng." nil t)
t)
(progn (goto-char (point-max))
(not (search-backward "It answers task 5" nil t)))))))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(t t t t t t t t (t t t t t)): one question per task, per message and per result, headed by its own words, a task saying the number to answer it by and a result the task it answers, beside a notice or a message alike; an interim and an abandonment each say the task is not answered.
(defconst konix/agent-shell-workspace-task-answer-said
"Answer it with coord_complete_task, task %s."
"What closes a buddy's task written as a question: how to answer it.")
(defconst konix/agent-shell-workspace-result-said
'(("interim" "%s has not answered yet: %s?" "Task %s is still open: %s")
("abandoned" "%s will never answer: %s?" "Task %s will never be answered: %s")
(nil "%s answers: %s?" "It answers task %s: %s"))
"For each status of a buddy's result, its question's heading and what closes it.
The entry for nil stands for any other status, an answer.")
(defun konix/agent-shell-workspace--coord-requests (payload)
"Return (WHO TEXT HEADING) for each task, message and result coord's PAYLOAD carries.
HEADING formats WHO and TEXT's first line into the question's heading."
(with-temp-buffer
(insert payload)
(goto-char (point-min))
(let (found)
(while (re-search-forward "^\\(Tasks\\|Messages\\|Results\\):\n" nil t)
(let ((results (equal (match-string 1) "Results")))
(dolist (item (append (ignore-errors
(json-parse-buffer :object-type 'alist :array-type 'list))
nil))
(when-let (((not (alist-get 'question item)))
;; t where it is no result, so the binding holds.
(said (or (not results)
(cdr (or (assoc (alist-get 'status item)
konix/agent-shell-workspace-result-said)
(assoc nil konix/agent-shell-workspace-result-said)))))
(text (cond
(results
(string-join
(delq nil (list (alist-get 'result item)
(format (nth 1 said)
(alist-get 'id item)
(alist-get 'description item))))
"\n\n"))
((alist-get 'message item))
(t
(string-join
(delq nil (list (alist-get 'description item)
(alist-get 'context item)
(when-let* ((id (alist-get 'id item)))
(format konix/agent-shell-workspace-task-answer-said
id))))
"\n\n")))))
(unless (string-empty-p text)
(push (list (alist-get (if results 'to 'from) item) text
(if results (nth 0 said) "%s asks: %s?"))
found))))))
(nreverse found))))
(defvar konix/agent-shell-workspace--asked-ids nil
"The ids of the questions the last payload fed a writer was written as.")
(defun konix/agent-shell-workspace--buddy-asks (writer payload from)
"Put each request in PAYLOAD, fed to WRITER, in its workspace as a question to discuss.
FROM names the sender where a request does not. Coord's notice that a wait ran out
is no request."
(setq konix/agent-shell-workspace--asked-ids nil)
(when-let* ((file (konix/agent-shell-workspace-file writer))
(requests (or (konix/agent-shell-workspace--coord-requests payload)
(unless (konix/agent-shell-workspace--coord-notices payload)
(list (list from payload "%s asks: %s?"))))))
(konix/agent-shell-workspace--write-file file
(dolist (request requests)
(let ((who (or (nth 0 request) from "another agent"))
(text (nth 1 request))
(id (konix/agent-shell-workspace--new-question-id)))
(push id konix/agent-shell-workspace--asked-ids)
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert (konix/agent-shell-workspace--stars) " "
konix/agent-shell-workspace-discuss-keyword " "
(format (nth 2 request) who
(string-trim-right
(truncate-string-to-width
(car (split-string (string-trim text) "\n")) 80 nil nil "…")
"[?.!: ]+"))
"\n :PROPERTIES:\n :ID: " id "\n"
" :" konix/agent-shell-workspace-by-hand-property ": " who "\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
(konix/agent-shell-workspace--subject-place
nil nil (konix/agent-shell-workspace--filled text))))))))
(add-hook 'konix/mcp-server-delivered-functions #'konix/agent-shell-workspace--buddy-asks)
- rule
- and the message is quoted filled, as
M-qwould leave it, fenced code, list items and table rows left as they came.- why: a buddy writes each paragraph on one line, which ran far past the window.
(defconst konix/agent-shell-workspace-unfilled-line-regexp
"[ \t]*\\(?:[-*+|]\\|[0-9]+[.)]\\|$\\)"
"A line filling leaves alone: a list item, a table row or a blank line.")
(defun konix/agent-shell-workspace--filled (text)
"Return TEXT filled as M-q would, fenced code, list items and table rows untouched."
(with-temp-buffer
(insert text)
(text-mode)
(goto-char (point-min))
(let (fenced)
(while (not (eobp))
(cond
((looking-at-p "[ \t]*```")
(setq fenced (not fenced))
(forward-line 1))
((or fenced (looking-at-p konix/agent-shell-workspace-unfilled-line-regexp))
(forward-line 1))
(t
(let ((start (point))
(end (make-marker)))
(while (and (not (eobp))
(not (looking-at-p "[ \t]*```"))
(not (looking-at-p konix/agent-shell-workspace-unfilled-line-regexp)))
(forward-line 1))
(set-marker end (point))
(fill-region start end)
(goto-char end)
(set-marker end nil))))))
(buffer-string)))
- what
- a long line is filled, a list item and fenced code are left as they came.
(let* ((long (mapconcat #'identity (make-list 30 "word") " "))
(filled (konix/agent-shell-workspace--filled
(concat long "\n\n- " long "\n\n```\n" long "\n```"))))
(list (< (length (car (split-string filled "\n"))) 80)
(and (string-search (concat "- " long "\n") filled) t)
(and (string-search (concat "```\n" long "\n```") filled) t)))
- what
- the check above is right when it reads
(t t t).
(defun konix/agent-shell-workspace--subject-place (file line quoted &optional indent)
"Return FILE at LINE as the lines under a subject, QUOTED shown above the link.
INDENT opens each line, two spaces where none is given."
(let ((indent (or indent " "))
(link (and file line
(format "[[file+emacs:%s::%s][%s:%s]]"
file line (file-name-nondirectory file) line))))
(if (and quoted (not (string-empty-p quoted)))
(concat indent "#+BEGIN_QUOTE\n"
(replace-regexp-in-string
"^" indent (org-escape-code-in-string quoted))
"\n"
(if link (format "%s--- %s\n" indent link) "")
indent "#+END_QUOTE\n")
(if link (format "%s- %s\n" indent link) ""))))
- rule
=puts one after the question the user stands in: a subject of the user’s own that waits on it.- why: the user reads a question and knows what has to come once it is settled, and says so in one gesture, standing where the thought came.
- rule: and
C-u =has it merely come after, asC-u Ddoes. - rule: and on a project it raises a subject for that project instead, waiting on nothing.
- why: a project is no step to wait on, and the subject is work toward it.
- rule: and the question it follows is settled as the key is pressed, and named in the prompt.
(defun konix/agent-shell-workspace--followed ()
"Return (ID HEADING PROJECT) of the question point stands in, for a subject to follow."
(save-excursion
(konix/agent-shell-workspace--goto-question)
(unless (konix/agent-shell-workspace--state-at-point)
(user-error "A fact is nobody's to do, so nothing waits on it"))
(list (or (org-entry-get (point) "ID")
(user-error "That one has no id to be waited on by"))
(substring-no-properties (org-get-heading t t t t))
(and (konix/agent-shell-workspace--project-at-point-p) t))))
(defun konix/agent-shell-workspace-add-subject-after
(subject &optional body loose followed)
"Put SUBJECT, and BODY under it, at the end, waiting on the question at point.
Where that one is a project, the subject is for it instead, waiting on nothing.
LOOSE has it merely come after that one instead. FOLLOWED is (ID HEADING
PROJECT) of that question, read at point where nil."
(interactive
(let* ((loose current-prefix-arg)
(followed (konix/agent-shell-workspace--followed)))
(append (konix/agent-shell-workspace--read-heading-and-body
(format "%s « %s »: "
(cond ((nth 2 followed) "For")
(loose "Comes after")
(t "Waits on"))
(nth 1 followed)))
(list loose followed))))
(pcase-let ((`(,need ,_heading ,project)
(or followed (konix/agent-shell-workspace--followed))))
(if project
(konix/agent-shell-workspace-add-subject
subject body nil nil nil nil nil nil need)
(konix/agent-shell-workspace-add-subject
subject body nil nil nil (list need) loose))))
- rule
+puts one before the question the user stands in: a subject of the user’s own that question then waits on, to be done first; following it moves to=.- why: reading a question, the user finds something it depends on, newly seen, and says so in one gesture.
- rule: and on a project it raises a subject for that project, as
=does.
- what
+on a question raises a subject that question waits on, and+and=are bound so.
(require 'cl-lib)
(let ((file (make-temp-file "check-first-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"* Mine :mine:\n"
"** REFINE Ship it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: ship\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Ship it")
(konix/agent-shell-workspace-add-subject-first "Fix the build first")
(prog1 (save-restriction
(widen)
(goto-char (point-min))
(re-search-forward "^\\*\\* .*Fix the build first")
(let ((new (org-entry-get (point) "ID")))
(konix/agent-shell-workspace--goto-id "q")
(list (and (member new (konix/agent-shell-workspace--needs-at-point))
t)
(lookup-key konix/agent-shell-workspace-mode-map "+")
(lookup-key konix/agent-shell-workspace-mode-map "="))))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(t ...-add-subject-first ...-add-subject-after): the question waits on the new one.
(defun konix/agent-shell-workspace-add-subject-first
(subject &optional body followed)
"Put SUBJECT, and BODY under it, at the end, the question at point waiting on it.
Where that one is a project, the subject is for it instead. FOLLOWED is (ID
HEADING PROJECT) of that question, read at point where nil."
(interactive
(let ((followed (konix/agent-shell-workspace--followed)))
(append (konix/agent-shell-workspace--read-heading-and-body
(format "%s « %s »: "
(if (nth 2 followed) "For" "First, before")
(nth 1 followed)))
(list followed))))
(pcase-let ((`(,waiting ,_heading ,project)
(or followed (konix/agent-shell-workspace--followed))))
(if project
(konix/agent-shell-workspace-add-subject
subject body nil nil nil nil nil nil waiting)
(konix/agent-shell-workspace-add-subject
subject body nil nil nil nil nil (list waiting)))))
raised without leaving what the user looks at
- rule
- the same subject can be raised from the code itself, without leaving it.
- why: looking at a file and wanting to add a todo, the user selects a region, or stands on a line, and gets that prompt.
- rule: and it asks nothing: it finds the one in the working directory the user is
in, whose writer is still alive.
- why: being asked about several workspaces the user did not care about is no help at all, and the last one worked in is a shitty assumption.
- how: the writer’s own working directory is what is compared, that being where a writer works.
- scope: finding none it says so rather than guessing, there being nothing to raise a subject with.
- rule: and finding several writers working here, it asks which.
- why: two writers in the same working directory is a choice only the user can make.
- therefore: it asks only ever between the ones that could each be the right answer.
(defun konix/agent-shell-workspace--working-directory-of (buffer)
"Return the working directory BUFFER sits in: its project root, or its directory."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(or (when-let ((project (ignore-errors (project-current nil))))
(expand-file-name (project-root project)))
(and default-directory (expand-file-name default-directory))))))
(defun konix/agent-shell-workspace--open-one ()
"Return this working directory's workspace whose writer lives, asking of several."
(let* ((here (konix/agent-shell-workspace--working-directory-of (current-buffer)))
(candidates
(seq-filter
(lambda (buffer)
(let ((writer (buffer-local-value
'konix/agent-shell-workspace--writer-buffer buffer)))
(and (buffer-local-value 'konix/agent-shell-workspace-mode buffer)
(buffer-live-p writer)
(equal here
(konix/agent-shell-workspace--working-directory-of writer)))))
(buffer-list))))
(pcase (length candidates)
(0 (user-error "No workspace of this working directory has a living writer"))
(1 (car candidates))
(_ (get-buffer (completing-read "Raise it with which writer: "
(mapcar #'buffer-name candidates)
nil t))))))
- how
- the prompt stays empty and the region comes out under the heading, quoted, the
place it was selected at named inside the quote.
- why: better not to prefill the prompt with it, but to provide the quote and the link in the body for the writer to get the context of the task.
- therefore: the user types what they want done, and the writer reads what it was about.
- rule: and the quote wears the shape the user’s own quotes wear: the words, then
---and the link, inside#+BEGIN_QUOTE.- why: their quotes look like that.
- rule: and the region goes once it is sent.
- why: as anywhere in Emacs, a region done with is left alone.
- therefore: the keys the region binding lends are handed back, and the next keystroke means what it usually means.
(defun konix/agent-shell-workspace-raise-here (subject &optional body file line quoted)
"Raise SUBJECT, and BODY under it, in the open workspace, about FILE at LINE.
QUOTED is what was selected there, which comes out under the heading as well."
(interactive
(append (konix/agent-shell-workspace--read-heading-and-body "Subject: ")
(list (buffer-file-name)
(line-number-at-pos (if (use-region-p)
(region-beginning)
(point)))
(when (use-region-p)
(string-trim (buffer-substring-no-properties
(region-beginning) (region-end)))))))
(with-current-buffer (konix/agent-shell-workspace--open-one)
(konix/agent-shell-workspace-add-subject subject body file line quoted))
(deactivate-mark))
(with-eval-after-load 'region-bindings-mode
(when (boundp 'konix/region-bindings-mode-map)
(keymap-set konix/region-bindings-mode-map "w"
#'konix/agent-shell-workspace-raise-here)))
- rule
- and one raised with nothing selected is about the line the cursor is on.
- why: a line is what the user is looking at often enough that selecting it first is a keystroke for nothing.
- how: the line stands in for the region and is quoted the same way, so what the writer reads is what it would have read either way.
- rule: and with a region selected, its key quotes the region, not the line.
- why: the user selected something to raise it, whichever key they reached for.
(defun konix/agent-shell-workspace-raise-this-line (subject &optional body)
"Raise SUBJECT, and BODY under it, about the region, or the line point is on."
(interactive (konix/agent-shell-workspace--read-heading-and-body "Subject: "))
(let ((start (if (use-region-p) (region-beginning) (line-beginning-position)))
(end (if (use-region-p) (region-end) (line-end-position))))
(konix/agent-shell-workspace-raise-here
subject body (buffer-file-name) (line-number-at-pos start)
(string-trim (buffer-substring-no-properties start end)))))
(keymap-global-set "M-g l M-RET"
#'konix/agent-shell-workspace-raise-this-line)
- rule
- and
M-RETraises one from the shell too, as in the workspace, watching the writer work being where the user sees what wants doing next.- rule: and it asks nothing either: the session names its own workspace.
- therefore: nothing is compared and nothing is guessed, this being the one case where the workspace is already known.
- scope: the viewport the user types in keeps the key, a second line of a message being what it means there.
- rule: and it asks nothing either: the session names its own workspace.
(defun konix/agent-shell-workspace-raise-with-writer (subject &optional body)
"Raise SUBJECT, and BODY under it, in the workspace bound to this session."
(declare (modes agent-shell-mode agent-shell-viewport-view-mode))
(interactive (konix/agent-shell-workspace--read-heading-and-body "Subject: "))
(let* ((shell (konix/agent-shell--current-shell-or-error))
(file (konix/agent-shell-workspace--bound-file-or-error shell)))
(with-current-buffer (konix/agent-shell-workspace--show file shell nil)
(konix/agent-shell-workspace-add-subject subject body))))
(with-eval-after-load 'agent-shell
(define-key agent-shell-mode-map (kbd "M-RET")
#'konix/agent-shell-workspace-raise-with-writer)
(define-key agent-shell-viewport-view-mode-map (kbd "M-RET")
#'konix/agent-shell-workspace-raise-with-writer))
a review of the commits
- rule
Vputs every commit of a range the user names in the workspace, one question each, asking them to review it.- why: a review wants every commit, and from git, not from the writer’s say.
- how: in the order they were made, each on the user’s side from the start.
- scope: nothing goes to the writer: they are the user’s to read, and answering one hands it over as ever.
the commits, from git
- rule
- several ranges are named at once, split by « ; », each read on its own.
- why: one review may span commits no single range names, and git joining ranges subtracts each one’s base from all the others.
- example:
1171f3c1b^..601d8539b ; 6f4da5207^..f457b5d1c
- rule
- git refusing says why, in git’s words and where it was asked.
- why: an exit status says nothing of what to fix.
(defun konix/agent-shell-workspace--git (&rest args)
"Return what git says to ARGS here, or say what went wrong in git's own words."
(with-temp-buffer
(let ((status (apply #'call-process "git" nil t nil args)))
(unless (equal status 0)
(user-error "git %s, in %s: %s" (string-join args " ") default-directory
(string-trim (buffer-string))))
(buffer-string))))
(defun konix/agent-shell-workspace--commits-of (revspec)
"Return (SHA . SUBJECT) for each commit REVSPEC names, oldest first.
REVSPEC may be several, split by « ; », each taken in turn, a commit named twice
coming once."
(seq-uniq
(mapcan (lambda (one)
(mapcar (lambda (line)
(let ((tab (string-search "\t" line)))
(cons (substring line 0 tab) (substring line (1+ tab)))))
(split-string (konix/agent-shell-workspace--git
"log" "--reverse" "--format=%H%x09%s" one)
"\n" t)))
(split-string revspec ";" t "[ \t]+"))
(lambda (a b) (equal (car a) (car b)))))
- how
- in the directory a
#+DIRECTORY:line of the workspace names, or else the working directory it sits in, a workspace living under the working directory it is about. - rule
- and the range comes prefilled: the remote’s main branch, to
HEAD, and the remote branch followed oneM-naway.- why: what is to be reviewed is the commits of one’s own, not yet pushed, and a local trunk behind or ahead of the remote names others’ too.
- why: about to open a pull request, the user wants to see the diff with main.
- how: by their names,
origin/main..HEADsay: the remote’s head, then the branch’s upstream where it differs, else the last commit alone.
- what
- on a branch of its own, pushed, the prompt offers main first, then the branch followed.
(require 'cl-lib)
(let* ((top (make-temp-file "check-range-" t))
(git (lambda (dir &rest args)
(let ((default-directory (file-name-as-directory dir)))
(apply #'konix/agent-shell-workspace--git
"-c" "user.name=t" "-c" "user.email=t@t" args)))))
(unwind-protect
(progn
(funcall git top "init" "-q" "--bare" "-b" "main" "origin.git")
(funcall git top "clone" "-q" "origin.git" "work")
(let ((work (expand-file-name "work" top)))
(with-temp-file (expand-file-name "a" work) (insert "a\n"))
(funcall git work "add" "a")
(funcall git work "commit" "-q" "-m" "a")
(funcall git work "push" "-q" "origin" "main")
(funcall git work "remote" "set-head" "origin" "main")
(funcall git work "checkout" "-q" "-b" "topic")
(funcall git work "push" "-q" "-u" "origin" "topic")
(with-temp-buffer
(insert "#+DIRECTORY: " work "\n")
(org-mode)
(catch 'asked
(cl-letf (((symbol-function 'read-string)
(lambda (_prompt initial _history defaults)
(throw 'asked (list initial defaults)))))
(call-interactively #'konix/agent-shell-workspace-review))))))
(delete-directory top t)))
- what
- the check above is right when it reads
("origin/main..HEAD" ("origin/topic..HEAD")): main prefilled, the branch oneM-naway.
(defun konix/agent-shell-workspace--review-directory ()
"Return where this workspace's commits are asked of git."
(file-name-as-directory
(or (konix/agent-shell-workspace--keyword "DIRECTORY")
(konix/agent-shell-workspace--working-directory-of (current-buffer)))))
(defun konix/agent-shell-workspace--review-ranges ()
"Return the ranges a review of this working directory may start from, first first.
The remote's main branch, then the branch followed, else the last commit alone."
(let ((default-directory (konix/agent-shell-workspace--review-directory)))
(mapcar (lambda (base) (format "%s..HEAD" base))
(or (delete-dups
(delq nil
(mapcar (lambda (remote)
(ignore-errors
(string-trim
(konix/agent-shell-workspace--git
"rev-parse" "--abbrev-ref" remote))))
'("origin/HEAD" "@{upstream}"))))
'("HEAD~1")))))
what a review question looks like
- rule
- a review question asks whether its commit is right, names that commit alone
as its revision,
SHA^!, and wears a tag of its own.- how: its heading is the commit’s subject and short sha, nothing more.
- why: the
Reviewpart it stands in already says what is asked.
- why: the
- rule: and the diff is not written in,
dshowing it, the whole commit.- why: a whole commit in the workspace drowns the questions, and
dis where a diff is read, with the keys that answer from it.
- why: a whole commit in the workspace drowns the questions, and
- how: its heading is the commit’s subject and short sha, nothing more.
(defconst konix/agent-shell-workspace-review-tag "review"
"Tag a question put up for the review of a commit wears.")
(defun konix/agent-shell-workspace--review-heading (commit)
"Make the question at point ask about COMMIT, (SHA . SUBJECT), keeping its state."
(org-edit-headline (format "%s %s"
(cdr commit) (substring (car commit) 0 8)))
(org-toggle-tag konix/agent-shell-workspace-review-tag 'on)
(org-entry-put (point) "REVSPEC" (concat (car commit) "^!")))
- rule
- and a review question shows nothing ahead of its keyword, nor a project: each
stands in a part of its own,
ReviewandProjects. - what
- the picking reads a project and a review question as their line reads, and nothing labels a heading.
(with-temp-buffer
(insert "#+TODO: TODO REFINE | DONE\n"
"* TODO A project :project:\n* REFINE Review it :review:\n")
(org-mode)
(append (mapcar (lambda (heading)
(goto-char (point-min))
(search-forward heading)
(beginning-of-line)
(konix/agent-shell-workspace--labelled-heading))
'("A project" "Review it"))
(list (fboundp 'konix/agent-shell-workspace--show-labels))))
- what
- the check above is right when it reads
("TODO A project" "REFINE Review it" nil).
(defface konix/agent-shell-workspace-review-face
'((t :inherit (diff-refine-added bold)))
"Face of the heading the review questions stand after."
:group 'agent-shell)
(face-spec-set 'konix/agent-shell-workspace-review-face
'((t :inherit (diff-refine-added bold)))
'face-defface-spec)
- how
- whether the user’s last answer asks something back is read off its words, for closing to be refused while it does.
(defun konix/agent-shell-workspace--asked-back-p ()
"Non-nil when the user's last answer under the open question at point asks something."
(when-let (((not (equal (org-get-todo-state)
konix/agent-shell-workspace-done-keyword)))
(said (konix/agent-shell-workspace--users-last-word)))
(string-suffix-p "?" said)))
- rule
- and
vshows the review’s questions alone, the rest folded away;vagain shows everything.- why: the user follows how the review goes without the rest of the work in the way.
(defun konix/agent-shell-workspace-show-review ()
"Show the review's questions alone, the rest folded away; again to see all."
(interactive)
(if (eq last-command this-command)
(progn (setq this-command nil)
(konix/agent-shell-workspace-focus-question))
(org-match-sparse-tree nil konix/agent-shell-workspace-review-tag)))
following the history as it is rewritten
- rule
Vrun again brings the review up to date with the history as it now stands: a question per commit still there, one for each new commit, none for the ones gone.- why: the writer rewrites what it is told to fix — amends, squashes, adds — and the review has to follow without anyone redoing it.
- how: each change carries its question’s id in a git note, found again by the
commit’s patch-id, so a rebased commit still names its question whatever git did
with notes on the way.
- why: a rebase need not carry notes hung on commits along, and the questions the user settled would be asked again.
- how: git notes hang on any git object, so the note hangs on the one holding
the patch-id’s text, one note per change.
- scope: a commit changing nothing, a merge say, has no patch-id, and is found by its own name; so is one git cannot tell the patch-id of.
- scope: an amended or squashed commit changes something else: it is a new question.
- rule: each workspace keeps its notes under a ref of its own, named after its
file, under
refs/notes/workspaces/.- why: several workspaces review the same repository.
(defconst konix/agent-shell-workspace-review-notes-root "refs/notes/workspaces/"
"Where each workspace's git notes ref stands.")
(defun konix/agent-shell-workspace--review-notes ()
"Return the git notes ref this workspace's review notes stand under."
(concat konix/agent-shell-workspace-review-notes-root
(replace-regexp-in-string "[^[:alnum:]._-]" "-"
(file-name-base buffer-file-name))))
(defun konix/agent-shell-workspace--review-key (sha)
"Return the object the note of the commit SHA's change hangs on."
(string-trim (konix/agent-shell-workspace--git-fed
(or (ignore-errors (konix/agent-shell-workspace--patch-id-of sha)) sha)
nil "hash-object" "-w" "--stdin")))
(defun konix/agent-shell-workspace--review-lines (key)
"Return (ID STATE) for each question the note on KEY names, in its order."
(mapcar #'split-string
(split-string (or (ignore-errors
(konix/agent-shell-workspace--git
"notes" (concat "--ref=" (konix/agent-shell-workspace--review-notes))
"show" key))
"")
"\n" t "[ \t]+")))
(defun konix/agent-shell-workspace--review-note (sha)
"Return (ID STATE) for each question the commit SHA's change was noted with."
(ignore-errors
(konix/agent-shell-workspace--review-lines
(konix/agent-shell-workspace--review-key sha))))
- rule
- and a note found hung on a commit is moved onto the patch-id it was written
with, each of its lines.
- why: the reviews the user settled stay settled.
- how: a
notes.rewriteReffound namingrefs/notes/workspaces/*is taken out too: nothing hangs on a commit for git to carry.
(defun konix/agent-shell-workspace--review-take-over ()
"Move the review notes found hung on commits onto their patch-ids."
(let ((ref (concat "--ref=" (konix/agent-shell-workspace--review-notes))))
(ignore-errors
(konix/agent-shell-workspace--git
"config" "--fixed-value" "--unset" "notes.rewriteRef"
(concat konix/agent-shell-workspace-review-notes-root "*")))
(dolist (line (split-string (or (ignore-errors
(konix/agent-shell-workspace--git "notes" ref "list"))
"")
"\n" t))
(let ((object (cadr (split-string line))))
(when (equal (ignore-errors
(string-trim (konix/agent-shell-workspace--git
"cat-file" "-t" object)))
"commit")
(dolist (noted (mapcar #'split-string
(split-string (konix/agent-shell-workspace--git
"notes" ref "show" object)
"\n" t)))
(let ((key (if (nth 2 noted)
(string-trim (konix/agent-shell-workspace--git-fed
(nth 2 noted) nil "hash-object" "-w" "--stdin"))
(konix/agent-shell-workspace--review-key object))))
(unless (assoc (car noted)
(konix/agent-shell-workspace--review-lines key))
(konix/agent-shell-workspace--review-put
key (car noted) (nth 1 noted)))))
(konix/agent-shell-workspace--git "notes" ref "remove" object))))))
- rule
- and a question followed keeps its state: one settled stays settled.
- why: what the user already validated is not to be asked again, and the log of it stays.
- rule: unless what the commit changes changed: then it is a new question, asked.
- why: the user agreed with what they read; a squash or an amend makes it something else, whatever it is called.
- scope: a rebase onto a main that moved is no such change.
- why: the commit’s own change is the same; only what it sits on moved.
- therefore: its patch-id, not its tree, which holds every file, main’s new ones too.
- how: the note is found by the patch-id, so a change that changed finds none.
(defun konix/agent-shell-workspace--patch-id-of (sha)
"Return the patch-id of the commit SHA: what it changes, whatever it sits on."
(let ((shown (konix/agent-shell-workspace--git "show" sha)))
(with-temp-buffer
(insert shown)
(unless (equal 0 (call-process-region (point-min) (point-max) "git" t t nil
"patch-id" "--stable"))
(user-error "git patch-id, of %s in %s: %s" sha default-directory
(string-trim (buffer-string))))
(car (split-string (buffer-string))))))
- rule
- and even one the user took out of the workspace comes back settled, if it
was.
- scope: settled alone: any other comes back asking the user to review it, the conversation it had being gone with it.
- why: the user clears settled questions out.
- how: the note carries the question’s state beside its id, written again each
time the state changes, and for every one still there as
Vstarts.- how: the patch-id’s own text is the note’s object, so git keeps no note on a commit, nor any other trace on it.
- how: the change is heard from org’s own hook, on every buffer, the workspace’s
alone answering it.
- why: a workspace already open when this is loaded hears it all the same.
(defun konix/agent-shell-workspace--review-put (key id state)
"Note on KEY that the question ID stands in STATE, its line kept in its place."
(let* ((lines (konix/agent-shell-workspace--review-lines key))
(lines (if (assoc id lines)
(mapcar (lambda (line) (if (equal (car line) id) (list id state) line))
lines)
(append lines (list (list id state))))))
(konix/agent-shell-workspace--git
"notes" (concat "--ref=" (konix/agent-shell-workspace--review-notes))
"add" "-f" "-m"
(mapconcat (lambda (line) (string-join line " ")) lines "\n")
key)))
(defun konix/agent-shell-workspace--review-note-down (sha id state)
"Note of the commit SHA's change that its question is ID, standing in STATE."
(konix/agent-shell-workspace--review-put
(konix/agent-shell-workspace--review-key sha) id state))
(defun konix/agent-shell-workspace--review-remember ()
"Note against its commit's change the state the review question at point stands in."
(when-let* (((bound-and-true-p konix/agent-shell-workspace-mode))
((member konix/agent-shell-workspace-review-tag (org-get-tags nil t)))
(revspec (org-entry-get (point) "REVSPEC"))
(id (org-entry-get (point) "ID"))
(default-directory (konix/agent-shell-workspace--review-directory)))
(ignore-errors
(konix/agent-shell-workspace--review-note-down
(string-remove-suffix "^!" revspec) id
(konix/agent-shell-workspace--state-at-point)))))
(add-hook 'org-after-todo-state-change-hook
#'konix/agent-shell-workspace--review-remember)
(defun konix/agent-shell-workspace--review-remember-all ()
"Note against each reviewed commit's change the state its question stands in now."
(save-excursion
(goto-char (point-min))
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
(format ".*:%s:" konix/agent-shell-workspace-review-tag))
nil t)
(konix/agent-shell-workspace--review-remember))))
- rule
- a question followed has its heading and revision rewritten, and one put up again takes the id its change’s note names.
(defun konix/agent-shell-workspace--review-put-up (commit id settled)
"Put up the question ID asking about COMMIT, settled where SETTLED, and note it."
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert (konix/agent-shell-workspace--stars) " "
(if settled
konix/agent-shell-workspace-done-keyword
konix/agent-shell-workspace-refine-keyword)
" x\n"
" :PROPERTIES:\n :ID: " id "\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
" - what :: review this commit, whole: d shows it\n")
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--review-heading commit)
(konix/agent-shell-workspace--review-note-down
(car commit) id (konix/agent-shell-workspace--state-at-point)))
- rule
- and several commits making one change, a change undone then made again, are
a question each, as every commit is.
- how: the note names their questions one per line, in the order of their commits, each taking the first its forerunners left.
(defun konix/agent-shell-workspace--review-follow (commit taken)
"Follow COMMIT, (SHA . SUBJECT), with its question, putting one up where none stands.
The ids TAKEN are its forerunners'. Return (ID . NEW), NEW where put up just now."
(let ((noted (seq-find (lambda (line) (not (member (car line) taken)))
(konix/agent-shell-workspace--review-note (car commit)))))
(if (not (and noted
(save-excursion
(konix/agent-shell-workspace--goto-id (car noted)))))
(let ((id (or (car noted) (konix/agent-shell-workspace--new-question-id))))
(konix/agent-shell-workspace--review-put-up
commit id (equal (nth 1 noted) konix/agent-shell-workspace-done-keyword))
(cons id t))
(konix/agent-shell-workspace--goto-id (car noted))
(konix/agent-shell-workspace--review-heading commit)
(cons (car noted) nil))))
- rule
- and the review’s questions stand in the order of their commits, wherever the
first of them stood.
- why: a review is read in the order it was written, whichever were there before.
(defun konix/agent-shell-workspace--review-in-commit-order (kept)
"Set the review's questions KEPT, ids in commit order, where the first stood.
The review's questions KEPT does not name are dropped; return how many."
(let (texts where (gone 0))
(goto-char (point-min))
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
(format ".*:%s:" konix/agent-shell-workspace-review-tag))
nil t)
(beginning-of-line)
(let ((id (org-entry-get (point) "ID"))
(end (konix/agent-shell-workspace--question-end)))
(if (not (member id kept))
(setq gone (1+ gone))
(setq where (or where (point)))
(push (cons id (string-trim-right (buffer-substring (point) end))) texts))
(delete-region (point) end)))
(goto-char where)
(dolist (id kept)
(insert (cdr (assoc id texts)) "\n"))
gone))
(defun konix/agent-shell-workspace-review (revspec)
"Put every commit REVSPEC names in this workspace, one question each to review."
(interactive
(let ((ranges (konix/agent-shell-workspace--review-ranges)))
(list (read-string "Review which commits: " (car ranges) nil (cdr ranges)))))
(let* ((default-directory (konix/agent-shell-workspace--review-directory))
(commits (or (konix/agent-shell-workspace--commits-of revspec)
(user-error "%s names no commit" revspec)))
(added 0) kept gone)
(konix/agent-shell-workspace--review-take-over)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--review-remember-all)
(save-excursion
(dolist (commit commits)
(let ((followed (konix/agent-shell-workspace--review-follow commit kept)))
(push (car followed) kept)
(when (cdr followed) (setq added (1+ added)))))
(setq gone (konix/agent-shell-workspace--review-in-commit-order
(reverse kept)))))
(message "%d commits: %d new, %d followed, %d gone"
(length commits) added (- (length commits) added) gone)))
forgetting a review
- rule
- one command forgets the review, asking first, so the next
Vstarts afresh: the review’s questions in the workspace, and this workspace’s notes in the repository.- why: a review question still standing would note itself again as
Vstarts.
- why: a review question still standing would note itself again as
(defun konix/agent-shell-workspace-review-forget ()
"Forget the review: its questions here, and this workspace's notes in the repository."
(interactive)
(let ((default-directory (konix/agent-shell-workspace--review-directory))
(ref (konix/agent-shell-workspace--review-notes)))
(when (yes-or-no-p (format "Forget the review, its questions and its notes in %s? "
default-directory))
(konix/agent-shell-workspace--write
(save-excursion
(goto-char (point-min))
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
(format ".*:%s:" konix/agent-shell-workspace-review-tag))
nil t)
(beginning-of-line)
(delete-region (point) (konix/agent-shell-workspace--question-end)))))
(ignore-errors (konix/agent-shell-workspace--git "update-ref" "-d" ref))
(message "The review is forgotten, here and in %s" default-directory))))
rewriting a reviewed commit, the writer working on
- what
- the user fixes a small thing of a commit under review themselves — its
message, a line — rather than asking the writer.
- why: a back and forth with the writer for a word is more than the word is worth.
- rule
- and the writer goes on working in its tree meanwhile, nothing checked out
under it.
- how: the new commit is made from trees and objects alone, and
git replaycarries the ones after it onto it, in memory.- how: it only says what the branches would become, so they are moved once the tree checked out is known to take the change.
- how: every branch holding the commit is moved, in one transaction.
- rule: and the branch checked out has its files and index get what changed in
it, so the writer’s next commit keeps the fix rather than undoing it.
- rule: refused, nothing moved, where the writer has touched those lines
itself.
- why: moving the branch then would leave its tree undoing the fix.
- rule: refused, nothing moved, where the writer has touched those lines
itself.
- how: the review follows by the commits old and new, every question followed noting its state under its commit’s patch-id as it now stands.
- how: the new commit is made from trees and objects alone, and
(defun konix/agent-shell-workspace--git-fed (input environment &rest args)
"Return what git says to ARGS, fed INPUT, ENVIRONMENT added, at the repository's top."
(let ((process-environment (append environment process-environment))
(default-directory (string-trim (konix/agent-shell-workspace--git
"rev-parse" "--show-toplevel"))))
(with-temp-buffer
(insert (or input ""))
(unless (equal 0 (apply #'call-process-region (point-min) (point-max)
"git" t t nil args))
(user-error "git %s, in %s: %s" (string-join args " ") default-directory
(string-trim (buffer-string))))
(buffer-string))))
(defun konix/agent-shell-workspace--commit-like (sha tree message)
"Return a commit of TREE and MESSAGE with the parents and the author of SHA."
(let ((author (split-string (konix/agent-shell-workspace--git
"log" "-1" "--date=raw" "--format=%an%x00%ae%x00%ad" sha)
"\0")))
(string-trim
(apply #'konix/agent-shell-workspace--git-fed message
(list (concat "GIT_AUTHOR_NAME=" (nth 0 author))
(concat "GIT_AUTHOR_EMAIL=" (nth 1 author))
(concat "GIT_AUTHOR_DATE=" (string-trim (nth 2 author))))
"commit-tree" tree
(mapcan (lambda (parent) (list "-p" parent))
(cdr (split-string (konix/agent-shell-workspace--git
"rev-list" "--parents" "-n1" sha))))))))
- how
- a branch whose tip is the commit is moved to the new one; any other has the
commits after it replayed.
- rule: a commit after it that conflicts with the edit moves nothing, and is
offered to be resolved.
- why: git replay says nothing of it, so the conflict is named for what it is.
- rule: a commit after it that conflicts with the edit moves nothing, and is
offered to be resolved.
(define-error 'konix/agent-shell-workspace-conflict
"A commit after the one edited conflicts with the edit")
(defun konix/agent-shell-workspace--replayed (sha new)
"Return (REF NEW-TIP OLD-TIP) for each branch holding SHA, once moved onto NEW."
(let* ((tips (mapcar (lambda (ref)
(cons ref (string-trim (konix/agent-shell-workspace--git
"rev-parse" ref))))
(split-string (konix/agent-shell-workspace--git
"for-each-ref" "--contains" sha
"--format=%(refname)" "refs/heads")
"\n" t)))
(onward (seq-remove (lambda (tip) (equal (cdr tip) sha)) tips)))
(append
(mapcar (lambda (tip) (list (car tip) new sha))
(seq-filter (lambda (tip) (equal (cdr tip) sha)) tips))
(when onward
(mapcar (lambda (line) (cdr (split-string line)))
(split-string
(condition-case nil
(apply #'konix/agent-shell-workspace--git
"replay" "--ref-action=print"
"--onto" new (concat "^" sha) (mapcar #'car onward))
(user-error
(signal 'konix/agent-shell-workspace-conflict
(list sha new (mapcar #'car onward)))))
"\n" t))))))
(defun konix/agent-shell-workspace--rewrite (sha new)
"Put NEW in the place of the commit SHA, the writer's tree following.
Return ((OLD . NEW) ...) for each commit rewritten."
(let ((updates (konix/agent-shell-workspace--replayed sha new)))
(konix/agent-shell-workspace--move updates)
(cons (cons sha new) (konix/agent-shell-workspace--rewritten sha new updates))))
(defun konix/agent-shell-workspace--move (updates)
"Move the branches as UPDATES say, (REF NEW-TIP OLD-TIP) each, the tree following."
(let* ((head (ignore-errors (string-trim (konix/agent-shell-workspace--git
"symbolic-ref" "-q" "HEAD"))))
(here (assoc head updates))
(delta (if here
(konix/agent-shell-workspace--git
"diff" "--binary" (nth 2 here) (nth 1 here))
"")))
(unless (string-empty-p delta)
(konix/agent-shell-workspace--git-fed delta nil "apply" "--check" "--index"))
(konix/agent-shell-workspace--git-fed
(mapconcat (lambda (update) (apply #'format "update %s %s %s\n" update))
updates "")
nil "update-ref" "--stdin")
(unless (string-empty-p delta)
(konix/agent-shell-workspace--git-fed delta nil "apply" "--index"))))
- how
- the commits after it are paired old with new in their order, the review
following those pairs.
- scope: a branch that lost or gained a commit on the way pairs none.
- why: paired by their order, they would be paired wrong.
- scope: a branch that lost or gained a commit on the way pairs none.
(defun konix/agent-shell-workspace--rewritten (sha new updates)
"Return (OLD . NEW) for each commit after SHA the UPDATES replayed onto NEW."
(seq-uniq
(mapcan (lambda (update)
(let ((old (konix/agent-shell-workspace--git
"rev-list" "--reverse" (concat "^" sha) (nth 2 update)))
(now (konix/agent-shell-workspace--git
"rev-list" "--reverse" (concat "^" new) (nth 1 update))))
(when (= (length (split-string old)) (length (split-string now)))
(cl-mapcar #'cons (split-string old) (split-string now)))))
updates)))
- rule
- rewritten, every review question names its commit as it now stands, the one
edited keeping its state, and the diff shows it again.
- why: the user edited the commit they had read, and their own edit needs no new yes of theirs.
- scope: unlike an amend of the writer’s, whose changed patch-id asks again.
- rule: and any other whose patch-id changed on the way, a conflict resolved
say, is asked again.
- why: a patch-id changed asks again, whoever changed it.
(defun konix/agent-shell-workspace--review-rewritten (workspace id pairs)
"Have WORKSPACE's review follow PAIRS, (OLD . NEW) each, question ID edited."
(with-current-buffer workspace
(let ((default-directory (konix/agent-shell-workspace--review-directory)))
(konix/agent-shell-workspace--write
(save-excursion
(goto-char (point-min))
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re)
(format ".*:%s:" konix/agent-shell-workspace-review-tag))
nil t)
(when-let* ((revspec (org-entry-get (point) "REVSPEC"))
(old (string-remove-suffix "^!" revspec))
(new (cdr (assoc old pairs))))
(konix/agent-shell-workspace--review-heading
(cons new (string-trim (konix/agent-shell-workspace--git
"log" "-1" "--format=%s" new))))
(when (and (not (equal (org-entry-get (point) "ID") id))
(equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-done-keyword)
(not (equal (konix/agent-shell-workspace--review-key old)
(konix/agent-shell-workspace--review-key new))))
(org-todo konix/agent-shell-workspace-refine-keyword))
(konix/agent-shell-workspace--review-remember))
(end-of-line))))
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--show-diff-at-point t))))
editing a reviewed commit
- rule
Ein the diff makes it editable, its message and its hunks alike;C-c C-cwrites all it now says into the commit at once,C-c C-kleaves the commit as it was.- why: a message or a line found wrong in review is fixed where it was read, in one go.
- how: the commit is the one the question the diff was opened from names.
(defun konix/agent-shell-workspace--diff-commit ()
"Return (ID . SHA) of the question this diff was opened from and its commit."
(let ((id (or (nth 1 konix/agent-shell-workspace--diff-question)
(user-error "This diff was opened from no question"))))
(with-current-buffer (if (buffer-live-p konix/agent-shell-workspace--buffer)
konix/agent-shell-workspace--buffer
(user-error "The workspace this diff was shown from is gone"))
(save-excursion
(unless (konix/agent-shell-workspace--goto-id id)
(user-error "The question this diff was opened from is gone"))
(cons id (string-remove-suffix
"^!" (or (org-entry-get (point) "REVSPEC")
(user-error "This question is about no commit"))))))))
- how
- the message is the lines between the header git shows and the diff, their
indent taken off.
- how: in an index of its own, the commit’s tree has the diff it had taken off and
the one edited put on, and that tree is the commit’s anew.
- how: hunk counts are worked out again from the lines, so no header needs fixing by hand.
- rule: a diff that does not apply leaves the commit as it was, and says why.
- scope: a diff left as it was keeps the commit’s tree.
- how: in an index of its own, the commit’s tree has the diff it had taken off and
the one edited put on, and that tree is the commit’s anew.
(defvar-local konix/agent-shell-workspace--diff-was nil
"The diff this buffer showed as it was made editable.")
(defun konix/agent-shell-workspace--diff-start ()
"Return where the diff of this buffer starts, after the message above it."
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^diff --git " nil t) (match-beginning 0) (point-max))))
(defun konix/agent-shell-workspace--diff-part ()
"Return the diff of this buffer, the message above it left out."
(buffer-substring-no-properties (konix/agent-shell-workspace--diff-start) (point-max)))
(defun konix/agent-shell-workspace--diff-message ()
"Return the message this buffer shows above its diff, its indent taken off."
(save-excursion
(goto-char (point-min))
(re-search-forward "^$")
(concat (string-trim
(replace-regexp-in-string
"^ " "" (buffer-substring-no-properties
(point) (konix/agent-shell-workspace--diff-start))))
"\n")))
(defconst konix/agent-shell-workspace-diff-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'konix/agent-shell-workspace-diff-edit-done)
(define-key map (kbd "C-c C-k") #'konix/agent-shell-workspace-diff-edit-leave)
map)
"Keymap of `konix/agent-shell-workspace-diff-edit-mode'.")
(define-minor-mode konix/agent-shell-workspace-diff-edit-mode
"Edit the diff of a commit under review.
\\{konix/agent-shell-workspace-diff-edit-mode-map}"
:lighter " WorkspaceDiffEdit"
:keymap konix/agent-shell-workspace-diff-edit-mode-map)
- how
- the diff’s own keys go while it is edited, a letter being typed then.
(defun konix/agent-shell-workspace-edit-diff ()
"Make this diff editable, to write it into its commit."
(declare (modes konix/agent-shell-workspace-diff-mode))
(interactive)
(setq-local konix/agent-shell-workspace--diff-was
(konix/agent-shell-workspace--diff-part))
(konix/agent-shell-workspace-diff-mode -1)
(konix/agent-shell-workspace-diff-edit-mode 1))
(defun konix/agent-shell-workspace--tree-edited (sha was now)
"Return the tree of SHA with its diff WAS taken off and NOW put on instead."
(let* ((index (make-temp-file "workspace-index"))
(environment (list (concat "GIT_INDEX_FILE=" index))))
(unwind-protect
(progn
(konix/agent-shell-workspace--git-fed nil environment "read-tree" sha)
(konix/agent-shell-workspace--git-fed was environment "apply" "--cached" "-R")
(konix/agent-shell-workspace--git-fed now environment
"apply" "--cached" "--recount")
(string-trim (konix/agent-shell-workspace--git-fed nil environment
"write-tree")))
(delete-file index))))
(defun konix/agent-shell-workspace-diff-edit-done ()
"Write what this diff now says into its commit, and show the commit again."
(interactive)
(pcase-let* ((workspace konix/agent-shell-workspace--buffer)
(`(,id . ,sha) (konix/agent-shell-workspace--diff-commit))
(now (konix/agent-shell-workspace--diff-part))
(tree (if (equal now konix/agent-shell-workspace--diff-was)
(string-trim (konix/agent-shell-workspace--git
"rev-parse" (concat sha "^{tree}")))
(konix/agent-shell-workspace--tree-edited
sha konix/agent-shell-workspace--diff-was now))))
(condition-case conflict
(konix/agent-shell-workspace--review-rewritten
workspace id
(konix/agent-shell-workspace--rewrite
sha (konix/agent-shell-workspace--commit-like
sha tree (konix/agent-shell-workspace--diff-message))))
(konix/agent-shell-workspace-conflict
(apply #'konix/agent-shell-workspace--resolve-start workspace id
(cdr conflict))
(konix/agent-shell-workspace-diff-edit-leave)))))
(defun konix/agent-shell-workspace-diff-edit-leave ()
"Leave the commit as it was, and show its diff again."
(interactive)
(pcase-let ((`(,id . ,_) (konix/agent-shell-workspace--diff-commit)))
(with-current-buffer konix/agent-shell-workspace--buffer
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--show-diff-at-point t))))
resolving a conflict the edit brings
- how
- a commit after the one edited conflicting with the edit,
git rebasecarries them onto it in a worktree of its own, stopping at the conflict.- why: the user resolves it with the whole tree around, the writer’s untouched.
- rule: the diff is shown again as the commit stands, and from it
wopens that worktree in dired,csays it is resolved and goes on,Kdrops the edit, nothing moved.- why: in the files the user edits, every key is theirs.
- scope: one conflict at a time, and on one branch: several holding the commit are resolved by hand.
(defvar konix/agent-shell-workspace--resolving nil
"(WORKSPACE ID SHA NEW REF OLD-TIP WORKTREE) while an edit's conflict is resolved.")
(defun konix/agent-shell-workspace--worktree-git (worktree &rest args)
"Return git's exit status to ARGS in WORKTREE, no editor ever asked for."
(let ((process-environment (cons "GIT_EDITOR=true" process-environment)))
(apply #'call-process "git" nil nil nil "-C" worktree args)))
(defun konix/agent-shell-workspace--resolve-start (workspace id sha new refs)
"Rebase what follows SHA in REFS onto NEW in a worktree of its own, to resolve."
(when (cdr refs)
(user-error "The conflict spans %s: resolve it by hand" (string-join refs ", ")))
(when konix/agent-shell-workspace--resolving
(user-error "A conflict is being resolved already: c or K in its diff"))
(let ((old (string-trim (konix/agent-shell-workspace--git "rev-parse" (car refs))))
(worktree (expand-file-name
"workspace-worktree"
(string-trim (konix/agent-shell-workspace--git
"rev-parse" "--absolute-git-dir")))))
(konix/agent-shell-workspace--git "worktree" "add" "--detach" worktree old)
(konix/agent-shell-workspace--worktree-git worktree "rebase" "--onto" new sha)
(setq konix/agent-shell-workspace--resolving
(list workspace id sha new (car refs) old worktree))
(message "A commit after it conflicts: w goes to it, c once resolved, K drops it")))
(defun konix/agent-shell-workspace--resolving-or-error ()
"Return the conflict being resolved, or say there is none."
(or konix/agent-shell-workspace--resolving
(user-error "No conflict is being resolved")))
(defun konix/agent-shell-workspace-resolve-visit ()
"Open the worktree the conflict is resolved in."
(interactive)
(dired (nth 6 (konix/agent-shell-workspace--resolving-or-error))))
(defun konix/agent-shell-workspace--resolve-end (worktree)
"Take away WORKTREE, the conflict it held done with."
(konix/agent-shell-workspace--git "worktree" "remove" "--force" worktree)
(setq konix/agent-shell-workspace--resolving nil))
(defun konix/agent-shell-workspace-resolve-drop ()
"Drop the edit whose conflict is being resolved, nothing moved."
(interactive)
(let ((worktree (nth 6 (konix/agent-shell-workspace--resolving-or-error))))
(konix/agent-shell-workspace--worktree-git worktree "rebase" "--abort")
(konix/agent-shell-workspace--resolve-end worktree)
(message "The edit is dropped, nothing moved")))
- rule
cwhere a file still holds a conflict’s markers is refused, naming it.- how
- resolved, the files are added and the rebase goes on; a new conflict takes the user back to the worktree, and none left lands it all as an edit without one does.
(defun konix/agent-shell-workspace--rebasing-p (worktree)
"Non-nil while a rebase stands stopped in WORKTREE."
(let ((default-directory (file-name-as-directory worktree)))
(file-directory-p (expand-file-name
(string-trim (konix/agent-shell-workspace--git
"rev-parse" "--git-path" "rebase-merge"))))))
(defun konix/agent-shell-workspace--refuse-markers (worktree)
"Refuse to go on where a file of WORKTREE still holds a conflict's markers."
(let ((default-directory (file-name-as-directory worktree)))
(dolist (file (split-string (konix/agent-shell-workspace--git
"diff" "--name-only" "--diff-filter=U")
"\n" t))
(with-temp-buffer
(insert-file-contents file)
(when (re-search-forward "^<<<<<<< " nil t)
(user-error "%s still holds a conflict" file))))))
(defun konix/agent-shell-workspace-resolve-continue ()
"Go on, the conflict resolved, landing the edit once none is left."
(interactive)
(pcase-let ((`(,workspace ,id ,sha ,new ,ref ,old ,worktree)
(konix/agent-shell-workspace--resolving-or-error)))
(konix/agent-shell-workspace--refuse-markers worktree)
(when (konix/agent-shell-workspace--rebasing-p worktree)
(konix/agent-shell-workspace--worktree-git worktree "add" "-u")
(konix/agent-shell-workspace--worktree-git worktree "rebase" "--continue"))
(if (konix/agent-shell-workspace--rebasing-p worktree)
(progn (dired worktree)
(message "Another commit conflicts: c once resolved, K drops it"))
(let ((updates (list (list ref
(string-trim
(let ((default-directory (file-name-as-directory
worktree)))
(konix/agent-shell-workspace--git "rev-parse" "HEAD")))
old))))
(konix/agent-shell-workspace--move updates)
(konix/agent-shell-workspace--resolve-end worktree)
(konix/agent-shell-workspace--review-rewritten
workspace id
(cons (cons sha new)
(konix/agent-shell-workspace--rewritten sha new updates)))))))
answering
- rule
- yes and no are one keystroke each.
- rule
- anything else is a line the user types and what goes under it, and it travels with whatever the user was looking at.
- rule
- answering one hands it back, whatever state it stood in, a settled one
included.
- why: answering a settled question and having it stay settled is a bug.
- therefore: the user needs no second keystroke to reopen something they have just said one more thing about.
told there is something there
- rule
- a writer the limit has stopped is not told at all.
- why: it has reached its limit, so there is no need to nudge it.
- how: the last words a session said are what say so, which is how the session tools already tell one the limit stopped from one that finished.
- therefore: the user hears it plainly rather than watching a nudge go into a session that cannot answer.
- rule
- a writer at work hears it as its turn ends, whatever it was doing.
- why: whether it hears it at all cannot turn on what it happened to be doing when the user pressed the key.
- rule: and it is left to finish, the telling waiting rather than cutting in.
- why: the rest of its turn is work the user asked for and would be thrown away.
- scope: but what the user says with a key about the one it holds, an answer or a
reword, is heard at once, cutting it short, and
C-uleaves it for the turn’s end.- why: it may make what the writer is doing on that one wrong.
- rule
- and a turn the user cuts short takes whatever was waiting on its end with it.
- why: cutting one is how they stop a writer, and words landing the moment it stops start it again.
- scope: unless the cut was made to make way for those very words, as an answer’s is.
- rule
- and telling one says back whether it heard it or will hear it at the turn’s
end.
- why: the user pressed a key and has to know whether the writer is on it already.
what the writer is told
- rule
- what it is told carries the headings themselves, not an invitation to go and
read them.
- why: show the stuff it would list, to save the call to the tool.
- rule: and the projects ride on it, ahead of the headings.
- why: the user changes the projects and the writer would never see them.
- therefore: a project changed mid-session reaches it at the next word.
- scope: a workspace naming none says nothing, so the reminder appears only where there is one.
- rule: and holding a question, it is told the projects that question is for alone.
- why: every project at every telling is noise; the ones it serves are what matters.
- scope: bar the nudge, which names every open one, the cases it lists being about the whole workspace.
- rule: and it rides on everything else the writer is told without asking: the
listing it reads back, and each thing it is steered with.
- why: anywhere it may matter to remind the writer that there is a project to focus on.
- how: one line built from the file, put in front of a nudge and after each steering guidance, so nothing else has to know about projects.
- rule: and it says that the one taken up is the only thing worked on.
- why: the writer wanders off the question into whatever it notices on the way, and comes back with an answer to something else.
- therefore: what it notices has one place to go, which is a question of its own, and the user decides whether it is worth doing.
- rule: and it carries only what the writer can act on.
- what: the ones waiting on the writer, with their bodies.
- scope: a settled one, one waiting on the user, one put off and every fact drop out.
- scope: the tool itself still gives the whole file back, the writer sometimes needing to see where a question of its own stands.
- rule
- and telling the writer anything puts the steering on again first, so it says
what the note now says.
- why: a reload never reaches what was copied onto the session at binding.
- rule: and its failing cannot stop the telling.
- why: a telling that waits on the putting-on never wakes the writer where that fails.
- rule
- and a writer bound to nothing is owed no briefing.
- why: there is no workspace to brief it on.
(defun konix/agent-shell-workspace--projects-in (file)
"Return the open projects the workspace FILE has, as one line, or nil."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(when-let ((projects (konix/agent-shell-workspace--projects-here)))
(mapconcat (lambda (project) (format "« %s »" project)) projects " ; ")))))
(defun konix/agent-shell-workspace--held-projects-in (file)
"Return the open projects the question held in FILE is for, as one line, or nil."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(save-excursion
(goto-char (point-min))
(when (let (held)
(while (and (not held)
(konix/agent-shell-workspace--search-state
(konix/agent-shell-workspace--keyword-regexp
konix/agent-shell-workspace-held-keywords)))
(setq held (not (konix/agent-shell-workspace--project-at-point-p))))
held)
(let ((limit (konix/agent-shell-workspace--question-end))
(open (konix/agent-shell-workspace--projects-here))
projects)
(while (re-search-forward
(konix/agent-shell-workspace--said-line-regexp
konix/agent-shell-workspace-for-said)
limit t)
(let ((words (save-excursion
(when (konix/agent-shell-workspace--goto-id
(match-string-no-properties 1))
(string-trim (substring-no-properties
(org-get-heading t t t t)))))))
(when (member words open)
(push words projects))))
(when projects
(mapconcat (lambda (project) (format "« %s »" project))
(nreverse projects) " ; "))))))))
(defun konix/agent-shell-workspace--project-line (file)
"Return the workspace FILE's projects as a line to put ahead of something, or empty.
Where the writer holds a question, the projects it is for; else every open one."
(if-let ((project (or (konix/agent-shell-workspace--held-projects-in file)
(konix/agent-shell-workspace--projects-in file))))
(concat (format konix/agent-shell-workspace-project-said project) "\n\n")
""))
- rule
- and where the user has set priorities, it names the highest of the writer’s own free to take, to be taken up before any other.
(defconst konix/agent-shell-workspace-pressing-said
(concat "\n\nThe user has marked « %s » [#%s], the highest standing there:"
" take that one up before any other.")
"What a writer is told of the priority the user put on one of its questions.")
(defun konix/agent-shell-workspace--the-pressing-one (file)
"Return what FILE says of the priority its questions carry, or nothing."
(konix/agent-shell-workspace--read-file file
(let ((questions (konix/agent-shell-workspace--every-question))
best)
(goto-char (point-min))
(while (konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-writers-regexp)
(when-let* (((konix/agent-shell-workspace--free-to-take-at-point-p questions))
(priority (org-element-property
:priority (org-element-at-point)))
(higher (or (null best) (< priority (car best)))))
(setq best (cons priority (org-get-heading t t t t)))))
(if best
(format konix/agent-shell-workspace-pressing-said
(string-trim (cdr best)) (char-to-string (car best)))
""))))
- rule
- the nudge goes case by case, each case its headings listed then what to do
with them: projects owed their done and doing, projects owed a plan, questions to
discuss, questions to work on; a case with nothing in it is left out.
- why: one wording per case, with no condition deciding which one is said, nor any sentence said far from the headings it is about.
- why: told to take one up and act on a list holding questions to discuss, the writer went to work on one of those, and was refused.
- what
- a nudge with only a question to discuss says to discuss it, not to take one up; one with a question to work on says to take one up.
(require 'cl-lib)
(mapcar
(lambda (keyword)
(let ((file (make-temp-file "check-nudgediscuss-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
(format "** %s Explain it?\n :PROPERTIES:\n :ID: q\n :END:\n" keyword)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(let ((said (konix/agent-shell-workspace--nudge (current-buffer))))
(list (and (string-match-p "Take one up" said) t)
(and (string-match-p "to discuss, not to work on" said) t))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file))))
'("DISCUSS" "TODO"))
- what
- the check above is right when it reads
((nil t) (t nil)). - what
- a question awaiting a run that is over is listed with those to work on.
- why: left out, its writer was woken with nothing listed, and kept saying it was waiting.
(require 'cl-lib)
(let ((file (make-temp-file "check-nudgerunover-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** AWAITING Merge and watch CI?\n :PROPERTIES:\n :ID: a\n :END:\n"
" - ran :: =gh run watch= exited 0\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file)))
(let ((said (konix/agent-shell-workspace--nudge (current-buffer))))
(and (string-match-p "Merge and watch CI\\?\n\\(.*\n\\)*\nTake one up" said)
t)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
t. - what
- what a writer is told of a question to discuss, nudged or refused, says it may
draw its answer with plantuml in
.agent-shell/tmp.
(and (string-match-p "plantuml" konix/agent-shell-workspace-discuss-said) t)
- what
- the check above is right when it reads
t. - rule
- and the nudge ends by saying the chat goes unread.
- why: otherwise the writer may believe the user read what it wrote and agreed to its decisions, and go on to act on them.
(defconst konix/agent-shell-workspace-talking-harms-said
"Talking in this session harms the user"
"What both the nudge's last line and the refusal of prose open on.")
(defconst konix/agent-shell-workspace-unread-said
(concat "\n\n" konix/agent-shell-workspace-talking-harms-said
": nothing you write in this chat is read by anyone, and what the user"
" should see goes to the workspace.")
"What a nudge ends on, the writer's prose going nowhere.")
(defconst konix/agent-shell-workspace-dod-group-said
(concat "These projects do not say yet what done means nor what doing looks like."
" Before any plan, propose both for each with workspace_project_define,"
" passing its id, as two bullets « done :: … » and « doing :: … »: the user's yes on it writes"
" them under the project.")
"What a writer is told under the projects owed their done and doing.")
(defconst konix/agent-shell-workspace-plan-group-said
(concat "Nothing is in motion toward these projects. Make a plan for each: call"
" set_workspace_plan with the next steps toward it, each naming that project."
" If you hold one done, call workspace_project_done instead with its id,"
" saying why."
" Anything you need to look at first, to know which, a git status say, is"
" itself a step: plan it, take it up, then look.")
"What a writer is told under the projects owed a plan.")
(defconst konix/agent-shell-workspace-todo-group-said
(concat "Take one up and act on it, and on nothing else. Whatever else you notice"
" on the way is a question to write, never work to do.")
"What a writer is told under the questions it is to work on.")
(defconst konix/agent-shell-workspace-thinking-group-said
(concat "You hold this one to discuss it. Answer it with set_workspace_question,"
" act refine.")
"What a writer is told under the question it is thinking through.")
(defconst konix/agent-shell-workspace-thinking-news-said
(concat "You hold this one to discuss it, and the user has just said more under it:"
" that is the news, the whole of it above. Take it into your answer, which"
" you give with set_workspace_question, act refine.")
"What a writer is told under the question it is thinking through, the user's answer new.")
(defvar konix/agent-shell-workspace--news (make-hash-table :test #'equal)
"Workspace files whose writer is owed the news of an answer on what it thinks through.")
(defun konix/agent-shell-workspace--thinking-said (file)
"Return what the writer of FILE is told under what it thinks through, owed news or not.
Telling the news pays it."
(if (gethash (expand-file-name file) konix/agent-shell-workspace--news)
(progn (remhash (expand-file-name file) konix/agent-shell-workspace--news)
konix/agent-shell-workspace-thinking-news-said)
konix/agent-shell-workspace-thinking-group-said))
(defconst konix/agent-shell-workspace-working-answered-said
(concat "The user answered the question you were working on: « %s ». It is a"
" DISCUSS again: stop that work and take it up again.")
"What a writer is told when the user answers the question it was working on.")
(defvar konix/agent-shell-workspace--answered-working (make-hash-table :test #'equal)
"Workspace files whose writer is owed the user's answer on what it worked on.")
(defun konix/agent-shell-workspace--discuss-said (file)
"Return what the writer of FILE is told under what it is to discuss, owed news or not.
Telling the news pays it."
(if-let* ((answer (gethash (expand-file-name file)
konix/agent-shell-workspace--answered-working)))
(progn (remhash (expand-file-name file)
konix/agent-shell-workspace--answered-working)
(concat (format konix/agent-shell-workspace-working-answered-said answer)
" " konix/agent-shell-workspace-discuss-said))
konix/agent-shell-workspace-discuss-said))
(defun konix/agent-shell-workspace--owing-projects (file)
"Return (DOD . PLAN) of FILE: the open projects owed their done and doing, and a plan.
Each is a list of (ID . WORDS), in the file's order; one held back owes nothing."
(konix/agent-shell-workspace--read-file file
(goto-char (point-min))
(let ((questions (konix/agent-shell-workspace--every-question))
dod plan)
(while (konix/agent-shell-workspace--next-open-project)
(let ((id (org-entry-get (point) "ID"))
(words (concat (string-trim (substring-no-properties
(org-get-heading t t t t)))
(konix/agent-shell-workspace--project-text
(org-entry-get (point) "ID")))))
(unless (konix/agent-shell-workspace--holding-back id questions)
(cond
((not (konix/agent-shell-workspace--project-defined-p id))
(unless (konix/agent-shell-workspace--proposal-open-for-p id)
(push (cons id words) dod)))
((not (konix/agent-shell-workspace--in-motion-for-p id))
(push (cons id words) plan))))))
(cons (nreverse dod) (nreverse plan)))))
(defun konix/agent-shell-workspace--group (rows said)
"Return ROWS, a listing or a list of (ID . WORDS), then SAID; nothing when ROWS is."
(when rows
(concat (if (stringp rows)
rows
(mapconcat (lambda (one) (format "project %s — %s" (car one) (cdr one)))
rows "\n"))
"\n\n" said)))
(defun konix/agent-shell-workspace--nudge (writer)
"Return what WRITER is told: the projects, then one group per case, each with its words.
The cases are the projects owed their done and doing, those owed a plan, the
questions to discuss and those to work on; a case with nothing in it is left out."
(let* ((file (konix/agent-shell-workspace-file writer))
(owing (konix/agent-shell-workspace--owing-projects file))
(projects (konix/agent-shell-workspace--projects-in file))
(discuss (let ((konix/agent-shell-workspace--listing-states
(list konix/agent-shell-workspace-discuss-keyword)))
(konix/agent-shell-workspace--listing file t)))
(thinking (let ((konix/agent-shell-workspace--listing-states
(list konix/agent-shell-workspace-thinking-keyword)))
(konix/agent-shell-workspace--listing file t)))
(todo (let ((konix/agent-shell-workspace--listing-states
(cons konix/agent-shell-workspace-awaiting-keyword
(seq-difference
konix/agent-shell-workspace-writers-keywords
(list konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-thinking-keyword)))))
(konix/agent-shell-workspace--listing file t))))
(concat
(if projects
(concat (format konix/agent-shell-workspace-project-said projects) "\n\n")
"")
(string-join
(delq nil
(list (konix/agent-shell-workspace--group
(car owing) konix/agent-shell-workspace-dod-group-said)
(konix/agent-shell-workspace--group
(cdr owing) konix/agent-shell-workspace-plan-group-said)
(konix/agent-shell-workspace--group
thinking (and thinking
(konix/agent-shell-workspace--thinking-said file)))
(konix/agent-shell-workspace--group
discuss (and discuss (konix/agent-shell-workspace--discuss-said file)))
(konix/agent-shell-workspace--group
todo (concat konix/agent-shell-workspace-todo-group-said
(konix/agent-shell-workspace--the-pressing-one file)))))
"\n\n")
konix/agent-shell-workspace-unread-said)))
(defvar-local konix/agent-shell-workspace--briefed nil
"Non-nil once this writer has been told what a workspace of its is.")
(defvar-local konix/agent-shell-workspace--handed-over nil
"The summary of what the writer before this one knew, told with the briefing.")
(defun konix/agent-shell-workspace--handover-said (summary &optional work)
"Return what a fresh writer is told of SUMMARY, the one before it summed up.
WORK, where the work lives, is to be read before it."
(concat (when work (konix/agent-shell-workspace--work-said work))
(format (concat "You take over from a writer whose context grew too big. %s"
" sums up what it knew: read it first. Where it and the"
" workspace disagree, the workspace is right: the summary is a"
" memory, the questions the truth.")
summary)))
(defun konix/agent-shell-workspace--briefed-once-submitted (writer)
"Have WRITER count as briefed once its next input is submitted.
A shell with no events to wait on, as in a check, counts as briefed at once."
(with-current-buffer writer
(unless (ignore-errors
(let (token)
(setq token
(agent-shell-subscribe-to
:shell-buffer writer
:event 'input-submitted
:on-event
(lambda (_event)
(agent-shell-unsubscribe :subscription token)
(when (buffer-live-p writer)
(with-current-buffer writer
(setq-local konix/agent-shell-workspace--briefed t))))))))
(setq-local konix/agent-shell-workspace--briefed t))))
(defun konix/agent-shell-workspace--briefing-owed (writer text)
"Return TEXT with the briefing ahead of it, WRITER never having had one.
A writer bound to nothing is owed none. A writer handed over to is told
the summary it starts from with it."
(let ((file (konix/agent-shell-workspace-file writer)))
(if (or konix/agent-shell-workspace--briefed (null file))
text
(konix/agent-shell-workspace--briefed-once-submitted writer)
(let ((work (konix/agent-shell-workspace--work file)))
(konix/agent-shell-workspace--owe-reading writer work)
(concat (konix/agent-shell-workspace-binding-briefing
(konix/agent-shell-workspace--projects-in file))
"\n\n"
(cond (konix/agent-shell-workspace--handed-over
(concat (konix/agent-shell-workspace--handover-said
konix/agent-shell-workspace--handed-over work)
"\n\n"))
(work
(concat (string-trim
(konix/agent-shell-workspace--work-said work))
"\n\n"))
(t ""))
(let ((memos (konix/agent-shell-workspace--memos-said file)))
(if memos (concat memos "\n\n") ""))
text)))))
- rule
- the briefing counts as given once a text carrying it is submitted, not once
it is written.
- why: F’s two early tellings wait on the prompt, the newest first; the bare one went out, the briefing one met « Busy » and was dropped, counted as given all the same.
- therefore: until one is submitted, every telling carries it.
- what
- two tellings before any submit both carry the briefing; once one is submitted, the next does not.
(require 'cl-lib)
(let (on-submit)
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) "/x/w.ws.org"))
((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING"))
((symbol-function 'konix/agent-shell-workspace--projects-in) #'ignore)
((symbol-function 'agent-shell-subscribe-to)
(lambda (&rest args) (push (plist-get args :on-event) on-submit) 1))
((symbol-function 'agent-shell-unsubscribe) #'ignore))
(with-temp-buffer
(let* ((writer (current-buffer))
(first (konix/agent-shell-workspace--briefing-owed writer "A"))
(second (konix/agent-shell-workspace--briefing-owed writer "B")))
(mapc (lambda (f) (funcall f nil)) on-submit)
(list (string-prefix-p "BRIEFING" first)
(string-prefix-p "BRIEFING" second)
(konix/agent-shell-workspace--briefing-owed writer "C"))))))
- what
- the check above is right when it reads
(t t "C"). - what
- a writer not handed over is told the work with its briefing, once; with no
#+WORK:line, not at all.
(require 'cl-lib)
(let ((work "/x/the-work.org"))
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) "/x/w.ws.org"))
((symbol-function 'konix/agent-shell-workspace--work) (lambda (_) work))
((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING"))
((symbol-function 'konix/agent-shell-workspace--projects-in) #'ignore)
((symbol-function 'agent-shell-subscribe-to) #'ignore))
(list (with-temp-buffer
(list (konix/agent-shell-workspace--briefing-owed (current-buffer) "A")
(konix/agent-shell-workspace--briefing-owed (current-buffer) "B")))
(with-temp-buffer
(setq work nil)
(konix/agent-shell-workspace--briefing-owed (current-buffer) "A")))))
The work lives in /x/the-work.org: read it first.
A B) |BRIEFING
A |
The work lives in /x/the-work.org: read it first.
A B) |BRIEFING
A |
The work lives in /x/the-work.org: read it first.
A B) |BRIEFING
A |
- what
- the check above is right when it reads
(("BRIEFING\n\nThe work lives in /x/the-work.org: read it first.\n\nA" "B") "BRIEFING\n\nA").
how the telling is sent
- how
- the refusals of told there is something there come first, the steering put on again before them, and the words are then put into the shell.
- rule
- nothing is asked of a writer idle past its cache’s life: its header says how
long it has been idle, and the user sees it before telling it anything.
- why: past that life the whole context is sent again and paid in full.
- why: the prompt asking it got in the way more than it helped.
- what: the cache lives an hour after the last turn on a subscription, five minutes once its usage is past, as the session’s log tells.
- how: the idle time is counted from the writer’s last turn end, read off its session’s log when the workspace opens.
- how
- its life is the token file’s
konix/agent-shell-tokens-cache-lifetime, so the header and the mode line agree on when a writer is cold. - rule
- but a writer both past 150k of context and idle past 58 minutes is woken only
once the user says so, asked whether
Fwould not do better.- why: waking it resends that whole context, paid in full, where a fresh writer starts from a handover.
- scope: on both bounds only, so the prompt the user found in the way stays away from every other telling.
- how: a
nsends nothing; both bounds are defcustoms.
(defcustom konix/agent-shell-workspace-costly-context 150000
"Context, in tokens, past which waking an idle writer is asked first."
:type 'integer :group 'konix)
(defcustom konix/agent-shell-workspace-costly-idle (* 58 60)
"Seconds idle past which waking a writer with a big context is asked first."
:type 'integer :group 'konix)
(defun konix/agent-shell-workspace--costly-wake-p ()
"Non-nil when waking this workspace's writer resends a big context in full."
(and (numberp konix/agent-shell-workspace--context)
(> konix/agent-shell-workspace--context
konix/agent-shell-workspace-costly-context)
(when-let* ((idle (konix/agent-shell-workspace--idle)))
(> idle konix/agent-shell-workspace-costly-idle))))
(defvar-local konix/agent-shell-workspace--turn-ended nil
"When this workspace's writer last ended a turn, or nil when unknown.")
(defun konix/agent-shell-workspace--idle ()
"Return the seconds this workspace's writer has been idle, or nil when unknown."
(when konix/agent-shell-workspace--turn-ended
(truncate (float-time (time-subtract nil konix/agent-shell-workspace--turn-ended)))))
(defun konix/agent-shell-workspace--stale-p ()
"Non-nil when this workspace's writer has been idle past its cache's life."
(when-let* ((idle (konix/agent-shell-workspace--idle)))
(>= idle konix/agent-shell-tokens-cache-lifetime)))
(defun konix/agent-shell-workspace--say-now (writer text)
"Say TEXT to WRITER, whose turn is over."
(unless (buffer-live-p writer)
(user-error "That writer is gone, so nothing is sent"))
(when (and (konix/agent-shell-workspace--costly-wake-p)
(not (y-or-n-p "This may consume a lot of tokens, sure not to F instead? ")))
(user-error "Nothing sent: F starts a fresh writer"))
(konix/agent-shell-workspace--note-compact :prompt text :shell-buffer writer)
(konix/agent-shell--submit-when-free writer text)
t)
(defun konix/agent-shell-workspace--refuse-telling (writer text)
"Put the steering on WRITER again, and refuse telling it TEXT where it may not be."
(ignore-errors (konix/agent-shell-workspace--install-steering writer))
(unless (or text
(not (konix/agent-shell-workspace-file writer))
(not (konix/agent-shell-workspace--writer-done-p
(konix/agent-shell-workspace-file writer))))
(user-error "Nothing in the workspace is %s's, so it is left alone"
(buffer-name writer)))
(when (with-current-buffer writer
(ignore-errors (konix/agent-shell--rate-limited-p)))
(user-error "%s has reached its limit, so it is left alone"
(buffer-name writer))))
- rule
- and the idle time of the session
Freplaces is never read again.- why: a revert while Haiku summed up read it back, and the fresh writer was shown as idle for hours.
- how: not read while the fresh writer is coming, and dropped as a writer starts.
- what
- idle two hours, the writer is told all the same; the header says the idle age, plain at 10 min, orange at 55 min, red at 2h.
(require 'cl-lib)
(let ((file (make-temp-file "check-stale-" nil ".ws.org"))
(shell (generate-new-buffer " check-stale-writer"))
sent)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--note-compact) #'ignore)
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (setq sent t))))
(let ((workspace (find-file-noselect file)))
(prog1 (with-current-buffer workspace
(setq konix/agent-shell-workspace--context 92000
konix/agent-shell-workspace--model "opus")
(cons (progn
(setq konix/agent-shell-workspace--turn-ended
(time-subtract nil 7200))
(konix/agent-shell-workspace--say-now shell "go on")
sent)
(mapcar (lambda (idle)
(setq konix/agent-shell-workspace--turn-ended
(time-subtract nil idle))
(let ((line (konix/agent-shell-workspace--context-header-line)))
(list (substring-no-properties line)
(let ((face (get-text-property 10 'face line)))
(if (consp face) (plist-get face :foreground) face)))))
'(600 3300 7200))))
(kill-buffer workspace))))
(kill-buffer shell)
(delete-file file)))
- what
- the check above is right when it reads
(t ("92k opus · idle 10m" konix/agent-shell-workspace-age-face) ("92k opus · idle 55m" "orange") ("92k opus · idle 2h" "red3")). - what
- a writer at 200k idle an hour is asked about first:
nsends nothing,ysends; idle ten minutes, or at 92k, it is told without asking.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-costly-writer")))
(unwind-protect
(with-temp-buffer
(cl-letf (((symbol-function 'konix/agent-shell-workspace--note-compact) #'ignore)
((symbol-function 'agent-shell--insert-to-shell-buffer) #'ignore))
(mapcar (lambda (case)
(pcase-let ((`(,context ,idle ,answer) case))
(setq konix/agent-shell-workspace--context context
konix/agent-shell-workspace--turn-ended
(time-subtract nil idle))
(let (asked)
(cl-letf (((symbol-function 'y-or-n-p)
(lambda (&rest _) (setq asked t) answer)))
(list (condition-case nil
(and (konix/agent-shell-workspace--say-now
shell "go on")
'sent)
(user-error 'kept))
(if asked 'asked 'silent))))))
'((200000 3600 nil) (200000 3600 t) (200000 600 nil)
(92000 3600 nil)))))
(kill-buffer shell)))
- what
- the check above is right when it reads
((kept asked) (sent asked) (sent silent) (sent silent)). - what
- a workspace reopened while the fresh writer is coming reads no idle time.
(require 'cl-lib)
(let ((file (make-temp-file "check-stale-once-" nil ".ws.org")))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--named-session-spec)
(lambda () "old?cwd=/tmp/"))
((symbol-function 'konix/agent-shell--claude-session-file)
(lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--turn-ended-in)
(lambda (_) (time-subtract nil 7200))))
(let ((workspace (find-file-noselect file)))
(prog1 (with-current-buffer workspace
(setq-local konix/agent-shell-workspace--fresh-coming t)
(setq konix/agent-shell-workspace--turn-ended nil)
(konix/agent-shell-workspace--context-at-open)
(prog1 konix/agent-shell-workspace--turn-ended
(setq-local konix/agent-shell-workspace--fresh-coming nil)))
(with-current-buffer workspace (set-buffer-modified-p nil))
(let ((kill-buffer-query-functions nil)) (kill-buffer workspace)))))
(delete-file file)))
- what
- the check above is right when it reads
nil. - rule
- a writer compacting is told nothing until its compaction has ended, the last
telling held and said then.
- why: Claude Code ends the /compact turn while it still compacts, and a prompt arriving then cancels the compaction: Z came back « Compaction canceled. » time after time, the workspace telling the writer right after the turn’s end.
- how: compacting from the /compact sent until the session’s file shows it done or canceled, as the header says « compacting… ».
- what
- told while compacting, the writer hears nothing; the compaction done, it is told once.
(require 'cl-lib)
(let ((file (make-temp-file "check-heldcompact-" nil ".ws.org"))
(jsonl (make-temp-file "check-heldcompact-" nil ".jsonl" "{\"usage\":{}}\n"))
(state (list (cons :usage (list (cons :context-used 290000)))))
said)
(unwind-protect
(cl-letf (((symbol-function 'agent-shell--state) (lambda () state))
((symbol-function 'file-notify-add-watch) (lambda (&rest _) 'w))
((symbol-function 'file-notify-rm-watch) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said) t))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file))
((symbol-function 'konix/agent-shell-workspace--session-file-of)
(lambda (_) jsonl))
((symbol-function 'konix/agent-shell-workspace--model-in) (lambda (_) "opus")))
(let ((workspace (find-file-noselect file)))
(with-temp-buffer
(let ((shell (current-buffer)))
(konix/agent-shell-workspace--note-compact :prompt "/compact" :shell-buffer shell)
(konix/agent-shell-workspace--context-at-turn-end shell)
(prog1 (list (konix/agent-shell-workspace--submit shell "go on")
(copy-sequence said)
(progn (write-region
"{\"type\":\"system\",\"subtype\":\"compact_boundary\"}\n"
nil jsonl t 'quiet)
(konix/agent-shell-workspace--context-at-turn-end shell)
said))
(kill-buffer workspace))))))
(delete-file file)
(delete-file jsonl)))
- what
- the check above is right when it reads
(held nil ("go on")).
(defvar-local konix/agent-shell-workspace--held-for-compaction nil
"(TEXT) where telling this writer waits for its compaction to end, or nil.")
(defun konix/agent-shell-workspace--tell-held (writer)
"Tell WRITER what was held for its compaction, once that compaction has ended."
(with-current-buffer writer
(when-let* ((held konix/agent-shell-workspace--held-for-compaction)
((not konix/agent-shell-workspace--compacting)))
(setq konix/agent-shell-workspace--held-for-compaction nil)
(condition-case err (konix/agent-shell-workspace--submit writer (car held))
(error (message "Told after compacting: %s" (error-message-string err)))))))
(defun konix/agent-shell-workspace--submit (writer &optional text now)
"Tell WRITER of the workspace, as its turn ends or at once if NOW.
TEXT overrides the headings it would otherwise be handed. Returns t
where it heard it, `injected' where it was asked to hear it in the
running turn, `queued' where it hears it as the turn ends and `held'
where it hears it once its compaction has ended."
(konix/agent-shell-workspace--refuse-telling writer text)
(with-current-buffer writer
(let* ((build (lambda ()
(konix/agent-shell-workspace--briefing-owed
writer (or text (konix/agent-shell-workspace--nudge writer)))))
(how (cond
(konix/agent-shell-workspace--compacting
(setq konix/agent-shell-workspace--held-for-compaction (list text))
'held)
((not (shell-maker-busy))
(konix/agent-shell-workspace--say-now writer (funcall build)))
(now
(let ((said (funcall build)))
(konix/agent-shell--inject
said (lambda ()
(konix/agent-shell-workspace--say-at-turn-end writer said))))
'injected)
(t
(konix/agent-shell-workspace--say-at-turn-end
writer (if text (funcall build) build))))))
(konix/agent-shell-workspace--debug
'telling (konix/agent-shell-workspace--debug-name writer) "%s -> %s: %s"
(buffer-name writer) (if (eq how t) 'said how)
(truncate-string-to-width (car (split-string (or text "the workspace") "\n"))
80 nil nil "…"))
how)))
- rule
- told at once mid-turn, the writer has the words injected into the turn it is
in, never that turn cancelled.
- why: a cancelled turn tells the writer « STOP what you are doing and wait for the user », the opposite of what it is told.
- how: injected through
_session/steering, the ACP extension for adding to a running turn.
- what
- told now mid-turn, the writer is asked to take the words into its turn, and the turn is not cancelled.
(lambda (busy refuse thunk)
(let ((shell (generate-new-buffer " check-now-writer")))
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'shell-maker-busy) (lambda () (car busy)))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'acp-send-request)
(cl-function (lambda (&key request on-failure &allow-other-keys)
(funcall refuse request on-failure)))))
(funcall thunk shell)))
(kill-buffer shell))))
(require 'cl-lib)
(let ((in-world
(lambda (busy refuse thunk)
(let ((shell (generate-new-buffer " check-now-writer")))
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'shell-maker-busy) (lambda () (car busy)))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'acp-send-request)
(cl-function (lambda (&key request on-failure &allow-other-keys)
(funcall refuse request on-failure)))))
(funcall thunk shell)))
(kill-buffer shell)))))
sent cut)
(funcall in-world (list t)
(lambda (request _on-failure) (setq sent request))
(lambda (shell)
(cl-letf (((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(list (konix/agent-shell-workspace--submit shell "Look." t)
(map-elt sent :method)
(map-nested-elt sent '(:params sessionId))
cut)))))
- what
- the check above is right when it reads
(injected "_session/steering" "s1" nil). - what
- each telling leaves a
tellingline saying how the writer was told.
(require 'cl-lib)
(let ((in-world
(lambda (busy refuse thunk)
(let ((shell (generate-new-buffer " check-now-writer")))
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'shell-maker-busy) (lambda () (car busy)))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'acp-send-request)
(cl-function (lambda (&key request on-failure &allow-other-keys)
(funcall refuse request on-failure)))))
(funcall thunk shell)))
(kill-buffer shell)))))
(konix/agent-shell-workspace-debug-log " check-telling-log"))
(unwind-protect
(progn
(funcall in-world (list t)
(lambda (_request _on-failure) nil)
(lambda (shell) (konix/agent-shell-workspace--submit shell "Look." t)))
(with-current-buffer konix/agent-shell-workspace-debug-log
(and (string-match-p "\\[telling\\] .*-> injected: Look\\." (buffer-string)) t)))
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))))
- what
- the check above is right when it reads
t. - what
- an agent refusing the injection hears the words as its turn ends, or at once where the turn has ended before the refusal came back.
(require 'cl-lib)
(let ((in-world
(lambda (busy refuse thunk)
(let ((shell (generate-new-buffer " check-now-writer")))
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'shell-maker-busy) (lambda () (car busy)))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'acp-send-request)
(cl-function (lambda (&key request on-failure &allow-other-keys)
(funcall refuse request on-failure)))))
(funcall thunk shell)))
(kill-buffer shell))))))
(mapcar
(lambda (ended-first)
(let ((busy (list t)) waited said)
(funcall in-world busy
(lambda (_request on-failure)
(when ended-first (setcar busy nil))
(funcall on-failure 'e nil))
(lambda (shell)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--say-when-idle)
(lambda (&rest _) (setq waited t) 'token))
((symbol-function 'agent-shell-unsubscribe)
(lambda (&rest _) (setq waited nil)))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (&rest _) (setq said t))))
(konix/agent-shell-workspace--submit shell "Look." t)
(cond (said 'said) (waited 'waits) (t 'lost)))))))
'(nil t)))
- what
- the check above is right when it reads
(waits said). - what
- words the agent takes into its turn are shown in the writer’s shell, as a submitted prompt would be.
(require 'cl-lib)
(let ((in-world
(lambda (busy refuse thunk)
(let ((shell (generate-new-buffer " check-now-writer")))
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'shell-maker-busy) (lambda () (car busy)))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'acp-send-request)
(cl-function (lambda (&key request on-failure &allow-other-keys)
(funcall refuse request on-failure)))))
(funcall thunk shell)))
(kill-buffer shell)))))
shown)
(funcall in-world (list t)
(lambda (_request _on-failure) nil)
(lambda (shell)
(cl-letf (((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success &allow-other-keys)
(funcall on-success nil))))
((symbol-function 'agent-shell--update-fragment)
(cl-function (lambda (&key body &allow-other-keys)
(push body shown)))))
(konix/agent-shell-workspace--submit shell "Look." t)
shown))))
- what
- the check above is right when it reads
("Look."). - rule
- and so does the steering when it refuses a tool call: its guidance injected
into the turn, queued for the turn’s end where the agent refuses it.
- scope: a match on the writer’s prose still cuts the turn, as does handing control back to the user at the last round.
- what
- the checks below share one world: a writer mid-turn, one steering rule
matching, the steering reacting to an event and the turn then ending; it gives back
what happened, in order —
sentan injection,queuedfor the turn’s end,cut,submittedas the next prompt,shownin the turn’s stop reason — and the rounds counted.
(lambda (event-kind rounds refuse)
(let ((shell (generate-new-buffer " check-steering-writer"))
happened ends)
(unwind-protect
(with-current-buffer shell
(cl-letf* ((log (lambda (what) (push what happened)))
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(push on-event ends))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
#'ignore)
((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success on-failure &allow-other-keys)
(funcall log 'sent)
(if refuse
(funcall on-failure 'e nil)
(funcall on-success nil)))))
((symbol-function 'agent-shell--update-fragment) #'ignore)
((symbol-function 'konix/agent-shell--enqueue-reason)
(lambda (_reason) (funcall log 'queued)))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (funcall log 'cut)))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (funcall log 'submitted)))
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (funcall log 'shown))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds rounds)
(dolist (kind (ensure-list event-kind))
(konix/agent-shell-steering--react (list (cons :event kind))))
(dolist (end ends) (funcall end nil))
(when (memq 'queued happened)
(konix/agent-shell-steering--on-input-submitted nil))
(list (reverse happened) konix/agent-shell-steering--rounds)))
(kill-buffer shell))))
- what
- the steering’s guidance on a tool call is injected into the turn, and the turn is not cancelled.
(require 'cl-lib)
(funcall
(lambda (event-kind rounds refuse)
(let ((shell (generate-new-buffer " check-steering-writer"))
happened ends)
(unwind-protect
(with-current-buffer shell
(cl-letf* ((log (lambda (what) (push what happened)))
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(push on-event ends))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
#'ignore)
((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success on-failure &allow-other-keys)
(funcall log 'sent)
(if refuse
(funcall on-failure 'e nil)
(funcall on-success nil)))))
((symbol-function 'agent-shell--update-fragment) #'ignore)
((symbol-function 'konix/agent-shell--enqueue-reason)
(lambda (_reason) (funcall log 'queued)))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (funcall log 'cut)))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (funcall log 'submitted)))
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (funcall log 'shown))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds rounds)
(dolist (kind (ensure-list event-kind))
(konix/agent-shell-steering--react (list (cons :event kind))))
(dolist (end ends) (funcall end nil))
(when (memq 'queued happened)
(konix/agent-shell-steering--on-input-submitted nil))
(list (reverse happened) konix/agent-shell-steering--rounds)))
(kill-buffer shell))))
'tool-call-update 0 nil)
- what
- the check above is right when it reads
((sent) 1). - what
- refused, the steering’s guidance on a tool call is queued for the turn’s end, and its submission is still counted as one of the steering’s rounds.
(require 'cl-lib)
(funcall
(lambda (event-kind rounds refuse)
(let ((shell (generate-new-buffer " check-steering-writer"))
happened ends)
(unwind-protect
(with-current-buffer shell
(cl-letf* ((log (lambda (what) (push what happened)))
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(push on-event ends))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
#'ignore)
((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success on-failure &allow-other-keys)
(funcall log 'sent)
(if refuse
(funcall on-failure 'e nil)
(funcall on-success nil)))))
((symbol-function 'agent-shell--update-fragment) #'ignore)
((symbol-function 'konix/agent-shell--enqueue-reason)
(lambda (_reason) (funcall log 'queued)))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (funcall log 'cut)))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (funcall log 'submitted)))
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (funcall log 'shown))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds rounds)
(dolist (kind (ensure-list event-kind))
(konix/agent-shell-steering--react (list (cons :event kind))))
(dolist (end ends) (funcall end nil))
(when (memq 'queued happened)
(konix/agent-shell-steering--on-input-submitted nil))
(list (reverse happened) konix/agent-shell-steering--rounds)))
(kill-buffer shell))))
'tool-call-update 0 t)
- what
- the check above is right when it reads
((sent queued) 1), the round not reset by the queued guidance going in. - what
- once an injection is answered, the next match in the same turn is injected too, rather than dropped without a word.
(require 'cl-lib)
(funcall
(lambda (event-kind rounds refuse)
(let ((shell (generate-new-buffer " check-steering-writer"))
happened ends)
(unwind-protect
(with-current-buffer shell
(cl-letf* ((log (lambda (what) (push what happened)))
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(push on-event ends))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
#'ignore)
((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success on-failure &allow-other-keys)
(funcall log 'sent)
(if refuse
(funcall on-failure 'e nil)
(funcall on-success nil)))))
((symbol-function 'agent-shell--update-fragment) #'ignore)
((symbol-function 'konix/agent-shell--enqueue-reason)
(lambda (_reason) (funcall log 'queued)))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (funcall log 'cut)))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (funcall log 'submitted)))
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (funcall log 'shown))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds rounds)
(dolist (kind (ensure-list event-kind))
(konix/agent-shell-steering--react (list (cons :event kind))))
(dolist (end ends) (funcall end nil))
(when (memq 'queued happened)
(konix/agent-shell-steering--on-input-submitted nil))
(list (reverse happened) konix/agent-shell-steering--rounds)))
(kill-buffer shell))))
'(tool-call-update tool-call-update) 0 nil)
- what
- the check above is right when it reads
((sent sent) 2). - what
- on a match on the writer’s prose, the steering still cuts the turn and submits its guidance as the next prompt.
(require 'cl-lib)
(funcall
(lambda (event-kind rounds refuse)
(let ((shell (generate-new-buffer " check-steering-writer"))
happened ends)
(unwind-protect
(with-current-buffer shell
(cl-letf* ((log (lambda (what) (push what happened)))
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(push on-event ends))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
#'ignore)
((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success on-failure &allow-other-keys)
(funcall log 'sent)
(if refuse
(funcall on-failure 'e nil)
(funcall on-success nil)))))
((symbol-function 'agent-shell--update-fragment) #'ignore)
((symbol-function 'konix/agent-shell--enqueue-reason)
(lambda (_reason) (funcall log 'queued)))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (funcall log 'cut)))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (funcall log 'submitted)))
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (funcall log 'shown))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds rounds)
(dolist (kind (ensure-list event-kind))
(konix/agent-shell-steering--react (list (cons :event kind))))
(dolist (end ends) (funcall end nil))
(when (memq 'queued happened)
(konix/agent-shell-steering--on-input-submitted nil))
(list (reverse happened) konix/agent-shell-steering--rounds)))
(kill-buffer shell))))
'agent-message-chunk 0 nil)
- what
- the check above is right when it reads
((cut submitted) 1). - what
- at the last round, even on a tool call, the steering cuts the turn and shows its guidance in the turn’s stop reason, submitting nothing.
(require 'cl-lib)
(funcall
(lambda (event-kind rounds refuse)
(let ((shell (generate-new-buffer " check-steering-writer"))
happened ends)
(unwind-protect
(with-current-buffer shell
(cl-letf* ((log (lambda (what) (push what happened)))
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell--state)
(lambda () '((:client . c) (:session . ((:id . "s1"))))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(push on-event ends))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions)
#'ignore)
((symbol-function 'acp-send-request)
(cl-function (lambda (&key on-success on-failure &allow-other-keys)
(funcall log 'sent)
(if refuse
(funcall on-failure 'e nil)
(funcall on-success nil)))))
((symbol-function 'agent-shell--update-fragment) #'ignore)
((symbol-function 'konix/agent-shell--enqueue-reason)
(lambda (_reason) (funcall log 'queued)))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (funcall log 'cut)))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(lambda (&rest _) (funcall log 'submitted)))
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (funcall log 'shown))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds rounds)
(dolist (kind (ensure-list event-kind))
(konix/agent-shell-steering--react (list (cons :event kind))))
(dolist (end ends) (funcall end nil))
(when (memq 'queued happened)
(konix/agent-shell-steering--on-input-submitted nil))
(list (reverse happened) konix/agent-shell-steering--rounds)))
(kill-buffer shell))))
'tool-call-update (1- konix/agent-shell-steering-max-rounds) nil)
- what
- the check above is right when it reads
((cut shown) 3), withkonix/agent-shell-steering-max-roundsat 3. - what
- a writer the steering stopped at its last round is set going once the steering’s notice is shown, never before, with no timer.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-steered-back-writer"))
ends happened)
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'run-at-time) #'ignore)
((symbol-function 'derived-mode-p) (lambda (&rest _) t))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event) '(subject . "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(when (eq event 'turn-complete)
(setq ends (append ends (list on-event))))
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--show-in-stop-reason)
(lambda (_text) (push 'shown happened)))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) "/tmp/check-steered.ws.org"))
((symbol-function 'konix/agent-shell-workspace--context-at-turn-end) #'ignore)
((symbol-function 'konix/agent-shell-workspace--turn-ended-as-ever) #'ignore)
((symbol-function 'konix/agent-shell-workspace--go-on)
(lambda (_writer) (push 'went happened))))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--auto-submitting nil)
(setq-local konix/agent-shell-steering--rounds
(1- konix/agent-shell-steering-max-rounds))
(konix/agent-shell-workspace--watch-turns)
(konix/agent-shell-steering--react '((:event . agent-message-chunk)))
(dolist (end ends) (funcall end nil))
(reverse happened)))
(kill-buffer shell)))
- what
- the check above is right when it reads
(shown went). - what
- refusing a tool call, the steering’s notice names the call: its title, its kind and what it was given.
(require 'cl-lib)
(let ((shell (generate-new-buffer " check-steering-names-writer"))
notice)
(unwind-protect
(with-current-buffer shell
(cl-letf (((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell-steering--compacting-p) #'ignore)
((symbol-function 'konix/agent-shell-steering--subject-and-haystack)
(lambda (_event)
'(((:title . "Write") (:kind . "edit")
(:raw-input . ((file_path . "/r/x.puml"))))
. "haystack")))
((symbol-function 'konix/agent-shell-steering--matches)
(lambda (&rest _) '(("rule" . "Stay on it."))))
((symbol-function 'konix/agent-shell--interrupt-and-deliver)
(lambda (text &rest _) (setq notice text) 'injected)))
(setq-local konix/agent-shell--reason-delivery-scheduled nil)
(setq-local konix/agent-shell-steering--cap-stopped nil)
(setq-local konix/agent-shell-steering--rounds 0)
(konix/agent-shell-steering--react '((:event . tool-call-update)))
(and notice
(string-match-p "on Write (edit): ((file_path \\. \"/r/x.puml\"))" notice)
t)))
(kill-buffer shell)))
- what
- the check above is right when it reads
t. - how
- a buffer mid-turn refuses the text, so it waits on
turn-complete, and what it waits for is asked for before the turn is looked at again.- why: a turn ending between the two would leave nobody listening and the words would be dropped.
- rule
- a turn cut short keeps the words waiting, said as the next turn ends.
- why: the steering cuts turns often, and the user’s answer died with them.
- rule
- what tells a busy writer the workspace waits as one, written as it is said.
- why: written as each answer came, the first said started a turn, and the next came on a busy writer and was lost, the user’s second answer with it.
- therefore: the workspace as it stands at the turn’s end is what the writer reads.
(defvar-local konix/agent-shell-workspace--telling-owed nil
"What waits to tell this writer the workspace as its turn ends, or nil.")
(defun konix/agent-shell-workspace--text-to-say (text)
"Return TEXT, or what it writes where it is a function."
(if (functionp text) (funcall text) text))
(defun konix/agent-shell-workspace--say-at-turn-end (writer text)
"Say TEXT to WRITER as its turn ends, or now where it has ended.
TEXT a function is the workspace's telling, written as it is said, and one
already waiting stands for it. Returns `queued', or t where it heard it."
(if (and (functionp text)
(buffer-local-value 'konix/agent-shell-workspace--telling-owed writer))
'queued
(let ((waiting (konix/agent-shell-workspace--say-when-idle writer text)))
(if (with-current-buffer writer (shell-maker-busy))
(progn (when (functionp text)
(with-current-buffer writer
(setq konix/agent-shell-workspace--telling-owed waiting)))
'queued)
(agent-shell-unsubscribe :subscription waiting)
(konix/agent-shell-workspace--say-now
writer (konix/agent-shell-workspace--text-to-say text))))))
(defun konix/agent-shell-workspace--say-when-idle (writer text)
"Wait for WRITER's turn to end and say TEXT then, returning what waits.
A turn cut short keeps TEXT waiting for the next one to end."
(let ((going-on konix/agent-shell-workspace--going-on)
token)
(setq token
(agent-shell-subscribe-to
:shell-buffer writer :event 'turn-complete
:on-event
(lambda (event)
(cond
((not (buffer-live-p writer))
(agent-shell-unsubscribe :subscription token))
((and going-on (konix/agent-shell-workspace--waiting-p writer))
(agent-shell-unsubscribe :subscription token))
((not (equal (map-elt (map-elt event :data) :stop-reason) "cancelled"))
(agent-shell-unsubscribe :subscription token)
(when (functionp text)
(with-current-buffer writer
(setq konix/agent-shell-workspace--telling-owed nil)))
(konix/agent-shell-workspace--say-now
writer (konix/agent-shell-workspace--text-to-say text)))))))))
- what
- words waiting through a cut turn are said once, as the next turn ends.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-cutkeeps-writer"))
handler said (subscribed 0))
(unwind-protect
(cl-letf (((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key on-event &allow-other-keys)
(cl-incf subscribed)
(setq handler on-event)
'token)))
((symbol-function 'agent-shell-unsubscribe)
(lambda (&rest _) (cl-decf subscribed)))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said))))
(konix/agent-shell-workspace--say-when-idle writer "Look.")
(funcall handler '((:data . ((:stop-reason . "cancelled")))))
(let ((after-cut (list said subscribed)))
(funcall handler '((:data . ((:stop-reason . "end_turn")))))
(list after-cut said subscribed)))
(kill-buffer writer)))
- what
- the check above is right when it reads
((nil 1) ("Look.") 0). - what
- two sends at one turn end: the second waits for the next end, where a bare insert errors.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-secondwaits-writer")))
(unwind-protect
(cl-flet ((run (send)
(let (busy subs (count 0) sent errors)
(cl-letf (((symbol-function 'shell-maker-busy) (lambda () busy))
((symbol-function 'agent-shell--insert-to-shell-buffer)
(cl-function (lambda (&key text &allow-other-keys)
(when busy (user-error "Busy, try later"))
(setq busy t)
(push text sent))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key on-event &allow-other-keys)
(push (cons (cl-incf count) on-event) subs)
count)))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq subs (assq-delete-all subscription subs))))))
(cl-flet ((turn-end ()
(setq busy nil)
(dolist (sub subs)
(condition-case err (funcall (cdr sub) nil)
(error (push (cadr err) errors))))))
(setq busy t)
(dolist (text '("B" "A"))
(let (token)
(setq token (agent-shell-subscribe-to
:on-event (lambda (_)
(agent-shell-unsubscribe :subscription token)
(funcall send text))))))
(turn-end)
(let ((first (list (reverse sent) errors)))
(turn-end)
(list first (reverse sent) errors)))))))
(list (run (lambda (text)
(agent-shell--insert-to-shell-buffer
:shell-buffer writer :text text :submit t :no-focus t)))
(run (lambda (text) (konix/agent-shell--submit-when-free writer text)))))
(kill-buffer writer)))
- what
- the check above is right when it reads
((((A) (Busy, try later)) (A) (Busy, try later)) (((A) nil) (A B) nil)). - what
- two answers told a busy writer wait as one telling, written at the turn’s end.
(require 'cl-lib)
(let ((writer (generate-new-buffer " check-oneowed-writer"))
(workspace "first answer")
handlers said)
(unwind-protect
(with-current-buffer writer
(cl-letf (((symbol-function 'konix/agent-shell-workspace--refuse-telling) #'ignore)
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'konix/agent-shell-workspace--nudge)
(lambda (_writer) workspace))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key on-event &allow-other-keys)
(push on-event handlers)
'token)))
((symbol-function 'agent-shell-unsubscribe) #'ignore)
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (_writer text) (push text said))))
(konix/agent-shell-workspace--submit writer)
(setq workspace "first answer, second answer")
(konix/agent-shell-workspace--submit writer)
(dolist (handler handlers)
(funcall handler '((:data . ((:stop-reason . "end_turn"))))))
(list (length handlers) said konix/agent-shell-workspace--telling-owed)))
(kill-buffer writer)))
- what
- the check above is right when it reads
(1 ("first answer, second answer") nil).
how a shell says it is warm or cold
- what
- every shell’s mode line counts down the time it stays warm, then shows, as « ❄ 180k », the context its next turn sends again.
- rule
- once a cold turn ends, it says what it resent: « Cold turn in A@Write « sli…:
resent 180k ».
- why: the rate limits it said before move in 1% steps, so one turn always read « +0.0% of 5h, +0.0% of 7d ».
- how: the shell is named by its buffer cut to 30 characters, not the whole heading.
;;; KONIX_agent-shell-tokens.el --- Whether a session is still warm in Anthropic's cache -*- lexical-binding: t; -*-
;; Copyright (C) 2026 konubinix
;; Author: konubinix <konubinixweb@gmail.com>
;; Keywords:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Anthropic keeps a session's prompt cached for a while after its last reply.
;; Past that, the next turn resends the whole context. The mode line counts
;; down the time the session stays warm, then shows what the next turn
;; resends; once a cold turn ends, it says how much it resent.
;;; Code:
(require 'map)
(require 'KONIX_agent-shell-naming)
(declare-function agent-shell--state "agent-shell")
(declare-function agent-shell-subscribe-to "agent-shell")
(defcustom konix/agent-shell-tokens-cache-lifetime 3600
"Seconds Anthropic keeps a session's prompt cached after its last reply."
:type 'integer
:group 'konix)
(defcustom konix/agent-shell-tokens-tail-bytes 65536
"Bytes read off the end of a session file to find its last reply."
:type 'integer
:group 'konix)
(defvar-local konix/agent-shell-tokens--last-reply nil
"When this shell's last reply came, as a float time, or nil when unknown.")
(defvar-local konix/agent-shell-tokens--resent nil
"The context, in tokens, this shell's cold turn resends, or nil.")
(defvar-local konix/agent-shell-tokens--last-cold nil
"What this shell's last cold turn resent, as said.")
(defun konix/agent-shell-tokens--last-reply-in (file)
"Return the float time of the last reply FILE, a session's JSONL, records."
(when (and file (file-readable-p file))
(with-temp-buffer
(let ((size (file-attribute-size (file-attributes file))))
(insert-file-contents
file nil (max 0 (- size konix/agent-shell-tokens-tail-bytes)) size))
(goto-char (point-max))
(when (re-search-backward "\"timestamp\":\"\\([^\"]+\\)\"" nil t)
(float-time (date-to-time (match-string 1)))))))
(defun konix/agent-shell-tokens--warm-left (&optional now)
"Return the seconds this shell stays warm after NOW, or nil when unknown."
(when konix/agent-shell-tokens--last-reply
(- (+ konix/agent-shell-tokens--last-reply konix/agent-shell-tokens-cache-lifetime)
(or now (float-time)))))
(defun konix/agent-shell-tokens--cold-p ()
"Non-nil when this shell's next turn resends its whole context."
(when-let* ((left (konix/agent-shell-tokens--warm-left)))
(<= left 0)))
(defun konix/agent-shell-tokens--context ()
"Return this shell's context, in tokens, or nil before any is known."
(map-nested-elt (agent-shell--state) '(:usage :context-used)))
(defun konix/agent-shell-tokens--mode-line ()
"Return what the mode line says of this shell's cache, or nothing yet."
(when-let* ((left (konix/agent-shell-tokens--warm-left)))
(if (> left 0)
(propertize (format " warm %dm" (ceiling left 60))
'help-echo (concat "Cached on Anthropic's side until then"
(when konix/agent-shell-tokens--last-cold
(concat "; last cold turn: "
konix/agent-shell-tokens--last-cold))))
(propertize (format " ❄ %s"
(if-let* ((context (konix/agent-shell-tokens--context)))
(format "%dk" (round context 1000))
"?"))
'face 'warning
'help-echo "Cold: the next turn resends this whole context"))))
(defun konix/agent-shell-tokens--turn-starts ()
"Note the context a cold turn resends, as it starts."
(setq konix/agent-shell-tokens--resent
(and (konix/agent-shell-tokens--cold-p)
(konix/agent-shell-tokens--context))))
(defun konix/agent-shell-tokens--turn-ends ()
"Note the reply, and say what a cold turn resent."
(setq konix/agent-shell-tokens--last-reply (float-time))
(when-let* ((resent konix/agent-shell-tokens--resent))
(setq konix/agent-shell-tokens--last-cold
(format "resent %dk" (round resent 1000)))
(message "Cold turn in %s: %s"
(truncate-string-to-width (buffer-name) 30 nil nil "…")
konix/agent-shell-tokens--last-cold))
(setq konix/agent-shell-tokens--resent nil)
(force-mode-line-update))
(defun konix/agent-shell-tokens--session-starts ()
"Know when this resumed session's last reply came, from its file."
(unless konix/agent-shell-tokens--last-reply
(setq konix/agent-shell-tokens--last-reply
(ignore-errors
(konix/agent-shell-tokens--last-reply-in
(konix/agent-shell--claude-session-file
(map-nested-elt (agent-shell--state) '(:session :id))))))))
(defvar konix/agent-shell-tokens--timer nil
"Timer redrawing the mode lines as the minutes go.")
(defun konix/agent-shell-tokens--watch ()
"Show in this shell's mode line whether it is still warm."
(setq-local mode-line-misc-info
(cons '(:eval (konix/agent-shell-tokens--mode-line))
(default-value 'mode-line-misc-info)))
(unless (timerp konix/agent-shell-tokens--timer)
(setq konix/agent-shell-tokens--timer
(run-at-time 60 60 #'force-mode-line-update t)))
(let ((shell (current-buffer)))
(pcase-dolist (`(,event . ,react)
'((init-finished . konix/agent-shell-tokens--session-starts)
(input-submitted . konix/agent-shell-tokens--turn-starts)
(turn-complete . konix/agent-shell-tokens--turn-ends)))
(agent-shell-subscribe-to
:shell-buffer shell
:event event
:on-event (lambda (_event)
(when (buffer-live-p shell)
(with-current-buffer shell
(funcall react))))))))
(add-hook 'agent-shell-mode-hook #'konix/agent-shell-tokens--watch)
(provide 'KONIX_agent-shell-tokens)
;;; KONIX_agent-shell-tokens.el ends here
- what
- a turn starting an hour and a minute after the last reply, on 182 400 tokens, says it resent 182k; a warm one says nothing.
(require 'cl-lib)
(with-temp-buffer
(rename-buffer "A@Write « slideshow » for both « frame » and « show »" t)
(cl-letf (((symbol-function 'agent-shell--state)
(lambda () '(:usage (:context-used 182400)))))
(mapcar (lambda (idle)
(let (said)
(cl-letf (((symbol-function 'message)
(lambda (&rest args) (setq said (apply #'format args)))))
(setq konix/agent-shell-tokens--last-reply (- (float-time) idle))
(konix/agent-shell-tokens--turn-starts)
(konix/agent-shell-tokens--turn-ends))
said))
'(3660 60))))
- what
- the check above is right when it reads
("Cold turn in A@Write « slideshow » for bot…: resent 182k" nil).
what the user says, put down
- rule
- what the user says waits under the question, and two things said in a row
both wait there.
- rule: it opens on no keyword.
- rule: and answering or settling while the user stands on one reaches the question it sits under, not the answer.
- rule
- what the words are about is settled as the key is pressed, not as they are
typed.
- why: the writer rewrites the workspace under the user while they type, and what stood under the cursor is not there to be read afterwards.
- how: what they stood on travels with the words: the fact, or else the question,
and the line itself.
- rule: or, a region selected, the region alone, its lines joined.
- why: the user selects the part they mean.
- rule: or, a region selected, the region alone, its lines joined.
- what
- a region quotes its words alone, links shown as their text; none, the line.
(with-temp-buffer
(org-mode)
(insert "* TODO Fix it?\n - what :: the tilt of [[id:x][the tower]]\n leans left\n")
(goto-char (point-min))
(re-search-forward "tilt")
(let ((start (match-beginning 0)))
(re-search-forward "leans")
(transient-mark-mode 1)
(push-mark start t t)
(prog1 (list (konix/agent-shell-workspace--line-here)
(progn (deactivate-mark) (konix/agent-shell-workspace--line-here))))))
- what
- the check above is right when it reads
("« tilt of the tower leans »" "« leans left »").
(defun konix/agent-shell-workspace--line-here ()
"Return the words of the region, or of the line point is on, quoted, the markup dropped."
(if (use-region-p)
(format "« %s »"
(string-trim
(replace-regexp-in-string
"[ \t\n]+" " "
(org-link-display-format
(buffer-substring-no-properties (region-beginning) (region-end))))))
(let ((words (if (org-at-heading-p)
(org-get-heading t t t t)
(org-link-display-format
(string-trim
(buffer-substring-no-properties (line-beginning-position)
(line-end-position)))))))
(when (string-prefix-p "- " words)
(setq words (substring words 2)))
(when-let* ((said (string-search " :: " words)))
(setq words (substring words (+ said 4))))
(format "« %s »" (string-trim words)))))
(defun konix/agent-shell-workspace--stood-on ()
"Return what the user stands on: a fact, the question's id, and the line's words."
(list (konix/agent-shell-workspace--fact-here)
(unless (org-before-first-heading-p)
(save-excursion
(konix/agent-shell-workspace--goto-question)
(org-entry-get (point) "ID")))
(konix/agent-shell-workspace--line-here)))
(defun konix/agent-shell-workspace--standing-on-a-question ()
"Return what the user stands on, coming back from a diff to the question first."
(if (bound-and-true-p konix/agent-shell-workspace-diff-mode)
(let ((question konix/agent-shell-workspace--diff-question))
(unless (buffer-live-p konix/agent-shell-workspace--buffer)
(user-error "The workspace this diff was shown from is gone"))
(konix/agent-shell-workspace-back)
(or question (konix/agent-shell-workspace--stood-on)))
(konix/agent-shell-workspace--stood-on)))
- how
- the words go at the end of the question, a heading of their own opening on
me:, the line they were said on quoted under them.- how: and said from a diff, the diff line they were said on quoted under them too, linked to its source, as the commit under review says.
(defun konix/agent-shell-workspace--write-answer (standing answer &optional body diff-line)
"Put ANSWER, and BODY under it, at the question STANDING was taken on.
DIFF-LINE, (FILE LINE QUOTED), comes out under it, quoted and linked."
(pcase-let ((`(,_fact ,question ,here) standing))
(konix/agent-shell-workspace--write
(save-excursion
(unless (and question (konix/agent-shell-workspace--goto-id question))
(konix/agent-shell-workspace--goto-heading))
(goto-char (konix/agent-shell-workspace--question-end))
(unless (bolp) (insert "\n"))
(insert (konix/agent-shell-workspace--stars 1) " "
konix/agent-shell-workspace-user-said
(string-trim answer) "\n"
" :PROPERTIES:\n :ID: " (org-id-new) "\n"
(konix/agent-shell-workspace--touched " ")
" :END:\n"
" - what :: said on " here "\n"
(konix/agent-shell-workspace--body-under body " ")
(if diff-line
(konix/agent-shell-workspace--subject-place
(nth 0 diff-line) (nth 1 diff-line) (nth 2 diff-line) " ")
""))))))
- rule
- and none goes under the facts heading, which asks nothing.
- how: the user is told to answer a fact or a question instead.
- rule: nor above every heading, nor on the memos, refused before a word is written.
- why: a go above every heading went to the memos heading, which became a question; refused there by its state, the answer still stood under the memo.
- what
- a go from the line above every heading, then on a memo: refused, nothing written.
(require 'cl-lib)
(mapcar
(lambda (where)
(let ((file (make-temp-file "check-no-answer-memos-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n#+WORK: ~/x.org\n"
"* Memos :memos:\n** A memo\n :PROPERTIES:\n :ID: m\n :END:\n"
"* Facts :facts:\n** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"
"* [0/1] Mine :mine:\n"
"** REFINE Do it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(if (eq where 'top)
(progn (goto-char (point-min)) (forward-line 1))
(konix/agent-shell-workspace--goto-id "m"))
(prog1 (list (condition-case nil
(progn (konix/agent-shell-workspace-answer-go) 'written)
(user-error 'refused))
(save-excursion
(goto-char (point-min))
(how-many "^\\*+ me: ")))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file))))
'(top memo))
- what
- the check above is right when it reads
((refused 0) (refused 0)).
(defun konix/agent-shell-workspace--refuse-answering-facts (standing)
"Refuse an answer STANDING would put on no question: under the facts heading,
above every heading, on the memos heading or a memo."
(when (save-excursion
(when-let* ((question (nth 1 standing)))
(and (konix/agent-shell-workspace--goto-id question)
(konix/agent-shell-workspace--facts-at-point-p))))
(user-error "The facts heading asks nothing: answer a fact or a question"))
(when (save-excursion
(when-let* ((question (nth 1 standing)))
(konix/agent-shell-workspace--goto-id question))
(or (org-before-first-heading-p)
(equal (konix/agent-shell-workspace--part-at)
konix/agent-shell-workspace-memos-tag)))
(user-error "No question here to answer: stand on a question, or on a fact")))
- how
- and the question is handed back, whatever state it stood in.
(defun konix/agent-shell-workspace--hand-back (&optional go answer)
"Hand the question at point back to the writer to answer, and save so it sees it.
GO, the user's go, hands it back to be worked on instead. One the writer is
thinking through stays held, to be thought through with the answer; one it was
working on owes it ANSWER, the user's words on it."
(let ((spot (konix/agent-shell-workspace--spot-at (point))))
(konix/agent-shell-workspace--goto-question)
(let ((thinking (equal (org-get-todo-state)
konix/agent-shell-workspace-thinking-keyword))
(working (equal (org-get-todo-state)
konix/agent-shell-workspace-working-keyword)))
(when (and thinking (not go) buffer-file-name)
(puthash (expand-file-name buffer-file-name) t konix/agent-shell-workspace--news))
(when (and working (not go) answer buffer-file-name)
(puthash (expand-file-name buffer-file-name) (string-trim answer)
konix/agent-shell-workspace--answered-working))
(konix/agent-shell-workspace--write
(org-todo (cond
(go konix/agent-shell-workspace-fresh-keyword)
(thinking konix/agent-shell-workspace-thinking-keyword)
(t konix/agent-shell-workspace-discuss-keyword)))))
(when-let* ((place (konix/agent-shell-workspace--spot-place spot)))
(goto-char place))))
- rule
- handing a question back leaves the cursor where it stood in it.
- why: a mark kept round the rewrite falls where the rewrite cut, the top of the file: the cursor wandered off the question answered.
- what
gon the only question of Mine leaves the cursor on Mine’s heading, the question gone to the writer’s part.
(require 'cl-lib)
(let ((file (make-temp-file "check-go-cursor-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Facts :facts:\n"
"* Mine :mine:\n"
"** REFINE Go here?\n :PROPERTIES:\n :ID: r\n :END:\n"
" - what :: body\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(goto-char (point-min))
(search-forward "body")
(konix/agent-shell-workspace-answer-go)
(prog1 (org-get-heading t t t t)
(set-buffer-modified-p nil))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
"[0/0] Mine". - rule
- no key jumps the cursor elsewhere once done: the write alone places it, and a
question it moved out of the part leaves the cursor on its neighbour there, the one
below, else above, else on the part’s heading.
- why: the user, having answered or settled one, was carried off to whatever waited next, out of the part they were reading.
- how: one place decides, the write’s keeping of the cursor, which every key goes
through;
nandpstill walk on, asked to.
- what
gon A,ron B,ton C, a fact beside them, each leave the cursor in Mine: on B, on C, then on Mine’s heading.
(require 'cl-lib)
(let ((file (make-temp-file "check-keys-part-" nil ".ws.org")) seen)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Facts :facts:\n"
"** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"
"* Mine :mine:\n")
(dolist (id '("A" "B" "C"))
(insert (format "** REFINE %s?\n :PROPERTIES:\n :ID: %s\n :END:\n - what :: body %s\n"
id id id))))
(cl-flet ((where ()
(list (save-excursion (org-back-to-heading t)
(while (org-up-heading-safe))
(car (org-get-tags nil t)))
(save-excursion (org-back-to-heading t)
(if (= (org-current-level) 1) "part"
(org-get-heading t t t t))))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "ok" nil))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(goto-char (point-min))
(search-forward "body A")
(konix/agent-shell-workspace-answer-go)
(push (where) seen)
(goto-char (point-min))
(search-forward "body B")
(konix/agent-shell-workspace-answer)
(push (where) seen)
(goto-char (point-min))
(search-forward "body C")
(konix/agent-shell-workspace-done-with-it)
(push (where) seen)
(set-buffer-modified-p nil)
(nreverse seen)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file))))
- what
- the check above is right when it reads
(("mine" "B?") ("mine" "C?") ("mine" "part")). - what
- each key, point in the body of B between A and C in Mine, leaves point in B where B stays in Mine, else on C; archive keeps B there. Each key’s time, in milliseconds over 20 runs, is read after where it left point.
(require 'cl-lib)
(let ((keys '(("g" . konix/agent-shell-workspace-answer-go)
("r" . konix/agent-shell-workspace-answer)
("t" . konix/agent-shell-workspace-done-with-it)
("." . konix/agent-shell-workspace-answer-done)
("k" . konix/agent-shell-workspace-drop)
("archive" . konix/agent-shell-workspace-archive)))
rows)
(cl-labels ((where ()
(list (save-excursion (org-back-to-heading t)
(while (org-up-heading-safe))
(car (org-get-tags nil t)))
(save-excursion (org-back-to-heading t)
(if (= (org-current-level) 1) "part"
(org-get-heading t t t t)))))
(run (command)
(let ((file (make-temp-file "check-keys-question-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Facts :facts:\n"
"** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"
"* Mine :mine:\n")
(dolist (id '("A" "B" "C"))
(insert (format "** REFINE %s?\n :PROPERTIES:\n :ID: %s\n :END:\n - link :: [[id:f][A fact]]\n - what :: body %s\n"
id id id))))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(goto-char (point-min))
(search-forward "body B")
(let* ((start (float-time))
(failed (condition-case err
(progn (funcall command) nil)
(error (error-message-string err))))
(took (- (float-time) start)))
(list (or failed (where)) took)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--read-heading-and-body)
(lambda (&rest _) (list "ok" nil)))
((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
((symbol-function 'y-or-n-p) (lambda (&rest _) t))
((symbol-function 'message) #'ignore))
(pcase-dolist (`(,key . ,command) keys)
(let ((landed (car (run command)))
(total 0))
(dotimes (_ 20) (cl-incf total (cadr (run command))))
(push (list key landed (round (* 1000 (/ total 20)))) rows)))))
(nreverse rows))
- rule
- the view is settled once the answer is written, never patched as it goes.
- rule
- an answer leaving the writer nothing it may take up, every question of its
own held back, is written all the same, and the writer is not told, the echo area
saying so.
- how: the writer hears of it once settling what holds its questions back frees work for it.
- what
gon a question held back behind another still open writes the answer, raises nothing, tells the writer nothing, and says so.
(require 'cl-lib)
(let ((file (make-temp-file "check-held-" nil ".ws.org")) told said)
(with-temp-file file
(insert "#+TODO: TODO REFINE AWAITING WORKING | DONE\n"
"* Mine :mine:\n"
"** REFINE Yours first?\n :PROPERTIES:\n :ID: held-x\n :END:\n"
" - holds back :: [[id:held-a][First?]]\n"
"** TODO First?\n :PROPERTIES:\n :ID: held-a\n :END:\n"
" - before :: [[id:held-b][Then?]]\n"
" - waits on :: [[id:held-x][Yours first?]]\n"
"** REFINE Then?\n :PROPERTIES:\n :ID: held-b\n :END:\n"
" - after :: [[id:held-a][First?]]\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--say-now)
(lambda (&rest _) (setq told t)))
((symbol-function 'konix/agent-shell-workspace--say-when-idle)
(lambda (&rest _) (setq told t)))
((symbol-function 'konix/agent-shell-workspace--install-steering)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--nudge)
(lambda (&rest _) "read it back"))
((symbol-function 'konix/agent-shell-workspace--briefing-owed)
(lambda (_writer text) text))
((symbol-function 'shell-maker-busy) #'ignore)
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--rate-limited-p) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'message)
(lambda (format-string &rest args)
(when (string-match-p "not told"
(apply #'format format-string args))
(setq said t)))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer (current-buffer))
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Then")
(prog1 (list (condition-case err
(progn (konix/agent-shell-workspace-answer-go) 'no-error)
(error (error-message-string err)))
(save-restriction
(widen)
(goto-char (point-min))
(and (re-search-forward "^\\*\\*\\* me: go on" nil t) 'answered))
(if told 'told 'not-told)
(and said 'said-so))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(no-error answered not-told said-so). - rule
- while
F’s fresh writer is coming, an answer is written but nobody is told.- why: the user prepares its work while waiting; nudging the writer being replaced makes no sense.
- therefore: the fresh writer reads it all as it starts.
- rule
- and nothing is said to a writer whose buffer is gone.
- why: a send to the writer
Fkilled failed on « Selecting deleted buffer ».
- why: a send to the writer
- what
gwhile the fresh writer is coming writes the answer, tells no one and says so; a send to a killed writer is refused.
(require 'cl-lib)
(let ((file (make-temp-file "check-fresh-answer-" nil ".ws.org"))
(gone (generate-new-buffer " check-fresh-gone"))
told said)
(with-temp-file file
(insert "#+TODO: TODO REFINE AWAITING WORKING | DONE\n"
"* Mine :mine:\n"
"** REFINE Do it?\n :PROPERTIES:\n :ID: fresh-q\n :END:\n"))
(kill-buffer gone)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (&rest _) (setq told t)))
((symbol-function 'message)
(lambda (format-string &rest args)
(setq said (apply #'format format-string args)))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--fresh-coming t)
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Do it")
(prog1 (list (condition-case err
(progn (konix/agent-shell-workspace-answer-go) 'no-error)
(error (error-message-string err)))
(save-restriction
(widen)
(goto-char (point-min))
(and (re-search-forward "^\\*\\*\\* me: go on" nil t) 'answered))
(if told 'told 'not-told)
(and (string-match-p "fresh writer reads it" (or said "")) 'said-so)
(condition-case err
(konix/agent-shell-workspace--say-now gone "go on")
(user-error (error-message-string err))))
(setq-local konix/agent-shell-workspace--fresh-coming nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(no-error answered not-told said-so "That writer is gone, so nothing is sent").
(defun konix/agent-shell-workspace--send (standing answer &optional later body diff-line go)
"Put ANSWER, and BODY under it, where STANDING says, and tell the writer.
An answer on the one it holds cuts it short, unless LATER; any other waits for
its turn to end. DIFF-LINE, (FILE LINE QUOTED), is the diff line it was said on.
GO is the user's go on one being worked out."
(deactivate-mark)
(konix/agent-shell-workspace--one-line-or-error answer)
(unless (car standing)
(konix/agent-shell-workspace--refuse-answering-facts standing))
(unless (bound-and-true-p konix/agent-shell-workspace--fresh-coming)
(konix/agent-shell-workspace--target-writer))
(if (car standing)
(konix/agent-shell-workspace--ask-about-fact standing answer body)
(let ((held (save-excursion
(when-let* ((question (nth 1 standing))
((konix/agent-shell-workspace--goto-id question)))
(konix/agent-shell-workspace--held-state-p
(konix/agent-shell-workspace--state-at-point))))))
(konix/agent-shell-workspace--write-answer standing answer body diff-line)
(when-let* ((question (nth 1 standing)))
(konix/agent-shell-workspace--goto-id question))
(konix/agent-shell-workspace--hand-back go answer)
(setq later (or later (not held))))
(message
(cond
((bound-and-true-p konix/agent-shell-workspace--fresh-coming)
"Written — the fresh writer reads it as it starts")
((konix/agent-shell-workspace--writer-done-p buffer-file-name)
"Written — nothing is the writer's to take up yet, so it is not told")
((eq t (konix/agent-shell-workspace--submit
konix/agent-shell-workspace--writer-buffer nil (not later)))
"Woke the writer")
(t "Queued — the writer reads it as its turn ends"))))
(konix/agent-shell-workspace--move-on))
(defun konix/agent-shell-workspace--move-on ()
"Settle the view, the cursor left where the write put it."
(konix/agent-shell-workspace-focus-question))
- rule
- whatever
ydoes — answer, give a leave, settle a project or write its DoD — it ends the one way, the view settled and the cursor left where the write put it.- how: a
ythe workspace handles itself, a leave, a project settled or its DoD written, ends on the very move an answer sent ends on, one function for both; so the check below, an answer and a project settled, with the DoD’s own check, stands for every kind, the move being shared.
- how: a
- rule
- and
gagrees asydoes wherever agreeing acts: it settles a closed one, agrees a project, gives a leave, writes a DoD; elsewhere it says « go on ».- why:
gon a closed one sent « go on », and on a leave, the command never ran. - how: one function does what agreeing does, for both keys.
- why:
(require 'cl-lib)
(let ((file (make-temp-file "check-go-closed-" nil ".ws.org")) sent)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING TOCHECK | DONE\n"
"* Mine :mine:\n"
"** TOCHECK Fixed the tilt\n :PROPERTIES:\n :ID: c\n :END:\n"
" - proof :: it ran\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send)
(lambda (&rest args) (push (nth 1 args) sent))))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(goto-char (point-min))
(re-search-forward "^\\*\\* TOCHECK")
(konix/agent-shell-workspace-answer-go)
(prog1 (list (save-excursion
(goto-char (point-min))
(re-search-forward "^\\*\\* \\([A-Z]+\\) Fixed")
(match-string 1))
sent)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("DONE" nil): settled, nothing sent. - what
- a
yanswering a question, and one saying a project is done, each move the user on.
(require 'cl-lib)
(let ((file (make-temp-file "check-yes-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"* Mine :mine:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"** REFINE A plain one?\n :PROPERTIES:\n :ID: a\n :END:\n"
" - what :: answer it\n"
"** TODO The writer's first?\n :PROPERTIES:\n :ID: w1\n :END:\n"
" - what :: its own\n"
"** REFINE Is the project done?\n :PROPERTIES:\n :ID: d\n"
" :PROJECT-CHECK: p\n :END:\n - what :: it is\n"
"** TODO The writer's?\n :PROPERTIES:\n :ID: w\n :END:\n"
" - what :: its own\n"
"** REFINE Another of yours?\n :PROPERTIES:\n :ID: n\n :END:\n"
" - what :: waits on you\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(cl-flet ((yes-on (heading)
(save-restriction
(widen)
(goto-char (point-min))
(re-search-forward heading))
(konix/agent-shell-workspace-answer-yes)
(org-entry-get (point) "ID")))
(prog1 (list (yes-on "^\\*\\* REFINE A plain one")
(yes-on "^\\*\\* REFINE Is the project done"))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
("d" "n"): past the writer’s own each time, to the next of the user’s.
(defun konix/agent-shell-workspace-answer (&optional later)
"Read an answer to what point stands on and send it, at once unless LATER."
(interactive "P")
(let* ((diff-line (konix/agent-shell-workspace--diff-line-here))
(standing (konix/agent-shell-workspace--standing-on-a-question))
(place (konix/agent-shell-workspace--location-at-point t)))
(pcase-let ((`(,answer ,body)
(konix/agent-shell-workspace--read-heading-and-body
(if place
(format "Answer on %s:%d: "
(file-name-nondirectory (car place)) (cdr place))
"Answer: "))))
(konix/agent-shell-workspace--send standing answer later body diff-line))))
(defun konix/agent-shell-workspace--agree-here ()
"Agree to what point stands on where agreeing acts, and say whether it did.
On one the writer closed, settle it; on a project, agree it; on one asking leave to
run a command, run it; on a proposal of a project's done and doing, write them."
(if (save-excursion (konix/agent-shell-workspace--goto-question)
(equal (org-get-todo-state)
konix/agent-shell-workspace-closing-keyword))
(progn (konix/agent-shell-workspace--goto-question)
(konix/agent-shell-workspace--settle-question)
t)
(let ((id (nth 1 (konix/agent-shell-workspace--standing-on-a-question))))
(when (or (konix/agent-shell-workspace--project-agreed id)
(konix/agent-shell-workspace--grant-the-run id)
(konix/agent-shell-workspace--project-defined-on-yes id)
(konix/agent-shell-workspace--promote-on-yes id)
(konix/agent-shell-workspace--merge-on-yes id))
(konix/agent-shell-workspace--move-on)
t))))
(defun konix/agent-shell-workspace-answer-yes (&optional later)
"Answer yes to what point stands on, at once unless LATER.
Where agreeing acts, `konix/agent-shell-workspace--agree-here' does it instead."
(interactive "P")
(unless (konix/agent-shell-workspace--agree-here)
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question) "yes" later)))
(defun konix/agent-shell-workspace-answer-go (&optional note)
"Tell the writer to go on with what point stands on, as work, NOTE under it.
The writer's turn is never cut short. With a prefix, NOTE is read.
Where agreeing acts, `konix/agent-shell-workspace--agree-here' does it instead, as yes."
(interactive (list (konix/agent-shell-workspace--read-note)))
(unless (konix/agent-shell-workspace--agree-here)
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question) "go on" t
(konix/agent-shell-workspace--note-body note) nil t)))
(defun konix/agent-shell-workspace-answer-bullshit (&optional later)
"Answer what point stands on that the writer is bullshitting, at once unless LATER."
(interactive "P")
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question)
"You are trying to bullshit me. Look on the internet please." later))
(defun konix/agent-shell-workspace-answer-look-it-up (&optional later)
"Answer what point stands on by sending the writer to the web, at once unless LATER."
(interactive "P")
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question)
"Look on the Internet." later))
(defun konix/agent-shell-workspace-answer-no (&optional later)
"Answer no to what point stands on, at once unless LATER.
On one asking leave to run a command, refuse it; on a proposal to make a question a
project, drop it."
(interactive "P")
(let ((question (konix/agent-shell-workspace--standing-on-a-question)))
(if (or (konix/agent-shell-workspace--promote-on-no (nth 1 question))
(konix/agent-shell-workspace--merge-on-no (nth 1 question)))
(konix/agent-shell-workspace--move-on)
(konix/agent-shell-workspace--forget-the-leave (nth 1 question))
(konix/agent-shell-workspace--send question "no" later))))
- how
- and on a question the writer closed,
ysettles it, as which question is next says. - rule
gon a proposal of a project’s done and doing writes them in it, asydoes.- why: going on from it is agreeing to it.
- what
gon the proposal writes both under the project and drops it, sending nothing; on any other question it sends « go on ».
(require 'cl-lib)
(let ((file (make-temp-file "check-go-define-" nil ".ws.org"))
sent)
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING | DONE\n"
"* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
"* REFINE DoD: « the project »?\n"
" :PROPERTIES:\n :ID: o\n :PROJECT-DEFINE: p\n :END:\n"
" - done :: it works\n - doing :: try it\n"
"* REFINE Another of yours?\n :PROPERTIES:\n :ID: n\n :END:\n"
" - what :: waits on you\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send)
(lambda (_question answer &rest _) (push answer sent)))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore))
(with-current-buffer (find-file-noselect file)
(prog1 (list (progn (konix/agent-shell-workspace--goto-id "o")
(konix/agent-shell-workspace-answer-go)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id "p")
(let ((end (save-excursion (outline-next-heading) (point))))
(list (konix/agent-shell-workspace--said-under-p "done" end)
(konix/agent-shell-workspace--said-under-p "doing" end)))))
(save-restriction
(widen)
(and (konix/agent-shell-workspace--goto-id "o") t))
(progn (save-restriction
(widen)
(konix/agent-shell-workspace--goto-id "n"))
(konix/agent-shell-workspace-answer-go)
sent))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(("- done :: it works" "- doing :: try it") nil ("go on")). - rule
M-BandM-ianswer as the same keys do in the agent’s own shell: « You are trying to bullshit me. Look on the internet please. » and « Look on the Internet. ».- what
M-Bon a question writes that answer under it.
(require 'cl-lib)
(let ((file (make-temp-file "check-mb-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Fixed?\n :PROPERTIES:\n :ID: a\n :END:\n - what :: it is\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(save-restriction (widen) (goto-char (point-min)) (search-forward "Fixed?"))
(call-interactively (lookup-key konix/agent-shell-workspace-mode-map (kbd "M-B")))
(prog1 (save-restriction
(widen)
(goto-char (point-min))
(and (search-forward "trying to bullshit me" nil t) 'answered))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
answered. - rule
- on a question asking leave to run a command,
yruns it, the question awaiting it as if the writer had, andnhands it back refused.- why: a leave given is the run started; nothing needs saying to the writer until it ends.
(defun konix/agent-shell-workspace--forget-the-leave (id)
"Take off the question ID the leave it asks; return (COMMAND . ROOT), or nil."
(save-excursion
(when-let* ((id)
((konix/agent-shell-workspace--goto-id id))
(command (org-entry-get (point) "PENDING-RUN")))
(let ((root (org-entry-get (point) "PENDING-ROOT")))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(org-entry-delete (point) "PENDING-RUN")
(org-entry-delete (point) "PENDING-ROOT")
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-asks-to-run-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match "")))
(cons command (and root t))))))
(defun konix/agent-shell-workspace--grant-the-run (id)
"Run the command the question ID asks leave for, it awaiting it; nil if none."
(pcase-let ((`(,command . ,root) (konix/agent-shell-workspace--forget-the-leave id)))
(when command
(let ((run (konix/agent-shell-workspace--run-to-come
id (konix/agent-shell-workspace--target-writer))))
(save-excursion
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(org-todo konix/agent-shell-workspace-awaiting-keyword)
(konix/agent-shell-workspace--await-at-point id command nil run root)))
(message "Running %s%s" command (if root ", as root" ""))
t))))
- rule
- on a question awaiting a run of its own,
ckills the run, then reads the user’s answer and hands the question back, asrdoes.- why: the user may give leave by mistake.
- rule: and the writer learns it as it learns any run’s end: the run’s line says
it was killed by the user, their answer under it.
- how: the run’s end is waited for, its line written without waking the writer, and the answer then wakes it, once.
- scope: a run still queued is taken out of the queue, its line saying so too.
- scope: a question joining another’s run has no run of its own to kill, and is refused before anything is read.
- how: the answer is read first, so a user who gives up on it kills nothing.
(defconst konix/agent-shell-workspace-cancelled-said "killed by you"
"What the line of a run the user killed says of its end.")
(defvar konix/agent-shell-workspace--no-wake nil
"Non-nil while a run's end is to be said without waking the writer.")
(defun konix/agent-shell-workspace--own-run (id)
"Return the process running for the question ID, or t where its run is queued."
(or (seq-find (lambda (process)
(and (process-live-p process)
(equal (process-get process 'konix/agent-shell-workspace-id)
id)))
(process-list))
(and (seq-some (lambda (runs) (assoc id runs))
(hash-table-values konix/agent-shell-workspace--queued))
t)))
(defun konix/agent-shell-workspace--cancel-run (id)
"Kill the run the question ID awaits, or take it out of the queue, saying so.
Return once its line says so, the writer not woken."
(let ((run (or (konix/agent-shell-workspace--own-run id)
(user-error "This question awaits no run of its own")))
(file buffer-file-name)
(konix/agent-shell-workspace--no-wake t))
(if (processp run)
(progn
(process-put run 'konix/agent-shell-workspace-cancelled t)
(kill-process run)
(while (process-live-p run)
(accept-process-output run 0.1))
(accept-process-output nil 0))
(konix/agent-shell-workspace--stop-run id)
(dolist (one (cons id (gethash id konix/agent-shell-workspace--joiners)))
(ignore-errors
(konix/agent-shell-workspace--run-over
file one (format "%s before it started"
konix/agent-shell-workspace-cancelled-said))))
(remhash id konix/agent-shell-workspace--joiners))))
(defun konix/agent-shell-workspace-cancel-run (&optional later)
"Kill the run the question point stands on awaits, then send an answer to it.
At once unless LATER."
(interactive "P")
(let* ((standing (konix/agent-shell-workspace--standing-on-a-question))
(id (or (nth 1 standing)
(user-error "Point stands on no question"))))
(unless (konix/agent-shell-workspace--own-run id)
(user-error "This question awaits no run of its own"))
(pcase-let ((`(,answer ,body)
(konix/agent-shell-workspace--read-heading-and-body
"Answer, the run killed: ")))
(konix/agent-shell-workspace--cancel-run id)
(konix/agent-shell-workspace--send standing answer later body))))
the other answers a key gives
- rule
gsays « go on », the user’s go, handing the question back as work.- why:
yanswers, and a yes that answers is not a yes to go ahead.
- why:
- rule
- and
.says « done », the user having done what they were asked to.- therefore: like
g, it hands the question back as work, so the writer goes on.
- therefore: like
- rule
- neither
gnor.cuts the writer’s turn short; withC-u, each reads a note that goes under it as awhatbullet.- why: the user said a
gor.cutting the turn was wrong, itsC-uuseless, and asked for a prompt adding some info to the go or done.
- why: the user said a
- what
gand.without a note, then with one, the prompt read.
(require 'cl-lib)
(let (sent)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send)
(lambda (_standing answer later body &rest _)
(push (list answer later body) sent)))
((symbol-function 'konix/agent-shell-workspace--standing-on-a-question)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--agree-here) #'ignore)
((symbol-function 'read-string) (lambda (&rest _) "a note")))
(dolist (command (list #'konix/agent-shell-workspace-answer-go
#'konix/agent-shell-workspace-answer-done))
(let ((current-prefix-arg nil)) (call-interactively command))
(let ((current-prefix-arg '(4))) (call-interactively command))))
(nreverse sent))
- what :: the check above is right when it reads =((“go on” t nil) (“go on” t “- what
- a note”) (“done” t nil) (“done” t “- what :: a note”))=; before,
C-usent no note. - rule
- and a digit,
1to9, answers that digit, picking one of the choices a question numbers.- scope: digits only: letters already walk and answer.
- rule
- and
?quotes a word of the question back, asking what it was supposed to mean, the answer given most often after those.- scope: with nothing selected it asks that of the whole question.
(defun konix/agent-shell-workspace-answer-choice (&optional later)
"Answer the digit just typed to what point stands on, at once unless LATER."
(interactive "P")
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question)
(string last-command-event) later))
(defun konix/agent-shell-workspace--read-note ()
"Read a note to go under a go or a done, with a prefix only; else nil."
(when current-prefix-arg
(read-string "Note: ")))
(defun konix/agent-shell-workspace--note-body (note)
"Return NOTE as the body going under an answer, nil when there is none."
(unless (or (null note) (string-empty-p (string-trim note)))
(concat "- what :: " (string-trim note))))
(defun konix/agent-shell-workspace-answer-done (&optional note)
"Tell the writer the user did what point stands on asks, NOTE under it.
The writer's turn is never cut short. With a prefix, NOTE is read."
(interactive (list (konix/agent-shell-workspace--read-note)))
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question)
"done" t (konix/agent-shell-workspace--note-body note) nil t))
(defun konix/agent-shell-workspace-answer-what (&optional later)
"Ask the writer what it was supposed to mean, at once unless LATER.
Sends back the region, or the whole question when nothing is selected."
(interactive "P")
(konix/agent-shell-workspace--send
(konix/agent-shell-workspace--standing-on-a-question)
(if (use-region-p)
(format "\"%s\" ?"
(string-trim (buffer-substring-no-properties
(region-beginning) (region-end))))
"?")
later))
- what
.on a question the writer refined leaves it TODO, the writer’s to take up.
(require 'cl-lib)
(let ((file (make-temp-file "check-done-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS REFINE WORKING | DONE\n"
"* Mine :mine:\n"
"** REFINE Did you do it?\n :PROPERTIES:\n :ID: a\n :END:\n"
" - what :: do it\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(goto-char (point-min))
(re-search-forward "^\\*\\* REFINE Did you")
(konix/agent-shell-workspace-answer-done)
(prog1 (save-excursion
(widen)
(goto-char (point-min))
(re-search-forward "^\\*\\* \\([A-Z]+\\) Did you")
(match-string 1))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
"TODO". - rule
- a region selected, its words taken, it is dropped before the question is handed
back.
- why:
org-todowith a region on changes only the headings in it, and a region in a body holds none: the answer came, the question stayedREFINE.
- why:
- what
?on a region in a question the writer refined hands it backDISCUSS.
(require 'cl-lib)
(let ((file (make-temp-file "check-region-back-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO DISCUSS REFINE WORKING | DONE\n"
"* Mine :mine:\n"
"** REFINE Tilt it?\n :PROPERTIES:\n :ID: a\n :END:\n"
" - what :: the tower leans left\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--target-writer)
(lambda () (current-buffer)))
((symbol-function 'konix/agent-shell-workspace--submit) #'ignore))
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(let ((transient-mark-mode t))
(goto-char (point-min))
(re-search-forward "the tower")
(push-mark (match-beginning 0) t t)
(konix/agent-shell-workspace-answer-what))
(prog1 (save-excursion
(widen)
(goto-char (point-min))
(re-search-forward "^\\*\\* \\([A-Z]+\\) Tilt")
(match-string 1))
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
"DISCUSS".
on a fact, a subject instead
- rule
- on a fact the same keys raise a subject about it instead.
- why: the writer says a lot of stupid shit as a fact and the user wants to ask about them.
- how: what they say becomes a subject of their own, in the writer’s state, its body linking the fact it is about.
- therefore: the fact stands untouched, the writer’s word kept as it wrote it, and what the user thinks of it is a heading of its own.
- scope: the subject’s link makes the fact reached, so no sweep takes a fact while it is being argued with.
- rule: and the line pointing at a fact counts as standing on that fact.
- why: that link is where the user reads a fact from, not the question the link sits under.
- rule: and the line they stood on goes under the subject, the way it does under an
answer.
- why: what they are arguing with is one bullet of the fact, not the whole of it.
- rule: and it goes in as a quotation of its words, inside the bullet.
- why: written out as it stands, the markup of the line comes with it and the bullet reads as rubbish.
- how: the stars of a heading, the dash of a bullet and the intention before its text are all dropped, and what is left is quoted.
(defun konix/agent-shell-workspace--fact-pointed-at ()
"Return (ID . HEADING) for the fact the line point is on points at, or nil."
(save-excursion
(beginning-of-line)
(when (re-search-forward org-link-any-re (line-end-position) t)
(goto-char (match-beginning 0))
(let ((link (org-element-context)))
(when (and (eq (org-element-type link) 'link)
(equal (org-element-property :type link) "id"))
(let ((id (org-element-property :path link)))
(when (and (konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--fact-at-point-p))
(cons id (org-get-heading t t t t)))))))))
(defun konix/agent-shell-workspace--fact-here ()
"Return (ID . HEADING) for the fact point stands in, or the one it points at."
(or (konix/agent-shell-workspace--fact-pointed-at)
(save-excursion
(konix/agent-shell-workspace--goto-heading)
(when (konix/agent-shell-workspace--fact-at-point-p)
(cons (org-entry-get (point) "ID") (org-get-heading t t t t))))))
(defun konix/agent-shell-workspace--ask-about-fact (standing answer &optional body)
"Raise ANSWER, and BODY under it, as a subject about the fact STANDING names."
(pcase-let* ((`(,fact ,_question ,here) standing)
(id (car fact))
(heading (cdr fact)))
(unless id
(user-error "That fact carries no id, so nothing can point at it"))
(konix/agent-shell-workspace-add-subject
answer
(concat (if (and body (not (string-empty-p (string-trim body))))
(concat (string-trim body) "\n")
"")
(format "- what :: said on %s\n" here)
(format "- what :: about [[id:%s][%s]]" id heading)))))
finding the writer again
- what
- the writer that asked is a live buffer, and the workspace holds on to it for as long as that buffer lives.
(defvar-local konix/agent-shell-workspace--writer-buffer nil
"Agent-shell buffer that writes into this workspace, where \\`r' sends questions.")
(put 'konix/agent-shell-workspace--writer-buffer 'permanent-local t)
- how
- four steps: the buffer already known, the session the workspace itself names,
resuming that same session where it is named but not live, and failing all three the
user’s choice — and each is remembered.
- why: the front matter names the session writing there, so asking the user which one is asking them what the file has said all along.
- scope: it asks only where the front matter names no session, or the one named cannot be resumed.
(defun konix/agent-shell-workspace--writer-named ()
"Return the live session this workspace's front matter names, or nil."
(when-let* ((named (konix/agent-shell-workspace--keyword "SESSION")))
(seq-find (lambda (shell)
(when-let* ((spec (konix/org-agent-shell--session-spec shell)))
(string-search spec named)))
(agent-shell-buffers))))
(defun konix/agent-shell-workspace--target-writer ()
"Return the writer this workspace talks to, asking only if it has to."
(when (bound-and-true-p konix/agent-shell-workspace--fresh-coming)
(user-error "Fresh writer not ready yet"))
(or (and (buffer-live-p konix/agent-shell-workspace--writer-buffer)
konix/agent-shell-workspace--writer-buffer)
(setq-local konix/agent-shell-workspace--writer-buffer
(konix/agent-shell-workspace--writer-named))
(setq-local konix/agent-shell-workspace--writer-buffer
(konix/agent-shell-workspace--resume-named-writer))
(let ((shells (seq-filter
(lambda (buffer)
(with-current-buffer buffer
(derived-mode-p 'agent-shell-mode)))
(buffer-list))))
(unless shells
(user-error "No agent-shell buffer to send this to"))
(setq-local konix/agent-shell-workspace--writer-buffer
(get-buffer
(completing-read "Send this workspace's answers to: "
(mapcar #'buffer-name shells)
nil t))))))
- rule
- anything the user sends an unstarted writer from the workspace starts it, and
nothing else does: the tools a writer answers with never spawn one.
- why: the workspace calling this on its own account is the one place a session with nobody at it yet still has a reason to exist.
- how: it resumes the session named, in its own working directory, unfocused — never taking the window from whatever the user was doing.
- rule: and its viewport is made ready before anything is said to it.
- why: a shell started unfocused mirrors nothing into a viewport that does not exist yet, so whatever is said first would land in the shell buffer alone.
- rule: and the workspace that resumed it is bound to it there and then.
- why: the store gives a session its workspace back only once it says its id, and whatever resumed it has something for it before that.
- therefore: seeing to a writer resumes it and sees to it in the one gesture.
(defun konix/agent-shell-workspace--named-session-spec ()
"Return the raw agent-shell spec this workspace's SESSION keyword names, or nil."
(when-let* ((named (konix/agent-shell-workspace--keyword "SESSION"))
(start (string-search "agent-shell:" named))
(from (+ start (length "agent-shell:"))))
(substring named from (string-search "]" named from))))
(defun konix/agent-shell-workspace--resume-named-writer ()
"Resume this workspace's named session in the background, or nil without one."
(when-let* ((spec (konix/agent-shell-workspace--named-session-spec)))
(pcase-let* ((`(,session-id ,rest) (split-string spec "\\?cwd="))
(`(,cwd ,_line) (split-string (or rest "") "&line="))
(shell (konix/org-agent-shell--resume-session session-id cwd)))
(konix/agent-shell-ensure-viewport shell)
(when buffer-file-name
(konix/agent-shell-workspace--remember shell buffer-file-name))
shell)))
- rule
Fin the workspace starts a fresh writer in place of the one it names, told what the old one knew from a summary Haiku writes off the old session’s file.- why: resuming a writer whose context grew big resends all of it, and a /compact first still reads all of it at the writer’s price.
- how:
clk claude handoversums up what resuming would load, into the old session’s.agent-shell/tmp/handover-ID.md; then a new writer starts there, bound to the workspace. - rule: and the fresh writer reads the summary with its briefing, told the workspace
wins where the two disagree.
- why: Haiku told a header line built that was only asked for: the summary is a memory, the questions the truth.
- rule: the named writer live,
Fasks to kill it first; no leaves all as it was.- why: two writers bound to one workspace would both answer it.
- how: killed before Haiku reads its file, so the summary holds its last turn.
import json
from pathlib import Path
from clk.decorators import argument, option
from . import LOGGER, claude, counts, session_file
def resumed(path):
"""The entries resuming PATH's session loads: from its last message back to its last compaction."""
entries = {}
last = None
with open(path, encoding="utf-8", errors="replace") as lines:
for line in lines:
try:
entry = json.loads(line)
except json.JSONDecodeError:
continue
if entry.get("uuid"):
entries[entry["uuid"]] = entry
if entry.get("type") in ("user", "assistant"):
last = entry["uuid"]
chain = []
while last in entries:
chain.append(entries[last])
last = entries[last].get("parentUuid")
return chain[::-1]
def cut(text, most):
"""TEXT, cut past MOST chars with a mark saying how much went."""
text = text if isinstance(text, str) else json.dumps(text, ensure_ascii=False)
return text if len(text) <= most else text[:most] + f" […{len(text) - most} chars cut]"
def transcript(entries, tools, said):
"""ENTRIES as a short transcript: tool calls and outputs cut to TOOLS chars, user texts to SAID."""
for entry in entries:
if entry.get("type") not in ("user", "assistant"):
continue
message = entry.get("message") or {}
who = "compact summary" if entry.get("isCompactSummary") else message.get("role", entry["type"])
content = message.get("content")
if isinstance(content, str):
content = [{"type": "text", "text": content}]
for part in content or []:
if not isinstance(part, dict):
continue
kind = part.get("type")
if kind == "text":
text = part["text"] if who != "user" else cut(part["text"], said)
yield f"## {who}\n{text}\n"
elif kind == "tool_use":
yield f"## tool call {part.get('name')}\n{cut(part.get('input'), tools)}\n"
elif kind == "tool_result":
yield f"## tool output\n{cut(part.get('content'), tools)}\n"
HANDOVER = (
"The text on stdin is the transcript of a coding session between a user and an agent,"
" tool calls and outputs cut short. A fresh agent will take over this work without"
" seeing it. Write the summary it starts from: the user's requests and constraints in"
" their own words, the files and functions touched with what changed, the decisions"
" taken and why, the errors met and their fixes, and what is left to do. The work"
" goes through a workspace of questions moving forward together: cover every one of"
" them, not the latest alone. Say only what the transcript shows: what was asked is"
" not what was done."
" Be precise: names, paths, values. No more than 3000 words."
" End on a section headed exactly « ## Facts »: one « - » line each, under 100"
" chars, for what the fresh agent must never lose and no file says: the user's"
" standing rules and steers, caveats found the hard way, decisions taken and why."
" No fact of where a file is or what is tangled where: those are computed."
" A fact states, never asks."
" A fact stays true: no state a later step changes, a question still open, a fix untried."
)
KNOWN = (
"\n\nThe fresh agent is told what follows before your summary. Write in « ## Facts »"
" none it already says, even in other words:\n\n"
)
@claude.command()
@argument("session", help="A session id, or the path of its .jsonl")
@option("--tools", type=int, default=120, help="Chars kept of each tool call and output")
@option("--said", type=int, default=1500, help="Chars kept of each user text")
def transcript_of(session, tools, said):
"What resuming SESSION would load, as a short transcript"
for section in transcript(resumed(session_file(session)), tools, said):
print(section)
@claude.command()
@argument("session", help="A session id, or the path of its .jsonl")
@argument("output", help="Where to write the summary")
@option("--model", default="haiku", help="The model summing it up")
@option("--tools", type=int, default=120, help="Chars kept of each tool call and output")
@option("--said", type=int, default=1500, help="Chars kept of each user text")
@option("--known", help="A file of what the fresh writer is told already, its facts left out")
def handover(session, output, model, tools, said, known):
"Sum up what resuming SESSION would load, for a fresh writer to start from, into OUTPUT"
import subprocess
text = "\n".join(transcript(resumed(session_file(session)), tools, said))
told = HANDOVER
if known and Path(known).expanduser().exists():
told += KNOWN + Path(known).expanduser().read_text(encoding="utf-8")
run = subprocess.run(
["claude", "-p", "--model", model, "--output-format", "json",
"--append-system-prompt", told, "Summarise the transcript on stdin as told."],
input=text, capture_output=True, text=True, check=True,
)
result = json.loads(run.stdout)
if result.get("is_error"):
raise RuntimeError(result.get("result"))
Path(output).expanduser().write_text(result["result"], encoding="utf-8")
usage = counts(result.get("usage") or {})
LOGGER.info(
f"{output}: {usage['input'] + usage['written'] + usage['read']} tokens read,"
f" {usage['output']} written"
)
- what
- the live writer is killed on yes and spared on no, Haiku run only on yes.
(require 'cl-lib)
(let* ((top (make-temp-file "check-fresh-kills-" t))
(file (expand-file-name "w.ws.org" top))
visiting)
(with-temp-file file
(insert (format "#+SESSION: [[agent-shell:old-id?cwd=%s/][old]]\n" top)))
;; opened before make-process is stubbed: a mode hook starting ispell then would keep t
(setq visiting (find-file-noselect file))
(unwind-protect
(mapcar
(lambda (answer)
(let ((live (generate-new-buffer " live-writer"))
ran)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-named)
(lambda () (and (buffer-live-p live) live)))
((symbol-function 'y-or-n-p) (lambda (_) answer))
((symbol-function 'make-process)
(lambda (&rest _) (setq ran t))))
(with-current-buffer visiting
(ignore-errors (konix/agent-shell-workspace-fresh-writer))))
(prog1 (list (if (buffer-live-p live) 'spared 'killed) (if ran 'ran 'idle))
(when (buffer-live-p live) (kill-buffer live)))))
'(t nil))
(when-let* ((visiting (find-buffer-visiting file)))
(let ((kill-buffer-query-functions nil)) (kill-buffer visiting)))
(delete-directory top t)))
- what
- the check above is right when it reads
((killed ran) (spared idle)). - what
- the summary’s path comes with the briefing, and
Fstarts a writer on it.
(require 'cl-lib)
(let* ((top (make-temp-file "check-fresh-" t))
(file (expand-file-name "w.ws.org" top))
(konix/agent-shell-workspace-handover-command
(list "sh" "-c" "printf known > \"$2\"" "sh"))
started told)
(with-temp-file file
(insert (format "#+SESSION: [[agent-shell:old-id?cwd=%s/][old]]\n" top)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-named) #'ignore)
((symbol-function 'konix/agent-shell-workspace--start-with-a-writer)
(lambda (&rest args) (setq started args)))
((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING"))
((symbol-function 'konix/agent-shell-workspace--projects-in) #'ignore)
((symbol-function 'konix/agent-shell-workspace-file) (lambda (_) file)))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-fresh-writer)
(let ((deadline (+ (float-time) 5)))
(while (and (not started) (< (float-time) deadline))
(accept-process-output nil 0.1)))
(with-temp-buffer
(setq-local konix/agent-shell-workspace--handed-over (nth 2 started))
(setq told (konix/agent-shell-workspace--briefing-owed (current-buffer) "NUDGE")))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))
(list (and started (file-name-nondirectory (nth 2 started)))
(and started (with-temp-buffer
(insert-file-contents (nth 2 started))
(buffer-string)))
(and (string-prefix-p "BRIEFING\n\n" told)
(string-search "handover-old-id.md" told)
(string-suffix-p "\n\nNUDGE" told)
t))))
(delete-directory top t)))
- what
- the check above is right when it reads
("handover-old-id.md" "known" t). - rule
- while Haiku sums up, the workspace is in a not-ready state: the user answers
in it as ever, but whatever would wake a writer says the fresh one is not ready yet.
-
why:
#+SESSIONstill names the old session then, so waking a writer resumed it. -
rule: and once the fresh writer is up,
Fsees to it, so it gets what the user answered meanwhile. -
how: the not-ready state ends when Haiku ends, done or failed.
-
rule: and the not-ready state shows: the workspace’s background turns dim amber and its header line reads « fresh writer coming… », both gone when it ends.
- why: it makes the not-ready state more obvious.
-
rule: and F forgets the old writer’s context, the header line blank until the fresh writer’s first turn ends.
- why: the old count stayed shown after F.
-
rule: and F, from the key, asks the user what else to keep, written word for word under the summary; nothing said, nothing written.
- why: the user knows what matters that the summary may drop.
-
rule: and the summary ends on a « ## Facts » list: Haiku’s, headed by those F computes, where the work lives first. F writes no FACT in the workspace.
- why: a fresh writer forgot where the work was.
- why: FACTs F wrote in the workspace were noise there; the handover is read once.
- rule: and Haiku is shown what the fresh writer knows already, its briefing and
the facts in the workspace, and writes only the facts they lack, none a later step
makes stale.
- why: F wrote again, in other words, facts already there, and some the next F found stale: a question « still open », a fix « untried until F ».
-
rule: and F gives the fresh writer the old session’s governing note: bound to it, and named at the end of the summary.
- why: the note is bound by session, and F starts a new one, so it was lost.
- how: named in the summary rather than sent, a send of its own racing the briefing’s.
-
(defun konix/agent-shell-workspace--session-note (id)
"Return the governing note the session ID was bound to, or nil."
(konix/agent-shell-session-store-get
(konix/agent-shell-session-binding-store konix/agent-shell--governing-note-binding)
id))
(defun konix/agent-shell-workspace--note-said (note)
"Return what the summary ends on to tell a fresh writer NOTE governs it."
(format (concat "\n\n## The governing note\n\n%s governs this session: read it with"
" readonly_render_note; call spawn_auditor (no note path) for audits.\n")
note))
- what
- F with a note bound to the old session binds it to the fresh writer, and the summary ends naming it.
(require 'cl-lib)
(let* ((top (make-temp-file "check-fresh-note-" t))
(file (expand-file-name "w.ws.org" top))
(konix/agent-shell-workspace-handover-command
(list "sh" "-c" "printf known > \"$2\"" "sh"))
(shell (generate-new-buffer " fresh-shell"))
bound summary)
(with-temp-file file
(insert (format "#+SESSION: [[agent-shell:old-id?cwd=%s/][old]]\n" top)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-named) #'ignore)
((symbol-function 'konix/agent-shell-workspace--session-note)
(lambda (id) (and (equal id "old-id") "/tmp/the-note.org")))
((symbol-function 'konix/agent-shell-set-governing-note)
(lambda (shell note) (setq bound (list (buffer-name shell) note))))
((symbol-function 'konix/agent-shell-workspace--start-with-a-writer)
(lambda (_file _cwd file-summary) (setq summary file-summary) shell))
((symbol-function 'konix/agent-shell-workspace-see-to-the-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-fresh-writer)
(let ((deadline (+ (float-time) 5)))
(while (and (not bound) (< (float-time) deadline))
(accept-process-output nil 0.1)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))
(list bound
(and summary
(with-temp-buffer
(insert-file-contents summary)
(and (search-forward "/tmp/the-note.org governs" nil t) t))))))
(kill-buffer shell)
(delete-directory top t)))
- what
- the check above is right when it reads
((" fresh-shell" "/tmp/the-note.org") t).
(defun konix/agent-shell-workspace--tangled-from (work)
"Return the files WORK, an org file, tangles to, each once, in the order it names them."
(let ((work (expand-file-name work)))
(when (file-readable-p work)
(with-temp-buffer
(insert-file-contents work)
(let ((default-directory (file-name-directory work))
targets)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#\\+\\(?:begin_src\\|property:\\)[^\n]*:tangle[ \t]+\\([^ \t\n]+\\)"
nil t)
(let ((target (string-trim (match-string 1) "\"" "\"")))
(unless (member target '("no" "yes"))
(cl-pushnew (abbreviate-file-name (expand-file-name target)) targets
:test #'equal))))
(nreverse targets))))))
(defun konix/agent-shell-workspace--computed-facts (workspace)
"Return the facts F computes of WORKSPACE: where its work lives, what that tangles to."
(when-let* ((work (konix/agent-shell-workspace--work workspace)))
(cons (format "The work lives in %s" work)
(mapcar (lambda (target)
(format "%s is tangled from the work file: edit the org, never it"
target))
(konix/agent-shell-workspace--tangled-from work)))))
(defun konix/agent-shell-workspace--handover-facts (workspace summary)
"Head the « ## Facts » SUMMARY ends on with the facts F computes of WORKSPACE.
The workspace gets none of them: the handover alone carries them."
(when-let* ((facts (konix/agent-shell-workspace--computed-facts workspace)))
(with-temp-file summary
(insert-file-contents summary)
(goto-char (point-min))
(if (re-search-forward "^## Facts[ \t]*$" nil t)
(progn (forward-line 1) (skip-chars-forward "\n"))
(goto-char (point-max))
(insert (if (bolp) "\n" "\n\n") "## Facts\n\n"))
(insert (mapconcat (lambda (fact) (concat "- " fact "\n")) facts)))))
(defun konix/agent-shell-workspace--handover-known (file)
"Write in FILE what a fresh writer knows before its summary: its briefing, the facts here.
The facts F computes count among them, so Haiku leaves them to it."
(let ((facts (seq-uniq
(append (save-excursion
(mapcar (lambda (where)
(goto-char where)
(org-get-heading t t t t))
(konix/agent-shell-workspace--facts)))
(konix/agent-shell-workspace--computed-facts buffer-file-name)))))
(with-temp-file file
(insert (konix/agent-shell-workspace-binding-briefing))
(when facts
(insert "\n\n## Facts already in the workspace\n\n"
(mapconcat (lambda (fact) (concat "- " fact)) facts "\n")
"\n")))
file))
- what
- Haiku is shown the briefing, then each fact the workspace already holds.
(require 'cl-lib)
(let* ((top (make-temp-file "check-known-" t))
(file (expand-file-name "w.ws.org" top))
(known (expand-file-name "k.md" top)))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n"
"* Tangle then load\n :PROPERTIES:\n :ID: f\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING")))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--handover-known known)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))
(with-temp-buffer
(insert-file-contents known)
(buffer-string))))
(delete-directory top t)))
- what
- the check above is right when it reads
"BRIEFING\n\n## Facts already in the workspace\n\n- Tangle then load\n". - what
- F heads the summary’s « ## Facts » with where the work lives, leaving the workspace as it was.
(let* ((top (make-temp-file "check-fresh-facts-" t))
(file (expand-file-name "w.ws.org" top))
(summary (expand-file-name "s.md" top)))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n#+WORK: /x/the-work.org\n"
"* Tangle then load\n :PROPERTIES:\n :ID: f\n :END:\n"))
(with-temp-file summary
(insert "# Handover\n\nsome words\n\n## Facts\n\n"
"- Checks run with run_babel\n"))
(unwind-protect
(progn
(konix/agent-shell-workspace--handover-facts file summary)
(prin1-to-string
(list (with-temp-buffer
(insert-file-contents file)
(let (headings)
(goto-char (point-min))
(while (re-search-forward "^\\* \\(.*\\)$" nil t)
(push (match-string 1) headings))
(nreverse headings)))
(with-temp-buffer
(insert-file-contents summary)
(buffer-string)))))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(delete-directory top t)))
- what
- the check above is right when it reads
(("Tangle then load") "# Handover\n\nsome words\n\n## Facts\n\n- The work lives in /x/the-work.org\n- Checks run with run_babel\n"): the workspace untouched. - rule
- F computes the facts a file gives: where the work lives, each file it tangles
to. Haiku writes only what no file says: steers, caveats, decisions.
- why: computed facts are deterministic, Haiku is not: it restated the work file and the tangled .el in other words, and kept one-off proofs as facts.
- what
- a work file tangling to two files, one twice, and one block not tangled, gives where the work lives and the two files; Haiku is shown them as known.
(let* ((top (make-temp-file "check-computed-" t))
(work (expand-file-name "the-work.org" top))
(file (expand-file-name "w.ws.org" top))
(known (expand-file-name "k.md" top)))
(with-temp-file work
(insert "#+begin_src emacs-lisp :tangle a.el\n#+end_src\n"
"#+begin_src python :tangle /tmp/b.py :comments no\n#+end_src\n"
"#+begin_src emacs-lisp :tangle no :results value\n#+end_src\n"
"#+begin_src emacs-lisp :tangle a.el\n#+end_src\n"))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS WORKING | DONE\n#+WORK: " work "\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-binding-briefing)
(lambda (&rest _) "BRIEFING")))
(list (mapcar (lambda (fact)
(string-replace (abbreviate-file-name top) "TOP"
(string-replace top "TOP" fact)))
(konix/agent-shell-workspace--computed-facts file))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--handover-known known)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))
(with-temp-buffer
(insert-file-contents known)
(and (search-forward "/tmp/b.py is tangled" nil t) t)))))
(delete-directory top t)))
- what
- the check above is right when it reads
(("The work lives in TOP/the-work.org" "TOP/a.el is tangled from the work file: edit the org, never it" "/tmp/b.py is tangled from the work file: edit the org, never it") t). - what
- F asked to keep « the tilt » leaves it under the summary the fresh writer reads.
(require 'cl-lib)
(let* ((top (make-temp-file "check-fresh-keep-" t))
(file (expand-file-name "w.ws.org" top))
(konix/agent-shell-workspace-handover-command
(list "sh" "-c" "printf known > \"$2\"" "sh"))
(shell (generate-new-buffer " fresh-shell"))
summary)
(with-temp-file file
(insert (format "#+SESSION: [[agent-shell:old-id?cwd=%s/][old]]\n" top)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-named) #'ignore)
((symbol-function 'read-string) (lambda (&rest _) " the tilt "))
((symbol-function 'konix/agent-shell-workspace--start-with-a-writer)
(lambda (_file _cwd path)
(setq summary (with-temp-buffer (insert-file-contents path)
(buffer-string)))
shell))
((symbol-function 'konix/agent-shell-workspace-see-to-the-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-fresh-writer t)
(let ((deadline (+ (float-time) 5)))
(while (and (not summary) (< (float-time) deadline))
(accept-process-output nil 0.1)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))
summary))
(kill-buffer shell)
(delete-directory top t)))
- what
- the check above is right when it reads
"known\n\n## The user asks to keep too\n\nthe tilt\n".
(require 'cl-lib)
(let* ((top (make-temp-file "check-fresh-ready-" t))
(file (expand-file-name "w.ws.org" top))
(konix/agent-shell-workspace-handover-command
(list "sh" "-c" "sleep 1; printf known > \"$2\"" "sh"))
(shell (generate-new-buffer " fresh-shell"))
during shown seen started)
(with-temp-file file
(insert (format "#+SESSION: [[agent-shell:old-id?cwd=%s/][old]]\n" top)))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer-named) #'ignore)
((symbol-function 'konix/agent-shell-workspace--resume-named-writer)
(lambda () (setq during 'resumed-old) nil))
((symbol-function 'completing-read)
(lambda (&rest _) (setq during 'asked) (user-error "asked")))
((symbol-function 'konix/agent-shell-workspace--start-with-a-writer)
(lambda (&rest _) (setq started t) shell))
((symbol-function 'konix/agent-shell-workspace-see-to-the-writer)
(lambda () (setq seen (current-buffer)))))
(with-current-buffer (find-file-noselect file)
(setq konix/agent-shell-workspace--context 290000)
(konix/agent-shell-workspace-fresh-writer)
(setq shown (list (format-mode-line header-line-format)
(and (assq 'default face-remapping-alist) t)))
(setq during
(or during
(condition-case err
(progn (konix/agent-shell-workspace--target-writer) 'woke)
(user-error (cadr err)))))
(let ((deadline (+ (float-time) 5)))
(while (and (not seen) (< (float-time) deadline))
(accept-process-output nil 0.1)))
(prog1 (list during
(eq seen (current-buffer))
(bound-and-true-p konix/agent-shell-workspace--fresh-coming)
shown
(list (and header-line-format (format-mode-line header-line-format nil nil (current-buffer)))
(and (assq 'default face-remapping-alist) t)))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(kill-buffer shell)
(delete-directory top t)))
- what
- the check above is right when it reads
("Fresh writer not ready yet" t nil ("fresh writer coming…" t) ("fresh" nil)), the header saying « fresh » until the new writer’s first turn ends.
(defvar-local konix/agent-shell-workspace--fresh-coming nil
"Non-nil while F's summary is being written, before the fresh writer is up.")
(put 'konix/agent-shell-workspace--fresh-coming 'permanent-local t)
(defface konix/agent-shell-workspace-fresh-coming
'((((background dark)) :background "#3a2e10")
(t :background "#fff0c8"))
"The workspace's background while F's fresh writer is not up yet.")
(defun konix/agent-shell-workspace--fresh-coming-mark ()
"Mark this workspace as waiting on F's fresh writer, for all to see."
(setq-local konix/agent-shell-workspace--fresh-coming
(face-remap-add-relative
'default 'konix/agent-shell-workspace-fresh-coming))
(setq-local header-line-format
(propertize "fresh writer coming…" 'face 'warning)))
(defun konix/agent-shell-workspace--fresh-coming-unmark ()
"Drop the mark F set on this workspace, its background and header line with it."
(when (consp konix/agent-shell-workspace--fresh-coming)
(face-remap-remove-relative konix/agent-shell-workspace--fresh-coming))
(setq-local konix/agent-shell-workspace--fresh-coming nil)
(kill-local-variable 'header-line-format)
(konix/agent-shell-workspace--context-shown))
(defvar konix/agent-shell-workspace-handover-command (list "clk" "claude" "handover")
"What sums up a session for a fresh writer, given its id and where to write.")
(defun konix/agent-shell-workspace-fresh-writer (&optional ask)
"Start a fresh writer in place of the named one, from a summary of what it knew.
ASK, as from the key, asks the user what else to keep, written under the summary."
(interactive (list t))
(let* ((workspace buffer-file-name)
(here (current-buffer))
(spec (konix/agent-shell-workspace--named-session-spec))
(keep (and spec ask (konix/agent-shell-workspace--also-keep))))
(unless spec
(user-error "This workspace names no session to take over from"))
(when-let* ((live (konix/agent-shell-workspace--writer-named)))
(unless (y-or-n-p (format "Kill %s and start fresh? " (buffer-name live)))
(user-error "%s left as it was" (buffer-name live)))
(let ((kill-buffer-query-functions nil))
(kill-buffer live)))
(pcase-let*((`(,id ,rest) (split-string spec "\\?cwd="))
(`(,cwd ,_line) (split-string (or rest "") "&line="))
(summary (expand-file-name (format ".agent-shell/tmp/handover-%s.md" id)
cwd))
(known (expand-file-name (format ".agent-shell/tmp/known-%s.md" id)
cwd))
(note (konix/agent-shell-workspace--session-note id)))
(make-directory (file-name-directory summary) t)
(konix/agent-shell-workspace--handover-known known)
(setq konix/agent-shell-workspace--context 'fresh)
(setq konix/agent-shell-workspace--model nil)
(setq konix/agent-shell-workspace--turn-ended nil)
(konix/agent-shell-workspace--fresh-coming-mark)
(make-process
:name "handover" :buffer (get-buffer-create " *handover*")
:command (append konix/agent-shell-workspace-handover-command
(list id summary "--known" known))
:sentinel (lambda (process _event)
(when (memq (process-status process) '(exit signal))
(when (buffer-live-p here)
(with-current-buffer here
(konix/agent-shell-workspace--fresh-coming-unmark)))
(if (and (zerop (process-exit-status process))
(file-exists-p summary))
(progn
(konix/agent-shell-workspace--handover-facts
workspace summary)
(when keep
(write-region (concat "\n\n## The user asks to keep too\n\n"
keep "\n")
nil summary t 'silent))
(when note
(write-region (konix/agent-shell-workspace--note-said note)
nil summary t 'silent))
(let ((shell (konix/agent-shell-workspace--start-with-a-writer
workspace cwd summary)))
(when (and note (buffer-live-p shell))
(konix/agent-shell-set-governing-note shell note))
(when (and (buffer-live-p shell) (buffer-live-p here))
(with-current-buffer here
(konix/agent-shell-workspace-see-to-the-writer)))))
(when (buffer-live-p here)
(with-current-buffer here
(setq konix/agent-shell-workspace--context nil)
(kill-local-variable 'header-line-format)))
(message "No summary of %s: see the buffer « *handover*»" id)))))
(message "Haiku sums up %s for a fresh writer…" id))))
- rule
- it opens where a writer opens when the user picks one out of the tree, so the workspace stays where the user left it.
(defun konix/agent-shell-workspace-goto-writer ()
"Go to the writer this workspace talks to, leaving its mode alone."
(interactive)
(let ((writer (konix/agent-shell-workspace--target-writer)))
(konix/mcp-server--pop-to-agent-from-tree
(konix/agent-shell-shown-buffer writer))))
what the writer can do to the file
rewriting it under the user
- rule
- the file is written on disk and the user’s buffer picks the change up itself.
- rule
- the user’s cursor stays in the heading it stands in through a rewrite, on its
top heading where what it stood on is folded away.
- why: else the user’s next key acts on a heading they did not choose,
tsettling a question they never meant to. - scope: a workspace being bound starts on its first heading, there being no cursor of the user’s to keep yet.
- why: else the user’s next key acts on a heading they did not choose,
- rule
- and a rewrite folds what it wrote, as everything else.
- why: what a rewrite writes arrives unfolded, and the user is not to be left reading the writer’s answers and facts.
- rule
- and a rewrite does not put itself in front of the user — it joins the tracking round the writers are already on.
- rule
- it joins that round while a question is the user’s to answer, and leaves
it otherwise.
- how: what asks them counts, a question asking leave to run a command asking them as one asking an answer does.
- rule: and one the writer closed, waiting on their settling, is theirs too, in this as wherever the workspace asks what is theirs.
- what
- a workspace whose only open question is closed joins the round.
(require 'cl-lib)
(let ((file (make-temp-file "check-closingtrack-" nil ".ws.org"))
tracked)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TOCHECK Fixed it?\n :PROPERTIES:\n :ID: c\n :END:\n"
" - proof :: it holds\n"
"* TODO Later one?\n :PROPERTIES:\n :ID: t\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'tracking-add-buffer)
(lambda (&rest _) (setq tracked 'tracked)))
((symbol-function 'tracking-remove-buffer)
(lambda (&rest _) (setq tracked 'untracked))))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--tracked-or-not (current-buffer) t)
(prog1 tracked
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
tracked. - rule
- what the workspace decides on its own is written down in
*workspace debug*, one line each, tagged with what it is about:tracking,steering,cut,telling,cursorandfold.- rule:
foldsays, as each settle ends, the command,OPENED, the part holding the cursor, the parts left open and the questions kept unfolded.- why: a part opened by a write could not be told from a part opened by the user.
- rule:
- what
- a settle run by
K, the cursor in Mine, writes onefoldline namingK, the cursor’s part and Mine left open.
(let ((file (make-temp-file "check-folddebug-" nil ".ws.org"))
(konix/agent-shell-workspace-debug-tags '(fold))
(konix/agent-shell-workspace-debug-log " check-fold-debug-log")
(konix/agent-shell-workspace-debug-workspace-regexp nil))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* [1] Facts :facts:\n"
"** A fact\n :PROPERTIES:\n :ID: f\n :END:\n"
"* [1] Mine :mine:\n"
"** REFINE Asks you?\n :PROPERTIES:\n :ID: r\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-mode 1)
(goto-char (point-min))
(search-forward "Asks you")
(let ((this-command 'konix/agent-shell-workspace-clean))
(konix/agent-shell-workspace-focus-question))
(prog1 (with-current-buffer konix/agent-shell-workspace-debug-log
(replace-regexp-in-string
"\\`[0-9:]+ \\[fold\\] [^:]+: " ""
(car (last (split-string (buffer-string) "\n" t)))))
(set-buffer-modified-p nil)))
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
konix/agent-shell-workspace-clean settled; OPENED nil, cursor in mine, open ("mine"), unfolded nil.- why: each misbehaviour we chased left no trace, and its cause had to be guessed.
- rule: and the user narrows it: the tags written, a regexp the workspace’s name must
match, and a cap on its lines, past which the oldest go.
- why: unbounded, the log would make Emacs heavy to use.
- what
- a line is written only for a tag kept and a workspace matched, and the log keeps no more lines than its cap.
(let ((konix/agent-shell-workspace-debug-tags '(cut))
(konix/agent-shell-workspace-debug-workspace-regexp "\\`kept")
(konix/agent-shell-workspace-debug-max-lines 2)
(konix/agent-shell-workspace-debug-log " check-debug-log"))
(unwind-protect
(progn
(konix/agent-shell-workspace--debug 'cut "kept.ws.org" "one")
(konix/agent-shell-workspace--debug 'steering "kept.ws.org" "tag off")
(konix/agent-shell-workspace--debug 'cut "other.ws.org" "name off")
(konix/agent-shell-workspace--debug 'cut "kept.ws.org" "two")
(konix/agent-shell-workspace--debug 'cut "kept.ws.org" "three")
(with-current-buffer konix/agent-shell-workspace-debug-log
(mapcar (lambda (line) (car (last (split-string line " "))))
(split-string (buffer-string) "\n" t))))
(kill-buffer konix/agent-shell-workspace-debug-log)))
- what
- the check above is right when it reads
("two" "three").
(defcustom konix/agent-shell-workspace-debug-tags
'(tracking steering cut telling cursor failing permit fold coding)
"Which of the workspace's decisions are written down in its debug log."
:type '(set (const tracking) (const steering) (const cut) (const telling) (const cursor)
(const failing) (const permit) (const fold) (const coding))
:group 'konix)
(defcustom konix/agent-shell-workspace-debug-workspace-regexp nil
"Regexp a workspace's name must match for its decisions to be written down; nil for all."
:type '(choice (const nil) regexp) :group 'konix)
(defcustom konix/agent-shell-workspace-debug-max-lines 2000
"Lines the debug log keeps, the oldest dropped past them."
:type 'integer :group 'konix)
(defvar konix/agent-shell-workspace-debug-log "*workspace debug*"
"Buffer the workspace's decisions are written down in.")
(defun konix/agent-shell-workspace--debug (tag workspace format &rest args)
"Write down, under TAG, a decision about WORKSPACE, a name, as FORMAT and ARGS say."
(when (and (memq tag konix/agent-shell-workspace-debug-tags)
(or (null konix/agent-shell-workspace-debug-workspace-regexp)
(string-match-p konix/agent-shell-workspace-debug-workspace-regexp
(or workspace ""))))
(with-current-buffer (get-buffer-create konix/agent-shell-workspace-debug-log)
(save-excursion
(goto-char (point-max))
(insert (format "%s [%s] %s: %s\n" (format-time-string "%T") tag workspace
(apply #'format format args)))
(let ((extra (- (count-lines (point-min) (point-max))
konix/agent-shell-workspace-debug-max-lines)))
(when (> extra 0)
(goto-char (point-min))
(forward-line extra)
(delete-region (point-min) (point))))))))
(defun konix/agent-shell-workspace--debug-name (shell)
"Return the name of the workspace SHELL is bound to, or nil."
(when-let ((file (ignore-errors (konix/agent-shell-workspace-file shell))))
(file-name-nondirectory file)))
- rule
- each time the round is weighed for a workspace, a
trackingline says what it asked, what it asked at its last nudge, whether it was on screen, and what was done.- why: a workspace missing from the round leaves no trace of why, and the user cannot tell a skipped nudge from one never made.
- what
- weighing a workspace for the round leaves one line naming it and the decision.
(require 'cl-lib)
(let ((file (make-temp-file "check-trackinglog-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'tracking-add-buffer) #'ignore)
((symbol-function 'tracking-remove-buffer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--tracked-or-not (current-buffer) t)
(prog1 (with-current-buffer konix/agent-shell-workspace-debug-log
(save-excursion
(goto-char (point-max))
(forward-line -1)
(let ((line (buffer-substring (point) (line-end-position))))
(list (string-match-p (regexp-quote (concat "[tracking] "
(file-name-nondirectory file)))
line)
(string-match-p (regexp-quote "asking (\"q Asked?\")") line)
(string-match-p "-> put in" line)))))
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file)))
- what
- the check above is right when no element of what it reads is
nil. - rule
- a question the writer rewrote asks the user anew, though it keeps its id.
- why: a refine hands the question back under the same id, and the user, who had read the old one, was never told of the new.
- what
- a question rewritten under the same id puts its workspace in the round again.
(require 'cl-lib)
(let ((file (make-temp-file "check-rewritetrack-" nil ".ws.org"))
(added 0))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE First wording?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'tracking-add-buffer) (lambda (&rest _) (cl-incf added)))
((symbol-function 'tracking-remove-buffer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--tracked-or-not (current-buffer) t)
(goto-char (point-min))
(search-forward "First wording?")
(replace-match "Second wording?")
(konix/agent-shell-workspace--tracked-or-not (current-buffer) t)
(prog1 added
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
2.
(defun konix/agent-shell-workspace--asking-anew (wanted before)
"Return what of WANTED, each an id and its heading, was not asking at the last nudge.
BEFORE is what was asking then. A question reworded asks anew."
(seq-remove (lambda (one) (member one before)) wanted))
- rule
- and it joins it too once its writer has stopped with nothing of its own
left.
- why: the user has more to give it, and nothing else tells them it is free.
- scope: a question awaiting a run counts as its own here.
- why: a writer looping on one task, awaiting and working, would send the user to find it still at work, each time.
- scope: nor is one finished, waiting on the user’s settling.
- how
- looked at again as each of the writer’s turns ends, as well as at each rewrite.
(defvar-local konix/agent-shell-workspace--nudged 'none
"What waited on the user when this workspace was last put in the round.")
(put 'konix/agent-shell-workspace--nudged 'permanent-local t)
(defun konix/agent-shell-workspace--asking-here ()
"Return the ids of what is the user's turn in this buffer."
(let ((questions (konix/agent-shell-workspace--every-question))
found)
(save-excursion
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(while (org-at-heading-p)
(when-let* (((konix/agent-shell-workspace--users-turn-p questions))
(id (org-entry-get nil "ID")))
(push id found))
(outline-next-heading)))
(nreverse found)))
(defun konix/agent-shell-workspace--free-here-p (stopped)
"Non-nil when nothing here is the writer's, its writer STOPPED.
STOPPED nil, the writer is asked whether it is busy."
(and (save-excursion
(goto-char (point-min))
(let (its)
(while (and (not its)
(konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-writers-regexp))
(beginning-of-line)
(setq its (or (konix/agent-shell-workspace--the-writers-at-point-p)
(equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-awaiting-keyword)))
(end-of-line))
(not its)))
(or stopped
(let ((writer konix/agent-shell-workspace--writer-buffer))
(not (and (buffer-live-p writer)
(with-current-buffer writer (shell-maker-busy))))))))
(defun konix/agent-shell-workspace--asking-as-worded ()
"Return the questions asking the user here, each as its id and its heading."
(mapcar (lambda (id)
(save-excursion
(goto-char (org-find-property "ID" id))
(format "%s %s" id (substring-no-properties (org-get-heading t t t t)))))
(konix/agent-shell-workspace--asking-here)))
(defun konix/agent-shell-workspace--tracked-or-not (buffer &optional stopped)
"Put BUFFER, a workspace, in the round or take it out, its writer STOPPED if so."
(let* ((wanted (or (konix/agent-shell-workspace--asking-as-worded)
(and (konix/agent-shell-workspace--free-here-p stopped) 'free)))
(before konix/agent-shell-workspace--nudged)
(decision
(cond ((not wanted) (tracking-remove-buffer buffer) "taken out")
((if (listp wanted)
(konix/agent-shell-workspace--asking-anew
wanted (and (listp before) before))
(not (equal wanted before)))
(tracking-add-buffer buffer) "put in")
(t "left as it was"))))
(konix/agent-shell-workspace--debug
'tracking (buffer-name buffer) "asking %S nudged-before %S on-screen %s -> %s"
wanted before (if (get-buffer-window buffer 'visible) "yes" "no") decision)
(setq-local konix/agent-shell-workspace--nudged wanted)))
- rule
- a rewrite is another of the moments the steering is put on again, so a refusal firing between two tellings still names the questions as they stand.
- how
- the view is settled, then the user’s cursor put back on the top heading it stands under, nothing opened.
(defun konix/agent-shell-workspace--focus-standing-still ()
"Settle the view as `konix/agent-shell-workspace-focus-question' does, point kept."
(let ((standing (point-marker)))
(konix/agent-shell-workspace-focus-question)
(goto-char standing)
(when (and (invisible-p (point)) (not (org-before-first-heading-p)))
(org-back-to-heading t)
(while (and (invisible-p (point)) (org-up-heading-safe))))
(set-marker standing nil)))
(defun konix/agent-shell-workspace--show (file writer fresh)
"Prepare the workspace FILE, telling it the WRITER that asked.
Point and folding are placed only when FRESH; otherwise point stays where it was."
(let* ((existing (find-buffer-visiting file))
(buffer (or existing (find-file-noselect file))))
(konix/agent-shell-workspace--settling-now buffer)
(with-current-buffer buffer
(unless (bound-and-true-p auto-revert-mode)
(auto-revert-mode 1))
(setq-local konix/agent-shell-workspace--writer-buffer writer)
(konix/agent-shell-workspace-mode 1)
(when (and existing (not (buffer-modified-p)))
(revert-buffer t t t))
(if fresh
(progn
(goto-char (point-min))
(org-next-visible-heading 1)
(konix/agent-shell-workspace-focus-question))
(konix/agent-shell-workspace--focus-standing-still))
(konix/agent-shell-workspace--tracked-or-not buffer))
(when (buffer-live-p writer)
(konix/agent-shell-workspace--steer writer)
(konix/agent-shell-workspace--label-writer writer buffer)
(konix/agent-shell-workspace--cut-short writer))
buffer))
- rule
- a shell bound to a workspace is reached through its workspace: the commands
taking the user to a shell take them to its workspace instead.
- why: bound, the workspace is where the user talks with the writer; its shell holds nothing they are to read.
- rule: but not while it awaits a permission: then its viewport, or itself.
- why: the user pops to do what is expected of them, and the workspace hides that permission.
- what
- the buffer the user goes to for a bound shell is its workspace, bar while it awaits a permission.
(require 'cl-lib)
(let ((file (make-temp-file "check-entry-" nil ".ws.org"))
(shell (generate-new-buffer " check-entry-writer")))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (buffer) (when (eq buffer shell) file))))
(list (equal (buffer-file-name (konix/agent-shell-entry-buffer shell))
file)
(cl-letf (((symbol-function 'konix/agent-shell--pending-permission-ids)
(lambda () '("id"))))
(konix/agent-shell-workspace--entry-buffer shell))))
(kill-buffer shell)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(kill-buffer visiting)))
(delete-file file)))
- what
- the check above is right when it reads
(t nil).
(defun konix/agent-shell-workspace--asking-leave-p (shell)
"Non-nil when SHELL awaits the user's permission."
(with-current-buffer shell
(ignore-errors (konix/agent-shell--pending-permission-ids))))
(defun konix/agent-shell-workspace--entry-buffer (shell)
"Return the workspace SHELL is bound to, as the buffer to reach it by, or nil.
Nil too while SHELL awaits a permission, which its workspace does not show."
(when-let ((file (konix/agent-shell-workspace-file shell))
((not (konix/agent-shell-workspace--asking-leave-p shell))))
(find-file-noselect file)))
(add-hook 'konix/agent-shell-entry-buffer-functions
#'konix/agent-shell-workspace--entry-buffer)
the writer’s label
- rule
- the writer’s session is labelled with the question it is on, and with the
workspace’s name while it is on none.
- why: the user often goes to the workspace only to read the question, to understand why the writer is doing what it is doing.
- why: the label the agent writes for itself is always poorly written.
- rule: and a heading ending in « , Go? » is labelled without it.
- why: it is how the writer asks leave to act, and tells nothing of the work.
- what
- a writer on a question bears its heading as its label, and the workspace’s name, without its suffix, while it is on none, the label following each write, the writer’s and the user’s, as questions are taken up, put down or closed.
(require 'cl-lib)
(let ((file (make-temp-file "check-label-" nil ".ws.org")) labels)
(with-temp-file file
(insert "#+TODO: TODO WORKING | DONE\n"
"* Writer's :writers:\n"
"** WORKING Fix the thing, Go?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell--rename-with-label)
(lambda (_shell label) (push label labels)))
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-short) #'ignore)
((symbol-function 'konix/agent-shell-workspace--cut-taken-back) #'ignore))
(let ((writer (generate-new-buffer " check-label-writer")))
(konix/agent-shell-workspace--show file writer nil)
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id "q")
(org-todo "TODO"))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer))
(kill-buffer writer))
(format "%S" (list (car (last labels))
(equal (car labels)
(string-remove-suffix
".ws.org" (file-name-nondirectory file))))))
(delete-file file)))
- what
- the check above is right when it reads the question’s words first, less their
« , Go? », then whether the next label is the file’s name without
.ws.org:("Fix the thing" t).
(defun konix/agent-shell-workspace--label-writer (writer workspace)
"Label WRITER's session with the question it is on in WORKSPACE, or its name."
(let ((label (with-current-buffer workspace
(or (save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(when (re-search-forward
(konix/agent-shell-workspace--keyword-regexp
konix/agent-shell-workspace-held-keywords)
nil t)
(replace-regexp-in-string
", *Go\\? *\\'" ""
(substring-no-properties (org-get-heading t t t t))))))
(string-remove-suffix konix/agent-shell-workspace-suffix
(buffer-name))))))
(konix/agent-shell--rename-with-label writer label)))
writing one question
- rule
- a write reaches one question and leaves the rest untouched.
- scope: their words; where they stand is whose turn they are, as every write sorts them.
- scope: that holds of every heading these tools wrote; one the user made by hand carries no id, and the write gives it one.
- scope: and a line of the user’s starting on a star, pasted into a body, reads as a heading there, so it takes a drawer of its own while another question is written.
- rule
- a rejected write leaves the file untouched, the write happening only once the whole question has been accepted.
(defun konix/agent-shell-workspace--edit (mutate)
"Rewrite the workspace by calling MUTATE in a buffer holding it.
Returns its path."
(let* ((writer (konix/agent-shell-workspace--writer))
(file (konix/agent-shell-workspace--file-or-error)))
(unless (file-readable-p file)
(error "No workspace here — bind one first"))
(konix/agent-shell-workspace--keeping-cursor
file
(lambda ()
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--ensure-well-formed)
(konix/agent-shell-workspace--ensure-session-link writer)
(funcall mutate))
(konix/agent-shell-workspace--show file writer nil)))
file))
- rule
- a write of the writer’s leaves the user’s cursor on the question it stood on,
at the same place in it, whatever the write did around it.
- why: the user answering one question was carried back to another by a rewrite they did not see, and answered the wrong one.
- rule: and the user’s own answer as well: it moves them on to nothing.
- what
- a write that replaces the text the cursor stands in leaves the cursor on the same question, at the same offset into it.
(require 'cl-lib)
(let ((file (make-temp-file "check-keepcursor-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Mine :mine:\n")
(dolist (id '("a" "b" "c" "d"))
(insert (format "** REFINE Question %s?\n :PROPERTIES:\n :ID: %s\n :END:\n" id id))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--show) #'ignore))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(search-forward "Question d")
(konix/agent-shell-workspace--edit
(lambda ()
(goto-char (point-min))
(search-forward "** REFINE Question b")
(beginning-of-line)
(let ((rest (buffer-substring (point) (point-max))))
(delete-region (point) (point-max))
(insert (string-replace "Question b?" "Question b, again?" rest)))))
(buffer-substring (line-beginning-position) (point))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
"** REFINE Question d". - rule
- and every write keeps each window on the workspace where it stood, not only
the writer’s.
- why: a write rewriting the text under a window sent it to the top, on a memo, and the user’s answer went there.
- what
- a window on question d, the buffer’s own point elsewhere, a write rewriting the whole text leaves that window on d.
(let ((file (make-temp-file "check-keepwindow-" nil ".ws.org"))
(frame (make-frame '((visibility . nil)))))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Memos :memos:\n** A memo\n :PROPERTIES:\n :ID: m\n :END:\n"
"* Mine :mine:\n")
(dolist (id '("a" "b" "c" "d"))
(insert (format "** REFINE Question %s?\n :PROPERTIES:\n :ID: %s\n :END:\n - what :: body %s\n" id id id))))
(unwind-protect
(let ((window (frame-root-window frame)))
(with-current-buffer (find-file-noselect file)
(set-window-buffer window (current-buffer))
(goto-char (point-min))
(search-forward "body d")
(set-window-point window (point))
(goto-char (point-min))
(konix/agent-shell-workspace--write-file file
(let ((text (buffer-string)))
(erase-buffer)
(insert text)))
(save-excursion
(goto-char (window-point window))
(if (org-before-first-heading-p)
'top
(org-back-to-heading t)
(org-get-heading t t t t)))))
(delete-frame frame)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
"Question d?". - what
- each write that keeps the cursor leaves a
cursorline naming where.
(let ((file (make-temp-file "check-cursorlog-" nil ".ws.org"))
(konix/agent-shell-workspace-debug-log " check-cursor-log"))
(with-temp-file file
(insert "* REFINE Question d?\n :PROPERTIES:\n :ID: d\n :END:\n"))
(unwind-protect
(with-current-buffer (find-file-noselect file)
(goto-char (point-max))
(konix/agent-shell-workspace--keeping-cursor file #'ignore)
(with-current-buffer konix/agent-shell-workspace-debug-log
(and (string-match-p "\\[cursor\\] .*kept on (\"d\" " (buffer-string)) t)))
(when (get-buffer konix/agent-shell-workspace-debug-log)
(kill-buffer konix/agent-shell-workspace-debug-log))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
t. - rule
- the cursor is kept by the nearest heading above it carrying an id, at the
same offset into it, wherever it stands.
- why: the top headings carry no id, and keeping it by theirs left it nowhere: it wandered.
- what
- mid-body of a question under a top heading with no id, the place kept is that question’s, at that offset.
(with-temp-buffer
(org-mode)
(insert "* Mine :mine:\n"
"** REFINE Question q?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: the body\n")
(search-backward "the body")
(let ((place (konix/agent-shell-workspace--cursor-place)))
(list (car place)
(progn (goto-char (point-min))
(konix/agent-shell-workspace--cursor-back place)
(looking-at-p "the body")))))
- what
- the check above is right when it reads
("q" t).
(defun konix/agent-shell-workspace--cursor-place ()
"Return (ID . OFFSET), the nearest heading above point with an id and how far into it
point stands, or nil."
(konix/agent-shell-workspace--spot-at (point)))
(defun konix/agent-shell-workspace--cursor-back (place)
"Go back to PLACE, as `konix/agent-shell-workspace--cursor-place' gave it."
(when-let* ((where (konix/agent-shell-workspace--spot-place place)))
(goto-char where)))
(defun konix/agent-shell-workspace--keeping-cursor (file thunk)
"Call THUNK, FILE's buffer and the windows on it left on the question they stood on."
(let* ((buffer (find-file-noselect file))
(windows (get-buffer-window-list buffer nil t))
(places (with-current-buffer buffer
(cons (konix/agent-shell-workspace--cursor-place)
(mapcar (lambda (window)
(save-excursion
(goto-char (window-point window))
(konix/agent-shell-workspace--cursor-place)))
windows)))))
(prog1 (funcall thunk)
(konix/agent-shell-workspace--debug
'cursor (file-name-nondirectory file) "kept on %S, windows on %S"
(car places) (cdr places))
(with-current-buffer buffer
(konix/agent-shell-workspace--cursor-back (car places))
(cl-mapc (lambda (window place)
(when (and place (window-live-p window))
(set-window-point
window (save-excursion
(konix/agent-shell-workspace--cursor-back place)
(point)))))
windows (cdr places))))))
one tool, adding or replacing
- rule
- writing a question adds it or replaces it, in one operation.
- why: Occam’s razor — two tools would be one more than the work needs.
- rule
- whatever question the writer writes, made or rewritten, comes back to the
user, never left the writer’s: only the user’s own move hands one to the writer.
- why: otherwise the user has no say about what is to be done.
- why: so the user knows exactly what the writer’s instructions are.
- scope: a rewrite may close it, the work done, which hands it to them as well.
- how: taking one up or putting it down goes through the state tool, which leaves its words alone.
- rule
- and whatever the writer writes carries a body, or the call is refused before anything is written.
(defconst konix/agent-shell-workspace-kept-error
(concat "A question you write, made or rewritten, comes back to the user, so they"
" know exactly what you are to do: ask it and wait, or close it once the"
" work is done. To take one up or put it down, use set_workspace_state,"
" which leaves its words alone.")
"What a writer is told when it writes a question and keeps it its own.")
(defun konix/agent-shell-workspace--users-act-p (act)
"Non-nil when ACT hands a question to the user, naming none doing so too."
(or (null act)
(string-empty-p (string-trim act))
(and (member (cdr (assoc-string (string-trim act)
konix/agent-shell-workspace-acts t))
konix/agent-shell-workspace-users-keywords)
t)))
- rule
- where the workspace has projects, a new question names the one it moves
forward, or is refused.
- why: the user’s commonest answer was « does that help the project? ».
- how: the writer passes the project’s id, and a « for » line under the question
links it, as a « waits on » line does.
- scope: or several ids, a question moving several projects forward.
- scope: a rewrite keeps the line it had, and may name another project.
- scope: bar a proposal of merges, answering the request
Mwrote, which names none either. - rule: and the id has to be an open project’s.
(defconst konix/agent-shell-workspace-for-said "for"
"What the line linking a question to the project it moves forward opens on.")
(defconst konix/agent-shell-workspace-aimless-error
(concat "This workspace has projects: pass project, the id of the project this question"
" moves forward, as the listing gives it. If it moves none, don't ask it.")
"What a writer is told when it writes a question naming no project, projects being there.")
(defun konix/agent-shell-workspace--project-ids (project)
"Return the ids PROJECT names: one id, or a JSON array of them; nil for none."
(cond
((or (null project) (string-empty-p (string-trim project))) nil)
((string-prefix-p "[" (string-trim project)) (konix/mcp-server-decode-json-list project))
(t (list (string-trim project)))))
(defun konix/agent-shell-workspace--refuse-aimless (id projects)
"Refuse a new question, its id ID nil, naming no PROJECTS where projects are, or a bad one."
(konix/agent-shell-workspace--read-file (konix/agent-shell-workspace--file-or-error)
(if projects
(dolist (project projects)
(unless (and (konix/agent-shell-workspace--goto-id project)
(konix/agent-shell-workspace--project-at-point-p)
(not (member (org-get-todo-state)
(list konix/agent-shell-workspace-later-keyword
konix/agent-shell-workspace-done-keyword))))
(error "%s is no open project of this workspace" project)))
(when (and (null id)
(not konix/agent-shell-workspace--answering-merges)
(konix/agent-shell-workspace--projects-here))
(error "%s" konix/agent-shell-workspace-aimless-error)))))
- rule
- a question names a place only where it is about one.
- why: held to name one, a writer with none to hand makes up a file to point at.
(defun konix/mcp-server-set-workspace-question
(label &optional note file line says also act id url needs project)
"Write one question of the workspace, replacing or adding it, at FILE and LINE if any.
The question comes back to the user, whatever ACT.
MCP Parameters:
label - What this question asks the user
file - Optional absolute path of the place it is about, only where it is about one
line - Line in that file
note - Optional JSON array of « intention :: text » bullets
says - Optional caption for the link itself
also - Optional JSON array of further {file, line, says} or {url, says}
act - Optional refine or close: what you write comes back to the user
id - Optional id of the question to rewrite, as the listing tool gives it
url - Optional web address, written out whole and counting against no limit
needs - Optional JSON array of ids it also waits on, held back until settled; none is taken off
project - Id of the project it moves forward, or a JSON array of several; required new, under projects"
(mcp-server-lib-with-error-handling
(when (konix/agent-shell-workspace--awaiting-act-p act)
(error "%s" (concat "Await with set_workspace_state, passing the command it"
" awaits: a rewrite has no command to run.")))
(unless (konix/agent-shell-workspace--users-act-p act)
(error "%s" konix/agent-shell-workspace-kept-error))
(when (null (konix/mcp-server-decode-json-list note))
(error "%s" konix/agent-shell-workspace-empty-handover-error))
(setq project (konix/agent-shell-workspace--project-ids project))
(konix/agent-shell-workspace--refuse-aimless id project)
(let* ((line (if (stringp line) (string-to-number line) (or line 1)))
(keyword (and act (not (string-empty-p (string-trim act)))
(konix/agent-shell-workspace--act-keyword act)))
(_ (konix/agent-shell-workspace--refuse-closing-unproven keyword note))
(_ (when (member keyword (list konix/agent-shell-workspace-closing-keyword
konix/agent-shell-workspace-refine-keyword))
(konix/agent-shell-workspace--refuse-unread-work)))
(entry (list (cons 'file file) (cons 'line line)
(cons 'label label) (cons 'note note)
(cons 'says says) (cons 'also also)
(cons 'url url)
(cons 'keyword keyword) (cons 'id id)))
(writer (ignore-errors (konix/agent-shell-workspace--writer)))
(gate (and (or (null id)
(member keyword (list konix/agent-shell-workspace-closing-keyword
konix/agent-shell-workspace-refine-keyword)))
(konix/agent-shell-workspace--gate-of writer)))
(transcript (and gate (konix/agent-shell-workspace--transcript-since-work
writer id)))
added kept sent was)
(konix/agent-shell-workspace--edit
(lambda ()
(save-excursion
(when (and id (konix/agent-shell-workspace--goto-id id))
(setq was (cond ((equal keyword konix/agent-shell-workspace-closing-keyword)
konix/agent-shell-workspace-working-keyword)
((konix/agent-shell-workspace--gated-was id))
(t (konix/agent-shell-workspace--state-at-point))))
(konix/agent-shell-workspace--refuse-closing-the-users-yes keyword)
(konix/agent-shell-workspace--refuse-closing-the-thought keyword)
(konix/agent-shell-workspace--refuse-closing-the-asked keyword)
(konix/agent-shell-workspace--refuse-the-same-heading keyword label)
(konix/agent-shell-workspace--refuse-design-undrawn keyword entry)))
(let* ((question (konix/agent-shell-workspace--render-question
entry (konix/agent-shell-workspace--priorities)
(konix/agent-shell-workspace--revisions)
(konix/agent-shell-workspace--tags))))
a plan, written in one go
- rule
- the writer asked for a plan writes its steps and the order between them in
one call, each step a question like any other.
- why: written one at a time, a step cannot name one not yet written, so saying the order costs round trips and is left unsaid.
- how: each step goes by a name of the writer’s own for the length of the call, and what it waits on is named by those, or by the id of a question already there.
- rule
- and nothing is written until every step would be: a step naming what no step
and no question is, or two steps going by one name, refuses the whole of it.
- why: a plan half written is a plan that says an order it does not have.
- rule
- and the writer’s turn is cut short
only once the plan stands and the call has ended, never between its steps.
- why: the first step written already leaves the writer nothing of its own, and a cut there cancels the very call writing the plan, so it never lands and the writer is told to plan again.
- rule
- and a plan for a project that does not yet say what done means and doing
looks like is refused, the writer told to propose them first.
- why: being told to propose them first does not keep the writer from planning anyway.
- rule
- and a step another question still holds back opens to discuss, not asked.
- why: once free, the writer likely needs to review it before submitting it to the user.
- therefore: once free it is the writer’s, which takes it up, rewords it and refines it.
- how: a step going through its auditor is to discuss once passed.
- what
- of a plan, the step waiting on nothing or on a settled question is asked, the one waiting on it or coming after it to discuss; through an auditor, so is each passed.
(require 'cl-lib)
(let ((file (make-temp-file "check-plandiscuss-" nil ".ws.org"))
(writer (generate-new-buffer " check-plandiscuss-writer"))
(konix/agent-shell-workspace--gates (make-hash-table :test #'eql))
(task 0)
result)
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--transcript-since-work) #'ignore)
((symbol-function 'konix/agent-shell-workspace--post-to-auditor)
(lambda (&rest _) (cl-incf task))))
(dolist (auditor '(nil "w::auditor"))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(let ((kill-buffer-query-functions nil)) (kill-buffer))))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - done :: it works\n - doing :: try it\n"
"* DONE Settled?\n :PROPERTIES:\n :ID: s\n :END:\n"))
(cl-letf (((symbol-function 'konix/agent-shell-workspace--gate-of)
(lambda (_) auditor)))
(with-current-buffer writer
(let ((said (konix/mcp-server-set-workspace-plan
(json-encode
`(((name . "a") (project . "p") (label . "First?") (note . ["what :: one"]))
((name . "b") (project . "p") (label . "Second?") (note . ["what :: two"])
(after . ["a"]))
((name . "c") (project . "p") (label . "Third?") (note . ["what :: three"])
(needs . ["a"]))
((name . "d") (project . "p") (label . "Fourth?") (note . ["what :: four"])
(needs . ["s"]))))))
gates)
(maphash (lambda (_ gate) (push (nth 1 gate) gates))
konix/agent-shell-workspace--gates)
(clrhash konix/agent-shell-workspace--gates)
(push (cond
((not (string-prefix-p "Wrote the plan" said)) said)
(auditor (sort gates #'string<))
(t
(with-temp-buffer
(insert-file-contents file)
(let (states)
(goto-char (point-min))
(while (re-search-forward
"^\\*\\* \\([A-Z]+\\) \\(First\\|Second\\|Third\\|Fourth\\)\\?" nil t)
(push (concat (match-string 2) " " (match-string 1)) states))
(nreverse states)))))
result)))))
(nreverse result))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads, unaudited, « First REFINE », « Second DISCUSS », « Third DISCUSS », « Fourth REFINE », then, audited, two gates to « DISCUSS » and two to « REFINE ».
- what
- a plan naming a project without done and doing is refused, nothing written, the refusal naming workspace_project_define.
(require 'cl-lib)
(let ((file (make-temp-file "check-plandod-" nil ".ws.org"))
(writer (generate-new-buffer " check-plandod-writer")))
(with-temp-file file
(insert "* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore))
(with-current-buffer writer
(list (condition-case err
(progn
(konix/mcp-server-set-workspace-plan
(json-encode
'(((name . "a") (project . "p") (label . "First?")
(note . ["what :: one"])))))
'accepted)
(error (if (string-match-p "workspace_project_define"
(error-message-string err))
'refused-pointing-to-dod
(error-message-string err))))
(with-temp-buffer (insert-file-contents file)
(how-many "First\\?" (point-min) (point-max))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(refused-pointing-to-dod 0). - what
- a plan for a project with nothing in motion is written whole, no cut landing while it is.
(require 'cl-lib)
(let ((file (make-temp-file "check-plan-" nil ".ws.org"))
(writer (generate-new-buffer " check-plan-writer"))
(cuts 0))
(with-temp-file file
(insert "* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - done :: it works\n - doing :: try it\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) (lambda (&rest _) (cl-incf cuts)))
((symbol-function 'agent-shell--state)
(lambda () '((:tool-calls ("t1" (:status . "in_progress"))))))
((symbol-function 'agent-shell-subscribe-to) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore))
(with-current-buffer writer
(konix/mcp-server-set-workspace-plan
(json-encode
`(((name . "a") (project . "p") (label . "First?") (note . ["what :: one"]))
((name . "b") (project . "p") (label . "Second?") (note . ["what :: two"])
(after . ["a"])))))
(format "cuts while writing: %d, steps written: %d" cuts
(with-temp-buffer (insert-file-contents file)
(how-many "^\\*\\* .*\\(First\\|Second\\)\\?" (point-min) (point-max))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
cuts while writing: 0, steps written: 2. - what
- the plan written, the cut waits on the call’s own completion, no timer: none while the call is in flight, one once it completes.
(require 'cl-lib)
(funcall
(lambda (thunk)
(let ((file (make-temp-file "check-nothingleft-" nil ".ws.org"))
(writer (generate-new-buffer " check-nothingleft-writer"))
(calls (list (cons "t1" (list (cons :status "in_progress")))))
handlers cut)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* REFINE Asked?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'konix/agent-shell--pending-permission-ids) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'agent-shell--state)
(lambda () (list (cons :tool-calls calls))))
((symbol-function 'agent-shell-subscribe-to)
(cl-function (lambda (&key event on-event &allow-other-keys)
(let ((token (list event)))
(push (cons token on-event) handlers)
token))))
((symbol-function 'agent-shell-unsubscribe)
(cl-function (lambda (&key subscription)
(setq handlers (assq-delete-all subscription handlers)))))
((symbol-function 'agent-shell-interrupt)
(lambda (&rest _) (setq cut t))))
(funcall thunk writer file
(lambda ()
(setf (alist-get :status (cdr (assoc "t1" calls))) "completed"))
(lambda (event)
(dolist (handler (copy-sequence handlers))
(when (eq (caar handler) event)
(funcall (cdr handler) nil))))
(lambda () cut)
(lambda (event)
(seq-count (lambda (handler) (eq (caar handler) event)) handlers))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file))))
(lambda (writer file complete fire cut-p _waiting)
(cl-letf (((symbol-function 'run-at-time) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore))
(with-current-buffer writer
(konix/mcp-server-set-workspace-plan
(json-encode '(((name . "a") (label . "First?") (note . ["what :: one"]))))))
(list (funcall cut-p)
(progn (funcall complete)
(funcall fire 'tool-call-update)
(funcall cut-p))))))
- what
- the check above is right when it reads
(nil t). - rule
- the questions one plan writes all carry the one
PLANid.- why: the user rejecting a plan wants to reach all of it at once, and nothing else tells which questions came together.
- what
- a plan’s steps share one
PLAN, which another plan’s do not.
(require 'cl-lib)
(let ((file (make-temp-file "check-planstamp-" nil ".ws.org"))
(writer (generate-new-buffer " check-planstamp-writer")))
(with-temp-file file
(insert "* TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"
" - done :: it works\n - doing :: try it\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace-file) (lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error) (lambda () file))
((symbol-function 'shell-maker-busy) (lambda () t))
((symbol-function 'agent-shell-interrupt) #'ignore)
((symbol-function 'konix/agent-shell--cancel-pending-permissions) #'ignore)
((symbol-function 'konix/agent-shell-workspace--steer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link) #'ignore)
((symbol-function 'konix/agent-shell-workspace--leave-the-round) #'ignore)
((symbol-function 'konix/agent-shell-workspace--label-writer) #'ignore))
(with-current-buffer writer
(dolist (labels '(("First?" "Second?") ("Third?")))
(konix/mcp-server-set-workspace-plan
(json-encode
(seq-map-indexed (lambda (label i)
`((name . ,(format "s%d" i)) (project . "p")
(label . ,label) (note . ["what :: one"])))
labels))))
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(let (plans)
(org-map-entries (lambda () (when-let ((plan (org-entry-get nil "PLAN")))
(push plan plans))))
(list (length plans)
(length (delete-dups (copy-sequence plans))))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(3 2): three stamped, two plans.
(defun konix/agent-shell-workspace--check-plan (steps)
"Refuse STEPS where a name is used twice or a need names nothing there is."
(let ((names (mapcar (lambda (step) (alist-get 'name step)) steps)))
(when (seq-some #'null names)
(error "Every step needs a name, for the others to wait on it by"))
(unless (equal names (delete-dups (copy-sequence names)))
(error "Two steps go by the one name"))
(dolist (step steps)
(dolist (project (konix/agent-shell-workspace--project-ids
(let ((named (alist-get 'project step)))
(if (listp named) (and named (json-encode named)) named))))
(unless (konix/agent-shell-workspace--read-file
(konix/agent-shell-workspace--file-or-error)
(konix/agent-shell-workspace--project-defined-p project))
(error (concat "The project %s does not say yet what done means nor what"
" doing looks like: propose both with"
" workspace_project_define before any plan")
project))))
(dolist (step steps)
(dolist (need (append (alist-get 'needs step) (alist-get 'after step) nil))
(unless (or (member need names)
(konix/agent-shell-workspace--read-file
(konix/agent-shell-workspace--file-or-error)
(konix/agent-shell-workspace--goto-id need)))
(error "« %s » waits on %s, which is no step and no question here"
(alist-get 'name step) need))))))
- how
- the steps are written first and the waitings after, a waiting needing every
step’s id, and the id a step was given is the one the last question added was given.
- how: every question added takes its id from one place, which keeps it; where the question then stands, the sort deciding, says nothing of it.
- what
- a question of the user’s added after one of the writer’s is the one named last added, though the sort puts it first.
(require 'cl-lib)
(let ((file (make-temp-file "check-last-added-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* TODO The writer's?\n :PROPERTIES:\n :ID: w\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--submit) #'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer) #'ignore))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace-add-subject
"Yours?" nil nil nil nil nil nil nil nil
konix/agent-shell-workspace-refine-keyword)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id
(konix/agent-shell-workspace--last-question-id file))
(substring-no-properties (org-get-heading t t t t)))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
"Yours?".- how: and a step the question tool refuses, past what was checked ahead, puts the workspace back as it stood before the call, the refusal then going on.
(defvar konix/agent-shell-workspace--added-id nil
"The id the last question added was given.")
(defun konix/agent-shell-workspace--new-question-id ()
"Return a new id for a question being added, kept as the one last added."
(setq konix/agent-shell-workspace--added-id (org-id-new)))
(defun konix/agent-shell-workspace--last-question-id (file)
"Return the id of the question last added, when the workspace FILE holds it."
(when (and konix/agent-shell-workspace--added-id
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id
konix/agent-shell-workspace--added-id)))
konix/agent-shell-workspace--added-id))
(defun konix/mcp-server-set-workspace-plan (steps)
"Write the STEPS of a plan as questions, and the order between them.
MCP Parameters:
steps - JSON array of {name, file, line, label, note, needs, after, project}: names or ids"
(mcp-server-lib-with-error-handling
(let* ((steps (append (json-parse-string steps :object-type 'alist
:array-type 'list)
nil))
(file (konix/agent-shell-workspace--file-or-error))
(before (konix/agent-shell-workspace--read-file file (buffer-string)))
(writer (konix/agent-shell-workspace--writer))
(konix/agent-shell-workspace--cut-held t)
ids)
(konix/agent-shell-workspace--check-plan steps)
(unwind-protect
(condition-case refused
(progn
(dolist (step steps)
(konix/mcp-server-set-workspace-question
(alist-get 'label step)
(json-encode (alist-get 'note step))
(alist-get 'file step)
(alist-get 'line step)
nil nil nil nil nil nil
(let ((project (alist-get 'project step)))
(if (listp project) (and project (json-encode project)) project)))
(push (cons (alist-get 'name step)
(konix/agent-shell-workspace--last-question-id file))
ids))
(konix/agent-shell-workspace--edit
(lambda ()
(konix/agent-shell-workspace--plan-order steps ids)
(konix/agent-shell-workspace--discuss-held-back (mapcar #'cdr ids))
(konix/agent-shell-workspace--stamp-plan (mapcar #'cdr ids)))))
(error
(konix/agent-shell-workspace--write-file file
(erase-buffer)
(insert before))
(signal (car refused) (cdr refused))))
;; the call still in flight, the cut waits for its completion
(let ((konix/agent-shell-workspace--cut-held nil))
(when (buffer-live-p writer)
(condition-case err
(konix/agent-shell-workspace--cut-short writer)
(error (message "Cut after the plan: %s" (error-message-string err)))))))
(concat "Wrote the plan: "
(mapconcat (lambda (one) (format "%s is %s" (car one) (cdr one)))
(reverse ids) ", ")))))
(defun konix/agent-shell-workspace--stamp-plan (ids)
"Give the questions IDS, written by one plan, one PLAN id between them."
(let ((plan (org-id-uuid)))
(dolist (id ids)
(save-excursion
(when (konix/agent-shell-workspace--goto-id id)
(org-entry-put (point) "PLAN" plan))))))
(defun konix/agent-shell-workspace--plan-order (steps ids)
"Write what each of STEPS waits on or comes after, IDS naming each step's question."
(let ((resolve (lambda (names)
(mapcar (lambda (need)
(or (alist-get need ids nil nil #'equal) need))
names))))
(dolist (step steps)
(let ((mine (alist-get (alist-get 'name step) ids nil nil #'equal)))
(konix/agent-shell-workspace--wait-on-each
mine (funcall resolve (alist-get 'needs step)))
(konix/agent-shell-workspace--wait-on-each
mine (funcall resolve (alist-get 'after step)) t)))))
(defun konix/agent-shell-workspace--discuss-held-back (ids)
"Put each of the questions IDS another still holds back to discuss.
One awaiting its auditor is put to discuss once passed."
(let ((questions (konix/agent-shell-workspace--every-question)))
(dolist (id ids)
(when (konix/agent-shell-workspace--holding-back id questions)
(if (konix/agent-shell-workspace--gated-p id)
(maphash (lambda (_task gate)
(when (equal (car gate) id)
(setf (nth 1 gate) konix/agent-shell-workspace-discuss-keyword)))
konix/agent-shell-workspace--gates)
(konix/agent-shell-workspace--goto-id id)
(let ((start (+ (line-beginning-position) (1+ (org-current-level)))))
(delete-region start (+ start (length (konix/agent-shell-workspace--state-at-point))))
(goto-char start)
(insert konix/agent-shell-workspace-discuss-keyword)))))))
rewriting one that already stands
- rule
- where the question already stands, a settled one, a put-off one or a project
is refused, and any other has the writer’s own words replaced.
- rule: and what the user put there outlives the rewrite: their answers, and the
links to the facts reporting on it.
- why: a rewrite of the heading alone would throw their answers away with it, and leave the facts it reported through reaching nothing.
- how: both are lifted out before the question goes and put back after it, the links through the same call that wrote them in the first place.
- rule: and a question still asking leave to run a command keeps asking it: the
command, and the line saying so.
- why: dropped, the question stands in
PERMwith nothing said of whatyruns.
- why: dropped, the question stands in
- rule: and a DoD proposal stays one, so
its
ystill writes into the project. - rule: an id that stands nowhere is refused too, rather than quietly adding one.
- rule: and an id naming anything but a question — a fact, an
answer of the user’s — is refused before a character goes.
- why: as addressing a heading says, the writer must not delete what is not done.
- therefore: the widest a rewrite can reach is the one question it names.
- rule: and what the user put there outlives the rewrite: their answers, and the
links to the facts reporting on it.
- what
- a DoD proposal rewritten after the user’s answers, then answered
y, writes its lines into the project.
(require 'cl-lib)
(let ((file (make-temp-file "check-dod-rw-" nil ".ws.org"))
(writer (generate-new-buffer " check-dod-rw-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE WORKING TOCHECK | DONE\n"
"* Projects :projects:\n"
"** TODO the project :project:\n :PROPERTIES:\n :ID: p\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer)
(lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(konix/mcp-server-workspace-project-define
"p" "[\"done :: it works\", \"doing :: try it\"]")
(let ((id (konix/agent-shell-workspace--last-question-id file)))
(with-current-buffer (find-file-noselect file)
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--goto-id id)
(goto-char (konix/agent-shell-workspace--question-end))
(insert "*** me: done is more like it works well\n"
" :PROPERTIES:\n :ID: ans\n :END:\n")
(konix/agent-shell-workspace--goto-id id)
(org-todo "TODO")))
(konix/mcp-server-set-workspace-question
"DoD: « the project »?"
"[\"done :: it works well\", \"doing :: try it\"]"
nil nil nil nil "refine" id nil nil "p")
(with-current-buffer (find-file-noselect file)
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(save-restriction
(widen)
(konix/agent-shell-workspace--goto-id id))
(konix/agent-shell-workspace-answer-yes)
(prog1 (save-restriction
(widen)
(and (konix/agent-shell-workspace--project-defined-p "p")
'defined))
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))))
(kill-buffer writer)
(delete-file file)))
- what
- the check above is right when it reads
defined.
(if (konix/agent-shell-workspace--goto-id id)
(setq kept (konix/agent-shell-workspace--take-out-to-rewrite id))
(when id
(error "No heading %s in the workspace" id))
(goto-char (point-max))
(setq added t))
(let ((at (point)))
(insert question)
(konix/agent-shell-workspace--put-back-what-stays id at kept)
(let ((mine (or id (save-excursion
(goto-char at)
(org-entry-get (point) "ID")))))
(save-excursion
(konix/agent-shell-workspace--wait-on-each
mine (konix/mcp-server-decode-json-list needs)))
(dolist (one project)
(save-excursion
(konix/agent-shell-workspace--link-under
mine one (konix/agent-shell-workspace--heading-by-id-here one)
konix/agent-shell-workspace-for-said)))
(when gate
(setq sent (konix/agent-shell-workspace--send-to-gate
mine gate writer (konix/agent-shell-workspace--file-or-error)
(save-excursion
(goto-char at)
(konix/agent-shell-workspace--state-at-point))
was transcript))))))))
(defun konix/agent-shell-workspace--take-out-to-rewrite (id)
"Take the question ID at point out for a rewrite, refusing what may not be.
Return (ANSWERS LINKS SAID HEADING RUN LEAVE DEFINES REJECTS REFUSAL), what outlives
the rewrite."
(unless (konix/agent-shell-workspace--state-at-point)
(error "%s is no question of yours to rewrite" id))
(when (konix/agent-shell-workspace--project-at-point-p)
(error "%s" konix/agent-shell-workspace-project-error))
(when (equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-done-keyword)
(error "%s" konix/agent-shell-workspace-settled-error))
(when (equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-later-keyword)
(error "%s" konix/agent-shell-workspace-put-off-error))
(let* ((limit (konix/agent-shell-workspace--question-end))
(kept (list (konix/agent-shell-workspace--answers-under (point) limit)
(konix/agent-shell-workspace--links-under (point) limit)
(konix/agent-shell-workspace--what-it-says (point) limit)
(string-trim (org-get-heading t t t t))
(save-excursion
(when (re-search-forward
konix/agent-shell-workspace-run-line-regexp limit t)
(match-string 0)))
(when-let ((command (org-entry-get (point) "PENDING-RUN")))
(list command
(org-entry-get (point) "PENDING-ROOT")
(save-excursion
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote
konix/agent-shell-workspace-asks-to-run-said))
limit t)
(match-string 0)))))
(org-entry-get (point)
konix/agent-shell-workspace-define-property)
(org-entry-get (point)
konix/agent-shell-workspace-rejects-property)
(save-excursion
(when (re-search-forward
konix/agent-shell-workspace-refusal-regexp
(save-excursion (outline-next-heading) (min (point) limit))
t)
(match-string 0))))))
(delete-region (point) limit)
kept))
(defconst konix/agent-shell-workspace-refusal-regexp
"^ *- audited :: needs work\n *#\\+BEGIN_QUOTE\n\\(?:.*\n\\)*? *#\\+END_QUOTE\n"
"What the last refusal of the auditor leaves under a question: its line, its answer quoted.")
- rule
- the links kept through a rewrite come back in the order they stood, newest on
top.
- why: each link goes back on top, so putting them back top first turned them over at every rewrite.
(defun konix/agent-shell-workspace--put-back-links (id links)
"Put LINKS, read top to bottom from under the question ID, back in that order.
Each goes back on top, so the bottom one goes first."
(dolist (link (reverse links))
(apply #'konix/agent-shell-workspace--link-under id link)))
(with-temp-buffer
(insert "* REFINE Q?\n :PROPERTIES:\n :ID: q\n :END:\n")
(org-mode)
(konix/agent-shell-workspace--put-back-links
"q" '(("a" "newest" "link") ("b" "oldest" "link")))
(mapcar #'car (konix/agent-shell-workspace--links-under (point-min) (point-max))))
- what
- the check above is right when it reads
("a" "b").
(defun konix/agent-shell-workspace--put-back-what-stays (id at kept)
"Put KEPT, what outlived the rewrite, back under the question ID written at AT."
(pcase-let ((`(,answers ,links ,said ,heading ,run ,leave ,defines ,rejects ,refusal)
kept))
(when refusal
(save-excursion
(goto-char at)
(org-end-of-meta-data)
(insert refusal)))
(when defines
(save-excursion
(goto-char at)
(org-entry-put (point) konix/agent-shell-workspace-define-property defines)))
(when rejects
(save-excursion
(goto-char at)
(org-entry-put (point) konix/agent-shell-workspace-rejects-property rejects)))
(when answers
(save-excursion (insert answers)))
(save-excursion
(konix/agent-shell-workspace--keep-what-it-asked id heading said))
(save-excursion
(konix/agent-shell-workspace--put-back-links id links))
(when run
(save-excursion
(goto-char at)
(org-end-of-meta-data)
(insert run)))
(when (and leave
(save-excursion
(goto-char at)
(equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-permission-keyword)))
(pcase-let ((`(,command ,root ,line) leave))
(save-excursion
(goto-char at)
(org-entry-put (point) "PENDING-RUN" command)
(when root (org-entry-put (point) "PENDING-ROOT" root))
(when line
(org-end-of-meta-data)
(insert line)))))))
- rule
- and the writer says what the question waits on as it writes it, the user
taking any of them off with their own key after.
- why: the writer is often the one that works out the order, and words to the user are no way of saying it.
- rule: it adds, and takes none away: what the user put there is theirs to undo.
- how: a rewrite carries every line of either order over, and the tool says it only adds, so no writer reads an empty list as a way to clear them.
- rule: and one naming a heading that is not there is refused, rather than written as a waiting on nothing.
(cond (sent (format (if (equal keyword konix/agent-shell-workspace-closing-keyword)
konix/agent-shell-workspace-gated-close-said
konix/agent-shell-workspace-gated-refine-said)
gate sent))
(added
(if file (format "Added a question at %s:%s" file line) "Added a question"))
(t (format "Rewrote %s" id))))))
(defun konix/agent-shell-workspace--answers-under (start limit)
"Return what the user said under the question between START and LIMIT, or nil."
(save-excursion
(goto-char start)
(forward-line 1)
(when (re-search-forward (konix/agent-shell-workspace--heading-re 1) limit t)
(buffer-substring (match-beginning 0) limit))))
(defconst konix/agent-shell-workspace-writer-said "writer: "
"What a wording of the writer's opens on, kept under the question it was.")
(defconst konix/agent-shell-workspace-user-said "me: "
"What an answer of the user's opens on, under the question it answers.")
- rule
- and the wording kept leaves out the run, the leave it asks and the order, the question itself carrying those on.
(defun konix/agent-shell-workspace--what-it-says (start limit)
"Return the question between START and LIMIT written out as the words it was.
One the user made by hand is kept as theirs."
(save-excursion
(goto-char start)
(concat (konix/agent-shell-workspace--stars 1) " "
(if (konix/agent-shell-workspace--by-hand-p)
konix/agent-shell-workspace-user-said
konix/agent-shell-workspace-writer-said)
(string-trim (org-get-heading t t t t)) "\n"
" :PROPERTIES:\n :ID: " (org-id-new) "\n :END:\n"
(replace-regexp-in-string
"^ *#\\+BEGIN_QUOTE\n\\(?:.*\n\\)*? *#\\+END_QUOTE\n" ""
(mapconcat
(lambda (line) (concat " " line "\n"))
(seq-remove
(lambda (line)
(or
(string-match-p konix/agent-shell-workspace-run-line-regexp
(concat line "\n"))
(string-match-p
(format "^ *- %s :: "
(regexp-quote konix/agent-shell-workspace-asks-to-run-said))
line)
(seq-some
(lambda (said)
(string-match-p
(konix/agent-shell-workspace--said-line-regexp said)
line))
(list konix/agent-shell-workspace-waits-said
konix/agent-shell-workspace-for-said
konix/agent-shell-workspace-holds-said
konix/agent-shell-workspace-after-said
konix/agent-shell-workspace-before-said
konix/agent-shell-workspace-running-said))))
(konix/agent-shell-workspace--body-lines start limit))
"")))))
- rule
- a rewrite keeping the heading word for word keeps no copy of it.
- why: the copy shows what used to be asked; unchanged, it only repeats the heading.
(defun konix/agent-shell-workspace--where-a-wording-goes (heading start limit)
"Return where the wording HEADING goes under the question START to LIMIT.
Above the first answer given on it, and at the end where it drew none."
(save-excursion
(goto-char start)
(if (re-search-forward (regexp-quote (format "« %s »" heading)) limit t)
(progn
(konix/agent-shell-workspace--goto-heading)
(line-beginning-position))
limit)))
(defun konix/agent-shell-workspace--keep-what-it-asked (id heading asked)
"Put ASKED, the wording HEADING the question ID had, among the answers under it.
Nothing is put where the question still reads HEADING."
(when (and asked (konix/agent-shell-workspace--goto-id id)
(not (equal heading (string-trim (org-get-heading t t t t)))))
(goto-char (konix/agent-shell-workspace--where-a-wording-goes
heading (point) (konix/agent-shell-workspace--question-end)))
(unless (bolp) (insert "\n"))
(insert asked)))
- rule
- and a link to a fact goes back opening on the word its line opened on.
- rule
- and what goes back is a line a link stands alone on, under the question
itself: a link amid a bullet’s words, or under an answer, is none.
- why: taken for one, it came back as a bullet of its own, the old wording’s or the old body’s link stranded atop the new body.
- rule: and opening on a word no bullet of the writer’s may open on, so a link
line the writer typed goes with its body.
- scope: bar a « what » one naming a heading here, which comes back opening on « link ».
(defun konix/agent-shell-workspace--said-on-the-line ()
"Return the word the line point is on opens on, or nothing where it has none."
(save-excursion
(beginning-of-line)
(when (looking-at " *- \\([^:]+\\) :: ")
(string-trim (match-string-no-properties 1)))))
(defun konix/agent-shell-workspace--links-under (start limit)
"Return (ID LABEL SAID) for each link line under the heading at START, up to LIMIT.
A link line is one a link alone stands on, the way links are put under a heading;
a link inside a bullet's words, or under an answer, is the writer's text, and so is
one opening on a word the writer may open a bullet on. A « what » one naming a
heading here comes back opening on « link »."
(let ((writers (append konix/note-intention-words
konix/agent-shell-workspace-intention-words))
links)
(save-excursion
(goto-char start)
(setq limit (min limit (save-excursion (outline-next-heading) (point))))
(while (re-search-forward
"^ *- [^:\n]+ :: \\[\\[id:\\([^]]+\\)\\]\\[\\([^]]*\\)\\]\\]$"
limit t)
(let ((id (match-string-no-properties 1))
(label (match-string-no-properties 2))
(said (konix/agent-shell-workspace--said-on-the-line)))
(cond ((and (equal said "what")
(save-excursion (konix/agent-shell-workspace--goto-id id)))
(push (list id label konix/agent-shell-workspace-link-said) links))
((not (assoc said writers))
(push (list id label said) links))))))
(nreverse links)))
- what
- a link line under the question comes back; a link amid a bullet’s words or under an answer does not, nor one opening on a word the writer may open a bullet on, bar a « what » one naming a heading here, which comes back opening on « link ».
(with-temp-buffer
(insert "* REFINE Q?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - for :: [[id:p][the project]]\n"
" - link :: [[id:h][a fact]]\n"
" - what :: [[id:f][the fact]]\n"
" - what :: [[id:nowhere][see fact]]\n"
" - how :: [[id:f][the fact]]\n"
" - how :: see [[id:f][the fact]] here\n"
"** writer: before?\n :PROPERTIES:\n :ID: w\n :END:\n"
" - what :: [[id:g][another]]\n"
"* the fact\n :PROPERTIES:\n :ID: f\n :END:\n")
(org-mode)
(konix/agent-shell-workspace--links-under (point-min) (point-max)))
- what
- the check above is right when it reads
(("p" "the project" "for") ("h" "a fact" "link") ("f" "the fact" "link")). - rule
- the writer deletes nothing: dropping a question, settled or not, is the user’s alone.
(seq-some (lambda (group)
(seq-some (lambda (tool)
(equal (plist-get (cdr tool) :id)
"delete_workspace_question"))
(cdr group)))
konix/mcp-server--tools)
- what
- the check above is right when it reads
nil: no tool deletes a question.
what the writer does to a question
- rule
- the writer names an act, never a keyword.
- why: the user will change their mind often on whether a thing is a keyword or a tag, and the code must absorb that.
- what: the writer’s five are
work,refine,put-down,awaitandclose. - rule: and each act is named after the state it leaves the question in, bar the
one whose state name says nothing about the move.
- why: the states converge, so the actions must converge as well, though
todois unclear as an act andput-downis what it does.
- why: the states converge, so the actions must converge as well, though
- rule: and
settle,doneandmaybeare the user’s own acts, refused the writer by name, settling and putting off each with words of its own.- why: a writer must never move one to done; that is a move from the user.
- how: it is named in the refusal rather than left out of it, so the writer hears whose move it is instead of thinking it mistyped.
- therefore: the keywords become a detail of the file, and moving one to a tag or back changes one table and no tool.
(defconst konix/agent-shell-workspace-acts
(list (cons "work" konix/agent-shell-workspace-working-keyword)
(cons "refine" konix/agent-shell-workspace-refine-keyword)
(cons "put-down" konix/agent-shell-workspace-fresh-keyword)
(cons "await" konix/agent-shell-workspace-awaiting-keyword)
(cons "close" konix/agent-shell-workspace-closing-keyword))
"Where each act the writer can name leaves a question.")
(defconst konix/agent-shell-workspace-proof-error
(concat "Closing hands the finished question to the user: pass a « proof :: … »"
" bullet saying how you know the work is done and tested. If you cannot, it"
" is not done.")
"What a writer is told when it closes a question without a proof.")
(defconst konix/agent-shell-workspace-close-here-error
(concat "close is not an act of this tool: close with set_workspace_question, its id"
" passed and act close, a « proof :: … » bullet in its body.")
"What a writer is told when it closes a question by state alone.")
(defconst konix/agent-shell-workspace-settled-error
"That question is settled — ask a new question rather than moving or rewriting it"
"What a writer is told when it acts on, or rewrites, a question the user settled.")
(defun konix/agent-shell-workspace--refuse-closing-the-users-yes (keyword)
"Refuse KEYWORD closing the question at point when its yes is the user's to give."
(when (and (equal keyword konix/agent-shell-workspace-closing-keyword)
(or (org-entry-get (point) konix/agent-shell-workspace-define-property)
(org-entry-get (point) konix/agent-shell-workspace-project-check-property)
(org-entry-get (point) konix/agent-shell-workspace-promote-property)))
(error "%s" (concat "Its yes is the user's to give: hand it back with act refine,"
" never close it."))))
(defconst konix/agent-shell-workspace-same-heading-error
(concat "That is the same heading the user already has: going back to them, say what"
" changed in the heading itself.")
"What a writer is told when it hands a question back under its heading unchanged.")
(defun konix/agent-shell-workspace--refuse-the-same-heading (keyword label)
"Refuse KEYWORD, a refine or a close, handing the question at point back as LABEL unchanged."
(when (and (member keyword (list konix/agent-shell-workspace-refine-keyword
konix/agent-shell-workspace-closing-keyword))
(not (org-entry-get (point) konix/agent-shell-workspace-define-property))
(equal (string-trim label) (string-trim (org-get-heading t t t t))))
(error "%s" konix/agent-shell-workspace-same-heading-error)))
(defun konix/agent-shell-workspace--refuse-closing-unproven (keyword note)
"Refuse KEYWORD closing a question whose NOTE carries no proof."
(when (and (equal keyword konix/agent-shell-workspace-closing-keyword)
(not (seq-some (lambda (bullet) (string-prefix-p "proof :: " bullet))
(konix/agent-shell-workspace--bullets note))))
(error "%s" konix/agent-shell-workspace-proof-error)))
(defconst konix/agent-shell-workspace-settling-error
(concat "Settling is the user's move, never yours. Close it instead, with a"
" « proof :: … » bullet, and leave the settling to them.")
"What a writer is told when it tries to settle a question itself.")
(defconst konix/agent-shell-workspace-putting-off-error
(concat "Putting a question off is the user's move, never yours. Put it down"
" instead, or ask them whether it can wait.")
"What a writer is told when it tries to put a question off itself.")
(defconst konix/agent-shell-workspace-users-acts
(list (cons "settle" konix/agent-shell-workspace-settling-error)
(cons "done" konix/agent-shell-workspace-settling-error)
(cons "maybe" konix/agent-shell-workspace-putting-off-error))
"Acts that are the user's own, which the writer is refused, each with its refusal.")
(defun konix/agent-shell-workspace--act-keyword (act)
"Return where ACT leaves a question, refusing a word that names no act."
(let ((named (string-trim (or act ""))))
(when-let ((refused (assoc-string named konix/agent-shell-workspace-users-acts t)))
(error "%s" (cdr refused)))
(or (cdr (assoc-string named konix/agent-shell-workspace-acts t))
(error "Unknown act \"%s\" — one of: %s" act
(mapconcat #'car konix/agent-shell-workspace-acts ", ")))))
(defun konix/agent-shell-workspace--act-keyword-from (act was)
"Return where ACT leaves a question standing in WAS.
Taken up, one to discuss is thought through, and put down it is to discuss again."
(let ((keyword (konix/agent-shell-workspace--act-keyword act)))
(cond
((and (equal keyword konix/agent-shell-workspace-working-keyword)
(member was (list konix/agent-shell-workspace-discuss-keyword
konix/agent-shell-workspace-thinking-keyword)))
konix/agent-shell-workspace-thinking-keyword)
((and (equal keyword konix/agent-shell-workspace-fresh-keyword)
(equal was konix/agent-shell-workspace-thinking-keyword))
konix/agent-shell-workspace-discuss-keyword)
(t keyword))))
- rule
- a refine of a question the user tagged
:design:names a drawing as its place, an.svgor.pngthat exists, or it is refused.- why: a design asked in words alone is one the user has to draw in their head.
- scope: only a refine: a close, a plan step, a new question are as before.
- how: the refusal says how to draw: plantuml in
.agent-shell/tmp, rendered withplantuml -tpng, the.pngpassed asfile, the user’s preference.
(defconst konix/agent-shell-workspace-design-undrawn-error
(concat "This question is tagged :design:: draw your answer. Write a .puml in"
" .agent-shell/tmp, render it with plantuml -tpng, and pass the .png (or an"
" .svg) as file.")
"What a writer is told when it refines a :design: question without a drawing.")
(defun konix/agent-shell-workspace--drawing-p (file)
"Non-nil when FILE is an .svg or .png that exists."
(and (stringp file)
(string-match-p "\\.\\(?:svg\\|png\\)\\'" file)
(file-exists-p file)))
(defun konix/agent-shell-workspace--refuse-design-undrawn (keyword entry)
"Refuse KEYWORD, a refine of the :design: question at point, ENTRY naming no drawing."
(when (and (equal keyword konix/agent-shell-workspace-refine-keyword)
(member konix/agent-shell-workspace-design-tag (org-get-tags nil t))
(not (seq-some (lambda (place)
(konix/agent-shell-workspace--drawing-p (car place)))
(konix/agent-shell-workspace--places entry))))
(error "%s" konix/agent-shell-workspace-design-undrawn-error)))
- what
- a refine of a
:design:question naming no file is refused, one naming an existing.svgpasses, a close of it passes, and an untagged refine passes.
(let ((drawing "/home/sam/perso/perso/roam/.agent-shell/tmp/design-tag.svg"))
(with-temp-buffer
(org-mode)
(cl-flet ((try (tags keyword file)
(erase-buffer)
(insert "* REFINE Draw it, Go?" tags "\n")
(goto-char (point-min))
(condition-case nil
(progn (konix/agent-shell-workspace--refuse-design-undrawn
keyword `((file . ,file) (line . 1)))
'written)
(error 'refused))))
(list (try " :design:" konix/agent-shell-workspace-refine-keyword nil)
(try " :design:" konix/agent-shell-workspace-refine-keyword drawing)
(try " :design:" konix/agent-shell-workspace-closing-keyword nil)
(try "" konix/agent-shell-workspace-refine-keyword nil)))))
- what
- the check above is right when it reads
(refused written written written). - rule
closehands the finished question to the user, and carries aproofbullet saying how the writer knows the work is done and tested, or it is refused.- why: writers keep handing over unfinished or untested work.
- why: having to write out its proof may make the writer reconsider.
- rule: and it goes through
set_workspace_question, the proof in its body: the state tool refuses it. - scope: a question whose
ythe user gives, a DoD proposal or one asking whether a project is done, is never closed: it is handed back withrefine.
- what
- a close without a proof is refused, nothing written; with one, the question waits on the user’s settling, the proof under it.
(require 'cl-lib)
(let ((file (make-temp-file "check-proof-" nil ".ws.org"))
(writer (generate-new-buffer " check-proof-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Fix the tilt?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: it tilts\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(cl-flet ((state ()
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(and (re-search-forward "^\\*\\* \\([A-Z]+\\) Fix the tilt" nil t)
(match-string 1)))))
(list (condition-case err
(progn (konix/mcp-server-set-workspace-question
"Fix the tilt" "[\"what :: fixed\"]"
nil nil nil nil "close" "q")
'closed)
(error (if (string-match-p "proof" (error-message-string err))
'refused-for-proof
(error-message-string err))))
(state)
(progn (konix/mcp-server-set-workspace-question
"Fix the tilt"
"[\"proof :: the level reads 0 after the fix\"]"
nil nil nil nil "close" "q")
(state))
(with-temp-buffer
(insert-file-contents file)
(how-many "- proof :: the level reads 0" (point-min) (point-max))))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(refused-for-proof "WORKING" "TOCHECK" 1). - rule
- a refine or a close whose heading is word for word the one the question
already has is refused, the question left as it was.
- why: when going back to me, the writer must be forbidden to use the same heading of question.
- scope: a DoD proposal is not, its heading being set: what changed is its done and doing.
- what
- a refine, then a close, keeping the heading are each refused and leave it WORKING; a refine with a new heading goes.
(require 'cl-lib)
(let ((file (make-temp-file "check-sameheading-" nil ".ws.org"))
(writer (generate-new-buffer " check-sameheading-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Levelled the tilt\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: it tilts\n"
"** WORKING Fix the wobble?\n :PROPERTIES:\n :ID: r\n :END:\n"
" - what :: it wobbles\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--send) #'ignore)
((symbol-function 'konix/agent-shell-workspace--writer) (lambda () writer))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore))
(cl-flet ((state (words)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(and (re-search-forward (format "^\\*\\* \\([A-Z]+\\) %s" words) nil t)
(match-string 1))))
(try (id label note act)
(condition-case err
(progn (konix/mcp-server-set-workspace-question
label (json-encode note) nil nil nil nil act id)
'went)
(error (if (string-match-p "same heading" (error-message-string err))
'refused
(error-message-string err))))))
(list (try "q" "Levelled the tilt" ["proof :: the level reads 0"] "close")
(state "Levelled")
(try "r" "Fix the wobble?" ["what :: still wobbles"] "refine")
(state "Fix the wobble\\?")
(try "r" "Fix the wobble now?" ["what :: still wobbles"] "refine")
(state "Fix the wobble now"))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(setq-local konix/agent-shell-workspace--writer-buffer nil)
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(refused "WORKING" refused "WORKING" went "REFINE"). - rule
closeis refused while the user’s last answer on the question asks something, ending in « ? ».- why: the writer answers what the user asked it back and closes, when its own question still waits on them: answering hands it back, which is a refine.
- scope: the user’s answers alone, not the heading: a question the user raised is done once answered.
- rule
- refine is refused here, and taken only as the question is written again.
- why: moved by its state alone, a question goes to the user asking nothing new, and they cannot tell what the writer wants.
(defconst konix/agent-shell-workspace-refine-here-error
(concat "refine is not an act of this tool: rewrite the question with"
" set_workspace_question, its id passed and act refine, its heading asking"
" what you need to know and its body saying why.")
"What a writer is told when it hands a question back to the user by state alone.")
(defconst konix/agent-shell-workspace-still-asked-error
(concat "The user's last word on it asks you something: « %s ». Answering it hands"
" the question back to them, it is not done: write the answer, then refine.")
"What a writer is told when it closes one the user's last word still asks of.")
(defun konix/agent-shell-workspace--users-last-word ()
"Return the words of the user's last answer under the question at point, or nil."
(save-excursion
(let ((limit (konix/agent-shell-workspace--question-end))
last)
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re 1)
(regexp-quote konix/agent-shell-workspace-user-said))
limit t)
(setq last (point)))
(when last
(goto-char last)
(let ((end (save-excursion (outline-next-heading) (min (point) limit))))
(string-trim
(replace-regexp-in-string
"^[ \t]*- what :: said on .*$" ""
(replace-regexp-in-string
"^[ \t]*:PROPERTIES:\\(?:.\\|\n\\)*?:END:" ""
(buffer-substring-no-properties last end)))))))))
(defun konix/agent-shell-workspace--refuse-closing-the-asked (keyword)
"Refuse KEYWORD closing the question at point while the user's last word asks."
(when (and (equal keyword konix/agent-shell-workspace-closing-keyword)
(konix/agent-shell-workspace--asked-back-p))
(error "%s" (format konix/agent-shell-workspace-still-asked-error
(konix/agent-shell-workspace--users-last-word)))))
(defconst konix/agent-shell-workspace-thinking-closed-error
(concat "You took that one up to discuss it, not to work on it: there is nothing to"
" close. Answer it with set_workspace_question, act refine.")
"What a writer is told when it closes one it took up to discuss.")
(defun konix/agent-shell-workspace--refuse-closing-the-thought (keyword)
"Refuse KEYWORD closing the question at point, taken up to discuss."
(when (and (equal keyword konix/agent-shell-workspace-closing-keyword)
(equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-thinking-keyword))
(error "%s" konix/agent-shell-workspace-thinking-closed-error)))
- rule
- an act by its id replaces that heading’s keyword and leaves every other
character of the heading alone.
- why: moving across the states without erasing the body is what saves tokens.
(defun konix/mcp-server-set-workspace-state (id &optional act command on root)
"Perform ACT on the workspace's question whose id is ID.
Every other character of that heading is left alone. COMMAND, with await, is
the run it awaits, which Emacs runs, as root where ROOT; ON, instead, names
another question whose run it awaits too.
MCP Parameters:
id - Id of the question to act on, as the listing tool gives it
act - work, put-down or await; refine and close go through set_workspace_question
command - With await, and only then: the shell command to run, told you when it ends; none, its own run still going, to await that run again
on - With await, instead of command: id of a question awaiting the run this one waits on
root - With command: \"true\" to run it as root, which always waits on the user's leave"
(mcp-server-lib-with-error-handling
(when (and command (string-empty-p (string-trim command)))
(setq command nil))
(when (and on (string-empty-p (string-trim on)))
(setq on nil))
(if-let* (((string-equal-ignore-case (string-trim (or act "")) "work"))
(file (konix/agent-shell-workspace--file-or-error))
(keep (konix/agent-shell-workspace--compact-request file id)))
(konix/agent-shell-workspace--compact-on-take-up
file id (konix/agent-shell-workspace--writer) keep)
(when (equal (konix/agent-shell-workspace--act-keyword act)
konix/agent-shell-workspace-refine-keyword)
(error "%s" konix/agent-shell-workspace-refine-here-error))
(when (equal (konix/agent-shell-workspace--act-keyword act)
konix/agent-shell-workspace-closing-keyword)
(error "%s" konix/agent-shell-workspace-close-here-error))
(konix/agent-shell-workspace--refuse-a-bad-await act command on id)
(setq root (and root (not (member (downcase (format "%s" root)) '("" "false" "nil")))))
(when (and root (not command))
(error "root goes with a command to await"))
(if (and command (or (not (konix/agent-shell-workspace--permit-run command)) root))
(konix/agent-shell-workspace--ask-leave-to-run id command root)
(let* ((run (and command (konix/agent-shell-workspace--run-to-come id)))
(file (konix/agent-shell-workspace--edit
(lambda ()
(let* ((was (and (konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--state-at-point)))
(keyword (konix/agent-shell-workspace--act-keyword-from act was)))
(konix/agent-shell-workspace--set-the-keyword id keyword))
(when (or command on)
(konix/agent-shell-workspace--await-at-point id command on run))))))
(concat (konix/agent-shell-workspace--act-said act id file)
(konix/agent-shell-workspace--await-said command on run)))))))
(defun konix/agent-shell-workspace--set-the-keyword (id keyword)
"Put the question ID in KEYWORD, its every other character left alone."
(let* ((was (konix/agent-shell-workspace--refuse-the-act id keyword))
(word-start (+ (line-beginning-position) (1+ (org-current-level))))
(word-end (+ word-start (length was))))
(delete-region word-start word-end)
(goto-char word-start)
(insert keyword)
(save-excursion (konix/agent-shell-workspace--touch))))
awaiting a run
- rule
- await carries the command it awaits, which Emacs runs.
- why: a run the writer starts itself is one it has to remember to come back to, and nothing tells it when it ends.
- rule: and one without a command, or a run to join, is refused, an empty one being
none.
- why: the end of every awaited run is Emacs’s to see, and so to wake it with.
- scope: bar a question whose own run still goes: awaiting it again with neither
puts it back on that run, the user’s answer read meanwhile.
- why: the user’s answer must be taken into account at once, not at the run’s end.
- rule: and writing a question refuses await, a rewrite having no command.
- why: awaiting by a rewrite would set the state with nothing run.
- rule: and a bare sleep is refused: the command is one that ends when what the
writer waits for holds.
- why: the user does not want the writer sleeping; it must detect whatever condition it needs to go on.
(defconst konix/agent-shell-workspace-await-sleep-error
(concat "Do not await a sleep: await a command that ends when what you wait for"
" holds, a check of that very condition.")
"What a writer is told when it awaits time passing rather than a condition.")
(defun konix/agent-shell-workspace--awaiting-act-p (act)
"Non-nil when ACT is await, told by its name alone."
(string-equal-ignore-case (string-trim (or act "")) "await"))
(defconst konix/agent-shell-workspace-await-no-command-error
(concat "await needs the command it awaits: pass it as command, and do not run it"
" yourself. Emacs runs it and hands the question back to you when it ends.")
"What a writer is told when it awaits without saying what.")
(defun konix/agent-shell-workspace--refuse-a-bad-await (act command on &optional id)
"Refuse ACT with COMMAND or ON where they do not make one await.
With neither, the question ID awaits its own run again, where that run still goes."
(let ((awaiting (konix/agent-shell-workspace--awaiting-act-p act)))
(when (and (or command on) (not awaiting))
(error "A command, or a run to join, goes with await alone"))
(when (and command on)
(error "Await a command of your own, or join the run of another: not both"))
(when (and awaiting (not command) (not on)
(not (and id (konix/agent-shell-workspace--run-going-p id))))
(error "%s" konix/agent-shell-workspace-await-no-command-error))
(when (and command
(string-match-p "\\`[ \t]*sleep[ \t]+[0-9.]+[smhd]?[ \t]*\\'" command))
(error "%s" konix/agent-shell-workspace-await-sleep-error))
(when (and on (not (konix/agent-shell-workspace--run-going-p on)))
(error "%s awaits no run to join; pass the command instead" on))))
- rule
- and the question shows the command it awaits while it runs, then how it
ended.
- why: the user reading an awaiting question wants to know what it waits for.
- how: a
runningline under its heading, linking the log, that becomes aranline with the exit as the run ends;queuedwhile it waits for room to start. - rule: and a rewrite of the question carries it over, as it does the order.
- why: the writer may rewrite a question while its run goes, and a rewrite that dropped the line would leave the user not knowing what it waits for.
(defconst konix/agent-shell-workspace-running-said "running"
"What the line naming the run a question awaits opens on.")
(defconst konix/agent-shell-workspace-queued-said "queued"
"What that line opens on while the run waits for room to start.")
(defconst konix/agent-shell-workspace-ran-said "ran"
"What that line opens on once the run is over.")
(defun konix/agent-shell-workspace--run-line-regexp (saids &optional own)
"Return what a line opening on one of SAIDS looks like, the word captured.
OWN keeps to the lines naming a command, leaving out those naming another's run."
(format "^ *- \\(%s\\) :: %s.*\n" (string-join saids "\\|") (if own "=" "")))
(defconst konix/agent-shell-workspace-run-line-regexp
(konix/agent-shell-workspace--run-line-regexp
(list konix/agent-shell-workspace-running-said
konix/agent-shell-workspace-queued-said
konix/agent-shell-workspace-ran-said)
t)
"What the line naming the command a question awaits, or awaited, looks like.")
- rule
- and a question awaits one run at a time, awaiting again taking out every line
that named a run before.
- rule: and the run it awaited before is stopped, and its end touches nothing but
the queue: no line, no joiner, no telling.
- rule: and one it had joined lets it go: the end of that run leaves its new line alone.
- how: a run’s end looks for the line naming the log it wrote into; gone, the run is one the question awaits no more.
- rule: and the run it awaited before is stopped, and its end touches nothing but
the queue: no line, no joiner, no telling.
(defun konix/agent-shell-workspace--forget-run-lines ()
"Take out every line of the question at point naming a run, going or gone."
(save-excursion
(org-back-to-heading t)
(let ((limit (copy-marker (konix/agent-shell-workspace--question-end))))
(while (re-search-forward
(konix/agent-shell-workspace--run-line-regexp
(list konix/agent-shell-workspace-running-said
konix/agent-shell-workspace-queued-said
konix/agent-shell-workspace-ran-said))
limit t)
(replace-match ""))
(set-marker limit nil))))
- rule
- and the reply says it started: the command, where it runs, its log.
- why: a writer told only the id cannot trust anything ran, and runs it itself.
(defconst konix/agent-shell-workspace-run-started-said
(concat "\n\n%s « %s » in %s, its output going to %s. It is nobody's while it"
" runs; once it ends it is yours again, saying how it went. Take up"
" another meanwhile.")
"What a writer is told as the run it awaits starts.")
- rule
- or, instead of a command, it names the question whose run it awaits too.
- why: several questions wait on one test run, and a second run of it fights the first.
- how: no run starts: a
runningline links that question, « the run of » it, and the run’s end turns each question that joined it back the same way. - scope: only a question whose run is going or queued can be joined.
(defconst konix/agent-shell-workspace-run-joined-said
(concat "\n\nIt awaits the run of %s, starting none: when that run ends it is yours"
" again, as that one is.")
"What a writer is told as it joins the run another question awaits.")
(defvar konix/agent-shell-workspace--joiners (make-hash-table :test #'equal)
"For each question awaiting a run of its own, the ids of the others awaiting it.")
(defun konix/agent-shell-workspace--heading-by-id-here (id)
"Return the heading ID goes by in this buffer, as plain words."
(save-excursion
(when (konix/agent-shell-workspace--goto-id id)
(substring-no-properties (org-get-heading t t t t)))))
- rule
- and while it runs the question is nobody’s to act on; once it ends the
question is the writer’s again, as any other it has not taken up.
- why: awaiting is just another state: the writer’s once the run is over, and the nudging, the cutting and the carrying on that every question of the writer’s gets then wake whichever writer is bound, respawned or not.
- how: whose it is is read off Emacs’s own processes each time it is asked, never
written down: a run going or queued makes it nobody’s, and none makes it the
writer’s, a run lost to a restart included.
- why: a run can end unseen, lost to a restart, and a state written down at its end would then stand awaiting for good.
(defvar konix/agent-shell-workspace--coord-waits-read nil
"When coord's waits were last read, whether it answered, and the ids it listed.")
(defun konix/agent-shell-workspace--coord-waits-read ()
"Return when coord's waits were read, whether it answered, and the ids it listed.
Read at most once a second."
(let ((now (float-time)))
(unless (and konix/agent-shell-workspace--coord-waits-read
(< (- now (car konix/agent-shell-workspace--coord-waits-read)) 1))
(setq konix/agent-shell-workspace--coord-waits-read
(condition-case nil
(list now t
(mapcar (lambda (cell) (symbol-name (car cell)))
(plz 'get (format "%s/coord/waits"
(bound-and-true-p
konix/mcp-server-coord-url))
:as #'json-read :timeout 1)))
(error (list now nil nil)))))
konix/agent-shell-workspace--coord-waits-read))
(defun konix/agent-shell-workspace--coord-waits ()
"Return the ids of the questions coord still waits on a buddy for.
None when coord cannot be asked."
(nth 2 (konix/agent-shell-workspace--coord-waits-read)))
(defun konix/agent-shell-workspace--run-going-p (id)
"Non-nil when the run the question ID awaits still goes, or waits to start.
Read off Emacs's own processes, so a run lost to a restart is simply over.
A wait on a buddy counts as going while coord still lists it."
(or (konix/agent-shell-workspace--gated-p id)
(and (gethash id konix/agent-shell-workspace--buddy-waits)
(or (konix/agent-shell-workspace--buddy-wait-young-p id)
(member id (konix/agent-shell-workspace--coord-waits))))
(seq-some (lambda (process)
(and (process-live-p process)
(equal (process-get process 'konix/agent-shell-workspace-id)
id)))
(process-list))
(let (queued)
(maphash (lambda (_file runs)
(when (assoc id runs) (setq queued t)))
konix/agent-shell-workspace--queued)
queued)
(let (joined)
(maphash (lambda (on joiners)
(when (and (member id joiners)
(konix/agent-shell-workspace--run-going-p on))
(setq joined t)))
konix/agent-shell-workspace--joiners)
joined)))
- how
- a question is the writer’s in one of its own states, or awaiting a run over, a project never being one.
(defun konix/agent-shell-workspace--the-writers-p (state id)
"Non-nil when a question in STATE, going by ID, is the writer's just now.
An awaiting one is the writer's once its run is over, and nobody's until then;
a project is never the writer's."
(and (or (member state konix/agent-shell-workspace-writers-keywords)
(and (equal state konix/agent-shell-workspace-awaiting-keyword)
(not (konix/agent-shell-workspace--run-going-p id))))
(not (and id (save-excursion
(and (konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--project-at-point-p)))))))
(defun konix/agent-shell-workspace--the-writers-at-point-p ()
"Non-nil when the question at point is the writer's just now."
(konix/agent-shell-workspace--the-writers-p
(konix/agent-shell-workspace--state-at-point)
(org-entry-get (point) "ID")))
awaiting a buddy
- rule
- a bound writer’s
coord_waitandcoord_ask_and_waitset the question it holds awaiting, and coord waits on its behalf while it ends its turn.- why: blocked in
coord_wait, the question reads as worked on and the writer can take up nothing else. - scope: a buddy bound to no workspace keeps them blocking as they always did.
- how: the workspace answers
konix/mcp-server-wait-begins-functionswith the id of the question it set awaiting, or nothing.
- why: blocked in
- rule
- and while coord waits, the question is nobody’s, as with a run going.
- how: asked of coord, never written down, so a wait whose end never reached
Emacs, coord restarted or unreachable included, leaves the question the writer’s.
- why: only a delivery reaching Emacs ended it, and an audit found five ways to lose that delivery.
- how: asked of coord, never written down, so a wait whose end never reached
Emacs, coord restarted or unreachable included, leaves the question the writer’s.
- what
- a question Emacs set awaiting a buddy is nobody’s while coord lists its wait, and the writer’s once coord does not, or cannot be asked.
(let ((konix/agent-shell-workspace--buddy-waits (make-hash-table :test #'equal)))
(puthash "q" (cons (current-buffer) "f") konix/agent-shell-workspace--buddy-waits)
(cl-flet ((going (listed)
(cl-letf (((symbol-function 'plz)
(lambda (&rest _)
(if (eq listed 'down) (error "Connection refused") listed))))
(setq konix/agent-shell-workspace--coord-waits-read nil)
(and (konix/agent-shell-workspace--run-going-p "q") t))))
(list (going '((q . "W"))) (going nil) (going 'down))))
- what
- the check above is right when it reads
(t nil nil). - rule
- but a wait just begun is going for its first seconds, coord listing it or not.
- why: Emacs sets the question awaiting before coord lists its wait, and read in between it would be the writer’s, woken onto it.
- rule
- and a wait coord no longer lists ends in the workspace, a line saying so, and
the writer of that workspace is woken, as at the end of a run.
-
why: the question become the writer’s again is no prompt: an idle writer would sit on it for good.
-
how: looked for every half minute while some wait is left.
-
scope: never when coord could not be asked: its waits may still go, and an end written then could not be taken back.
-
rule: and a workspace that cannot be written has its waits forgotten all the same, the others ended as ever.
-
- what
- a wait just begun is going though coord lists it not; past its first seconds it is not, yet coord unreachable ends nothing; once coord answers, its end writes a line under the question, forgets it, and wakes the writer; a wait in a workspace gone is forgotten.
(let ((konix/agent-shell-workspace--buddy-waits (make-hash-table :test #'equal))
(konix/agent-shell-workspace--buddy-wait-since (make-hash-table :test #'equal))
(file (make-temp-file "check-buddywait-lost-" nil ".ws.org"))
(writer (generate-new-buffer " check-buddywait-lost-writer"))
(answered nil)
told)
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* WORKING Q?\n :PROPERTIES:\n :ID: q\n :END:\n - what :: q\n"))
(cl-flet ((under (regexp)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id "q")
(and (re-search-forward
regexp (konix/agent-shell-workspace--question-end) t)
t))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (shell) (when (eq shell writer) file)))
((symbol-function 'konix/agent-shell-workspace--coord-waits-read)
(lambda () (list 0 answered nil)))
((symbol-function 'konix/agent-shell-workspace--writer-of)
(lambda (_) writer))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (shell &rest _) (push shell told))))
(list
(progn (konix/agent-shell-workspace--wait-begins writer)
(and (konix/agent-shell-workspace--run-going-p "q") t))
(progn (puthash "q" 0 konix/agent-shell-workspace--buddy-wait-since)
(and (konix/agent-shell-workspace--run-going-p "q") t))
(progn (konix/agent-shell-workspace--buddy-waits-lost)
(list (and (gethash "q" konix/agent-shell-workspace--buddy-waits) t)
(under "^ *- lost :: ")
told))
(progn (setq answered t)
(puthash "gone" (cons writer "/nonexistent/gone.ws.org")
konix/agent-shell-workspace--buddy-waits)
(konix/agent-shell-workspace--buddy-waits-lost)
(list (gethash "q" konix/agent-shell-workspace--buddy-waits)
(gethash "gone" konix/agent-shell-workspace--buddy-waits)
(under "^ *- lost :: ")
(under "^ *- awaiting :: ")
(and (memq writer told) t)))))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file))))
- what
- the check above is right when it reads
(t nil (t nil nil) (nil nil t nil t)). - rule
- and whatever coord feeds the writer then makes every question awaiting a buddy
its own again, a line under each for every question the messages came as.
- why: nothing in a message says which wait it answers: the writer reads it and judges.
- therefore: that line tells the writer to wait again where it is not this question’s answer.
- rule: but the end of one wait with nothing fed makes that question alone the writer’s again, saying whether nothing came or the writer’s own coord call took it, and leaves no question to discuss.
- rule
- and a wait ends in the workspace it was set in, whatever the writer is bound
to by then.
- why: unbound mid-wait, the question stayed awaiting for good.
- rule: and a writer respawned on that workspace ends the waits there too.
- what
- asked as a wait begins, a writer bound to no workspace gets nothing, and any workspace a writer is bound to sets its held question awaiting and nobody’s; with two waiting, coord’s notice that one wait ran out frees that one alone; two messages fed free the other, linking both questions they came as; a third, whose wait the writer’s own call ended, says so and not that nobody wrote.
(require 'cl-lib)
(let ((file (make-temp-file "check-buddywait-" nil ".ws.org"))
(plain (make-temp-file "check-buddywait-plain-" nil ".ws.org"))
(writer (generate-new-buffer " check-buddywait-writer"))
(respawned (generate-new-buffer " check-buddywait-respawned"))
(bound nil))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* WORKING First?\n :PROPERTIES:\n :ID: q1\n :END:\n - what :: one\n"
"* TODO Third?\n :PROPERTIES:\n :ID: q3\n :END:\n - what :: three\n"
"* TODO Fourth?\n :PROPERTIES:\n :ID: q4\n :END:\n - what :: four\n"
"* TODO Fifth?\n :PROPERTIES:\n :ID: q5\n :END:\n - what :: five\n"
"* TODO Sixth?\n :PROPERTIES:\n :ID: q6\n :END:\n - what :: six\n"))
(with-temp-file plain
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* WORKING Plain?\n :PROPERTIES:\n :ID: p\n :END:\n - what :: p\n"))
(cl-flet ((state (id)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--state-at-point)))
(writers (id)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id id)
(and (konix/agent-shell-workspace--the-writers-at-point-p) t)))
(under (id regexp)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id id)
(and (re-search-forward
regexp (konix/agent-shell-workspace--question-end) t)
t)))
(discuss-count ()
(konix/agent-shell-workspace--read-file file
(goto-char (point-min))
(let ((n 0))
(while (re-search-forward "^\\*\\* DISCUSS " nil t) (cl-incf n))
n))))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (shell)
(cond ((eq shell writer) (or bound file))
((eq shell respawned) file))))
((symbol-function 'konix/agent-shell-workspace--coord-waits)
(lambda () (hash-table-keys konix/agent-shell-workspace--buddy-waits))))
(list
(konix/agent-shell-workspace--wait-begins (current-buffer))
(progn (setq bound plain)
(prog1 (konix/agent-shell-workspace--wait-begins writer)
(setq bound nil)))
(with-temp-buffer (insert-file-contents plain)
(and (search-forward "* AWAITING Plain?" nil t) t))
(konix/agent-shell-workspace--wait-begins writer)
(state "q1")
(writers "q1")
;; q3 taken up and awaiting too: two waits side by side.
(progn (konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "q3")
(org-todo "WORKING"))
(konix/agent-shell-workspace--wait-begins writer))
;; q1's wait ends with nothing: q1 alone is the writer's, no DISCUSS.
(progn
(run-hook-with-args
'konix/mcp-server-delivered-functions writer
(concat "Messages:\n"
(json-encode '[((from . "coord") (question . "q1") (ended . "timeout")
(message . "Your wait on question q1 ran out"))]))
"coord")
(list (writers "q1") (writers "q3") (discuss-count)
(under "q1" "^ *- timed out :: ")))
;; Two buddy messages fed at once: q3 the writer's, linking both
;; questions they came as.
(progn
(run-hook-with-args
'konix/mcp-server-delivered-functions writer
(concat "Messages:\n"
(json-encode '[((from . "bob") (message . "Here it is"))
((from . "ann") (message . "And this"))]))
"bob")
(list (writers "q3") (discuss-count)
(under "q3" "if it is not its answer, coord_wait again")
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--goto-id "q3")
(let ((end (konix/agent-shell-workspace--question-end)) (n 0))
(while (re-search-forward "^ *- came :: \\[\\[id:" end t)
(cl-incf n))
n))))
;; q4's wait ends with what came taken by the writer's own call:
;; q4 the writer's, saying so, not that nobody wrote.
(progn
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "q4")
(org-todo "WORKING"))
(konix/agent-shell-workspace--wait-begins writer)
(run-hook-with-args
'konix/mcp-server-delivered-functions writer
(concat "Messages:\n"
(json-encode '[((from . "coord") (question . "q4") (ended . "taken")
(message . "Your wait on question q4 ended"))]))
"coord")
(list (writers "q4") (under "q4" "^ *- taken :: ")
(under "q4" "nobody wrote")))
;; q5 awaiting, then the writer bound elsewhere: its wait still
;; ends in the workspace it was set in.
(progn
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "q5")
(org-todo "WORKING"))
(konix/agent-shell-workspace--wait-begins writer)
(setq bound plain)
(run-hook-with-args
'konix/mcp-server-delivered-functions writer
(concat "Messages:\n"
(json-encode '[((from . "coord") (question . "q5") (ended . "timeout")
(message . "Your wait on question q5 ran out"))]))
"coord")
(list (writers "q5") (under "q5" "^ *- timed out :: ")))
;; q6 awaiting, then the writer respawned, bound to the same
;; workspace: the new one's delivery ends the wait.
(progn
(setq bound nil)
(konix/agent-shell-workspace--write-file file
(konix/agent-shell-workspace--goto-id "q6")
(org-todo "WORKING"))
(konix/agent-shell-workspace--wait-begins writer)
(run-hook-with-args
'konix/mcp-server-delivered-functions respawned
(concat "Messages:\n"
(json-encode '[((from . "coord") (question . "q6") (ended . "timeout")
(message . "Your wait on question q6 ran out"))]))
"coord")
(list (writers "q6") (under "q6" "^ *- timed out :: ")))))
(konix/agent-shell-workspace--forget-buddy-waits file)
(konix/agent-shell-workspace--forget-buddy-waits plain)
(kill-buffer writer)
(kill-buffer respawned)
(let ((kill-buffer-query-functions nil))
(dolist (f (list file plain))
(when-let* ((visiting (find-buffer-visiting f)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer)))
(delete-file f))))))
- what
- the check above is right when it reads
(nil "p" t "q1" "AWAITING" nil "q3" (t nil 0 t) (t 2 t 2) (t t nil) (t t) (t t)).
(defvar konix/agent-shell-workspace--buddy-waits (make-hash-table :test #'equal)
"For each question coord waits on a buddy for, its writer and the workspace file it is in.")
(defconst konix/agent-shell-workspace-buddy-awaiting-said "awaiting"
"What the line of a question awaiting a buddy opens on.")
(defconst konix/agent-shell-workspace-buddy-came-said "came"
"What the line linking the question a buddy's message came as opens on.")
(defconst konix/agent-shell-workspace-buddy-timed-out-said "timed out"
"What the line of a question whose buddy wait ran out opens on.")
(defconst konix/agent-shell-workspace-buddy-taken-said "taken"
"What the line of a question whose buddy wait the writer's own coord call ended opens on.")
(defun konix/agent-shell-workspace--forget-buddy-waits (file)
"Forget every buddy wait of the workspace FILE."
(maphash (lambda (id where)
(when (equal (cdr where) file)
(remhash id konix/agent-shell-workspace--buddy-waits)
(remhash id konix/agent-shell-workspace--buddy-wait-since)))
konix/agent-shell-workspace--buddy-waits))
(defun konix/agent-shell-workspace--wait-begins (writer)
"Set the question WRITER holds awaiting a buddy, and return its id.
Nil, writing nothing, where WRITER is bound to no workspace or holds none there."
(when-let* ((file (konix/agent-shell-workspace-file writer)))
(let (id)
(konix/agent-shell-workspace--write-file file
(goto-char (point-min))
(when (konix/agent-shell-workspace--search-state
(concat (konix/agent-shell-workspace--heading-re)
konix/agent-shell-workspace-working-keyword " "))
(org-back-to-heading t)
(setq id (org-entry-get (point) "ID"))
(konix/agent-shell-workspace--set-the-keyword
id konix/agent-shell-workspace-awaiting-keyword)
(org-end-of-meta-data)
(insert (format " - %s :: a buddy, coord waiting on the writer's behalf\n"
konix/agent-shell-workspace-buddy-awaiting-said))
(puthash id (cons writer file) konix/agent-shell-workspace--buddy-waits)
(puthash id (float-time) konix/agent-shell-workspace--buddy-wait-since)))
id)))
(add-hook 'konix/mcp-server-wait-begins-functions
#'konix/agent-shell-workspace--wait-begins)
(defvar konix/agent-shell-workspace--buddy-wait-since (make-hash-table :test #'equal)
"For each question awaiting a buddy, when its wait began.")
(defconst konix/agent-shell-workspace-buddy-wait-grace 10
"Seconds a wait just begun is going, coord listing it or not.")
(defconst konix/agent-shell-workspace-buddy-lost-said "lost"
"What the line of a question whose buddy wait coord no longer holds opens on.")
(defun konix/agent-shell-workspace--buddy-wait-young-p (id)
"Non-nil when the wait on a buddy for the question ID began a moment ago."
(< (- (float-time) (gethash id konix/agent-shell-workspace--buddy-wait-since 0))
konix/agent-shell-workspace-buddy-wait-grace))
(defun konix/agent-shell-workspace--buddy-waits-lost ()
"End the waits on a buddy coord no longer lists, waking the writer of each workspace.
Nothing ends when coord cannot be asked."
(let ((read (konix/agent-shell-workspace--coord-waits-read))
lost)
(when (nth 1 read)
(maphash (lambda (id where)
(unless (or (konix/agent-shell-workspace--buddy-wait-young-p id)
(member id (nth 2 read)))
(push (cons id (cdr where)) lost)))
konix/agent-shell-workspace--buddy-waits))
(dolist (wait lost)
(remhash (car wait) konix/agent-shell-workspace--buddy-waits)
(remhash (car wait) konix/agent-shell-workspace--buddy-wait-since))
(dolist (file (delete-dups (mapcar #'cdr lost)))
(when (file-writable-p file)
(ignore-errors
(konix/agent-shell-workspace--buddy-waits-lost-in
file (mapcar #'car (seq-filter (lambda (wait) (equal (cdr wait) file))
lost))))
(when-let ((writer (and (not konix/agent-shell-workspace--no-wake)
(konix/agent-shell-workspace--writer-of file))))
(when (buffer-live-p writer)
(ignore-errors (konix/agent-shell-workspace--submit writer))))))))
(defun konix/agent-shell-workspace--buddy-waits-lost-in (file ids)
"Say under each question of IDS in FILE still awaiting a buddy that coord lost its wait."
(konix/agent-shell-workspace--write-file file
(dolist (id ids)
(when (and (konix/agent-shell-workspace--goto-id id)
(equal (konix/agent-shell-workspace--state-at-point)
konix/agent-shell-workspace-awaiting-keyword))
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-buddy-awaiting-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match ""))
(konix/agent-shell-workspace--goto-id id)
(org-end-of-meta-data)
(insert (format " - %s :: coord no longer waits on it\n"
konix/agent-shell-workspace-buddy-lost-said))))))
(defvar konix/agent-shell-workspace--buddy-waits-lost-timer nil
"The timer looking for waits on a buddy coord no longer holds.")
(when (timerp konix/agent-shell-workspace--buddy-waits-lost-timer)
(cancel-timer konix/agent-shell-workspace--buddy-waits-lost-timer))
(setq konix/agent-shell-workspace--buddy-waits-lost-timer
(run-with-timer 30 30
(lambda ()
(unless (zerop (hash-table-count
konix/agent-shell-workspace--buddy-waits))
(ignore-errors
(konix/agent-shell-workspace--buddy-waits-lost))))))
(defun konix/agent-shell-workspace--coord-notices (payload)
"Return, for each question whose wait coord says in PAYLOAD ended with nothing
fed, its id and how it ended: \"timeout\" or \"taken\"."
(with-temp-buffer
(insert payload)
(goto-char (point-min))
(let (found)
(while (re-search-forward "^Messages:\n" nil t)
(dolist (item (append (ignore-errors
(json-parse-buffer :object-type 'alist :array-type 'list))
nil))
(when-let ((question (alist-get 'question item)))
(push (cons question (alist-get 'ended item)) found))))
(nreverse found))))
(defun konix/agent-shell-workspace--buddy-wait-ends (writer payload _from)
"Make the questions awaiting a buddy WRITER set, or that wait in the workspace it is
bound to, its own again, PAYLOAD fed, each in the workspace its wait was set in.
A message makes every one of them its own, a line under each for every question
the messages came as; a wait that ended with nothing fed, the question it was for alone."
(let* ((bound (konix/agent-shell-workspace-file writer))
(waiting (let (waits)
(maphash (lambda (id where)
(when (or (eq (car where) writer)
(equal (cdr where) bound))
(push (cons id (cdr where)) waits)))
konix/agent-shell-workspace--buddy-waits)
waits))
(came (reverse konix/agent-shell-workspace--asked-ids))
(notices (konix/agent-shell-workspace--coord-notices payload))
(ended (if came waiting
(seq-filter (lambda (wait) (assoc (car wait) notices))
waiting))))
(dolist (file (delete-dups (mapcar #'cdr ended)))
(konix/agent-shell-workspace--write-file file
(dolist (id (mapcar #'car (seq-filter (lambda (wait) (equal (cdr wait) file))
ended)))
(remhash id konix/agent-shell-workspace--buddy-waits)
(remhash id konix/agent-shell-workspace--buddy-wait-since)
(when (konix/agent-shell-workspace--goto-id id)
(when (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-buddy-awaiting-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match ""))
(if came
(dolist (asked came)
(konix/agent-shell-workspace--link-under
id asked
"a message; take this up and, if it is not its answer, coord_wait again"
konix/agent-shell-workspace-buddy-came-said))
(org-end-of-meta-data)
(insert
(if (equal (alist-get id notices nil nil #'equal) "taken")
(format " - %s :: what came went to the writer's own coord call\n"
konix/agent-shell-workspace-buddy-taken-said)
(format " - %s :: nobody wrote meanwhile\n"
konix/agent-shell-workspace-buddy-timed-out-said))))))))))
(add-hook 'konix/mcp-server-delivered-functions
#'konix/agent-shell-workspace--buddy-wait-ends 90)
- rule
- and what coord feeds its writer goes into the workspace, never into its
conversation: written in as above, then the writer is told of the workspace as of
any question become its own.
- why: typed into its conversation, it cut the writer’s turn and reached it beside the questions it answers from, not among them.
- how: the workspace takes coord’s work through
konix/mcp-server-take-functions; the requests are written as questions and the waits lifted before it is told. - scope: a buddy bound to no workspace still has coord’s work typed in, as always.
- rule: but a writer costly to wake is not woken for it, and nothing is asked.
- why: asked, coord’s call waited on the user past its 10s, and the sender was told its work never arrived.
- what
- any workspace a writer is bound to takes what coord feeds it and tells the writer of the workspace; a writer bound to none has nothing taken; a writer costly to wake is not told.
(let ((file (make-temp-file "check-buddywait-take-" nil ".ws.org"))
(plain (make-temp-file "check-buddywait-take-plain-" nil ".ws.org"))
(writer (generate-new-buffer " check-buddywait-take-writer"))
(bound nil)
(told nil))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"))
(with-temp-file plain
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (shell) (when (eq shell writer) bound)))
((symbol-function 'konix/agent-shell-workspace--submit)
(lambda (shell &rest _) (push shell told)))
((symbol-function 'konix/agent-shell-workspace--costly-wake-p) #'ignore)
((symbol-function 'shell-maker-busy) #'ignore))
(list
(progn (setq bound file)
(let ((take (konix/agent-shell-workspace--take writer)))
(and (functionp take)
(progn (funcall take "WORK" "bob")
(equal told (list writer))))))
(progn (setq bound plain)
(functionp (konix/agent-shell-workspace--take writer)))
(progn (setq bound nil)
(konix/agent-shell-workspace--take writer))
(progn (setq bound file told nil)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--costly-wake-p)
(lambda () t)))
(funcall (konix/agent-shell-workspace--take writer) "WORK" "bob"))
told)))
(kill-buffer writer)
(let ((kill-buffer-query-functions nil))
(dolist (f (list file plain))
(when-let* ((visiting (find-buffer-visiting f)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer)))
(delete-file f)))))
- what
- the check above is right when it reads
(t t nil nil).
(defun konix/agent-shell-workspace--take (writer)
"Take coord's work for WRITER where it is bound to a workspace.
Return a function telling WRITER of the workspace once the work is written in,
or nil, leaving the work to be typed into its conversation."
(when (konix/agent-shell-workspace-file writer)
(lambda (_payload _from)
(if (with-current-buffer writer
(and (not (shell-maker-busy))
(konix/agent-shell-workspace--costly-wake-p)))
(message "%s is not woken for coord's work, costly to wake: wake it yourself"
(buffer-name writer))
(konix/agent-shell-workspace--submit writer)))))
(add-hook 'konix/mcp-server-take-functions #'konix/agent-shell-workspace--take)
a command awaited, judged first
- rule
- a command awaited as root always waits on the user’s leave, whatever the
rules say, and their
yruns it through/sudo::, TRAMP asking them the password.- why: root is the one run no rule written ahead may speak for.
- scope: a blacklist still refuses it before anything is asked.
- scope: the writer never sees the password, nor the prompt.
- rule: and it runs with the user’s own PATH.
- why: root’s shell knows only a few directories, and the user’s commands live elsewhere, NixOS’s among them.
- rule
- a command awaited goes through the writer’s own permissions first, as if it
ran it itself: blacklisted, refused with its reason; whitelisted, run; neither, the
question goes to
PERM, the user’s, whichyruns andnhands back refused.- why: otherwise await runs, unasked, what the writer’s own shell would have stopped.
- why: asked in the workspace, never at a prompt, and in a state of its own: it is a permission, not a question the writer worded.
- how: it is judged as a shell command of the writer’s, against the rules its session holds.
- how: each verdict is noted in the debug log under
permit: the command, the shell judging it and the entry each list matched.- why: a
PERMa list should have spared shows which list it read, in which shell.
- why: a
(defun konix/agent-shell-workspace--permit-run (command &optional writer)
"Non-nil when WRITER's permissions let COMMAND run, the calling writer's by default.
A blacklisted COMMAND is refused with its reason."
(let* ((call (list (cons :title command) (cons :kind "execute")
(cons :raw-input (list (cons 'command command)))))
(shell (or writer (konix/agent-shell-workspace--writer)))
(verdict (with-current-buffer shell
(cons (konix/agent-shell-policy--match
konix/agent-shell--blacklist call)
(konix/agent-shell-policy--match
konix/agent-shell--whitelist call)))))
(konix/agent-shell-workspace--debug
'permit (konix/agent-shell-workspace--debug-name shell)
"%S in %s: blacklist %S, whitelist %S"
command (buffer-name shell) (car verdict) (cdr verdict))
(when (car verdict)
(error "%s is blacklisted: %s" command (or (cdar verdict) "")))
(cdr verdict)))
- how
- asked, the question remembers the command and where it would run, and says
both on a line of its own.
- rule: and asking leave is refused whatever an await is refused, before a character is written.
- rule: and a leave asked again replaces the one waiting, its line going with it:
one command waits on them at a time, the one
yruns, as the second ask has it, as root or not.
- what
- a question asked leave as root, then again plainly, shows one line, the
second command’s, and
yruns that one, not as root.
(require 'cl-lib)
(let ((file (make-temp-file "check-leave-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO PERM AWAITING WORKING | DONE\n"
"* WORKING Run it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--run-directory)
(lambda (&rest _) "/tmp/"))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--refuse-the-act)
(lambda (id &rest _) (konix/agent-shell-workspace--goto-id id))))
(konix/agent-shell-workspace--ask-leave-to-run "q" "first.sh" t)
(konix/agent-shell-workspace--ask-leave-to-run "q" "second.sh")
(with-current-buffer (find-file-noselect file)
(revert-buffer t t t)
(let ((lines (save-excursion
(goto-char (point-min))
(let (found)
(while (re-search-forward "asks to run :: \\(.*\\)$" nil t)
(push (match-string-no-properties 1) found))
found)))
ran)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--run-to-come)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--await-at-point)
(lambda (_id command _on _run root)
(setq ran (list command (if root 'as-root 'plainly))))))
(goto-char (point-min))
(re-search-forward "^\\*\\* PERM")
(konix/agent-shell-workspace-answer-yes))
(prog1 (list (length lines)
(and (string-match-p "=second\\.sh=" (car lines))
'second-shown)
ran)
(set-buffer-modified-p nil)
(kill-buffer)))))
(delete-file file)))
- what
- the check above is right when it reads
(1 second-shown ("second.sh" plainly)). - what
gon a question asking leave runs the command and sends the writer nothing.
(require 'cl-lib)
(let ((file (make-temp-file "check-go-leave-" nil ".ws.org")) ran sent)
(with-temp-file file
(insert "#+TODO: TODO PERM AWAITING WORKING | DONE\n"
"* WORKING Run it?\n :PROPERTIES:\n :ID: q\n :END:\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace--writer) #'ignore)
((symbol-function 'konix/agent-shell-workspace--run-directory)
(lambda (&rest _) "/tmp/"))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file))
((symbol-function 'konix/agent-shell-workspace--show) #'ignore)
((symbol-function 'konix/agent-shell-workspace--ensure-session-link)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--refuse-the-act)
(lambda (id &rest _) (konix/agent-shell-workspace--goto-id id))))
(konix/agent-shell-workspace--ask-leave-to-run "q" "it.sh")
(with-current-buffer (find-file-noselect file)
(revert-buffer t t t)
(cl-letf (((symbol-function 'konix/agent-shell-workspace--run-to-come)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--target-writer)
#'ignore)
((symbol-function 'konix/agent-shell-workspace--move-on) #'ignore)
((symbol-function 'konix/agent-shell-workspace--send)
(lambda (&rest args) (setq sent args)))
((symbol-function 'konix/agent-shell-workspace--await-at-point)
(lambda (_id command &rest _) (setq ran command))))
(goto-char (point-min))
(re-search-forward "^\\*\\* PERM")
(konix/agent-shell-workspace-answer-go))
(prog1 (list ran sent)
(set-buffer-modified-p nil)
(kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
("it.sh" nil).
(defconst konix/agent-shell-workspace-run-asked-said
(concat "« %s » %s, so nothing runs yet: the question asks the"
" user's leave. On their yes it runs, and you hear when it ends; on their"
" no it is yours again, refused.")
"What a writer is told when the run it awaits needs the user's leave.")
(defconst konix/agent-shell-workspace-asks-to-run-said "asks to run"
"What the line of a run waiting on the user's leave opens on.")
(defun konix/agent-shell-workspace--ask-leave-to-run (id command &optional root)
"Put the question ID in PERM, asking the user's leave to run COMMAND, as root if ROOT."
(let ((directory (konix/agent-shell-workspace--run-directory
(konix/agent-shell-workspace--writer))))
(konix/agent-shell-workspace--edit
(lambda ()
(konix/agent-shell-workspace--refuse-the-act
id konix/agent-shell-workspace-awaiting-keyword)
(org-todo konix/agent-shell-workspace-permission-keyword)
(save-excursion
(while (re-search-forward
(format "^ *- %s :: .*\n"
(regexp-quote konix/agent-shell-workspace-asks-to-run-said))
(konix/agent-shell-workspace--question-end) t)
(replace-match "")))
(org-entry-put (point) "PENDING-RUN" command)
(if root
(org-entry-put (point) "PENDING-ROOT" "t")
(org-entry-delete (point) "PENDING-ROOT"))
(org-end-of-meta-data)
(insert (format " - %s :: =%s= in %s%s: y runs it, n refuses it\n"
konix/agent-shell-workspace-asks-to-run-said
command directory (if root ", as root" "")))))
(format konix/agent-shell-workspace-run-asked-said command
(if root "runs as root" "is not whitelisted"))))
(defun konix/agent-shell-workspace--run-to-come (id &optional writer)
"Return (FILE DIRECTORY LOG AHEAD) for a run the question ID is to await.
WRITER is whose run it is, the calling one where nil."
(let* ((writer (or writer (konix/agent-shell-workspace--writer)))
(directory (konix/agent-shell-workspace--run-directory writer))
(file (konix/agent-shell-workspace-file writer)))
(list file directory
(konix/agent-shell-workspace--run-log directory id)
(konix/agent-shell-workspace--runs-ahead file))))
(defun konix/agent-shell-workspace--await-said (command on run)
"Return what the writer is told of awaiting COMMAND, or the run ON awaits.
RUN is (FILE DIRECTORY LOG AHEAD) for COMMAND."
(pcase-let ((`(,file ,directory ,log ,ahead) run))
(concat
(when on
(format konix/agent-shell-workspace-run-joined-said on))
(when command
(format konix/agent-shell-workspace-run-started-said
(if ahead "Queued" "Running") command directory log))
(when ahead
(format konix/agent-shell-workspace-run-queued-said
(konix/agent-shell-workspace--run-cap file) ahead)))))
(defun konix/agent-shell-workspace--await-at-point (id command on run &optional root)
"Have the question ID at point await COMMAND, as root if ROOT, or the run ON awaits.
RUN is (FILE DIRECTORY LOG AHEAD), where and how COMMAND goes."
(pcase-let ((`(,file ,directory ,log ,ahead) run))
(konix/agent-shell-workspace--stop-run id)
(maphash (lambda (run joiners)
(puthash run (delete id joiners) konix/agent-shell-workspace--joiners))
konix/agent-shell-workspace--joiners)
(konix/agent-shell-workspace--forget-run-lines)
(when command
(org-end-of-meta-data)
(insert (format " - %s :: =%s=%s [[file+emacs:%s][its output]]\n"
(if ahead
konix/agent-shell-workspace-queued-said
konix/agent-shell-workspace-running-said)
command (if root " as root" "") log))
(konix/agent-shell-workspace--run-or-queue
file id (lambda ()
(konix/agent-shell-workspace--run-for
file id command directory log root))))
(when on
(konix/agent-shell-workspace--link-under
id on (format "the run of « %s »"
(konix/agent-shell-workspace--heading-by-id-here on))
konix/agent-shell-workspace-running-said)
(puthash on (append (gethash on konix/agent-shell-workspace--joiners)
(list id))
konix/agent-shell-workspace--joiners))))
the run itself
- how
- a run’s end sets no state: it says how it went, on its line and its joiners’,
starts what was queued behind it, and nudges the workspace’s writer as for any change.
- rule: and the run is started, or queued, inside the write that sets it awaiting.
- why: whose a question is is read as each write ends, and that is what cuts a writer left nothing; a run started after that write would leave the question reading as the writer’s at the one moment it counts.
- therefore: the one rule, nothing of the writer’s cuts it, covers awaiting too, with no cut of its own.
- rule: and the run is started, or queued, inside the write that sets it awaiting.
(defun konix/agent-shell-workspace--run-line (file id now)
"Make the line naming the run the question ID awaits in FILE open on NOW."
(when (and file (file-readable-p file))
(konix/agent-shell-workspace--write-file file
(when (konix/agent-shell-workspace--goto-id id)
(when (re-search-forward
konix/agent-shell-workspace-run-line-regexp
(konix/agent-shell-workspace--question-end) t)
(replace-match now t t nil 1))))))
(defun konix/agent-shell-workspace--run-over (file id how &optional log)
"Say under the question ID of FILE HOW its run went, now that it is over.
LOG, where given, keeps to the line naming it: the log of its own run, or the
link to the question whose run it joined."
(konix/agent-shell-workspace--write-file file
(when (konix/agent-shell-workspace--goto-id id)
(let ((limit (konix/agent-shell-workspace--question-end)))
(when (re-search-forward
(concat
(string-remove-suffix
".*\n" (konix/agent-shell-workspace--run-line-regexp
(list konix/agent-shell-workspace-running-said
konix/agent-shell-workspace-queued-said)))
(if log (concat ".*" (regexp-quote log)) "")
".*\n")
limit t)
(replace-match (format " - %s :: %s\n"
konix/agent-shell-workspace-ran-said how)
t t))))))
(defun konix/agent-shell-workspace--writer-of (file)
"Return the writer the workspace FILE is bound to just now, or nil."
(when-let ((workspace (find-buffer-visiting file)))
(buffer-local-value 'konix/agent-shell-workspace--writer-buffer workspace)))
- how
- in the writer’s working directory, in the background, its output going to a log.
- rule: and the log is under the working directory’s
.agent-shell/tmp.- why: a writer may read inside its working directory’s scratch directory alone.
- rule: and the log is under the working directory’s
(defconst konix/agent-shell-workspace-run-log-directory ".agent-shell/tmp"
"Where under the directory a run goes its log is kept, for the writer to read.")
(defun konix/agent-shell-workspace--run-log (directory id)
"Return a fresh log for the run the question ID awaits, under DIRECTORY."
(let ((where (expand-file-name konix/agent-shell-workspace-run-log-directory
directory)))
(make-directory where t)
(make-temp-file (expand-file-name (format "awaited-%s-" id) where) nil ".log")))
(defun konix/agent-shell-workspace--run-directory (writer)
"Return where a run WRITER awaits goes: its working directory, or where it stands."
(or (konix/agent-shell-workspace--working-directory-of writer) default-directory))
- how
- the run is a process of Emacs’s own, marked with the question it is for, and its end rewrites the lines of that question and of every one that joined it.
- rule
- and a run still going past its time is killed, its line saying so.
- why: a hanging command would hold its question awaiting for ever.
- scope: the run alone: a question asking leave waits on the user for ever.
- how: a
#+RUN-TIMEOUT:line in minutes, thirty where it names none.
- rule
- and a run ended in under two minutes says how long it took, and that one that
short is not to be awaited.
- why: await is for long runs; a short one is called directly.
- how: the bound said is the two minutes in seconds, never written apart.
- what
- a run ended after 1 s says how long and not to await; one after 3 minutes says its status alone.
(list (konix/agent-shell-workspace--exit-said 0 1.4)
(konix/agent-shell-workspace--exit-said 2 180))
- what
- the check above is right when it reads
("0, took 1s; if shorter than 120s, don't use await" 2).
(defconst konix/agent-shell-workspace-default-run-timeout 30
"How many minutes a run of a workspace naming no timeout may go.")
(defun konix/agent-shell-workspace--run-timeout (file)
"Return how many minutes a run of the workspace FILE may go."
(let ((said (and file (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--keyword "RUN-TIMEOUT")))))
(if (and said (> (string-to-number said) 0))
(string-to-number said)
konix/agent-shell-workspace-default-run-timeout)))
(defconst konix/agent-shell-workspace-short-run-minutes 2
"How many minutes a run may take and still have been better run directly.")
(defun konix/agent-shell-workspace--exit-said (status seconds)
"Say a run exited STATUS after SECONDS, telling to run it directly when it was short."
(let ((short (* 60 konix/agent-shell-workspace-short-run-minutes)))
(if (< seconds short)
(format "%s, took %ds; if shorter than %ds, don't use await" status seconds short)
status)))
(defun konix/agent-shell-workspace--run-for (file id command directory log &optional root)
"Run COMMAND for the question ID of FILE in DIRECTORY, into LOG, as root if ROOT.
As it ends, the question, and every one that joined it, is the writer's again.
One still going past the workspace's timeout is killed."
(let* ((started (float-time))
(default-directory (if root (concat "/sudo::" directory) directory))
(line (concat (when root
(format "PATH=%s; export PATH; "
(shell-quote-argument (getenv "PATH"))))
(format "{ %s\n} > %s 2>&1" command (shell-quote-argument log))))
(process (if root
(start-file-process-shell-command (format "awaited-%s" id) nil line)
(make-process :name (format "awaited-%s" id) :buffer nil
:command (list shell-file-name shell-command-switch line)
:connection-type 'pipe)))
(minutes (konix/agent-shell-workspace--run-timeout file))
(timer (run-with-timer
(* 60 minutes) nil
(lambda ()
(when (process-live-p process)
(process-put process 'konix/agent-shell-workspace-timed-out t)
(kill-process process))))))
(set-process-sentinel
process
(lambda (process _event)
(unless (process-live-p process)
(cancel-timer timer)
(konix/agent-shell-workspace--the-run-ended
file id command log
(cond ((process-get process 'konix/agent-shell-workspace-timed-out)
(format "%s, killed after %s minutes"
(process-exit-status process) minutes))
((process-get process 'konix/agent-shell-workspace-cancelled)
(format "%s, %s" (process-exit-status process)
konix/agent-shell-workspace-cancelled-said))
(t (konix/agent-shell-workspace--exit-said
(process-exit-status process) (- (float-time) started))))))))
(konix/agent-shell-workspace--mark-run file id process)))
(defun konix/agent-shell-workspace--mark-run (file id process)
"Say PROCESS is the run the question ID of the workspace FILE awaits."
(process-put process 'konix/agent-shell-workspace file)
(process-put process 'konix/agent-shell-workspace-id id)
process)
(defun konix/agent-shell-workspace--run-still-named-p (file id log)
"Non-nil when the question ID of FILE still names the run writing into LOG."
(and (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(when (konix/agent-shell-workspace--goto-id id)
(re-search-forward (regexp-quote log)
(konix/agent-shell-workspace--question-end) t)))))
(defun konix/agent-shell-workspace--the-run-ended (file id command log exit)
"Say under the question ID of FILE, and its joiners, that COMMAND exited EXIT.
A run the question awaits no more touches nothing but the queue."
(if (not (konix/agent-shell-workspace--run-still-named-p file id log))
(konix/agent-shell-workspace--run-ended file)
(konix/agent-shell-workspace--the-awaited-run-ended file id command log exit)))
(defun konix/agent-shell-workspace--the-awaited-run-ended (file id command log exit)
"Say under the question ID of FILE, and its joiners, that COMMAND exited EXIT."
(ignore-errors
(konix/agent-shell-workspace--run-over
file id (format "=%s= exited %s, [[file+emacs:%s][its output]]"
command exit log)
log))
(dolist (joined (gethash id konix/agent-shell-workspace--joiners))
(ignore-errors
(konix/agent-shell-workspace--run-over
file joined (format "the run of [[id:%s][%s]] exited %s, [[file+emacs:%s][its output]]"
id (konix/agent-shell-workspace--heading-of id file)
exit log)
(format "[[id:%s]" id))))
(remhash id konix/agent-shell-workspace--joiners)
(konix/agent-shell-workspace--run-ended file)
(when-let ((writer (and (not konix/agent-shell-workspace--no-wake)
(konix/agent-shell-workspace--writer-of file))))
(when (buffer-live-p writer)
(ignore-errors (konix/agent-shell-workspace--submit writer)))))
- rule
- and each workspace caps how many of its runs go at once, the rest queued in
the order they were awaited.
- why: several suites at once eat the machine, and how much one eats is the working directory’s own.
- how: a
#+RUNS:line, two where it names none;Csets it.
(defconst konix/agent-shell-workspace-default-run-cap 2
"How many runs a workspace naming no cap lets go at once.")
(defun konix/agent-shell-workspace--run-cap (file)
"Return how many runs the workspace FILE lets go at once."
(let ((said (and file (file-readable-p file)
(konix/agent-shell-workspace--read-file file
(konix/agent-shell-workspace--keyword "RUNS")))))
(if (and said (> (string-to-number said) 0))
(string-to-number said)
konix/agent-shell-workspace-default-run-cap)))
(defun konix/agent-shell-workspace-set-run-cap (cap)
"Let CAP runs of this workspace go at once."
(interactive
(list (read-number "Runs at once: "
(konix/agent-shell-workspace--run-cap (buffer-file-name)))))
(konix/agent-shell-workspace--write
(konix/agent-shell-workspace--ensure-keyword "RUNS" (format "%d" cap)))
(message "%d runs of this workspace go at once" cap))
- how
- what goes is counted off Emacs’s own live processes, never kept apart.
- why: a count kept apart drifts from what really runs, and a queued run then waits for room that is never given back.
(defun konix/agent-shell-workspace--running (file)
"Return how many runs of the workspace FILE go just now, counted off Emacs's own."
(seq-count (lambda (process)
(and (process-live-p process)
(equal (process-get process 'konix/agent-shell-workspace)
file)))
(process-list)))
- how
- a queued one shows
queuedon its line, the reply saying how many are ahead of it, and turnsrunningas it starts.
(defconst konix/agent-shell-workspace-run-queued-said
(concat " This workspace lets %s go at once, so it waits, %s queued ahead of it,"
" and starts as one ends.")
"What a writer is told when the run it awaits has to wait for room.")
(defvar konix/agent-shell-workspace--queued (make-hash-table :test #'equal)
"For each workspace file, the runs waiting for room to start, first first.")
(defun konix/agent-shell-workspace--runs-ahead (file)
"Return how many runs of FILE a new one would wait behind, nil when it starts."
(let ((queued (gethash file konix/agent-shell-workspace--queued)))
(when (or queued
(>= (konix/agent-shell-workspace--running file)
(konix/agent-shell-workspace--run-cap file)))
(length queued))))
(defun konix/agent-shell-workspace--run-or-queue (file id start)
"Call START, the run of FILE's question ID, if the cap has room, else queue it."
(if (konix/agent-shell-workspace--runs-ahead file)
(puthash file (append (gethash file konix/agent-shell-workspace--queued)
(list (cons id start)))
konix/agent-shell-workspace--queued)
(funcall start)))
(defun konix/agent-shell-workspace--run-ended (file)
"Start as many of FILE's queued runs as its cap now has room for."
(while (and (gethash file konix/agent-shell-workspace--queued)
(< (konix/agent-shell-workspace--running file)
(konix/agent-shell-workspace--run-cap file)))
(let ((next (pop (gethash file konix/agent-shell-workspace--queued))))
(ignore-errors
(konix/agent-shell-workspace--run-line
file (car next) konix/agent-shell-workspace-running-said))
(funcall (cdr next)))))
what an act is refused
- rule
- it refuses before it writes, so a refused call leaves the heading as it was.
- rule: an id standing nowhere is refused.
- rule: a fact is refused, standing in no state.
- rule: an answer is refused, being the user’s and not the writer’s to move.
- rule: and a word naming no act is refused, the refusal naming the acts there are.
- rule
- no act reaches a question the user put off.
- how: no act names that state, and acting on one there is refused.
(defconst konix/agent-shell-workspace-put-off-error
(concat "The user put that question off. Leave it alone and take up one they have"
" not.")
"What a writer is told when it goes for a question the user put off.")
- rule
- and taking up one standing below the highest of its own is refused, the
refusal naming the one to take instead.
- scope: only taking up: putting down, refining and closing reach whatever the writer holds, whatever it stands at.
(defconst konix/agent-shell-workspace-lower-error
(concat "The user has put another of yours higher: « %s ». Take that one, or one"
" standing as high. This one comes back to you once the higher ones are no"
" longer yours.")
"What a writer is told when it takes up one below the highest it has.")
(defun konix/agent-shell-workspace--taking-up-p (keyword was)
"Non-nil when KEYWORD on a question that WAS takes it up afresh."
(and (konix/agent-shell-workspace--held-state-p keyword)
(not (konix/agent-shell-workspace--held-state-p was))))
(defun konix/agent-shell-workspace--refuse-a-second-held (keyword was)
"Refuse KEYWORD taking up a question that WAS, where another is held already."
(when (and (konix/agent-shell-workspace--taking-up-p keyword was)
(konix/agent-shell-workspace--holding-p))
(error "%s" (concat "You already hold a question."
" Put that one down first, or work on it"))))
(defun konix/agent-shell-workspace--refuse-the-lower (keyword was)
"Refuse KEYWORD on the question at point, which WAS, when another stands higher.
Only taking one up is refused, and only where the writer has a higher one of its own."
(when (konix/agent-shell-workspace--taking-up-p keyword was)
(let ((here (konix/agent-shell-workspace--standing-at-point))
(highest (konix/agent-shell-workspace--standing-highest)))
(when (and highest (< here (car highest)))
(error "%s" (format konix/agent-shell-workspace-lower-error
(cdr highest)))))))
- rule
- and taking up one another holds back is refused on the same terms, the refusal naming what it waits on.
(defconst konix/agent-shell-workspace-blocked-error
(concat "That one waits on another first: « %s ». It comes back to you once that one"
" no longer holds it back.")
"What a writer is told when it takes up one waiting on another.")
(defun konix/agent-shell-workspace--refuse-the-blocked (keyword was)
"Refuse KEYWORD on the question at point, which WAS, while it waits on another."
(when (konix/agent-shell-workspace--taking-up-p keyword was)
(when-let* ((waiting (konix/agent-shell-workspace--waited-on)))
(error "%s" (format konix/agent-shell-workspace-blocked-error
(car waiting))))))
- rule
- and no act reaches one that waits on the user.
- why: taking it up would answer it for them.
- therefore: putting one down does not reach it either, or the writer takes their turn away to get at what holding a question unlocks.
- how: it comes back to the writer of itself the moment they say anything, so there is nothing to do but wait.
- rule
- nor one awaiting a run that still goes, and only the one held can await.
- rule
- nor one the user settled, no more than it can be rewritten.
- why: settling is the user’s last word on it: a writer took a settled one up again.
(require 'cl-lib)
(let ((file (make-temp-file "check-settled-" nil ".ws.org"))
(writer (generate-new-buffer " check-settled-writer")))
(with-temp-file file
(insert "#+TODO: TODO REFINE PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* DONE Fixed the tilt\n :PROPERTIES:\n :ID: q\n :END:\n"
" - proof :: it ran\n"))
(unwind-protect
(cl-letf (((symbol-function 'konix/agent-shell-workspace-file)
(lambda (&rest _) file))
((symbol-function 'konix/agent-shell-workspace--file-or-error)
(lambda () file)))
(with-current-buffer writer
(mapcar (lambda (act)
(condition-case err
(progn (konix/mcp-server-set-workspace-state "q" act) 'moved)
(error (if (string-match-p "settled" (error-message-string err))
'refused
(error-message-string err)))))
'("work" "put-down"))))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting
(set-buffer-modified-p nil)
(kill-buffer)))
(kill-buffer writer))
(delete-file file)))
- what
- the check above is right when it reads
(refused refused).
(defconst konix/agent-shell-workspace-waiting-error
(concat "That question waits on the user, so no act of yours reaches it. Wait: it"
" comes back to you the moment they say anything.")
"What a writer is told when it acts on a question waiting on the user.")
(defconst konix/agent-shell-workspace-awaiting-error
(concat "That one awaits its run, so no act reaches it: it is yours again, saying how"
" the run went, once the run ends. Take up another meanwhile.")
"What a writer is told when it acts on one whose run still goes.")
(defconst konix/agent-shell-workspace-await-unheld-error
(concat "Only the one you hold can await a run of yours. Work on it first, start the"
" run, then say await.")
"What a writer is told when it awaits one it does not hold.")
(defconst konix/agent-shell-workspace-project-error
"That is a project, the user's alone: no act or rewrite of yours reaches it."
"What a writer is told when it acts on, or rewrites, a project.")
(defun konix/agent-shell-workspace--refuse-the-act (id keyword)
"Refuse KEYWORD on the question ID, or return the state it stands in.
Point is left on its heading and not a character of it is written."
(unless (konix/agent-shell-workspace--goto-id id)
(error "No heading %s in the workspace" id))
(when (equal (org-current-level) (1+ konix/agent-shell-workspace-question-level))
(error "An answer is the user's to move, not yours: %s" id))
(let ((was (or (konix/agent-shell-workspace--state-at-point)
(error "A fact stands in no state, so there is none to act on"))))
(when (konix/agent-shell-workspace--project-at-point-p)
(error "%s" konix/agent-shell-workspace-project-error))
(when (equal was konix/agent-shell-workspace-done-keyword)
(error "%s" konix/agent-shell-workspace-settled-error))
(konix/agent-shell-workspace--refuse-a-second-held keyword was)
(when (and (equal keyword konix/agent-shell-workspace-awaiting-keyword)
(not (equal was konix/agent-shell-workspace-working-keyword)))
(error "%s" konix/agent-shell-workspace-await-unheld-error))
(when (equal was konix/agent-shell-workspace-later-keyword)
(error "%s" konix/agent-shell-workspace-put-off-error))
(when (and (equal was konix/agent-shell-workspace-discuss-keyword)
(not (equal keyword konix/agent-shell-workspace-thinking-keyword)))
(error "%s" konix/agent-shell-workspace-discuss-said))
(when (and (equal was konix/agent-shell-workspace-awaiting-keyword)
(konix/agent-shell-workspace--run-going-p id))
(error "%s" konix/agent-shell-workspace-awaiting-error))
(konix/agent-shell-workspace--refuse-the-lower keyword was)
(konix/agent-shell-workspace--refuse-the-blocked keyword was)
(konix/agent-shell-workspace--refuse-closing-the-asked keyword)
(when (member was konix/agent-shell-workspace-users-keywords)
(error "%s" konix/agent-shell-workspace-waiting-error))
(when (and (member keyword konix/agent-shell-workspace-users-keywords)
(konix/agent-shell-workspace--nothing-written-p))
(error "%s" konix/agent-shell-workspace-empty-handover-error))
was))
what taking one up says
- rule
- taking one up is answered by insisting on what it commits the writer to, and
by the projects it is for, said again in full.
- why: the writer takes one up and then wanders off into whatever it notices next, and the one moment it is certainly listening is the answer to that call.
- rule: and what it committed to is said in the question’s own words, quoted, not
as « that one ».
- why: a writer told it has committed to « that one » has been told nothing it can hold itself to, and it is the words it drifts from.
- scope: a question whose words cannot be read back is « that one » still, the answer being worth saying either way.
- rule: and it is told it holds that one alone: whatever else it sees is a question to leave with the user, every doubt of its own asked of them about that one.
- rule: and it is told to hand that one back the moment what it asks is unclear,
rather than to guess at it.
- why: a guess costs the work it sends the writer off to do and the reading of it, where asking costs the user a sentence.
- therefore: handing one back is an ordinary move, said as one.
- rule: and where no project is named, nothing is said of projects.
- why: told to ask what the work is, the writer pushed the user toward a project they never asked for; the question says the work.
- rule: and it is handed that question whole, every answer of the user’s under it.
- why: an answer told while the writer was busy could be lost, and it then worked without the user’s last word.
- how: the listing, kept to that one id.
(defconst konix/agent-shell-workspace-holding-said
(concat "You have committed to %s. It is now the only thing you work on:"
" not the next thing you notice, not the thing that looks quicker, not"
" what you were doing before. Anything else you see is a question to"
" write and leave with the user, never work to do. Every doubt you have"
" is put to them as a question about this one, asked so that this one"
" gets done. Where what it asks is itself unclear, refine it and say what"
" you need — do not hesitate and do not guess: a guess costs you the work"
" it sends you off to do, and them the reading of it, where asking costs"
" one sentence. Nothing lets you off it but putting it down, with"
" set_workspace_state, or handing it back, by rewriting it with"
" set_workspace_question, act refine.")
"What a writer is told as it takes one up, that question's words filled in.")
(defconst konix/agent-shell-workspace-thinking-said
(concat "You have taken up %s to discuss it, not to work on it. Below is all of it,"
" every answer of the user's read from the workspace just now: answer from"
" that, not from what you remember. Read what you need, write what you find"
" as facts with set_workspace_fact, then answer it with set_workspace_question,"
" act refine. Where answering needs work, ask for the go, worded « <Action>,"
" Go? ». Whatever the user adds while you think is pushed to you at once.")
"What a writer is told as it takes one up to discuss, that question's words filled in.")
(defun konix/agent-shell-workspace--heading-of (id file)
"Return what the question ID asks in FILE, or nil where it names none."
(when (and id file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(when (konix/agent-shell-workspace--goto-id id)
(org-get-heading t t t t)))))
(defun konix/agent-shell-workspace--state-of (id file)
"Return the state the question ID stands in in FILE, or nil."
(when (and id file (file-readable-p file))
(konix/agent-shell-workspace--read-file file
(when (konix/agent-shell-workspace--goto-id id)
(konix/agent-shell-workspace--state-at-point)))))
(defun konix/agent-shell-workspace--act-said (act id file)
"Return what a writer is told of ACT on ID, FILE being the workspace it is in."
(string-trim
(concat (format "%s: %s" act id)
(when (equal (konix/agent-shell-workspace--act-keyword act)
konix/agent-shell-workspace-working-keyword)
(let ((project (konix/agent-shell-workspace--project-line file))
(asked (konix/agent-shell-workspace--heading-of id file))
(thinking (equal (konix/agent-shell-workspace--state-of id file)
konix/agent-shell-workspace-thinking-keyword)))
(concat "\n\n"
(format (if thinking
konix/agent-shell-workspace-thinking-said
konix/agent-shell-workspace-holding-said)
(if asked (format "« %s »" asked) "that one"))
"\n\n"
(if-let* ((whole (let ((konix/agent-shell-workspace--listing-ids
(list id)))
(konix/agent-shell-workspace--listing file))))
(concat whole "\n\n")
"")
project))))))
- what
- taking one up hands it whole, both answers under it, and nothing else.
(let ((file (make-temp-file "check-whole-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: the tilt\n"
"*** me: go on\n :PROPERTIES:\n :ID: a1\n :END:\n"
"*** me: only the left one\n :PROPERTIES:\n :ID: a2\n :END:\n"
"** TODO Other?\n :PROPERTIES:\n :ID: o\n :END:\n"
" - what :: not this\n"))
(unwind-protect
(let ((said (konix/agent-shell-workspace--act-said "work" "q" file)))
(list (and (string-match-p "a1 — me: go on" said) 'first)
(and (string-match-p "a2 — me: only the left one" said) 'last)
(and (string-match-p "Other" said) 'other)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(first last nil). - what
- taking one up where no project is says nothing of projects.
(let ((file (make-temp-file "check-noproject-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** WORKING Fix it?\n :PROPERTIES:\n :ID: q\n :END:\n"
" - what :: the tilt\n"))
(unwind-protect
(let ((said (konix/agent-shell-workspace--act-said "work" "q" file)))
(list (and (string-match-p "project" said) t)
(and (string-suffix-p "the tilt" said) t)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads
(nil t).
(defun konix/agent-shell-workspace--working-p ()
"Non-nil when a question of this buffer is one the writer is on."
(save-excursion
(goto-char (point-min))
(konix/agent-shell-workspace--search-state
(concat (konix/agent-shell-workspace--heading-re)
konix/agent-shell-workspace-working-keyword " "))))
(defun konix/agent-shell-workspace--holding-p ()
"Non-nil when the writer holds a question of this buffer, at work or thinking."
(save-excursion
(goto-char (point-min))
(konix/agent-shell-workspace--search-state
(konix/agent-shell-workspace--keyword-regexp
konix/agent-shell-workspace-held-keywords))))
- rule
- and an act that hands a question over with nothing written under it is
refused.
- why: the user won’t know what to do about it.
- scope: it reaches
refineandclose, the two that hand it over. - therefore:
put-downis the one act that needs nothing said, which is what makes it the way out. - how: what is written is what the listing reads back, so a heading carrying only the place it names counts as carrying nothing.
- scope: a subject the user raised themselves is spared, since they know already
what they meant by it.
- scope: the writer may still rewrite it, the user’s wording staying under it as theirs.
- how: its
BYsays it is the user’s, so one they end with a question mark is spared too.- scope: and one asking nothing is the user’s as well, every question of the writer’s being refused unless it ends in a question mark.
- scope: naming a place does not tell them apart, a subject raised from a region naming one too.
(defconst konix/agent-shell-workspace-empty-handover-error
(concat "Nothing is written under that question, so handing it to the user says"
" nothing. Say what you are asking in its body, or put it down, which"
" touches not a word of it.")
"What a writer is told when it hands over a question carrying no body.")
(defun konix/agent-shell-workspace--the-users-own-p ()
"Non-nil when the user raised the heading at point.
Its BY says so, or it asks nothing."
(or (konix/agent-shell-workspace--by-hand-p)
(save-excursion
(beginning-of-line)
(not (string-suffix-p
"?" (string-trim (buffer-substring-no-properties
(point) (line-end-position))))))))
(defun konix/agent-shell-workspace--nothing-written-p ()
"Non-nil when nothing is written under the question at point.
A subject the user raised themselves counts as written, whatever it carries."
(and (not (konix/agent-shell-workspace--the-users-own-p))
(null (konix/agent-shell-workspace--body-lines
(line-beginning-position)
(konix/agent-shell-workspace--question-end)))))
reading them back
- what
- reading the headings back is one of these tools, and it is the first thing the writer does on being told there is something for it.
(defun konix/agent-shell-workspace--listing (file &optional only-actionable)
"Return the workspace FILE's headings with what is written under them, or nil.
ONLY-ACTIONABLE keeps back whatever the writer has nothing to do about."
(konix/agent-shell-workspace--read-file file
(goto-char (point-min))
(let ((highest (and only-actionable
(car (konix/agent-shell-workspace--standing-highest))))
rows)
(while (konix/agent-shell-workspace--search-state
(concat konix/agent-shell-workspace-state-regexp "\\(.*\\)$"))
(let* ((state (match-string 1))
(heading (match-string 2))
(start (line-beginning-position))
(limit (konix/agent-shell-workspace--question-end))
(id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(when (save-excursion
(goto-char start)
(konix/agent-shell-workspace--listed-p state id only-actionable highest))
(push (format "%s %s %s — %s"
(cond
((save-excursion (goto-char start)
(konix/agent-shell-workspace--project-at-point-p))
(concat (pcase state
((pred (equal konix/agent-shell-workspace-later-keyword))
"later ")
((pred (equal konix/agent-shell-workspace-done-keyword))
"settled ")
(_ ""))
"project"))
((when-let* (((not (konix/agent-shell-workspace--held-state-p state)))
(time (save-excursion
(goto-char start)
(konix/agent-shell-workspace--scheduled-alone))))
(concat "scheduled " time)))
((and (not (konix/agent-shell-workspace--held-state-p state))
(konix/agent-shell-workspace--the-writers-p state id))
(konix/agent-shell-workspace--standing
konix/agent-shell-workspace-fresh-keyword))
(t (konix/agent-shell-workspace--standing state)))
(or id "-")
(if (re-search-forward
konix/agent-shell-workspace-link-regexp limit t)
(format "%s:%s" (match-string 1) (match-string 2))
"?")
heading)
rows)
(dolist (line (konix/agent-shell-workspace--body-lines start limit))
(push (concat " " line) rows))
(let (answers)
(save-excursion
(goto-char start)
(forward-line 1)
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re 1) "\\(.*\\)$") limit t)
(let* ((answer (match-string 1))
(its-id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(push (cons (format " %s — %s" (or its-id "-") answer)
(mapcar (lambda (line) (concat " " line))
(konix/agent-shell-workspace--body-lines
(line-beginning-position) limit)))
answers))))
(dolist (lines (reverse
(if only-actionable
(or (seq-take-while
(lambda (answer)
(not (string-prefix-p
konix/agent-shell-workspace-writer-said
(cadr (split-string (car answer) " — ")))))
answers)
(seq-take answers 1))
answers)))
(dolist (line lines) (push line rows)))))
(goto-char limit)))
(goto-char (point-min))
(while (re-search-forward "^\\* \\(.*\\)$" nil t)
(let* ((heading (match-string 1))
(limit (konix/agent-shell-workspace--question-end))
(id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(unless (or (org-get-todo-state)
only-actionable
konix/agent-shell-workspace--listing-ids)
(cond ((save-excursion (beginning-of-line)
(konix/agent-shell-workspace--memos-at-point-p))
(setq rows (append (reverse (konix/agent-shell-workspace--memo-rows limit nil))
rows)))
((save-excursion (beginning-of-line)
(konix/agent-shell-workspace--facts-at-point-p))
(setq rows (append (reverse (konix/agent-shell-workspace--fact-rows limit))
rows)))
((save-excursion (beginning-of-line)
(konix/agent-shell-workspace--part-at-point-p)))
(t (push (format "FACT %s — %s" (or id "-") heading) rows))))
(goto-char limit)))
(when rows
(string-join (nreverse rows) "\n")))))
(defun konix/mcp-server-list-workspace-questions ()
"List the workspace's headings with what is written under them.
A question comes with its state and place, then a fact."
(mcp-server-lib-with-error-handling
(let ((file (konix/agent-shell-workspace--file-or-error)))
(unless (file-readable-p file)
(error "No workspace here"))
(concat (konix/agent-shell-workspace--project-line file)
(or (konix/agent-shell-workspace--listing file)
"The workspace has nothing in it")))))
- rule
- the listing says enough to act on any of them next: which heading it is, what is written under it, and for a question the place it names and whose turn it is.
- rule
- and it says whose turn it is in a word of its own, never the file’s keyword.
- why: fix the coupling at the reading end too, not only where the writer writes.
- what:
yours,held,thinking,awaiting,asked,permission,finished,settled,later, andprojectfor a project.
(defconst konix/agent-shell-workspace-standings
(list (cons konix/agent-shell-workspace-fresh-keyword "yours")
(cons konix/agent-shell-workspace-working-keyword "held")
(cons konix/agent-shell-workspace-thinking-keyword "thinking")
(cons konix/agent-shell-workspace-awaiting-keyword "awaiting")
(cons konix/agent-shell-workspace-refine-keyword "asked")
(cons konix/agent-shell-workspace-permission-keyword "permission")
(cons konix/agent-shell-workspace-closing-keyword "finished")
(cons konix/agent-shell-workspace-done-keyword "settled")
(cons konix/agent-shell-workspace-later-keyword "later"))
"What the listing calls each keyword, so no keyword reaches the writer.")
(defun konix/agent-shell-workspace--standing (keyword)
"Return what the listing calls KEYWORD, or KEYWORD where it calls it nothing."
(or (cdr (assoc keyword konix/agent-shell-workspace-standings)) keyword))
- what
- what is written runs from the heading down to the first place, so a subject of
the user’s comes back whether it was put in bullets or not.
- why: the writer needs to read before choosing, to choose knowingly.
- scope: a fact’s body stays out, no choice of the writer’s turning on a heading that is the user’s to read rather than to act on.
- scope: and the code of every place a question names stays out, the place bullets with it, so what comes back is what somebody wrote and not what the question shows.
- scope: what org keeps between the heading and the body is stepped over, and anything of org’s met after the body has begun ends it, so none of it comes back.
- rule
- and one held back by another is left out of it, whoever is reading.
- why: it is nothing the writer can act on and nothing it can hand over, and reading it only sets it wondering why every act on it is refused.
- scope: what it waits on comes back in its own right, so nothing of the work is hidden — only the one thing that cannot be got at yet.
- scope: bar the one it holds, listed as
heldwhatever holds it back, it being in hand already and the putting down of it the writer’s own to do. - therefore: the writer is caught in no ring: one it does not hold is simply not there, and the one it holds stays, to be put down.
- scope: bar one held back by its schedule alone, listed as
scheduledand its time.- why: a writer planning cannot see it otherwise, and may write it twice.
- therefore: the time says why every act on it is refused, so it sets no wondering.
- scope: every act on it is still refused.
- what
- a question held back by its schedule alone comes out with its time and body; one held back by another question too stays out, and the nudge carries neither.
(let ((file (make-temp-file "check-listsched-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Later one?\n SCHEDULED: <2099-01-01 Thu 09:00>\n"
" :PROPERTIES:\n :ID: s\n :END:\n - what :: body s\n"
"** TODO Both?\n SCHEDULED: <2099-01-01 Thu 09:00>\n"
" :PROPERTIES:\n :ID: b\n :END:\n - waits on :: [[id:s][Later one?]]\n"))
(unwind-protect
(append (split-string (konix/agent-shell-workspace--listing file) "\n")
(list (konix/agent-shell-workspace--listing file t)))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
- what
- the check above is right when it reads « scheduled 2099-01-01 Thu 09:00 s ? — Later one? », then its body « - what :: body s », then nil for the nudge.
- rule
- and what the writer is nudged with keeps to what it may take up: its own, standing highest, or the one it holds.
(defvar konix/agent-shell-workspace--listing-states nil
"The states a listing keeps to, or nil for every one.")
(defvar konix/agent-shell-workspace--listing-ids nil
"The ids of the questions a listing keeps to, facts left out, or nil for every one.")
(defun konix/agent-shell-workspace--listed-p (state id only-actionable highest)
"Non-nil when the question at point, in STATE, going by ID, is listed.
ONLY-ACTIONABLE keeps to what the writer may take up, HIGHEST standing first."
(and (or (null konix/agent-shell-workspace--listing-states)
(member state konix/agent-shell-workspace--listing-states))
(or (null konix/agent-shell-workspace--listing-ids)
(member id konix/agent-shell-workspace--listing-ids))
(or (null (konix/agent-shell-workspace--waited-on))
(konix/agent-shell-workspace--held-state-p state)
(and (not only-actionable)
(konix/agent-shell-workspace--scheduled-alone)))
(or (not only-actionable)
(and (konix/agent-shell-workspace--the-writers-p state id)
(or (null highest)
(konix/agent-shell-workspace--held-state-p state)
(>= (konix/agent-shell-workspace--standing-at-point)
highest))))))
(defun konix/agent-shell-workspace--scheduled-alone ()
"Return the time the question at point is scheduled for, where nothing else holds it back."
(let* ((questions (konix/agent-shell-workspace--every-question))
(one (assoc (org-entry-get (point) "ID") questions)))
(when (and (nth 5 one)
(equal (konix/agent-shell-workspace--holding-back (car one) questions)
(list (nth 5 one))))
(string-trim (nth 5 one) "<" ">"))))
(while (konix/agent-shell-workspace--search-state
(concat konix/agent-shell-workspace-state-regexp "\\(.*\\)$"))
(let* ((state (match-string 1))
(heading (match-string 2))
(start (line-beginning-position))
(limit (konix/agent-shell-workspace--question-end))
(id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(when (save-excursion
(goto-char start)
(konix/agent-shell-workspace--listed-p state id only-actionable highest))
(push (format "%s %s %s — %s"
(cond
((save-excursion (goto-char start)
(konix/agent-shell-workspace--project-at-point-p))
(concat (pcase state
((pred (equal konix/agent-shell-workspace-later-keyword))
"later ")
((pred (equal konix/agent-shell-workspace-done-keyword))
"settled ")
(_ ""))
"project"))
((when-let* (((not (konix/agent-shell-workspace--held-state-p state)))
(time (save-excursion
(goto-char start)
(konix/agent-shell-workspace--scheduled-alone))))
(concat "scheduled " time)))
((and (not (konix/agent-shell-workspace--held-state-p state))
(konix/agent-shell-workspace--the-writers-p state id))
(konix/agent-shell-workspace--standing
konix/agent-shell-workspace-fresh-keyword))
(t (konix/agent-shell-workspace--standing state)))
(or id "-")
(if (re-search-forward
konix/agent-shell-workspace-link-regexp limit t)
(format "%s:%s" (match-string 1) (match-string 2))
"?")
heading)
rows)
(dolist (line (konix/agent-shell-workspace--body-lines start limit))
(push (concat " " line) rows))
(let (answers)
(save-excursion
(goto-char start)
(forward-line 1)
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re 1) "\\(.*\\)$") limit t)
(let* ((answer (match-string 1))
(its-id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(push (cons (format " %s — %s" (or its-id "-") answer)
(mapcar (lambda (line) (concat " " line))
(konix/agent-shell-workspace--body-lines
(line-beginning-position) limit)))
answers))))
(dolist (lines (reverse
(if only-actionable
(or (seq-take-while
(lambda (answer)
(not (string-prefix-p
konix/agent-shell-workspace-writer-said
(cadr (split-string (car answer) " — ")))))
answers)
(seq-take answers 1))
answers)))
(dolist (line lines) (push line rows)))))
(goto-char limit)))
(defconst konix/agent-shell-workspace-pointing-regexp
(concat "^ *- \\(?:.* : \\)?\\(?:"
konix/agent-shell-workspace-link-regexp
"\\|\\[\\[[a-z][a-z0-9+.-]*:[^]]+\\]\\]\\)")
"Regexp matching a line saying only where to look: a place, or an address.")
(defun konix/agent-shell-workspace--body-lines (start limit)
"Return what is written between START and LIMIT, stopping at the first place.
Org's own bookkeeping between the heading and the body — a planning line, a drawer —
is stepped over, and anything of org's met after the body has begun ends it, so none
of it is ever returned."
(let (lines)
(save-excursion
(goto-char start)
(forward-line 1)
(while (or (looking-at org-planning-line-re)
(and (looking-at org-drawer-regexp)
(re-search-forward org-property-end-re limit t)))
(forward-line 1))
(while (and (< (point) limit)
(not (looking-at "^\\*+ "))
(not (looking-at org-planning-line-re))
(not (looking-at org-drawer-regexp))
(not (looking-at
konix/agent-shell-workspace-pointing-regexp)))
(let ((line (string-trim
(buffer-substring (line-beginning-position)
(line-end-position)))))
(unless (string-empty-p line) (push line lines)))
(forward-line 1)))
(nreverse lines)))
the facts and the answers
- rule
- a fact comes out after the questions, named by its id.
(goto-char (point-min))
(while (re-search-forward "^\\* \\(.*\\)$" nil t)
(let* ((heading (match-string 1))
(limit (konix/agent-shell-workspace--question-end))
(id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(unless (or (org-get-todo-state)
only-actionable
konix/agent-shell-workspace--listing-ids)
(cond ((save-excursion (beginning-of-line)
(konix/agent-shell-workspace--memos-at-point-p))
(setq rows (append (reverse (konix/agent-shell-workspace--memo-rows limit nil))
rows)))
((save-excursion (beginning-of-line)
(konix/agent-shell-workspace--facts-at-point-p))
(setq rows (append (reverse (konix/agent-shell-workspace--fact-rows limit))
rows)))
((save-excursion (beginning-of-line)
(konix/agent-shell-workspace--part-at-point-p)))
(t (push (format "FACT %s — %s" (or id "-") heading) rows))))
(goto-char limit)))
- how
- the facts under their heading come out one by one, as one at the top would.
(defun konix/agent-shell-workspace--fact-rows (limit)
"Return a FACT row for each fact from point up to LIMIT."
(let (rows)
(save-excursion
(while (re-search-forward "^\\*\\* \\(.*\\)$" limit t)
(let ((heading (match-string 1))
(id (org-entry-get (point) "ID")))
(push (format "FACT %s — %s" (or id "-") heading) rows))))
(nreverse rows)))
- rule
- and each of the writer’s memos comes out last, marked MEMO, by its heading
alone.
- why: the listing is an index of them; what they say is retrieved with a tool of their own, so a long memory costs no nudge.
- scope: the listing only: a binding,
FandZshow them whole.
(defun konix/agent-shell-workspace--memo-rows (limit with-body &optional query)
"Return the rows listing each memo under the memos heading, up to LIMIT.
WITH-BODY adds what each says; QUERY, a regexp, keeps those whose heading or body
matches it."
(let (rows)
(save-excursion
(while (re-search-forward "^\\*\\* \\(.*\\)$" limit t)
(let* ((start (line-beginning-position))
(heading (string-trim (org-get-heading t t t t)))
(end (save-excursion (org-end-of-subtree t t) (min (point) limit)))
(id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" end t)
(string-trim (match-string 1)))))
(body (konix/agent-shell-workspace--body-lines start end)))
(when (or (null query)
(let ((case-fold-search t))
(seq-some (lambda (text) (string-match-p query text))
(cons heading body))))
(push (format "MEMO %s — %s" (or id "-") heading) rows)
(when with-body
(dolist (line body)
(push (concat " " line) rows))))
(goto-char end))))
(nreverse rows)))
- rule
- an answer of the user’s comes out indented under its question.
- scope: what the writer is nudged with carries only those after its own last word,
the ones it is nudged for, or the last one where none is; the rest is the
listing’s, asked for.
- why: every nudge resent the whole exchange, and paid for it each time.
- why: and carrying the last one alone lost the user’s first when they said two.
- scope: what the writer is nudged with carries only those after its own last word,
the ones it is nudged for, or the last one where none is; the rest is the
listing’s, asked for.
- what
- a nudge’s listing carries each question’s last answer only.
(let ((file (make-temp-file "check-nudgebrief-" nil ".ws.org")))
(with-temp-file file
(insert "#+TODO: TODO REFINE DISCUSS PERM WORKING AWAITING TOCHECK MAYBE | DONE\n"
"* Writer's :writers:\n"
"** TODO Second wording?\n :PROPERTIES:\n :ID: q\n :END:\n"
"*** writer: First wording?\n :PROPERTIES:\n :ID: w1\n :END:\n"
"*** me: no\n :PROPERTIES:\n :ID: a1\n :END:\n"
"*** me: yes\n :PROPERTIES:\n :ID: a2\n :END:\n"))
(unwind-protect
(list (konix/agent-shell-workspace--listing file t)
(length (split-string (konix/agent-shell-workspace--listing file) "\n")))
(let ((kill-buffer-query-functions nil))
(when-let* ((visiting (find-buffer-visiting file)))
(with-current-buffer visiting (set-buffer-modified-p nil) (kill-buffer))))
(delete-file file)))
a1 — me: no a2 — me: yes |4 | a1 — me: no a2 — me: yes |4 | a1 — me: no a2 — me: yes |4 |
a2 — me: yes |4 |
a2 — me: yes |4 | a2 — me: yes |4 | a2 — me: yes |4 | w1 — writer: First wording? a1 — me: no a2 — me: yes |4 |
- what
- the check above is right when it reads the question and « a1 — me: no », « a2 — me: yes » under it, past the writer’s word, the full listing four lines long.
(let (answers)
(save-excursion
(goto-char start)
(forward-line 1)
(while (re-search-forward
(concat (konix/agent-shell-workspace--heading-re 1) "\\(.*\\)$") limit t)
(let* ((answer (match-string 1))
(its-id (save-excursion
(when (re-search-forward "^ *:ID: *\\(.+\\)$" limit t)
(string-trim (match-string 1))))))
(push (cons (format " %s — %s" (or its-id "-") answer)
(mapcar (lambda (line) (concat " " line))
(konix/agent-shell-workspace--body-lines
(line-beginning-position) limit)))
answers))))
(dolist (lines (reverse
(if only-actionable
(or (seq-take-while
(lambda (answer)
(not (string-prefix-p
konix/agent-shell-workspace-writer-said
(cadr (split-string (car answer) " — ")))))
answers)
(seq-take answers 1))
answers)))
(dolist (line lines) (push line rows))))
what the questions say of themselves
- how
- the questions are read out of the file once, each with what it waits on, and whatever has to reason about the shape of it works off that rather than off the buffer.
(defun konix/agent-shell-workspace--every-question ()
"Return (ID HEADING STATE NEEDS AFTERS SCHEDULED) for each question of this workspace."
(let (found)
(save-excursion
(goto-char (point-min))
(while (konix/agent-shell-workspace--search-state
konix/agent-shell-workspace-state-regexp)
(when-let* ((id (org-entry-get (point) "ID")))
(push (list id
(org-get-heading t t t t)
(konix/agent-shell-workspace--state-at-point)
(konix/agent-shell-workspace--needs-at-point)
(konix/agent-shell-workspace--afters-at-point)
(org-entry-get (point) "SCHEDULED"))
found))))
(nreverse found)))