1 ;;; rail-tools.el --- RAIL MCP tools for RAIL.org -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2025 4 5 ;; This file is NOT part of GNU Emacs. 6 7 ;;; Commentary: 8 9 ;; RAIL means "Rolling Action Item List". 10 ;; 11 ;; This file registers dedicated Emacs MCP tools for the RAIL skill so the 12 ;; agent does not run raw `eval-elisp' snippets for each capture, status 13 ;; change, log, result, or verification. Each operation becomes a named tool. 14 ;; 15 ;; RAIL.org is a flat stream. Each action item is a top-level heading, newest 16 ;; first, tagged from a vocabulary that the file itself declares. The file 17 ;; holds no container heading. 18 ;; 19 ;; The tools carry no project vocabulary and no project workflow. The stream 20 ;; file owns both. The `#+TODO:' line declares the status keywords. The 21 ;; `#+TAGS:' lines declare the tag vocabulary, grouped into axes. The tools 22 ;; read both from the file, so one tool file serves every project. 23 ;; 24 ;; Why dedicated tools instead of `eval-elisp'? 25 ;; 26 ;; The `eval-elisp' tool routes its argument through 27 ;; `mcp-server-security-safe-eval', whose form walker blocks or prompts for 28 ;; "dangerous" functions such as `find-file-noselect', `write-file', and 29 ;; `save-buffer'. With `mcp-server-security-prompt-for-permissions' set to t, 30 ;; every RAIL snippet triggers a minibuffer prompt. 31 ;; 32 ;; A registered MCP tool runs through `mcp-server-tools-call', which calls the 33 ;; handler function directly and does NOT pass through the form walker. The 34 ;; handlers below therefore run without the repeated security prompt. Each 35 ;; tool also carries MCP `annotations' so the MCP client can auto-approve the 36 ;; read-only tools. 37 ;; 38 ;; The tools operate only on the file "RAIL.org". They find that file 39 ;; under `rail-project-root', or under a caller-supplied project ROOT that 40 ;; overrides it. They never touch any other file. 41 ;; 42 ;; `rail-project-root' comes from an upward search for the stream file. The 43 ;; search starts at this file's own directory, then at `default-directory'. It 44 ;; assumes no directory layout, so this file needs no absolute path and it 45 ;; works on every machine. 46 ;; 47 ;; Install the tools once per Emacs session. Load this file, and the tools 48 ;; register themselves. With `mcp-server-emacs-tools-enabled' set to `all', 49 ;; which is the default, they appear in the MCP tool list at once. 50 ;; 51 ;; The MCP framework is a soft dependency. When the framework is absent, for 52 ;; example in a batch test run, this file still loads and every handler stays 53 ;; callable. Run the test suite with the run-tests.sh script beside this file. 54 55 ;;; Code: 56 57 (require 'cl-lib) 58 (require 'org) 59 (require 'org-id) 60 (require 'json) 61 (require 'subr-x) 62 63 ;; Load the MCP tool framework when it is available. When it is absent, for 64 ;; example in a batch test run, define the two symbols the registrations below 65 ;; need and discard each registration. The handler functions stay callable, so 66 ;; the test suite runs on any machine without the framework. 67 (defconst rail-mcp-available (require 'mcp-server-tools nil t) 68 "Non-nil when the Emacs MCP tool framework is available.") 69 70 (unless rail-mcp-available 71 ;; Define plain functions, never a struct. A stub struct would clobber the 72 ;; real slot layout if the framework loads later in the same session. 73 (defun make-mcp-server-tool (&rest _args) 74 "Return nil. The MCP framework is absent." 75 nil) 76 (defun mcp-server-register-tool (_tool) 77 "Discard _TOOL. The MCP framework is absent." 78 nil)) 79 80 (defvar rail-stream-file-name "RAIL.org" 81 "Name of the Org file that RAIL manages.") 82 83 (defvar rail-tools-path 84 (let ((file (or load-file-name buffer-file-name))) 85 (and file (expand-file-name file))) 86 "Absolute path of this file, or nil when the path is unknown.") 87 88 (defun rail-locate-root (start) 89 "Return the closest directory at or above START that holds the stream file. 90 The stream file is `rail-stream-file-name'. Return nil when no 91 ancestor directory holds that file." 92 (let ((dir (and start (locate-dominating-file 93 (file-name-as-directory (expand-file-name start)) 94 rail-stream-file-name)))) 95 (and dir (expand-file-name (file-name-as-directory dir))))) 96 97 (defvar rail-project-root 98 (or (rail-locate-root (and rail-tools-path 99 (file-name-directory rail-tools-path))) 100 (rail-locate-root default-directory) 101 (expand-file-name default-directory)) 102 "Default project directory that holds the RAIL stream file. 103 The value comes from an upward search for `rail-stream-file-name', 104 first from this file's own directory, then from `default-directory'. 105 The search makes no assumption about the depth of this file in the 106 project. Set this variable to override the search, or pass a `root' 107 argument to any tool.") 108 109 ;;; Helpers 110 111 (defun rail-tools--file (args) 112 "Return the absolute path of the stream file for ARGS. 113 ARGS may hold a `root' string that names the project directory. When 114 `root' is absent, use `rail-project-root'. Signal an error when the 115 selected root is not a directory." 116 (let ((root (or (alist-get 'root args) rail-project-root))) 117 (unless (and (stringp root) (> (length root) 0)) 118 (error "No project root: pass `root' or set `rail-project-root'")) 119 (let ((dir (expand-file-name root))) 120 (unless (file-directory-p dir) 121 (error "Not a directory: %s" dir)) 122 (expand-file-name rail-stream-file-name dir)))) 123 124 (defun rail-tools--buffer (file) 125 "Return an org-mode buffer visiting FILE, creating it as needed." 126 (let ((buf (find-file-noselect file))) 127 (with-current-buffer buf 128 (unless (derived-mode-p 'org-mode) 129 (org-mode))) 130 buf)) 131 132 (defun rail-tools--goto-id (id) 133 "Move point to the heading with Org ID in the current buffer. 134 Signal an error when ID is not found." 135 (let ((marker (org-id-find id 'marker))) 136 (unless marker 137 (error "Org ID not found: %s" id)) 138 (goto-char marker))) 139 140 (defun rail-tools--fill-body () 141 "Wrap the body of the entry at point to 72 columns. 142 Fill every paragraph after the metadata (SCHEDULED line, property 143 drawer) up to the next heading. Use `org-fill-paragraph' so Org 144 list items and other structure fill correctly. Point must be on 145 the entry heading." 146 (let ((fill-column 72)) 147 (org-back-to-heading t) 148 (let ((end (save-excursion (org-end-of-subtree t t) (point-marker)))) 149 ;; Move past the heading and all metadata (planning line, 150 ;; property drawer, logbook) to the first line of body text. 151 (org-end-of-meta-data t) 152 ;; Fill each body line. `org-fill-paragraph' fills the whole 153 ;; element and is idempotent, so stepping one line at a time is 154 ;; safe and does not overshoot a trailing paragraph. 155 (while (< (point) end) 156 (unless (looking-at-p "^[ \t]*$") 157 (org-fill-paragraph)) 158 (forward-line 1)) 159 (set-marker end nil)))) 160 161 (defun rail-tools--nonblank (value) 162 "Return VALUE trimmed when it is a non-blank string, else nil." 163 (and (stringp value) 164 (let ((trimmed (string-trim value))) 165 (and (> (length trimmed) 0) trimmed)))) 166 167 (defconst rail-tools--closing-labels 168 '((done . "CLOSING NOTE") 169 (blocked . "BLOCKED NOTE") 170 (cancelled . "CANCELLED NOTE")) 171 "Map a closing purpose to its `:LOGBOOK:' note label. 172 The label mirrors Org's own `CLOSING NOTE' heading for the `done' 173 purpose, so a RAIL closing note reads like a native Org log note.") 174 175 (defun rail-tools--drawer-insert (line &optional nofill) 176 "Insert LINE as the newest item in the entry's `:LOGBOOK:' drawer. 177 Create the drawer directly after the metadata when it is absent. LINE 178 is one already-formatted list item without its leading dash. Wrap the 179 inserted item to 72 columns, unless NOFILL is non-nil, in which case 180 keep it on one line. This never edits an existing item or the body. 181 Point must be on the entry heading." 182 (let ((fill-column 72)) 183 (org-back-to-heading t) 184 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))) 185 (org-back-to-heading t) 186 (let ((drawer-start 187 (save-excursion 188 (when (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t) 189 (line-beginning-position))))) 190 (unless drawer-start 191 (org-end-of-meta-data t) 192 (insert ":LOGBOOK:\n:END:\n") 193 (setq drawer-start 194 (save-excursion 195 (org-back-to-heading t) 196 (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t) 197 (line-beginning-position)))) 198 (goto-char drawer-start) 199 (forward-line 1) 200 (let ((item-start (point))) 201 (insert (format "- %s\n" line)) 202 (unless nofill 203 (save-excursion 204 (goto-char item-start) 205 (org-fill-paragraph))))) 206 (set-marker subtree-end nil)))) 207 208 (defun rail-tools--append-log (note) 209 "Append NOTE as a timestamped item to the entry's `:LOGBOOK:' drawer. 210 Insert the newest item first and wrap it to 72 columns. This is 211 append-only. It never edits an existing item or the body. Point must 212 be on the entry heading." 213 (let ((ts (format-time-string "[%Y-%m-%d %a %H:%M]"))) 214 (rail-tools--drawer-insert (format "%s %s" ts note)))) 215 216 (defun rail-tools--closing-note-text (commit tests &optional model notes) 217 "Compose the closing-note text for a completed item. 218 COMMIT is a commit hash. TESTS is a short recap such as \"215 pass\". 219 MODEL names the agent that did the work, and NOTES adds a free-text 220 tail after a semicolon. Both are optional. Return one line, because 221 the reader reads one line." 222 (let ((model (rail-tools--nonblank model)) 223 (notes (rail-tools--nonblank notes))) 224 (concat (if model (format "model=%s " model) "") 225 (format "commit=%s tests=%s" commit tests) 226 (if notes (format "; %s" notes) "")))) 227 228 (defun rail-tools--append-closing-note (purpose text) 229 "Write a closing note into the entry's `:LOGBOOK:' drawer. 230 PURPOSE is `done', `blocked', or `cancelled'. TEXT is the note body. 231 The note reads `LABEL [timestamp] :: TEXT', with LABEL from 232 `rail-tools--closing-labels'. It lands in the drawer next to the 233 state timestamp, and it replaces the old body-line evidence. When the 234 entry already carries a note of the same PURPOSE, replace that note in 235 place, so a re-run does not stack a second note. Point must be on the 236 entry heading." 237 (let ((label (or (cdr (assq purpose rail-tools--closing-labels)) 238 (error "Unknown closing purpose: %s" purpose))) 239 (ts (format-time-string "[%Y-%m-%d %a %H:%M]"))) 240 (org-back-to-heading t) 241 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker))) 242 (line (format "%s %s :: %s" label ts text))) 243 (org-back-to-heading t) 244 (if (re-search-forward 245 (format "^[ \t]*- %s \\[[^]]*\\] ::.*$" (regexp-quote label)) 246 subtree-end t) 247 ;; Replace an existing note of this purpose in place. Keep the 248 ;; note on one line, because the reader reads one line. 249 (replace-match (format "- %s" line) t t) 250 (rail-tools--drawer-insert line 'nofill)) 251 (set-marker subtree-end nil)))) 252 253 (defun rail-tools--closing-note-of (purpose) 254 "Return the text of the newest closing note of PURPOSE at point. 255 PURPOSE is `done', `blocked', or `cancelled'. Return nil when the 256 entry carries no such note. Point must be on the entry heading." 257 (let ((label (cdr (assq purpose rail-tools--closing-labels)))) 258 (org-back-to-heading t) 259 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point)))) 260 (org-back-to-heading t) 261 (when (re-search-forward 262 (format "^[ \t]*- %s \\[[^]]*\\] :: \\(.*\\)$" 263 (regexp-quote label)) 264 subtree-end t) 265 (string-trim (match-string-no-properties 1)))))) 266 267 (defmacro rail-tools--json (&rest body) 268 "Evaluate BODY and return its value as a JSON string. 269 Catch any error and return a JSON object with an `error' field." 270 (declare (indent 0)) 271 `(condition-case err 272 (json-encode (progn ,@body)) 273 (error (json-encode `((error . ,(error-message-string err))))))) 274 275 ;;; Tag vocabulary 276 277 ;; The vocabulary is not hardcoded. Each stream file declares it with 278 ;; `#+TAGS:' group-tag lines, for example: 279 ;; 280 ;; #+TAGS: [ Kind : feat fix chore ] 281 ;; #+TAGS: [ Scope : core web ] 282 ;; 283 ;; Org parses those lines into `org-current-tag-alist'. The functions below 284 ;; read that alist, so the vocabulary follows the file, not this code. A file 285 ;; with no `#+TAGS:' line accepts any tag. 286 287 (defun rail-tools--tag-axes () 288 "Return the tag vocabulary of the current buffer, grouped by axis. 289 Read the group tags that Org parsed from the `#+TAGS:' lines into 290 `org-current-tag-alist'. Return an alist that maps each axis symbol to 291 its list of tag strings. Return nil when the file declares no axis, and 292 then the file accepts any tag." 293 (let ((axes '()) (current nil)) 294 (dolist (entry org-current-tag-alist) 295 (pcase entry 296 (`(:startgrouptag) (setq current nil)) 297 (`(:endgrouptag) 298 (when current 299 (push (cons (intern (downcase (car current))) 300 (nreverse (cdr current))) 301 axes)) 302 (setq current nil)) 303 (`(:grouptags)) 304 (`(,(and tag (pred stringp)) . ,_) 305 (if current 306 (setcdr current (cons tag (cdr current))) 307 ;; The first tag in a group is the axis name. 308 (setq current (cons tag '())))))) 309 (nreverse axes))) 310 311 (defun rail-tools--all-tags () 312 "Return every tag the current buffer declares, as one flat list. 313 Return nil when the file declares no vocabulary." 314 (apply #'append (mapcar #'cdr (rail-tools--tag-axes)))) 315 316 (defun rail-tools--check-tags (tags) 317 "Signal an error when TAGS holds a tag outside the file vocabulary. 318 TAGS is a list of strings. When the file declares no vocabulary, accept 319 any tag. Return TAGS unchanged when valid." 320 (let ((allowed (rail-tools--all-tags))) 321 (when allowed 322 (dolist (tag tags) 323 (unless (member tag allowed) 324 (error "Unknown tag `%s'; allowed: %s" 325 tag (string-join allowed ", ")))))) 326 tags) 327 328 (defun rail-tools--goto-stream-top () 329 "Move point to the insertion place for a new item. 330 That place is the start of the first top-level heading, after the 331 file preamble. When no heading exists, move to the end of the 332 preamble." 333 (goto-char (point-min)) 334 (if (re-search-forward "^\\* " nil t) 335 (goto-char (line-beginning-position)) 336 (goto-char (point-max)))) 337 338 ;;; inspect (read-only) 339 340 (defun rail-tools--inspect-handler (args) 341 "Report the TODO sequence and the tag vocabulary for RAIL.org. 342 Read both from the stream file, so the report mirrors the file." 343 (rail-tools--json 344 (let ((file (rail-tools--file args))) 345 (with-current-buffer (rail-tools--buffer file) 346 (org-with-wide-buffer 347 `((file . ,file) 348 (todo_keywords . ,(vconcat org-todo-keywords-1)) 349 (tags . ,(mapcar (lambda (axis) 350 (cons (car axis) (vconcat (cdr axis)))) 351 (rail-tools--tag-axes))))))))) 352 353 (mcp-server-register-tool 354 (make-mcp-server-tool 355 :name "rail-inspect" 356 :title "RAIL Inspect" 357 :description "Inspect RAIL.org: return its TODO keyword sequence and the tag vocabulary that the file declares, grouped by axis. Read-only." 358 :input-schema '((type . "object") 359 (properties . ((root . ((type . "string") 360 (description . "Absolute path to the project directory containing RAIL.org"))))) 361 (required . [])) 362 :function #'rail-tools--inspect-handler 363 :annotations '((readOnlyHint . t) 364 (destructiveHint . :false) 365 (idempotentHint . t) 366 (openWorldHint . :false)))) 367 368 ;;; list (read-only) 369 370 (defun rail-tools--list-handler (args) 371 "List the top-level action items in RAIL.org, newest first. 372 ARGS keys: `root', `state' (optional), `tag' (optional). When STATE is 373 given, return only items with that TODO keyword. When TAG is given, 374 return only items that carry that tag. Each row has `id', `title', 375 `state', `scheduled', and `tags'." 376 (rail-tools--json 377 (let ((file (rail-tools--file args)) 378 (state (alist-get 'state args)) 379 (tag (alist-get 'tag args))) 380 (with-current-buffer (rail-tools--buffer file) 381 (org-with-wide-buffer 382 (goto-char (point-min)) 383 (let ((rows '())) 384 (while (re-search-forward "^\\* " nil t) 385 (let ((todo (org-get-todo-state)) 386 (tags (org-get-tags nil t))) 387 (when (and (or (null state) (equal state todo)) 388 (or (null tag) (member tag tags))) 389 (push `((id . ,(org-id-get)) 390 (title . ,(org-get-heading t t t t)) 391 (state . ,todo) 392 (scheduled . ,(org-entry-get nil "SCHEDULED")) 393 (tags . ,(vconcat tags))) 394 rows)))) 395 ;; The file is newest-first, so reverse to keep that order. 396 (vconcat (nreverse rows)))))))) 397 398 (mcp-server-register-tool 399 (make-mcp-server-tool 400 :name "rail-list" 401 :title "RAIL List" 402 :description "List the top-level action items in RAIL.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." 403 :input-schema '((type . "object") 404 (properties . ((root . ((type . "string") 405 (description . "Absolute path to the project directory"))) 406 (state . ((type . "string") 407 (description . "Optional TODO keyword filter, for example TODO or IN-PROGRESS"))) 408 (tag . ((type . "string") 409 (description . "Optional tag filter, for example web or major"))))) 410 (required . [])) 411 :function #'rail-tools--list-handler 412 :annotations '((readOnlyHint . t) 413 (destructiveHint . :false) 414 (idempotentHint . t) 415 (openWorldHint . :false)))) 416 417 ;;; capture 418 419 (defun rail-tools--capture-handler (args) 420 "Capture a TODO entry at the top of the RAIL.org stream. 421 ARGS keys: `root', `title', `body' (optional), `tags' (optional array). 422 Insert the entry as a top-level heading directly below the file 423 preamble, so the newest item is first. Record the capture time as an 424 inactive SCHEDULED timestamp, apply TAGS from the file vocabulary, 425 assign an Org ID, and wrap the body to 72 columns." 426 (rail-tools--json 427 (let* ((file (rail-tools--file args)) 428 (title (or (alist-get 'title args) (error "Missing `title'"))) 429 (body (or (alist-get 'body args) "")) 430 (raw-tags (append (alist-get 'tags args) nil)) 431 (captured-at (format-time-string "[%Y-%m-%d %a %H:%M]"))) 432 (with-current-buffer (rail-tools--buffer file) 433 (org-with-wide-buffer 434 ;; Validate inside the buffer, because the vocabulary lives here. 435 (let ((tags (rail-tools--check-tags raw-tags))) 436 (rail-tools--goto-stream-top) 437 (let ((start (point))) 438 (insert (format "* TODO %s\nSCHEDULED: %s\n" title captured-at)) 439 (unless (string-empty-p body) 440 (insert body "\n")) 441 (goto-char start) 442 (when tags 443 (org-set-tags tags)) 444 (let ((id (org-id-get-create))) 445 (rail-tools--fill-body) 446 (when (buffer-modified-p) (save-buffer)) 447 (goto-char (org-id-find id 'marker)) 448 `((id . ,id) 449 (file . ,file) 450 (heading . ,(org-get-heading t t t t)) 451 (tags . ,(vconcat (org-get-tags nil t)))))))))))) 452 453 (mcp-server-register-tool 454 (make-mcp-server-tool 455 :name "rail-capture" 456 :title "RAIL Capture" 457 :description "Capture a TODO action item as a top-level heading at the top of RAIL.org, so the newest item comes first. Applies tags that the file vocabulary permits, records the capture time as an inactive SCHEDULED timestamp, wraps the body to 72 columns, and assigns an Org ID." 458 :input-schema '((type . "object") 459 (properties . ((root . ((type . "string") 460 (description . "Absolute path to the project directory"))) 461 (title . ((type . "string") 462 (description . "Imperative title under 60 chars"))) 463 (body . ((type . "string") 464 (description . "Full request text, verbatim"))) 465 (tags . ((type . "array") 466 (items . ((type . "string"))) 467 (description . "Tags from the vocabulary that the file declares in its #+TAGS: lines. Run rail-inspect to read the axes and their allowed tags."))))) 468 (required . ["title"])) 469 :function #'rail-tools--capture-handler 470 :annotations '((readOnlyHint . :false) 471 (destructiveHint . :false) 472 (idempotentHint . :false) 473 (openWorldHint . :false)))) 474 475 ;;; set-status 476 477 (defun rail-tools--set-status-handler (args) 478 "Change the TODO keyword of an entry. 479 ARGS keys: `root', `id', `state'. STATE must be one keyword from the 480 file's own #+TODO sequence, and must not be DONE (use rail-complete)." 481 (rail-tools--json 482 (let ((file (rail-tools--file args)) 483 (id (or (alist-get 'id args) (error "Missing `id'"))) 484 (state (or (alist-get 'state args) (error "Missing `state'")))) 485 (when (string-equal state "DONE") 486 (error "Use rail-complete for DONE, not rail-set-status")) 487 (with-current-buffer (rail-tools--buffer file) 488 (rail-tools--goto-id id) 489 (org-todo state) 490 (when (buffer-modified-p) (save-buffer)) 491 `((id . ,id) 492 (state . ,(org-get-todo-state))))))) 493 494 (mcp-server-register-tool 495 (make-mcp-server-tool 496 :name "rail-set-status" 497 :title "RAIL Set Status" 498 :description "Set the TODO keyword of a RAIL entry to any open keyword from the file's own #+TODO sequence. Does not accept DONE; use rail-complete for that." 499 :input-schema '((type . "object") 500 (properties . ((root . ((type . "string"))) 501 (id . ((type . "string") 502 (description . "Org ID of the entry"))) 503 (state . ((type . "string") 504 (description . "TODO keyword from the file's #+TODO sequence"))))) 505 (required . ["id" "state"])) 506 :function #'rail-tools--set-status-handler 507 :annotations '((readOnlyHint . :false) 508 (destructiveHint . :false) 509 (idempotentHint . t) 510 (openWorldHint . :false)))) 511 512 ;;; log 513 514 (defun rail-tools--log-handler (args) 515 "Append a timestamped note to an entry's `:LOGBOOK:' drawer. 516 ARGS keys: `root', `id', `note'. Append-only progress feedback from an 517 agentic session. Never edits an existing note or the item body." 518 (rail-tools--json 519 (let ((file (rail-tools--file args)) 520 (id (or (alist-get 'id args) (error "Missing `id'"))) 521 (note (or (alist-get 'note args) (error "Missing `note'")))) 522 (with-current-buffer (rail-tools--buffer file) 523 (rail-tools--goto-id id) 524 (rail-tools--append-log note) 525 (when (buffer-modified-p) (save-buffer)) 526 `((id . ,id) 527 (state . ,(org-get-todo-state))))))) 528 529 (mcp-server-register-tool 530 (make-mcp-server-tool 531 :name "rail-log" 532 :title "RAIL Log" 533 :description "Append a timestamped progress note to a RAIL entry's `:LOGBOOK:' drawer. The drawer is append-only. The tool never rewrites an earlier note, and never rewrites the item body. Newest note first, wrapped to 72 columns." 534 :input-schema '((type . "object") 535 (properties . ((root . ((type . "string"))) 536 (id . ((type . "string") 537 (description . "Org ID of the entry"))) 538 (note . ((type . "string") 539 (description . "Progress note to append"))))) 540 (required . ["id" "note"])) 541 :function #'rail-tools--log-handler 542 :annotations '((readOnlyHint . :false) 543 (destructiveHint . :false) 544 (idempotentHint . :false) 545 (openWorldHint . :false)))) 546 547 ;;; set-result 548 549 (defun rail-tools--set-result-handler (args) 550 "Write the DONE closing note for an entry without changing its state. 551 ARGS keys: `root', `id', `commit', `tests', `model' (optional), 552 `notes' (optional). COMMIT is a commit hash. TESTS is a short recap 553 such as \"215 pass\". Compose the note text and write it as a 554 `CLOSING NOTE' item in the `:LOGBOOK:' drawer, replacing an earlier 555 one. Use this to pre-stage the closing evidence before rail-complete." 556 (rail-tools--json 557 (let ((file (rail-tools--file args)) 558 (id (or (alist-get 'id args) (error "Missing `id'"))) 559 (commit (or (alist-get 'commit args) (error "Missing `commit'"))) 560 (tests (or (alist-get 'tests args) (error "Missing `tests'"))) 561 (model (alist-get 'model args)) 562 (notes (alist-get 'notes args))) 563 (with-current-buffer (rail-tools--buffer file) 564 (rail-tools--goto-id id) 565 (rail-tools--append-closing-note 566 'done (rail-tools--closing-note-text commit tests model notes)) 567 (when (buffer-modified-p) (save-buffer)) 568 (rail-tools--goto-id id) 569 `((id . ,id) 570 (result . ,(rail-tools--result-text))))))) 571 572 (mcp-server-register-tool 573 (make-mcp-server-tool 574 :name "rail-set-result" 575 :title "RAIL Set Result" 576 :description "Write the DONE closing note for a RAIL entry into the :LOGBOOK: drawer, recording the commit hash, a short test recap, and optionally the model that did the work and a free-text note. Replaces an earlier closing note. Use it to pre-stage the closing evidence; rail-complete writes the same note when it closes the item." 577 :input-schema '((type . "object") 578 (properties . ((root . ((type . "string"))) 579 (id . ((type . "string") 580 (description . "Org ID of the entry"))) 581 (commit . ((type . "string") 582 (description . "Commit hash"))) 583 (tests . ((type . "string") 584 (description . "Short test recap, for example \"215 pass\""))) 585 (model . ((type . "string") 586 (description . "Optional model or agent that did the work, for example the agent name"))) 587 (notes . ((type . "string") 588 (description . "Optional free-text tail appended after a semicolon, for example a root cause"))))) 589 (required . ["id" "commit" "tests"])) 590 :function #'rail-tools--set-result-handler 591 :annotations '((readOnlyHint . :false) 592 (destructiveHint . :false) 593 (idempotentHint . t) 594 (openWorldHint . :false)))) 595 596 ;;; check (checklist for sub-tasks) 597 598 (defconst rail-tools--checklist-header "Checklist [/]:" 599 "Header line that introduces an item's checkbox list. 600 The `[/]' cookie tracks completed items against the total.") 601 602 (defun rail-tools--checklist-add (item) 603 "Add ITEM as an unchecked checkbox to the entry at point. 604 Create the checklist block when it does not exist. Wrap ITEM to 72 605 columns and refresh the `[/]' cookie. Point must be on the heading." 606 (let ((fill-column 72)) 607 (org-back-to-heading t) 608 (let* ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker))) 609 (line (format "- [ ] %s\n" item)) 610 insert-at) 611 (org-back-to-heading t) 612 (if (re-search-forward "^Checklist \\[[0-9]*/[0-9]*\\]:[ \t]*$" 613 subtree-end t) 614 ;; Existing block: step past the trailing checkbox items. 615 (progn (forward-line 1) 616 (while (looking-at-p "^- \\[.\\] \\|^ ") (forward-line 1)) 617 (setq insert-at (point)) 618 (insert line)) 619 ;; No block: append one at the end of the body. 620 (goto-char subtree-end) 621 (skip-chars-backward "\n") 622 (insert "\n\n" rail-tools--checklist-header "\n") 623 (setq insert-at (point)) 624 (insert line)) 625 (save-excursion (goto-char insert-at) (org-fill-paragraph)) 626 (org-update-checkbox-count) 627 (set-marker subtree-end nil)))) 628 629 (defun rail-tools--checklist-toggle (item) 630 "Toggle the checkbox whose text matches ITEM in the entry at point. 631 Signal an error when no item matches. Refresh the `[/]' cookie. 632 Point must be on the heading." 633 (org-back-to-heading t) 634 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))) 635 (org-back-to-heading t) 636 (if (re-search-forward (concat "^- \\[.\\] " (regexp-quote item)) 637 subtree-end t) 638 (progn (beginning-of-line) (org-toggle-checkbox) 639 (org-update-checkbox-count)) 640 (set-marker subtree-end nil) 641 (error "No checklist item matches: %s" item)) 642 (set-marker subtree-end nil))) 643 644 (defun rail-tools--checklist-items () 645 "Return the checklist items of the entry at point. 646 Each item is an alist with `done' and `text'. Point must be on the 647 heading." 648 (org-back-to-heading t) 649 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point))) 650 (items '())) 651 (org-back-to-heading t) 652 (while (re-search-forward "^- \\[\\(.\\)\\] \\(.*\\)$" subtree-end t) 653 (push `((done . ,(if (string-equal (match-string 1) " ") :json-false t)) 654 (text . ,(string-trim (match-string-no-properties 2)))) 655 items)) 656 (vconcat (nreverse items)))) 657 658 (defun rail-tools--check-handler (args) 659 "Manage the checklist of an item, for splitting a complex task. 660 ARGS keys: `root', `id', `action' (add|toggle|list), `item'. 661 `add' appends an unchecked item. `toggle' flips a matching item. 662 `list' returns the items. A `[/]' cookie tracks progress." 663 (rail-tools--json 664 (let ((file (rail-tools--file args)) 665 (id (or (alist-get 'id args) (error "Missing `id'"))) 666 (action (or (alist-get 'action args) (error "Missing `action'"))) 667 (item (alist-get 'item args))) 668 (with-current-buffer (rail-tools--buffer file) 669 (rail-tools--goto-id id) 670 (cond 671 ((string-equal action "add") 672 (unless item (error "`add' needs an `item'")) 673 (rail-tools--checklist-add item)) 674 ((string-equal action "toggle") 675 (unless item (error "`toggle' needs an `item'")) 676 (rail-tools--checklist-toggle item)) 677 ((string-equal action "list") nil) 678 (t (error "Unknown action `%s'; use add, toggle, or list" action))) 679 (when (buffer-modified-p) (save-buffer)) 680 (rail-tools--goto-id id) 681 `((id . ,id) 682 (items . ,(rail-tools--checklist-items))))))) 683 684 (mcp-server-register-tool 685 (make-mcp-server-tool 686 :name "rail-check" 687 :title "RAIL Checklist" 688 :description "Manage an item'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. The items stay inside the one request. They are not separate stream entries." 689 :input-schema '((type . "object") 690 (properties . ((root . ((type . "string"))) 691 (id . ((type . "string") 692 (description . "Org ID of the item"))) 693 (action . ((type . "string") 694 (description . "add, toggle, or list"))) 695 (item . ((type . "string") 696 (description . "Item text for add or toggle"))))) 697 (required . ["id" "action"])) 698 :function #'rail-tools--check-handler 699 :annotations '((readOnlyHint . :false) 700 (destructiveHint . :false) 701 (idempotentHint . :false) 702 (openWorldHint . :false)))) 703 704 ;;; show (read-only) 705 706 (defun rail-tools--body-text () 707 "Return the plain body text of the entry at point. 708 Read from the first line after the metadata up to the first of: a 709 `Checklist [' line or the end of the subtree. The closing note lives 710 in the `:LOGBOOK:' drawer, not the body, so it never appears here. 711 Return the trimmed string. Point must be on the entry heading." 712 (org-back-to-heading t) 713 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point)))) 714 (org-back-to-heading t) 715 (org-end-of-meta-data t) 716 (let ((body-start (point)) 717 (body-end subtree-end)) 718 (save-excursion 719 (goto-char body-start) 720 (when (re-search-forward "^Checklist \\[" subtree-end t) 721 (setq body-end (line-beginning-position)))) 722 (string-trim 723 (buffer-substring-no-properties body-start body-end))))) 724 725 (defun rail-tools--logbook-items () 726 "Return the `:LOGBOOK:' drawer item lines of the entry at point. 727 Each item is a string, in the order stored (newest first). Return an 728 empty vector when there is no drawer. Point must be on the heading." 729 (org-back-to-heading t) 730 (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point))) 731 (items '())) 732 (org-back-to-heading t) 733 (when (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t) 734 (forward-line 1) 735 (while (and (< (point) subtree-end) 736 (not (looking-at-p "^[ \t]*:END:[ \t]*$"))) 737 (when (looking-at "^[ \t]*- \\(.*\\)$") 738 (push (string-trim (match-string-no-properties 1)) items)) 739 (forward-line 1))) 740 (vconcat (nreverse items)))) 741 742 (defun rail-tools--result-text () 743 "Return the text of the entry's DONE closing note. 744 Read the newest `CLOSING NOTE' item from the `:LOGBOOK:' drawer. 745 Return nil when there is no such note, so it encodes as JSON null. 746 Point must be on the heading." 747 (rail-tools--closing-note-of 'done)) 748 749 (defun rail-tools--show-handler (args) 750 "Return the full content of an entry. 751 ARGS keys: `root', `id'. Report the heading, state, tags, scheduled 752 and closed timestamps, body text, logbook notes, checklist items, and 753 the DONE closing note. Read-only." 754 (rail-tools--json 755 (let ((file (rail-tools--file args)) 756 (id (or (alist-get 'id args) (error "Missing `id'")))) 757 (with-current-buffer (rail-tools--buffer file) 758 (org-with-wide-buffer 759 (rail-tools--goto-id id) 760 `((id . ,id) 761 (heading . ,(org-get-heading t t t t)) 762 (state . ,(org-get-todo-state)) 763 (tags . ,(vconcat (org-get-tags nil t))) 764 (scheduled . ,(org-entry-get nil "SCHEDULED")) 765 (closed . ,(org-entry-get nil "CLOSED")) 766 (body . ,(rail-tools--body-text)) 767 (logbook . ,(rail-tools--logbook-items)) 768 (checklist . ,(rail-tools--checklist-items)) 769 (result . ,(rail-tools--result-text)))))))) 770 771 (mcp-server-register-tool 772 (make-mcp-server-tool 773 :name "rail-show" 774 :title "RAIL Show" 775 :description "Return the full content of a RAIL entry: heading, state, tags, scheduled and closed timestamps, body text, logbook notes, checklist items, and the DONE closing note. Read-only." 776 :input-schema '((type . "object") 777 (properties . ((root . ((type . "string"))) 778 (id . ((type . "string") 779 (description . "Org ID of the entry"))))) 780 (required . ["id"])) 781 :function #'rail-tools--show-handler 782 :annotations '((readOnlyHint . t) 783 (destructiveHint . :false) 784 (idempotentHint . t) 785 (openWorldHint . :false)))) 786 787 ;;; retag 788 789 (defun rail-tools--retag-handler (args) 790 "Replace the tags on an entry with a validated set. 791 ARGS keys: `root', `id', `tags' (array). Validate TAGS against the 792 file vocabulary, then set them, keeping the file's default tag 793 alignment." 794 (rail-tools--json 795 (let ((file (rail-tools--file args)) 796 (id (or (alist-get 'id args) (error "Missing `id'"))) 797 (raw-tags (append (alist-get 'tags args) nil))) 798 (with-current-buffer (rail-tools--buffer file) 799 (let ((tags (rail-tools--check-tags raw-tags))) 800 (rail-tools--goto-id id) 801 (org-set-tags tags) 802 (when (buffer-modified-p) (save-buffer)) 803 `((id . ,id) 804 (tags . ,(vconcat (org-get-tags nil t))))))))) 805 806 (mcp-server-register-tool 807 (make-mcp-server-tool 808 :name "rail-retag" 809 :title "RAIL Retag" 810 :description "Replace the tags on a RAIL entry with a validated set from the file vocabulary. Use this tool to re-tag an entry as its shape changes. The tool keeps the file's default tag alignment." 811 :input-schema '((type . "object") 812 (properties . ((root . ((type . "string"))) 813 (id . ((type . "string") 814 (description . "Org ID of the entry"))) 815 (tags . ((type . "array") 816 (items . ((type . "string"))) 817 (description . "Tags from the file vocabulary"))))) 818 (required . ["id" "tags"])) 819 :function #'rail-tools--retag-handler 820 :annotations '((readOnlyHint . :false) 821 (destructiveHint . :false) 822 (idempotentHint . :false) 823 (openWorldHint . :false)))) 824 825 ;;; cancel and block 826 827 (defun rail-tools--transition-with-reason (id keyword purpose reason) 828 "Transition entry ID to KEYWORD and record REASON as a closing note. 829 Signal an error when REASON is missing or blank. Set the TODO keyword 830 first, so the state timestamp lands, then write REASON as a PURPOSE 831 closing note in the `:LOGBOOK:' drawer. PURPOSE is `blocked' or 832 `cancelled'. The closing note replaces the old `- PURPOSE ::' body 833 line, so the decision is never silent." 834 (when (or (null reason) (string-empty-p (string-trim reason))) 835 (error "A reason is required")) 836 (rail-tools--goto-id id) 837 (org-todo keyword) 838 (rail-tools--goto-id id) 839 (rail-tools--append-closing-note purpose (string-trim reason)) 840 (when (buffer-modified-p) (save-buffer))) 841 842 (defun rail-tools--cancel-handler (args) 843 "Set an entry to CANCELLED with a required reason. 844 ARGS keys: `root', `id', `reason'. Record REASON as a `CANCELLED NOTE' 845 closing note in the `:LOGBOOK:' drawer, so the decision is never 846 silent." 847 (rail-tools--json 848 (let ((file (rail-tools--file args)) 849 (id (or (alist-get 'id args) (error "Missing `id'"))) 850 (reason (alist-get 'reason args))) 851 (with-current-buffer (rail-tools--buffer file) 852 (rail-tools--transition-with-reason id "CANCELLED" 'cancelled reason) 853 (rail-tools--goto-id id) 854 `((id . ,id) 855 (state . ,(org-get-todo-state))))))) 856 857 (mcp-server-register-tool 858 (make-mcp-server-tool 859 :name "rail-cancel" 860 :title "RAIL Cancel" 861 :description "Set a RAIL entry to CANCELLED and record a required reason as a CANCELLED NOTE closing note in the :LOGBOOK: drawer, so the decision is never silent." 862 :input-schema '((type . "object") 863 (properties . ((root . ((type . "string"))) 864 (id . ((type . "string") 865 (description . "Org ID of the entry"))) 866 (reason . ((type . "string") 867 (description . "Reason for cancelling the entry"))))) 868 (required . ["id" "reason"])) 869 :function #'rail-tools--cancel-handler 870 :annotations '((readOnlyHint . :false) 871 (destructiveHint . :false) 872 (idempotentHint . :false) 873 (openWorldHint . :false)))) 874 875 (defun rail-tools--block-handler (args) 876 "Set an entry to BLOCKED with a required reason. 877 ARGS keys: `root', `id', `reason'. Record REASON as a `BLOCKED NOTE' 878 closing note in the `:LOGBOOK:' drawer, so the blocker is never 879 silent." 880 (rail-tools--json 881 (let ((file (rail-tools--file args)) 882 (id (or (alist-get 'id args) (error "Missing `id'"))) 883 (reason (alist-get 'reason args))) 884 (with-current-buffer (rail-tools--buffer file) 885 (rail-tools--transition-with-reason id "BLOCKED" 'blocked reason) 886 (rail-tools--goto-id id) 887 `((id . ,id) 888 (state . ,(org-get-todo-state))))))) 889 890 (mcp-server-register-tool 891 (make-mcp-server-tool 892 :name "rail-block" 893 :title "RAIL Block" 894 :description "Set a RAIL entry to BLOCKED and record a required reason as a BLOCKED NOTE closing note in the :LOGBOOK: drawer, so the blocker is never silent." 895 :input-schema '((type . "object") 896 (properties . ((root . ((type . "string"))) 897 (id . ((type . "string") 898 (description . "Org ID of the entry"))) 899 (reason . ((type . "string") 900 (description . "Reason for blocking the entry"))))) 901 (required . ["id" "reason"])) 902 :function #'rail-tools--block-handler 903 :annotations '((readOnlyHint . :false) 904 (destructiveHint . :false) 905 (idempotentHint . :false) 906 (openWorldHint . :false)))) 907 908 ;;; complete 909 910 (defun rail-tools--complete-handler (args) 911 "Set an entry to DONE with its closing note and confirm CLOSED. 912 ARGS keys: `root', `id', `commit', `tests', `model' (optional), 913 `notes' (optional). Transition to DONE, then write the closing note 914 into the `:LOGBOOK:' drawer next to the CLOSED timestamp. Requires 915 `org-log-done' to be `time' so the normal Org transition inserts 916 CLOSED; this handler never writes CLOSED." 917 (rail-tools--json 918 (let ((file (rail-tools--file args)) 919 (id (or (alist-get 'id args) (error "Missing `id'"))) 920 (commit (or (alist-get 'commit args) (error "Missing `commit'"))) 921 (tests (or (alist-get 'tests args) (error "Missing `tests'"))) 922 (model (alist-get 'model args)) 923 (notes (alist-get 'notes args))) 924 (with-current-buffer (rail-tools--buffer file) 925 (hack-local-variables) 926 (unless (eq org-log-done 'time) 927 (error "org-log-done is not set to time")) 928 (rail-tools--goto-id id) 929 (org-todo "DONE") 930 (rail-tools--goto-id id) 931 (rail-tools--append-closing-note 932 'done (rail-tools--closing-note-text commit tests model notes)) 933 (when (buffer-modified-p) (save-buffer)) 934 (let ((closed (org-entry-get nil "CLOSED"))) 935 (unless closed 936 (error "Org did not record a CLOSED timestamp")) 937 `((id . ,id) 938 (state . ,(org-get-todo-state)) 939 (result . ,(rail-tools--result-text)) 940 (closed . ,closed))))))) 941 942 (mcp-server-register-tool 943 (make-mcp-server-tool 944 :name "rail-complete" 945 :title "RAIL Complete" 946 :description "Set a RAIL entry to DONE. The tool writes the closing note as a CLOSING NOTE item in the :LOGBOOK: drawer. The note holds the commit hash, a short test recap, and optionally the agent that did the work and a free-text note. The tool then confirms that Org inserted a CLOSED timestamp. The file must set org-log-done to time. The tool never writes the timestamp itself. The entry stays in place, and there is no refile step." 947 :input-schema '((type . "object") 948 (properties . ((root . ((type . "string"))) 949 (id . ((type . "string"))) 950 (commit . ((type . "string") 951 (description . "Commit hash for the completed work"))) 952 (tests . ((type . "string") 953 (description . "Short test recap, for example \"215 pass\""))) 954 (model . ((type . "string") 955 (description . "Optional model or agent that did the work, for example the agent name"))) 956 (notes . ((type . "string") 957 (description . "Optional free-text tail appended after a semicolon, for example a root cause"))))) 958 (required . ["id" "commit" "tests"])) 959 :function #'rail-tools--complete-handler 960 :annotations '((readOnlyHint . :false) 961 (destructiveHint . :false) 962 (idempotentHint . t) 963 (openWorldHint . :false)))) 964 965 ;;; verify (read-only) 966 967 (defun rail-tools--verify-handler (args) 968 "Return the current state of the entry with `id'. 969 ARGS keys: `root', `id'. Read-only." 970 (rail-tools--json 971 (let ((file (rail-tools--file args)) 972 (id (or (alist-get 'id args) (error "Missing `id'")))) 973 (with-current-buffer (rail-tools--buffer file) 974 (org-with-wide-buffer 975 (rail-tools--goto-id id) 976 `((id . ,id) 977 (heading . ,(org-get-heading t t t t)) 978 (state . ,(org-get-todo-state)) 979 (closed . ,(org-entry-get nil "CLOSED")) 980 (tags . ,(vconcat (org-get-tags nil t))))))))) 981 982 (mcp-server-register-tool 983 (make-mcp-server-tool 984 :name "rail-verify" 985 :title "RAIL Verify" 986 :description "Return the heading, TODO state, CLOSED timestamp, and tags of a RAIL entry. Read-only." 987 :input-schema '((type . "object") 988 (properties . ((root . ((type . "string"))) 989 (id . ((type . "string"))))) 990 (required . ["id"])) 991 :function #'rail-tools--verify-handler 992 :annotations '((readOnlyHint . t) 993 (destructiveHint . :false) 994 (idempotentHint . t) 995 (openWorldHint . :false)))) 996 997 (provide 'rail-tools) 998 999 ;;; rail-tools.el ends here 1000