Skip to content

Commit db14672

Browse files
cxxxrclaude
cxxxr
and
claude
authored
feat(mcp-server): add editor screen state and key input tools (#2094)
* feat(mcp-server): add editor screen state and key input tools Add two new MCP tools for AI agent interaction: - editor_get_screen: Returns complete visual state including windows, cursor positions, visible content with attributes, overlays, and prompt window state - editor_send_keys: Sends key sequences using Emacs notation (e.g., "C-x C-s", "M-x") Co-Authored-By: Claude Opus 4.5 <[email protected]> * test(mcp-server): add tests for editor_get_screen and editor_send_keys Add comprehensive test suite for the new MCP tools: - editor_get_screen: 7 tests covering display info, windows, cursor, visible content, and prompt state - editor_send_keys: 6 tests covering key parsing, error handling, modifier keys, and special keys - Integration tests: 2 tests for tool registration and buffer changes Co-Authored-By: Claude Opus 4.5 <[email protected]> * docs(mcp-server): document internal symbol usage Add documentation explaining why internal lem-core symbols are used in the display and input handlers, as required by internal_symbol_rule. The internal symbols are necessary for complete screen state capture and key input parsing, as these low-level APIs are not exported. Co-Authored-By: Claude Opus 4.5 <[email protected]> --------- Co-authored-by: Claude Opus 4.5 <[email protected]>
1 parent a3da8ab commit db14672

File tree

6 files changed

+677
-3
lines changed

6 files changed

+677
-3
lines changed

‎extensions/mcp-server/handlers/display.lisp‎

Lines changed: 235 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,235 @@
1+
(in-package :lem-mcp-server)
2+
3+
;;; Display/Screen Operation Tools
4+
;;;
5+
;;; Note on internal symbol usage:
6+
;;; This module requires access to internal lem-core symbols for complete
7+
;;; screen state capture. These are not exported because they are low-level
8+
;;; implementation details, but are necessary for AI agent integration:
9+
;;; - lem-core::get-string-and-attributes-at-point: Get line content with
10+
;;; syntax highlighting attributes (needed for accurate visual representation)
11+
;;; - lem-core::buffer-overlays: Access buffer overlay list
12+
;;; - lem-core::overlay-temporary-p: Check overlay lifetime
13+
;;; - lem-core::cursor-overlay, line-overlay, line-endings-overlay: Overlay types
14+
;;; Consider exporting these or creating a public API for editor introspection.
15+
16+
;;; Helper functions
17+
18+
(defun window-id (window)
19+
"Generate a unique ID for a window."
20+
(format nil "window-~A" (sxhash window)))
21+
22+
(defun get-write-state (buffer)
23+
"Get the write state of a buffer."
24+
(cond ((buffer-read-only-p buffer) "readonly")
25+
((buffer-modified-p buffer) "modified")
26+
(t "unmodified")))
27+
28+
(defun get-scroll-percent (window)
29+
"Get the scroll position as a percentage string."
30+
(let* ((buffer (window-buffer window))
31+
(total-lines (buffer-nlines buffer))
32+
(view-point (window-view-point window))
33+
(top-line (line-number-at-point view-point))
34+
(height (window-height window)))
35+
(cond ((<= total-lines height) "All")
36+
((= top-line 1) "Top")
37+
((>= (+ top-line height) total-lines) "Bot")
38+
(t (format nil "~D%" (round (* 100 (/ (1- top-line) (max 1 (- total-lines height))))))))))
39+
40+
(defun get-region-info (window)
41+
"Get selection/region information for a window."
42+
(let* ((buffer (window-buffer window))
43+
(mark (buffer-mark buffer)))
44+
(if (and mark (mark-active-p buffer))
45+
(let ((point (buffer-point buffer)))
46+
`(("active" . t)
47+
("start" . (("line" . ,(line-number-at-point mark))
48+
("column" . ,(point-charpos mark))))
49+
("end" . (("line" . ,(line-number-at-point point))
50+
("column" . ,(point-charpos point))))))
51+
`(("active" . :false)))))
52+
53+
(defun color-to-string (color)
54+
"Convert a color to a string representation."
55+
(typecase color
56+
(null :null)
57+
(string color)
58+
(t (format nil "~A" color))))
59+
60+
(defun attribute-to-json (attr)
61+
"Convert a Lem attribute to JSON-serializable form."
62+
(if attr
63+
`(("foreground" . ,(color-to-string (attribute-foreground attr)))
64+
("background" . ,(color-to-string (attribute-background attr)))
65+
("bold" . ,(if (attribute-bold attr) t :false))
66+
("underline" . ,(if (attribute-underline attr) t :false))
67+
("reverse" . ,(if (attribute-reverse attr) t :false)))
68+
`(("foreground" . :null)
69+
("background" . :null)
70+
("bold" . :false)
71+
("underline" . :false)
72+
("reverse" . :false))))
73+
74+
(defun get-line-attributes (point)
75+
"Get attributes for a line at point. Returns list of (start end attribute) tuples."
76+
(handler-case
77+
(let ((attrs (lem-core::get-string-and-attributes-at-point point)))
78+
(cdr attrs))
79+
(error () nil)))
80+
81+
(defun get-visible-lines (window)
82+
"Get visible lines with their content and attributes."
83+
(let ((result '()))
84+
(with-point ((point (window-view-point window)))
85+
(loop :for y :from 0 :below (window-height window)
86+
:while (not (end-buffer-p point))
87+
:do (let ((line-num (line-number-at-point point))
88+
(text (line-string point))
89+
(attrs (get-line-attributes point)))
90+
(push `(("line_number" . ,line-num)
91+
("text" . ,text)
92+
("wrapped" . :false)
93+
("attributes" . ,(if attrs
94+
(mapcar (lambda (attr-spec)
95+
(destructuring-bind (start end attr &rest rest) attr-spec
96+
(declare (ignore rest))
97+
`(("start" . ,start)
98+
("end" . ,end)
99+
("style" . ,(attribute-to-json attr)))))
100+
attrs)
101+
())))
102+
result))
103+
(unless (line-offset point 1)
104+
(return))))
105+
(nreverse result)))
106+
107+
(defun get-modeline-info (window)
108+
"Get modeline information for a window."
109+
(when (window-use-modeline-p window)
110+
(let ((buffer (window-buffer window)))
111+
`(("buffer_name" . ,(buffer-name buffer))
112+
("write_state" . ,(get-write-state buffer))
113+
("major_mode" . ,(mode-name (buffer-major-mode buffer)))
114+
("minor_modes" . ,(mapcar (lambda (mode) (mode-name mode))
115+
(buffer-minor-modes buffer)))
116+
("position" . ,(format nil "~D:~D"
117+
(line-number-at-point (buffer-point buffer))
118+
(point-charpos (buffer-point buffer))))
119+
("scroll" . ,(get-scroll-percent window))))))
120+
121+
(defun get-window-info (window)
122+
"Get comprehensive information about a window."
123+
(let* ((buffer (window-buffer window))
124+
(point (buffer-point buffer))
125+
(is-current (eq window (current-window))))
126+
`(("id" . ,(window-id window))
127+
("type" . ,(cond ((floating-window-p window) "floating")
128+
((header-window-p window) "header")
129+
(t "normal")))
130+
("active" . ,(if is-current t :false))
131+
("position" . (("x" . ,(window-x window))
132+
("y" . ,(window-y window))))
133+
("size" . (("width" . ,(window-width window))
134+
("height" . ,(window-height window))))
135+
("buffer" . (("name" . ,(buffer-name buffer))
136+
("filename" . ,(or (buffer-filename buffer) :null))
137+
("modified" . ,(if (buffer-modified-p buffer) t :false))
138+
("readonly" . ,(if (buffer-read-only-p buffer) t :false))))
139+
("cursor" . (("line" . ,(line-number-at-point point))
140+
("column" . ,(point-charpos point))
141+
("screen_x" . ,(window-cursor-x window))
142+
("screen_y" . ,(window-cursor-y window))))
143+
("region" . ,(get-region-info window))
144+
("view" . (("top_line" . ,(line-number-at-point (window-view-point window)))
145+
("visible_lines" . ,(window-height window))
146+
("scroll_percent" . ,(get-scroll-percent window))))
147+
("visible_content" . ,(get-visible-lines window))
148+
("modeline" . ,(or (get-modeline-info window) :null)))))
149+
150+
(defun get-prompt-window-info ()
151+
"Get prompt window (minibuffer equivalent) state."
152+
(let ((prompt-window (active-prompt-window)))
153+
(if prompt-window
154+
(let ((buffer (window-buffer prompt-window)))
155+
`(("active" . ,(if (eq prompt-window (current-window)) t :false))
156+
("prompt" . :null)
157+
("input" . ,(buffer-text buffer))
158+
("message" . :null)))
159+
`(("active" . :false)
160+
("prompt" . :null)
161+
("input" . "")
162+
("message" . :null)))))
163+
164+
(defun get-overlay-type (overlay)
165+
"Determine the type of an overlay."
166+
(typecase overlay
167+
(lem-core::cursor-overlay "cursor")
168+
(lem-core::line-overlay "line")
169+
(lem-core::line-endings-overlay "line-endings")
170+
(t "highlight")))
171+
172+
(defun get-overlay-info (overlay)
173+
"Get information about a single overlay."
174+
(let ((start (overlay-start overlay))
175+
(end (overlay-end overlay)))
176+
`(("buffer" . ,(buffer-name (overlay-buffer overlay)))
177+
("type" . ,(get-overlay-type overlay))
178+
("start" . (("line" . ,(line-number-at-point start))
179+
("column" . ,(point-charpos start))))
180+
("end" . (("line" . ,(line-number-at-point end))
181+
("column" . ,(point-charpos end))))
182+
("attribute" . ,(attribute-to-json (overlay-attribute overlay)))
183+
("temporary" . ,(if (lem-core::overlay-temporary-p overlay) t :false)))))
184+
185+
(defun get-all-overlays ()
186+
"Get all overlays from all buffers."
187+
(let ((result '()))
188+
(dolist (buffer (buffer-list))
189+
(dolist (overlay (lem-core::buffer-overlays buffer))
190+
(push (get-overlay-info overlay) result)))
191+
(nreverse result)))
192+
193+
(defun get-header-windows-info ()
194+
"Get information about header windows."
195+
(let ((result '()))
196+
(dolist (window (frame-header-windows (current-frame)))
197+
(push `(("id" . ,(window-id window))
198+
("position" . (("x" . ,(window-x window))
199+
("y" . ,(window-y window))))
200+
("size" . (("width" . ,(window-width window))
201+
("height" . ,(window-height window))))
202+
("content" . ,(buffer-text (window-buffer window))))
203+
result))
204+
(nreverse result)))
205+
206+
;;; Main tool definition
207+
208+
(define-mcp-tool "editor_get_screen" (include-floating-windows)
209+
(:description "Get current screen state including all windows, their content, cursor positions, overlays, and UI elements. Returns complete visual state of the editor."
210+
:input-schema (("type" . "object")
211+
("properties" . (("include_floating_windows" . (("type" . "boolean")
212+
("description" . "Include floating windows (popups, prompts). Default: true")))))
213+
("required" . ())))
214+
(let* ((include-floating (if (null include-floating-windows) t include-floating-windows))
215+
(all-windows (window-list))
216+
(floating-windows (when include-floating
217+
(frame-floating-windows (current-frame))))
218+
(prompt-window (active-prompt-window))
219+
(windows-to-process (remove-if (lambda (w)
220+
(or (header-window-p w)
221+
(eq w prompt-window)))
222+
all-windows)))
223+
(with-output-to-string (s)
224+
(yason:encode
225+
(alist-to-hash-table
226+
`(("display" . (("width" . ,(display-width))
227+
("height" . ,(display-height))))
228+
("current_window_id" . ,(window-id (current-window)))
229+
("windows" . ,(mapcar #'get-window-info windows-to-process))
230+
("floating_windows" . ,(when include-floating
231+
(mapcar #'get-window-info floating-windows)))
232+
("header_windows" . ,(get-header-windows-info))
233+
("prompt" . ,(get-prompt-window-info))
234+
("overlays" . ,(get-all-overlays))))
235+
s))))

‎extensions/mcp-server/handlers/input.lisp‎

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
(in-package :lem-mcp-server)
2+
3+
;;; Key Input Tools
4+
;;;
5+
;;; Note on internal symbol usage:
6+
;;; - lem-core::parse-keyspec: Parses Emacs-style key notation strings into
7+
;;; key objects. This is essential for accepting user key input but is not
8+
;;; exported from lem-core. Consider exporting for public use.
9+
10+
;;; Helper functions
11+
12+
(defun safe-parse-keyspec (keyspec)
13+
"Parse a key specification string with error handling.
14+
Returns (values keys error-message)."
15+
(handler-case
16+
(values (lem-core::parse-keyspec keyspec) nil)
17+
(editor-error (e)
18+
(values nil (format nil "~A" e)))
19+
(error (e)
20+
(values nil (format nil "Parse error: ~A" e)))))
21+
22+
(defun key-to-string (key)
23+
"Convert a key object to a human-readable string representation."
24+
(with-output-to-string (s)
25+
(when (key-ctrl key) (write-string "C-" s))
26+
(when (key-meta key) (write-string "M-" s))
27+
(when (key-super key) (write-string "s-" s))
28+
(when (key-hyper key) (write-string "H-" s))
29+
(when (key-shift key) (write-string "Shift-" s))
30+
(write-string (key-sym key) s)))
31+
32+
(defun keys-to-string-list (keys)
33+
"Convert a list of key objects to a list of string representations."
34+
(mapcar #'key-to-string keys))
35+
36+
;;; Main tool definition
37+
38+
(define-mcp-tool "editor_send_keys" (keys wait-for-completion)
39+
(:description "Send a key sequence to the editor. Uses Emacs-style key notation (e.g., 'C-x C-s' for Ctrl+x Ctrl+s, 'M-x' for Alt+x, 'Return' for Enter)."
40+
:input-schema (("type" . "object")
41+
("properties" . (("keys" . (("type" . "string")
42+
("description" . "Key sequence in Emacs notation (e.g., 'C-x C-s', 'M-x forward-char Return', 'C-g')")))
43+
("wait_for_completion" . (("type" . "boolean")
44+
("description" . "Wait for key sequence to be processed before returning. Default: true")))))
45+
("required" . ("keys"))))
46+
;; Validate keys parameter
47+
(unless keys
48+
(mcp-error +invalid-params+ "Missing required parameter: keys"))
49+
(when (string= keys "")
50+
(mcp-error +invalid-params+ "Empty key sequence"))
51+
52+
;; Parse the key specification
53+
(multiple-value-bind (parsed-keys parse-error) (safe-parse-keyspec keys)
54+
(when parse-error
55+
(mcp-error +invalid-params+ (format nil "Invalid key sequence '~A': ~A" keys parse-error)))
56+
57+
(let ((wait (if (null wait-for-completion) t wait-for-completion))
58+
(key-strings (keys-to-string-list parsed-keys)))
59+
(if wait
60+
;; Execute synchronously
61+
(handler-case
62+
(progn
63+
(execute-key-sequence parsed-keys)
64+
(redraw-display)
65+
(with-output-to-string (s)
66+
(yason:encode
67+
(alist-to-hash-table
68+
`(("success" . t)
69+
("keys_sent" . ,key-strings)
70+
("message" . "Key sequence executed")))
71+
s)))
72+
(editor-abort ()
73+
(with-output-to-string (s)
74+
(yason:encode
75+
(alist-to-hash-table
76+
`(("success" . :false)
77+
("keys_sent" . ,key-strings)
78+
("message" . "Operation aborted (C-g)")))
79+
s)))
80+
(editor-error (e)
81+
(mcp-error +server-error+ (format nil "Editor error: ~A" e)))
82+
(error (e)
83+
(mcp-error +server-error+ (format nil "Execution error: ~A" e))))
84+
;; Execute asynchronously
85+
(progn
86+
(send-event
87+
(lambda ()
88+
(ignore-errors
89+
(execute-key-sequence parsed-keys)
90+
(redraw-display))))
91+
(with-output-to-string (s)
92+
(yason:encode
93+
(alist-to-hash-table
94+
`(("success" . t)
95+
("keys_sent" . ,key-strings)
96+
("message" . "Key sequence queued for execution")))
97+
s)))))))

‎extensions/mcp-server/lem-mcp-server.asd‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,5 +19,7 @@
1919
:serial t
2020
:components ((:file "buffer")
2121
(:file "editing")
22-
(:file "command")))
22+
(:file "command")
23+
(:file "display")
24+
(:file "input")))
2325
(:file "commands")))

0 commit comments

Comments
 (0)