[OCaml] High Intensity Training Online
feat add request stream lifecycle tools
Replace the Dispatch container and refile model with a flat tagged stream. Add lifecycle tools: list, log, set-result, check, show, retag, cancel, and block. Rework capture to insert a tagged top-level heading at the top of the file, and rework complete to record result evidence in place. Validate tags against a closed vocabulary. Why: a flat, tag-driven stream removes container bookkeeping and the refile step, and makes the newest request first. Cancel and block now require an explicit reason, so a stopped or blocked request is never silent.
.kiro/skills/fracas/fracas-tools.el
@@ -10,8 +10,11 @@
10
10
;;
11
11
;; This file registers dedicated Emacs MCP tools for the FRACAS skill so the
12
12
;; agent does not run raw `eval-elisp' snippets for each capture, status
13
Removed:
;; change, refile, or verification. Each operation becomes a named tool.
13
Added:
;; change, log, result, or verification. Each operation becomes a named tool.
14
14
;;
15
Added:
;; REQUESTS.org is a flat stream: each request is a top-level heading, newest
16
Added:
;; first, tagged by kind, scope, and impact. There are no container headings.
17
Added:
;;
15
18
;; Why dedicated tools instead of `eval-elisp'?
16
19
;;
17
20
;; The `eval-elisp' tool routes its argument through
@@ -41,8 +44,6 @@
41
44
(require 'mcp-server-tools)
42
45
(require 'org)
43
46
(require 'org-id)
44
Removed:
(require 'org-capture)
45
Removed:
(require 'org-refile)
46
47
(require 'json)
47
48
48
49
;;; Helpers
@@ -75,6 +76,75 @@
75
76
(error "Org ID not found: %s" id))
76
77
(goto-char marker)))
77
78
79
Added:
(defun fracas-tools--fill-body ()
80
Added:
"Wrap the body of the entry at point to 72 columns.
81
Added:
Fill every paragraph after the metadata (SCHEDULED line, property
82
Added:
drawer) up to the next heading. Use `org-fill-paragraph' so Org
83
Added:
list items and other structure fill correctly. Point must be on
84
Added:
the entry heading."
85
Added:
(let ((fill-column 72))
86
Added:
(org-back-to-heading t)
87
Added:
(let ((end (save-excursion (org-end-of-subtree t t) (point-marker))))
88
Added:
;; Move past the heading and all metadata (planning line,
89
Added:
;; property drawer, logbook) to the first line of body text.
90
Added:
(org-end-of-meta-data t)
91
Added:
;; Fill each body line. `org-fill-paragraph' fills the whole
92
Added:
;; element and is idempotent, so stepping one line at a time is
93
Added:
;; safe and does not overshoot a trailing paragraph.
94
Added:
(while (< (point) end)
95
Added:
(unless (looking-at-p "^[ \t]*$")
96
Added:
(org-fill-paragraph))
97
Added:
(forward-line 1))
98
Added:
(set-marker end nil))))
99
Added:
100
Added:
(defun fracas-tools--set-result (commit tests)
101
Added:
"Write the structured result line for the entry at point.
102
Added:
Replace an existing `- result ::' line, or append one at the end of
103
Added:
the entry body. COMMIT is a commit hash; TESTS is a short recap
104
Added:
such as \"215 pass\". Point must be on the entry heading."
105
Added:
(org-back-to-heading t)
106
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))
107
Added:
(line (format "- result :: commit=%s tests=%s" commit tests)))
108
Added:
(org-back-to-heading t)
109
Added:
(if (re-search-forward "^[ \t]*- result ::.*$" subtree-end t)
110
Added:
(replace-match line t t)
111
Added:
(goto-char subtree-end)
112
Added:
(skip-chars-backward "\n")
113
Added:
(insert "\n\n" line))
114
Added:
(set-marker subtree-end nil)))
115
Added:
116
Added:
(defun fracas-tools--append-log (note)
117
Added:
"Append NOTE as a timestamped item to the entry's `:LOGBOOK:' drawer.
118
Added:
Create the drawer directly after the metadata when it is absent.
119
Added:
Insert the newest item first and wrap it to 72 columns. This is
120
Added:
append-only; it never edits an existing item or the body. Point
121
Added:
must be on the entry heading."
122
Added:
(let ((fill-column 72))
123
Added:
(org-back-to-heading t)
124
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))
125
Added:
(ts (format-time-string "[%Y-%m-%d %a %H:%M]")))
126
Added:
(org-back-to-heading t)
127
Added:
(let ((drawer-start
128
Added:
(save-excursion
129
Added:
(when (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t)
130
Added:
(line-beginning-position)))))
131
Added:
(unless drawer-start
132
Added:
(org-end-of-meta-data t)
133
Added:
(insert ":LOGBOOK:\n:END:\n")
134
Added:
(setq drawer-start
135
Added:
(save-excursion
136
Added:
(org-back-to-heading t)
137
Added:
(re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t)
138
Added:
(line-beginning-position))))
139
Added:
(goto-char drawer-start)
140
Added:
(forward-line 1)
141
Added:
(let ((item-start (point)))
142
Added:
(insert (format "- %s %s\n" ts note))
143
Added:
(save-excursion
144
Added:
(goto-char item-start)
145
Added:
(org-fill-paragraph))))
146
Added:
(set-marker subtree-end nil))))
147
Added:
78
148
(defmacro fracas-tools--json (&rest body)
79
149
"Evaluate BODY and return its value as a JSON string.
80
150
Catch any error and return a JSON object with an `error' field."
@@ -83,24 +153,56 @@
83
153
(json-encode (progn ,@body))
84
154
(error (json-encode `((error . ,(error-message-string err)))))))
85
155
156
Added:
;;; Tag vocabulary
157
Added:
158
Added:
(defconst fracas-tools--tags
159
Added:
'("feat" "fix" "refactor" "chore" "docs"
160
Added:
"core" "app" "web" "ui"
161
Added:
"trivial" "major"
162
Added:
"doctrine")
163
Added:
"Closed tag vocabulary for FRACAS request headings.
164
Added:
A request carries one kind tag (feat, fix, refactor, chore, docs) and
165
Added:
one scope tag (core, app, web, ui). An impact tag is optional and
166
Added:
marks an exception: `trivial' for a trivial change, `major' for a
167
Added:
potential major rework. The `doctrine' flag is optional.
168
Added:
The three axes use distinct words, so a bare tag stays unambiguous.")
169
Added:
170
Added:
(defun fracas-tools--check-tags (tags)
171
Added:
"Signal an error when TAGS holds a value outside the vocabulary.
172
Added:
TAGS is a list of strings. Return TAGS unchanged when valid."
173
Added:
(dolist (tag tags)
174
Added:
(unless (member tag fracas-tools--tags)
175
Added:
(error "Unknown tag `%s'; allowed: %s"
176
Added:
tag (string-join fracas-tools--tags ", "))))
177
Added:
tags)
178
Added:
179
Added:
(defun fracas-tools--goto-stream-top ()
180
Added:
"Move point to the insertion place for a new request.
181
Added:
That place is the start of the first top-level heading, after the
182
Added:
file preamble. When no heading exists, move to the end of the
183
Added:
preamble."
184
Added:
(goto-char (point-min))
185
Added:
(if (re-search-forward "^\\* " nil t)
186
Added:
(goto-char (line-beginning-position))
187
Added:
(goto-char (point-max))))
188
Added:
86
189
;;; inspect (read-only)
87
190
88
191
(defun fracas-tools--inspect-handler (args)
89
Removed:
"Report the TODO sequence and Dispatch presence for REQUESTS.org."
192
Added:
"Report the TODO sequence and the tag vocabulary for REQUESTS.org."
90
193
(fracas-tools--json
91
194
(let ((file (fracas-tools--file args)))
92
195
(with-current-buffer (fracas-tools--buffer file)
93
196
(org-with-wide-buffer
94
197
`((file . ,file)
95
198
(todo_keywords . ,(vconcat org-todo-keywords-1))
96
Removed:
(dispatch . ,(if (org-find-exact-headline-in-buffer "Dispatch")
97
Removed:
t :false))))))))
199
Added:
(tags . ,(vconcat fracas-tools--tags))))))))
98
200
99
201
(mcp-server-register-tool
100
202
(make-mcp-server-tool
101
203
:name "fracas-inspect"
102
204
:title "FRACAS Inspect"
103
Removed:
:description "Inspect REQUESTS.org: return its TODO keyword sequence and whether a top-level `Dispatch' heading exists. Read-only."
205
Added:
:description "Inspect REQUESTS.org: return its TODO keyword sequence and the closed tag vocabulary for request headings. Read-only."
104
206
:input-schema '((type . "object")
105
207
(properties . ((root . ((type . "string")
106
208
(description . "Absolute path to the project directory containing REQUESTS.org")))))
@@ -111,50 +213,106 @@
111
213
(idempotentHint . t)
112
214
(openWorldHint . :false))))
113
215
216
Added:
;;; list (read-only)
217
Added:
218
Added:
(defun fracas-tools--list-handler (args)
219
Added:
"List the top-level request entries in REQUESTS.org, newest first.
220
Added:
ARGS keys: `root', `state' (optional), `tag' (optional). When STATE is
221
Added:
given, return only entries with that TODO keyword. When TAG is given,
222
Added:
return only entries that carry that tag. Each row has `id', `title',
223
Added:
`state', `scheduled', and `tags'."
224
Added:
(fracas-tools--json
225
Added:
(let ((file (fracas-tools--file args))
226
Added:
(state (alist-get 'state args))
227
Added:
(tag (alist-get 'tag args)))
228
Added:
(with-current-buffer (fracas-tools--buffer file)
229
Added:
(org-with-wide-buffer
230
Added:
(goto-char (point-min))
231
Added:
(let ((rows '()))
232
Added:
(while (re-search-forward "^\\* " nil t)
233
Added:
(let ((todo (org-get-todo-state))
234
Added:
(tags (org-get-tags nil t)))
235
Added:
(when (and (or (null state) (equal state todo))
236
Added:
(or (null tag) (member tag tags)))
237
Added:
(push `((id . ,(or (org-id-get) :null))
238
Added:
(title . ,(org-get-heading t t t t))
239
Added:
(state . ,(or todo :null))
240
Added:
(scheduled . ,(or (org-entry-get nil "SCHEDULED")
241
Added:
:null))
242
Added:
(tags . ,(vconcat tags)))
243
Added:
rows))))
244
Added:
;; The file is newest-first, so reverse to keep that order.
245
Added:
(vconcat (nreverse rows))))))))
246
Added:
247
Added:
(mcp-server-register-tool
248
Added:
(make-mcp-server-tool
249
Added:
:name "fracas-list"
250
Added:
:title "FRACAS List"
251
Added:
:description "List the top-level feature-request entries in REQUESTS.org, newest first, with each entry's Org ID, title, TODO state, SCHEDULED time, and tags. Pass an optional `state' or `tag' to filter. Read-only."
252
Added:
:input-schema '((type . "object")
253
Added:
(properties . ((root . ((type . "string")
254
Added:
(description . "Absolute path to the project directory")))
255
Added:
(state . ((type . "string")
256
Added:
(description . "Optional TODO keyword filter, for example TODO or IN-PROGRESS")))
257
Added:
(tag . ((type . "string")
258
Added:
(description . "Optional tag filter, for example web or major")))))
259
Added:
(required . ["root"]))
260
Added:
:function #'fracas-tools--list-handler
261
Added:
:annotations '((readOnlyHint . t)
262
Added:
(destructiveHint . :false)
263
Added:
(idempotentHint . t)
264
Added:
(openWorldHint . :false))))
265
Added:
114
266
;;; capture
115
267
116
268
(defun fracas-tools--capture-handler (args)
117
Removed:
"Capture a TODO entry under `Dispatch' in REQUESTS.org.
118
Removed:
ARGS keys: `root', `title', `body' (optional). The Dispatch heading must
119
Removed:
already exist; create it with the org-capture MCP tool first when absent.
120
Removed:
Record the capture time as an inactive SCHEDULED timestamp."
269
Added:
"Capture a TODO entry at the top of the REQUESTS.org stream.
270
Added:
ARGS keys: `root', `title', `body' (optional), `tags' (optional array).
271
Added:
Insert the entry as a top-level heading directly below the file
272
Added:
preamble, so the newest request is first. Record the capture time as
273
Added:
an inactive SCHEDULED timestamp, apply TAGS from the closed
274
Added:
vocabulary, assign an Org ID, and wrap the body to 72 columns."
121
275
(fracas-tools--json
122
276
(let* ((file (fracas-tools--file args))
123
277
(title (or (alist-get 'title args) (error "Missing `title'")))
124
278
(body (or (alist-get 'body args) ""))
125
Removed:
(captured-at (format-time-string "[%Y-%m-%d %a %H:%M]"))
126
Removed:
(org-capture-templates
127
Removed:
`(("e" "Request" entry
128
Removed:
(file+headline ,file "Dispatch")
129
Removed:
"%i" :immediate-finish t))))
279
Added:
(tags (fracas-tools--check-tags
280
Added:
(append (alist-get 'tags args) nil)))
281
Added:
(captured-at (format-time-string "[%Y-%m-%d %a %H:%M]")))
130
282
(with-current-buffer (fracas-tools--buffer file)
131
Removed:
(unless (org-find-exact-headline-in-buffer "Dispatch")
132
Removed:
(error "No `Dispatch' heading in %s; create it first" file)))
133
Removed:
(org-capture-string
134
Removed:
(format "** TODO %s\nSCHEDULED: %s\n%s\n" title captured-at body)
135
Removed:
"e")
136
Removed:
(with-current-buffer (fracas-tools--buffer file)
137
Removed:
(let ((marker org-capture-last-stored-marker))
138
Removed:
(goto-char marker)
139
Removed:
(let ((id (org-id-get-create)))
140
Removed:
(when (buffer-modified-p) (save-buffer))
141
Removed:
`((id . ,id)
142
Removed:
(file . ,file)
143
Removed:
(heading . ,(org-get-heading t t t t))
144
Removed:
(outline_path . ,(vconcat (org-get-outline-path t))))))))))
283
Added:
(org-with-wide-buffer
284
Added:
(fracas-tools--goto-stream-top)
285
Added:
(let ((start (point)))
286
Added:
(insert (format "* TODO %s\nSCHEDULED: %s\n" title captured-at))
287
Added:
(unless (string-empty-p body)
288
Added:
(insert body "\n"))
289
Added:
(goto-char start)
290
Added:
(when tags
291
Added:
(org-set-tags tags))
292
Added:
(let ((id (org-id-get-create)))
293
Added:
(fracas-tools--fill-body)
294
Added:
(when (buffer-modified-p) (save-buffer))
295
Added:
(goto-char (org-id-find id 'marker))
296
Added:
`((id . ,id)
297
Added:
(file . ,file)
298
Added:
(heading . ,(org-get-heading t t t t))
299
Added:
(tags . ,(vconcat (org-get-tags nil t)))))))))))
145
300
146
301
(mcp-server-register-tool
147
302
(make-mcp-server-tool
148
303
:name "fracas-capture"
149
304
:title "FRACAS Capture"
150
Removed:
:description "Capture a TODO feature request under the `Dispatch' heading in REQUESTS.org. Records the capture time as an inactive SCHEDULED timestamp and assigns an Org ID. The `Dispatch' heading must exist first."
305
Added:
:description "Capture a TODO feature request as a top-level heading at the top of REQUESTS.org, so the newest request comes first. Applies scope, impact, and kind tags from the closed vocabulary, records the capture time as an inactive SCHEDULED timestamp, wraps the body to 72 columns, and assigns an Org ID."
151
306
:input-schema '((type . "object")
152
307
(properties . ((root . ((type . "string")
153
308
(description . "Absolute path to the project directory")))
154
309
(title . ((type . "string")
155
310
(description . "Imperative title under 60 chars")))
156
311
(body . ((type . "string")
157
Removed:
(description . "Full request text, verbatim")))))
312
Added:
(description . "Full request text, verbatim")))
313
Added:
(tags . ((type . "array")
314
Added:
(items . ((type . "string")))
315
Added:
(description . "Tags from the closed vocabulary: one kind (feat|fix|refactor|chore|docs), one scope (core|app|web|ui), an optional impact (trivial|major), plus optional doctrine.")))))
158
316
(required . ["root" "title"]))
159
317
:function #'fracas-tools--capture-handler
160
318
:annotations '((readOnlyHint . :false)
@@ -199,84 +357,461 @@
199
357
(idempotentHint . t)
200
358
(openWorldHint . :false))))
201
359
202
Removed:
;;; complete
360
Added:
;;; log
203
361
204
Removed:
(defun fracas-tools--complete-handler (args)
205
Removed:
"Set an entry to DONE and confirm Org recorded a CLOSED timestamp.
206
Removed:
ARGS keys: `root', `id'. Requires `org-log-done' to be `time' so the
207
Removed:
normal Org transition inserts CLOSED; this handler never writes CLOSED."
362
Added:
(defun fracas-tools--log-handler (args)
363
Added:
"Append a timestamped note to an entry's `:LOGBOOK:' drawer.
364
Added:
ARGS keys: `root', `id', `note'. Append-only progress feedback from an
365
Added:
agentic session. Never edits an existing note or the request body."
208
366
(fracas-tools--json
209
367
(let ((file (fracas-tools--file args))
210
Removed:
(id (or (alist-get 'id args) (error "Missing `id'"))))
368
Added:
(id (or (alist-get 'id args) (error "Missing `id'")))
369
Added:
(note (or (alist-get 'note args) (error "Missing `note'"))))
211
370
(with-current-buffer (fracas-tools--buffer file)
212
Removed:
(hack-local-variables)
213
Removed:
(unless (eq org-log-done 'time)
214
Removed:
(error "org-log-done is not set to time"))
215
371
(fracas-tools--goto-id id)
216
Removed:
(org-todo "DONE")
372
Added:
(fracas-tools--append-log note)
217
373
(when (buffer-modified-p) (save-buffer))
218
Removed:
(let ((closed (org-entry-get nil "CLOSED")))
219
Removed:
(unless closed
220
Removed:
(error "Org did not record a CLOSED timestamp"))
221
Removed:
`((id . ,id)
222
Removed:
(state . ,(org-get-todo-state))
223
Removed:
(closed . ,closed)))))))
374
Added:
`((id . ,id)
375
Added:
(state . ,(org-get-todo-state)))))))
224
376
225
377
(mcp-server-register-tool
226
378
(make-mcp-server-tool
227
Removed:
:name "fracas-complete"
228
Removed:
:title "FRACAS Complete"
229
Removed:
:description "Set a FRACAS entry to DONE and confirm Org inserted a CLOSED timestamp. Requires org-log-done set to time. Never writes the timestamp itself. Refile with fracas-refile afterward."
379
Added:
:name "fracas-log"
380
Added:
:title "FRACAS Log"
381
Added:
:description "Append a timestamped progress note to a FRACAS entry's `:LOGBOOK:' drawer. Append-only feedback from an agentic session; it never rewrites earlier notes or the request body. Newest note first, wrapped to 72 columns."
230
382
:input-schema '((type . "object")
231
383
(properties . ((root . ((type . "string")))
232
Removed:
(id . ((type . "string")))))
233
Removed:
(required . ["root" "id"]))
234
Removed:
:function #'fracas-tools--complete-handler
384
Added:
(id . ((type . "string")
385
Added:
(description . "Org ID of the entry")))
386
Added:
(note . ((type . "string")
387
Added:
(description . "Progress note to append")))))
388
Added:
(required . ["root" "id" "note"]))
389
Added:
:function #'fracas-tools--log-handler
235
390
:annotations '((readOnlyHint . :false)
236
391
(destructiveHint . :false)
392
Added:
(idempotentHint . :false)
393
Added:
(openWorldHint . :false))))
394
Added:
395
Added:
;;; set-result
396
Added:
397
Added:
(defun fracas-tools--set-result-handler (args)
398
Added:
"Write the structured result line for an entry.
399
Added:
ARGS keys: `root', `id', `commit', `tests'. COMMIT is a commit hash;
400
Added:
TESTS is a short recap such as \"215 pass\". Replace an existing result
401
Added:
line or append one at the end of the body."
402
Added:
(fracas-tools--json
403
Added:
(let ((file (fracas-tools--file args))
404
Added:
(id (or (alist-get 'id args) (error "Missing `id'")))
405
Added:
(commit (or (alist-get 'commit args) (error "Missing `commit'")))
406
Added:
(tests (or (alist-get 'tests args) (error "Missing `tests'"))))
407
Added:
(with-current-buffer (fracas-tools--buffer file)
408
Added:
(fracas-tools--goto-id id)
409
Added:
(fracas-tools--set-result commit tests)
410
Added:
(when (buffer-modified-p) (save-buffer))
411
Added:
`((id . ,id)
412
Added:
(commit . ,commit)
413
Added:
(tests . ,tests))))))
414
Added:
415
Added:
(mcp-server-register-tool
416
Added:
(make-mcp-server-tool
417
Added:
:name "fracas-set-result"
418
Added:
:title "FRACAS Set Result"
419
Added:
:description "Write the structured `- result ::' line for a FRACAS entry, recording the commit hash and a short test recap. Replaces an existing result line or appends one. fracas-complete calls this when you pass commit and tests."
420
Added:
:input-schema '((type . "object")
421
Added:
(properties . ((root . ((type . "string")))
422
Added:
(id . ((type . "string")
423
Added:
(description . "Org ID of the entry")))
424
Added:
(commit . ((type . "string")
425
Added:
(description . "Commit hash")))
426
Added:
(tests . ((type . "string")
427
Added:
(description . "Short test recap, for example \"215 pass\"")))))
428
Added:
(required . ["root" "id" "commit" "tests"]))
429
Added:
:function #'fracas-tools--set-result-handler
430
Added:
:annotations '((readOnlyHint . :false)
431
Added:
(destructiveHint . :false)
237
432
(idempotentHint . t)
238
433
(openWorldHint . :false))))
239
434
240
Removed:
;;; refile
435
Added:
;;; check (checklist for sub-tasks)
241
436
242
Removed:
(defun fracas-tools--refile-handler (args)
243
Removed:
"Refile the entry with `id' under the top-level heading `target'.
244
Removed:
ARGS keys: `root', `id', `target'. Both entry and target are in
245
Removed:
REQUESTS.org."
437
Added:
(defconst fracas-tools--checklist-header "Checklist [/]:"
438
Added:
"Header line that introduces a request's checkbox list.
439
Added:
The `[/]' cookie tracks completed items against the total.")
440
Added:
441
Added:
(defun fracas-tools--checklist-add (item)
442
Added:
"Add ITEM as an unchecked checkbox to the entry at point.
443
Added:
Create the checklist block when it does not exist. Wrap ITEM to 72
444
Added:
columns and refresh the `[/]' cookie. Point must be on the heading."
445
Added:
(let ((fill-column 72))
446
Added:
(org-back-to-heading t)
447
Added:
(let* ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))
448
Added:
(line (format "- [ ] %s\n" item))
449
Added:
insert-at)
450
Added:
(org-back-to-heading t)
451
Added:
(if (re-search-forward "^Checklist \\[[0-9]*/[0-9]*\\]:[ \t]*$"
452
Added:
subtree-end t)
453
Added:
;; Existing block: step past the trailing checkbox items.
454
Added:
(progn (forward-line 1)
455
Added:
(while (looking-at-p "^- \\[.\\] \\|^ ") (forward-line 1))
456
Added:
(setq insert-at (point))
457
Added:
(insert line))
458
Added:
;; No block: append one at the end of the body.
459
Added:
(goto-char subtree-end)
460
Added:
(skip-chars-backward "\n")
461
Added:
(insert "\n\n" fracas-tools--checklist-header "\n")
462
Added:
(setq insert-at (point))
463
Added:
(insert line))
464
Added:
(save-excursion (goto-char insert-at) (org-fill-paragraph))
465
Added:
(org-update-checkbox-count)
466
Added:
(set-marker subtree-end nil))))
467
Added:
468
Added:
(defun fracas-tools--checklist-toggle (item)
469
Added:
"Toggle the checkbox whose text matches ITEM in the entry at point.
470
Added:
Signal an error when no item matches. Refresh the `[/]' cookie.
471
Added:
Point must be on the heading."
472
Added:
(org-back-to-heading t)
473
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker))))
474
Added:
(org-back-to-heading t)
475
Added:
(if (re-search-forward (concat "^- \\[.\\] " (regexp-quote item))
476
Added:
subtree-end t)
477
Added:
(progn (beginning-of-line) (org-toggle-checkbox)
478
Added:
(org-update-checkbox-count))
479
Added:
(set-marker subtree-end nil)
480
Added:
(error "No checklist item matches: %s" item))
481
Added:
(set-marker subtree-end nil)))
482
Added:
483
Added:
(defun fracas-tools--checklist-items ()
484
Added:
"Return the checklist items of the entry at point.
485
Added:
Each item is an alist with `done' and `text'. Point must be on the
486
Added:
heading."
487
Added:
(org-back-to-heading t)
488
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point)))
489
Added:
(items '()))
490
Added:
(org-back-to-heading t)
491
Added:
(while (re-search-forward "^- \\[\\(.\\)\\] \\(.*\\)$" subtree-end t)
492
Added:
(push `((done . ,(if (string-equal (match-string 1) " ") :false t))
493
Added:
(text . ,(string-trim (match-string-no-properties 2))))
494
Added:
items))
495
Added:
(vconcat (nreverse items))))
496
Added:
497
Added:
(defun fracas-tools--check-handler (args)
498
Added:
"Manage the checklist of a request, for splitting a complex task.
499
Added:
ARGS keys: `root', `id', `action' (add|toggle|list), `item'.
500
Added:
`add' appends an unchecked item; `toggle' flips a matching item;
501
Added:
`list' returns the items. A `[/]' cookie tracks progress."
246
502
(fracas-tools--json
247
503
(let ((file (fracas-tools--file args))
248
504
(id (or (alist-get 'id args) (error "Missing `id'")))
249
Removed:
(target (or (alist-get 'target args) (error "Missing `target'"))))
505
Added:
(action (or (alist-get 'action args) (error "Missing `action'")))
506
Added:
(item (alist-get 'item args)))
250
507
(with-current-buffer (fracas-tools--buffer file)
508
Added:
(fracas-tools--goto-id id)
509
Added:
(cond
510
Added:
((string-equal action "add")
511
Added:
(unless item (error "`add' needs an `item'"))
512
Added:
(fracas-tools--checklist-add item))
513
Added:
((string-equal action "toggle")
514
Added:
(unless item (error "`toggle' needs an `item'"))
515
Added:
(fracas-tools--checklist-toggle item))
516
Added:
((string-equal action "list") nil)
517
Added:
(t (error "Unknown action `%s'; use add, toggle, or list" action)))
518
Added:
(when (buffer-modified-p) (save-buffer))
519
Added:
(fracas-tools--goto-id id)
520
Added:
`((id . ,id)
521
Added:
(items . ,(fracas-tools--checklist-items)))))))
522
Added:
523
Added:
(mcp-server-register-tool
524
Added:
(make-mcp-server-tool
525
Added:
:name "fracas-check"
526
Added:
:title "FRACAS Checklist"
527
Added:
:description "Manage a request's checkbox list to split a complex task into sub-tasks with their own done state. Actions: add an unchecked item, toggle a matching item, or list items. A [/] cookie on the checklist header tracks progress. Items stay inside the one request; they are not separate stream entries."
528
Added:
:input-schema '((type . "object")
529
Added:
(properties . ((root . ((type . "string")))
530
Added:
(id . ((type . "string")
531
Added:
(description . "Org ID of the request")))
532
Added:
(action . ((type . "string")
533
Added:
(description . "add, toggle, or list")))
534
Added:
(item . ((type . "string")
535
Added:
(description . "Item text for add or toggle")))))
536
Added:
(required . ["root" "id" "action"]))
537
Added:
:function #'fracas-tools--check-handler
538
Added:
:annotations '((readOnlyHint . :false)
539
Added:
(destructiveHint . :false)
540
Added:
(idempotentHint . :false)
541
Added:
(openWorldHint . :false))))
542
Added:
543
Added:
;;; show (read-only)
544
Added:
545
Added:
(defun fracas-tools--body-text ()
546
Added:
"Return the plain body text of the entry at point.
547
Added:
Read from the first line after the metadata up to the first of: a
548
Added:
`Checklist [' line, a `- result ::' line, or the end of the subtree.
549
Added:
Return the trimmed string. Point must be on the entry heading."
550
Added:
(org-back-to-heading t)
551
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point))))
552
Added:
(org-back-to-heading t)
553
Added:
(org-end-of-meta-data t)
554
Added:
(let ((body-start (point))
555
Added:
(body-end subtree-end))
556
Added:
(save-excursion
557
Added:
(goto-char body-start)
558
Added:
(when (re-search-forward "^\\(Checklist \\[\\|[ \t]*- result ::\\)"
559
Added:
subtree-end t)
560
Added:
(setq body-end (line-beginning-position))))
561
Added:
(string-trim
562
Added:
(buffer-substring-no-properties body-start body-end)))))
563
Added:
564
Added:
(defun fracas-tools--logbook-items ()
565
Added:
"Return the `:LOGBOOK:' drawer item lines of the entry at point.
566
Added:
Each item is a string, in the order stored (newest first). Return an
567
Added:
empty vector when there is no drawer. Point must be on the heading."
568
Added:
(org-back-to-heading t)
569
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point)))
570
Added:
(items '()))
571
Added:
(org-back-to-heading t)
572
Added:
(when (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t)
573
Added:
(forward-line 1)
574
Added:
(while (and (< (point) subtree-end)
575
Added:
(not (looking-at-p "^[ \t]*:END:[ \t]*$")))
576
Added:
(when (looking-at "^[ \t]*- \\(.*\\)$")
577
Added:
(push (string-trim (match-string-no-properties 1)) items))
578
Added:
(forward-line 1)))
579
Added:
(vconcat (nreverse items))))
580
Added:
581
Added:
(defun fracas-tools--result-text ()
582
Added:
"Return the text after `- result ::' for the entry at point.
583
Added:
Return :null when there is no result line. Point must be on the
584
Added:
heading."
585
Added:
(org-back-to-heading t)
586
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point))))
587
Added:
(org-back-to-heading t)
588
Added:
(if (re-search-forward "^[ \t]*- result ::[ \t]*\\(.*\\)$"
589
Added:
subtree-end t)
590
Added:
(string-trim (match-string-no-properties 1))
591
Added:
:null)))
592
Added:
593
Added:
(defun fracas-tools--show-handler (args)
594
Added:
"Return the full content of an entry.
595
Added:
ARGS keys: `root', `id'. Report the heading, state, tags, scheduled
596
Added:
and closed timestamps, body text, logbook notes, checklist items, and
597
Added:
result line. Read-only."
598
Added:
(fracas-tools--json
599
Added:
(let ((file (fracas-tools--file args))
600
Added:
(id (or (alist-get 'id args) (error "Missing `id'"))))
601
Added:
(with-current-buffer (fracas-tools--buffer file)
251
602
(org-with-wide-buffer
252
Removed:
(let ((target-position
253
Removed:
(let ((tm (org-find-exact-headline-in-buffer target)))
254
Removed:
(unless tm (error "Org target not found: %s" target))
255
Removed:
(marker-position tm))))
256
Removed:
(fracas-tools--goto-id id)
257
Removed:
(org-refile nil nil (list target file nil target-position))
258
Removed:
(when (buffer-modified-p) (save-buffer))
259
Removed:
(fracas-tools--goto-id id)
260
Removed:
`((id . ,id)
261
Removed:
(outline_path . ,(vconcat (org-get-outline-path t))))))))))
603
Added:
(fracas-tools--goto-id id)
604
Added:
`((id . ,id)
605
Added:
(heading . ,(org-get-heading t t t t))
606
Added:
(state . ,(or (org-get-todo-state) :null))
607
Added:
(tags . ,(vconcat (org-get-tags nil t)))
608
Added:
(scheduled . ,(or (org-entry-get nil "SCHEDULED") :null))
609
Added:
(closed . ,(or (org-entry-get nil "CLOSED") :null))
610
Added:
(body . ,(fracas-tools--body-text))
611
Added:
(logbook . ,(fracas-tools--logbook-items))
612
Added:
(checklist . ,(fracas-tools--checklist-items))
613
Added:
(result . ,(fracas-tools--result-text))))))))
262
614
263
615
(mcp-server-register-tool
264
616
(make-mcp-server-tool
265
Removed:
:name "fracas-refile"
266
Removed:
:title "FRACAS Refile"
267
Removed:
:description "Move a completed FRACAS entry out of `Dispatch' and under a top-level `target' heading in REQUESTS.org."
617
Added:
:name "fracas-show"
618
Added:
:title "FRACAS Show"
619
Added:
:description "Return the full content of a FRACAS entry: heading, state, tags, scheduled and closed timestamps, body text, logbook notes, checklist items, and result line. Read-only."
268
620
:input-schema '((type . "object")
269
621
(properties . ((root . ((type . "string")))
270
Removed:
(id . ((type . "string")))
271
Removed:
(target . ((type . "string")
272
Removed:
(description . "Top-level heading to receive the entry")))))
273
Removed:
(required . ["root" "id" "target"]))
274
Removed:
:function #'fracas-tools--refile-handler
622
Added:
(id . ((type . "string")
623
Added:
(description . "Org ID of the entry")))))
624
Added:
(required . ["root" "id"]))
625
Added:
:function #'fracas-tools--show-handler
626
Added:
:annotations '((readOnlyHint . t)
627
Added:
(destructiveHint . :false)
628
Added:
(idempotentHint . t)
629
Added:
(openWorldHint . :false))))
630
Added:
631
Added:
;;; retag
632
Added:
633
Added:
(defun fracas-tools--retag-handler (args)
634
Added:
"Replace the tags on an entry with a validated set.
635
Added:
ARGS keys: `root', `id', `tags' (array). Validate TAGS against the
636
Added:
closed vocabulary, then set them, keeping the file's default tag
637
Added:
alignment."
638
Added:
(fracas-tools--json
639
Added:
(let ((file (fracas-tools--file args))
640
Added:
(id (or (alist-get 'id args) (error "Missing `id'")))
641
Added:
(tags (fracas-tools--check-tags
642
Added:
(append (alist-get 'tags args) nil))))
643
Added:
(with-current-buffer (fracas-tools--buffer file)
644
Added:
(fracas-tools--goto-id id)
645
Added:
(org-set-tags tags)
646
Added:
(when (buffer-modified-p) (save-buffer))
647
Added:
`((id . ,id)
648
Added:
(tags . ,(vconcat (org-get-tags nil t))))))))
649
Added:
650
Added:
(mcp-server-register-tool
651
Added:
(make-mcp-server-tool
652
Added:
:name "fracas-retag"
653
Added:
:title "FRACAS Retag"
654
Added:
:description "Replace the tags on a FRACAS entry with a validated set from the closed vocabulary. Use this to re-tag as a feature's shape changes; it keeps the file's default tag alignment."
655
Added:
:input-schema '((type . "object")
656
Added:
(properties . ((root . ((type . "string")))
657
Added:
(id . ((type . "string")
658
Added:
(description . "Org ID of the entry")))
659
Added:
(tags . ((type . "array")
660
Added:
(items . ((type . "string")))
661
Added:
(description . "Tags from the closed vocabulary")))))
662
Added:
(required . ["root" "id" "tags"]))
663
Added:
:function #'fracas-tools--retag-handler
275
664
:annotations '((readOnlyHint . :false)
276
665
(destructiveHint . :false)
277
666
(idempotentHint . :false)
278
667
(openWorldHint . :false))))
279
668
669
Added:
;;; cancel and block
670
Added:
671
Added:
(defun fracas-tools--transition-with-reason (id keyword marker-label reason)
672
Added:
"Transition entry ID to KEYWORD and record REASON.
673
Added:
Signal an error when REASON is missing or blank. Write a wrapped body
674
Added:
line `- MARKER-LABEL :: REASON', replacing an existing line of that
675
Added:
form or appending one at the end of the body. Fill the line to 72
676
Added:
columns, then set the TODO keyword and save."
677
Added:
(when (or (null reason) (string-empty-p (string-trim reason)))
678
Added:
(error "A reason is required"))
679
Added:
(fracas-tools--goto-id id)
680
Added:
(let ((fill-column 72))
681
Added:
(org-back-to-heading t)
682
Added:
(let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))
683
Added:
(line (format "- %s :: %s" marker-label reason))
684
Added:
insert-at)
685
Added:
(org-back-to-heading t)
686
Added:
(if (re-search-forward
687
Added:
(format "^[ \t]*- %s ::.*$" (regexp-quote marker-label))
688
Added:
subtree-end t)
689
Added:
(progn (replace-match line t t)
690
Added:
(setq insert-at (line-beginning-position)))
691
Added:
(goto-char subtree-end)
692
Added:
(skip-chars-backward "\n")
693
Added:
(insert "\n\n" line)
694
Added:
(setq insert-at (line-beginning-position)))
695
Added:
(save-excursion (goto-char insert-at) (org-fill-paragraph))
696
Added:
(set-marker subtree-end nil)))
697
Added:
(fracas-tools--goto-id id)
698
Added:
(org-todo keyword)
699
Added:
(when (buffer-modified-p) (save-buffer)))
700
Added:
701
Added:
(defun fracas-tools--cancel-handler (args)
702
Added:
"Set an entry to CANCELLED with a required reason.
703
Added:
ARGS keys: `root', `id', `reason'. Record REASON as a `- cancelled ::'
704
Added:
line so the decision is never silent."
705
Added:
(fracas-tools--json
706
Added:
(let ((file (fracas-tools--file args))
707
Added:
(id (or (alist-get 'id args) (error "Missing `id'")))
708
Added:
(reason (alist-get 'reason args)))
709
Added:
(with-current-buffer (fracas-tools--buffer file)
710
Added:
(fracas-tools--transition-with-reason id "CANCELLED" "cancelled" reason)
711
Added:
(fracas-tools--goto-id id)
712
Added:
`((id . ,id)
713
Added:
(state . ,(org-get-todo-state)))))))
714
Added:
715
Added:
(mcp-server-register-tool
716
Added:
(make-mcp-server-tool
717
Added:
:name "fracas-cancel"
718
Added:
:title "FRACAS Cancel"
719
Added:
:description "Set a FRACAS entry to CANCELLED and record a required reason as a `- cancelled ::' line, so the decision is never silent."
720
Added:
:input-schema '((type . "object")
721
Added:
(properties . ((root . ((type . "string")))
722
Added:
(id . ((type . "string")
723
Added:
(description . "Org ID of the entry")))
724
Added:
(reason . ((type . "string")
725
Added:
(description . "Reason for cancelling the entry")))))
726
Added:
(required . ["root" "id" "reason"]))
727
Added:
:function #'fracas-tools--cancel-handler
728
Added:
:annotations '((readOnlyHint . :false)
729
Added:
(destructiveHint . :false)
730
Added:
(idempotentHint . :false)
731
Added:
(openWorldHint . :false))))
732
Added:
733
Added:
(defun fracas-tools--block-handler (args)
734
Added:
"Set an entry to BLOCKED with a required reason.
735
Added:
ARGS keys: `root', `id', `reason'. Record REASON as a `- blocked ::'
736
Added:
line so the blocker is never silent."
737
Added:
(fracas-tools--json
738
Added:
(let ((file (fracas-tools--file args))
739
Added:
(id (or (alist-get 'id args) (error "Missing `id'")))
740
Added:
(reason (alist-get 'reason args)))
741
Added:
(with-current-buffer (fracas-tools--buffer file)
742
Added:
(fracas-tools--transition-with-reason id "BLOCKED" "blocked" reason)
743
Added:
(fracas-tools--goto-id id)
744
Added:
`((id . ,id)
745
Added:
(state . ,(org-get-todo-state)))))))
746
Added:
747
Added:
(mcp-server-register-tool
748
Added:
(make-mcp-server-tool
749
Added:
:name "fracas-block"
750
Added:
:title "FRACAS Block"
751
Added:
:description "Set a FRACAS entry to BLOCKED and record a required reason as a `- blocked ::' line, so the blocker is never silent."
752
Added:
:input-schema '((type . "object")
753
Added:
(properties . ((root . ((type . "string")))
754
Added:
(id . ((type . "string")
755
Added:
(description . "Org ID of the entry")))
756
Added:
(reason . ((type . "string")
757
Added:
(description . "Reason for blocking the entry")))))
758
Added:
(required . ["root" "id" "reason"]))
759
Added:
:function #'fracas-tools--block-handler
760
Added:
:annotations '((readOnlyHint . :false)
761
Added:
(destructiveHint . :false)
762
Added:
(idempotentHint . :false)
763
Added:
(openWorldHint . :false))))
764
Added:
765
Added:
;;; complete
766
Added:
767
Added:
(defun fracas-tools--complete-handler (args)
768
Added:
"Set an entry to DONE with its result evidence and confirm CLOSED.
769
Added:
ARGS keys: `root', `id', `commit', `tests'. Write the structured result
770
Added:
line (commit hash and test recap), then transition to DONE. Requires
771
Added:
`org-log-done' to be `time' so the normal Org transition inserts CLOSED;
772
Added:
this handler never writes CLOSED."
773
Added:
(fracas-tools--json
774
Added:
(let ((file (fracas-tools--file args))
775
Added:
(id (or (alist-get 'id args) (error "Missing `id'")))
776
Added:
(commit (or (alist-get 'commit args) (error "Missing `commit'")))
777
Added:
(tests (or (alist-get 'tests args) (error "Missing `tests'"))))
778
Added:
(with-current-buffer (fracas-tools--buffer file)
779
Added:
(hack-local-variables)
780
Added:
(unless (eq org-log-done 'time)
781
Added:
(error "org-log-done is not set to time"))
782
Added:
(fracas-tools--goto-id id)
783
Added:
(fracas-tools--set-result commit tests)
784
Added:
(fracas-tools--goto-id id)
785
Added:
(org-todo "DONE")
786
Added:
(when (buffer-modified-p) (save-buffer))
787
Added:
(let ((closed (org-entry-get nil "CLOSED")))
788
Added:
(unless closed
789
Added:
(error "Org did not record a CLOSED timestamp"))
790
Added:
`((id . ,id)
791
Added:
(state . ,(org-get-todo-state))
792
Added:
(commit . ,commit)
793
Added:
(tests . ,tests)
794
Added:
(closed . ,closed)))))))
795
Added:
796
Added:
(mcp-server-register-tool
797
Added:
(make-mcp-server-tool
798
Added:
:name "fracas-complete"
799
Added:
:title "FRACAS Complete"
800
Added:
:description "Set a FRACAS entry to DONE. Records the result evidence (commit hash and a short test recap) as a `- result ::' line, then confirms Org inserted a CLOSED timestamp. Requires org-log-done set to time. Never writes the timestamp itself. The entry stays in place; there is no refile step."
801
Added:
:input-schema '((type . "object")
802
Added:
(properties . ((root . ((type . "string")))
803
Added:
(id . ((type . "string")))
804
Added:
(commit . ((type . "string")
805
Added:
(description . "Commit hash for the completed work")))
806
Added:
(tests . ((type . "string")
807
Added:
(description . "Short test recap, for example \"215 pass\"")))))
808
Added:
(required . ["root" "id" "commit" "tests"]))
809
Added:
:function #'fracas-tools--complete-handler
810
Added:
:annotations '((readOnlyHint . :false)
811
Added:
(destructiveHint . :false)
812
Added:
(idempotentHint . t)
813
Added:
(openWorldHint . :false))))
814
Added:
280
815
;;; verify (read-only)
281
816
282
817
(defun fracas-tools--verify-handler (args)
@@ -292,13 +827,13 @@
292
827
(heading . ,(org-get-heading t t t t))
293
828
(state . ,(org-get-todo-state))
294
829
(closed . ,(or (org-entry-get nil "CLOSED") :null))
295
Removed:
(outline_path . ,(vconcat (org-get-outline-path t)))))))))
830
Added:
(tags . ,(vconcat (org-get-tags nil t)))))))))
296
831
297
832
(mcp-server-register-tool
298
833
(make-mcp-server-tool
299
834
:name "fracas-verify"
300
835
:title "FRACAS Verify"
301
Removed:
:description "Return the heading, TODO state, CLOSED timestamp, and outline path of a FRACAS entry. Read-only."
836
Added:
:description "Return the heading, TODO state, CLOSED timestamp, and tags of a FRACAS entry. Read-only."
302
837
:input-schema '((type . "object")
303
838
(properties . ((root . ((type . "string")))
304
839
(id . ((type . "string")))))