Fix automation bridge: drain callback queue, async keys, responsive minibuffer
ober
000f29862cd512d7ca2fee99dedc79f30f6822d5
--- a/Makefile +++ b/Makefile @@ -54,6 +54,30 @@ qt_chez_shim.so: vendor/qt_chez_shim.c vendor/qt_shim.h run-qt: build repl_shim.so libqt_shim.so vterm_shim.so qt_chez_shim.so LD_PRELOAD=./qt_chez_shim.so $(SCHEME) $(LIBDIRS) --script qt-main.ss +# Headless Qt with automation REPL (for Claude). Uses xvfb-run for +# virtual display (static binary needs xcb). Auto-assigned REPL port. +run-qt-test: build repl_shim.so libqt_shim.so vterm_shim.so qt_chez_shim.so + @rm -f $(HOME)/.jerboa-repl-port + xvfb-run -a LD_PRELOAD=./qt_chez_shim.so \ + $(SCHEME) $(LIBDIRS) --script qt-main.ss --repl 0 & + @for i in $$(seq 1 20); do \ + [ -f $(HOME)/.jerboa-repl-port ] && break; \ + sleep 0.3; \ + done + @if [ -f $(HOME)/.jerboa-repl-port ]; then \ + echo "jemacs-qt running (headless). REPL port: $$(grep -oP '\\d+' $(HOME)/.jerboa-repl-port)"; \ + else \ + echo "ERROR: REPL port file not created after 6s"; exit 1; \ + fi + +stop-qt-test: + @PORT=$$(grep -oP '\\d+' $(HOME)/.jerboa-repl-port 2>/dev/null); \ + if [ -n "$$PORT" ]; then \ + PID=$$(lsof -ti :$$PORT 2>/dev/null | head -1); \ + [ -n "$$PID" ] && kill $$PID && echo "Killed jemacs-qt (PID $$PID)" || echo "No running jemacs-qt found"; \ + else echo "No running jemacs-qt found"; fi + @rm -f $(HOME)/.jerboa-repl-port + # Qt backend build target build-qt: build @echo "╔════════════════════════════════════════════════════════════════╗" --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -2259,6 +2259,10 @@ 'send-keys! (lambda keys (apply automation-send-keys! app keys))) (cons + 'send-keys-async! + (lambda keys + (apply automation-send-keys-async! app keys))) + (cons 'screenshot! (lambda (path) (automation-screenshot! app path))) (cons 'app-state (lambda () (automation-state app))) --- a/lib/jerboa-emacs/qt/automation.sls +++ b/lib/jerboa-emacs/qt/automation.sls @@ -3,9 +3,9 @@ ;;; Source: src/jerboa-emacs/qt/automation.ss (library (jerboa-emacs qt automation) - (export automation-send-keys! automation-screenshot! - automation-state automation-wait! automation-set-qt-app! - emacs-key->qt-event) + (export automation-send-keys! automation-send-keys-async! + automation-screenshot! automation-state automation-wait! + automation-set-qt-app! emacs-key->qt-event) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -139,24 +139,26 @@ [(string=? name "<f12>") (cons QT_KEY_F12 0)] [else #f])) (def (automation-send-keys! app . key-strings) - (let* ([fr (app-state-frame app)] - [ed (qt-current-editor fr)]) - (when ed - (for-each - (lambda (ks) - (if (or (<= (string-length ks) 1) - (emacs-special-key ks) - (and (>= (string-length ks) 3) - (or (string=? (substring ks 0 2) "C-") - (string=? (substring ks 0 2) "M-") - (string=? (substring ks 0 2) "S-")))) - (send-one-key! app ks) - (let loop ([i 0]) - (when (< i (string-length ks)) - (send-one-key! app (string (string-ref ks i))) - (loop (+ i 1)))))) - key-strings)))) - (def (send-one-key! app key-str) + (for-each + (lambda (ks) (dispatch-key-string! app ks #t)) + key-strings)) + (def (automation-send-keys-async! app . key-strings) + (for-each + (lambda (ks) (dispatch-key-string! app ks #f)) + key-strings)) + (def (dispatch-key-string! app ks drain?) + (if (or (<= (string-length ks) 1) + (emacs-special-key ks) + (and (>= (string-length ks) 3) + (or (string=? (substring ks 0 2) "C-") + (string=? (substring ks 0 2) "M-") + (string=? (substring ks 0 2) "S-")))) + (send-one-key! app ks drain?) + (let loop ([i 0]) + (when (< i (string-length ks)) + (send-one-key! app (string (string-ref ks i)) drain?) + (loop (+ i 1)))))) + (def (send-one-key! app key-str drain?) (let-values ([(code mods text) (emacs-key->qt-event key-str)]) (let* ([fr (app-state-frame app)] @@ -165,7 +167,9 @@ (qt-current-editor fr))]) (when target (qt-send-key-press! target code mods text) - (qt-send-key-release! target code mods text))))) + (when drain? (qt-drain-pending-callbacks!)) + (qt-send-key-release! target code mods text) + (when drain? (qt-drain-pending-callbacks!)))))) (def (automation-screenshot! app path) (let* ([fr (app-state-frame app)] [main-win (qt-frame-main-win fr)]) --- a/lib/jerboa-emacs/qt/echo.sls +++ b/lib/jerboa-emacs/qt/echo.sls @@ -15,7 +15,7 @@ (std sugar) (std sort) (std srfi srfi-1) (only (std srfi srfi-13) string-contains string-suffix?) (jerboa-emacs qt sci-shim) (jerboa-emacs core) - (jerboa-emacs qt window) + (jerboa-emacs async) (jerboa-emacs qt window) (except (jerboa core) iota any every filter-map take drop delete) (except (jerboa runtime) iota)) @@ -474,6 +474,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* (let ([text (if (pair? *mb-result*) @@ -513,6 +514,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* (let ([text (if (pair? *mb-result*) @@ -550,6 +552,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* (let ([text (if (pair? *mb-result*) @@ -604,6 +607,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* (let ([text (if (pair? *mb-result*) @@ -648,6 +652,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* (let ([text (if (pair? *mb-result*) new file mode 100755 --- /dev/null +++ b/scripts/jemacs-rc.sh @@ -0,0 +1,124 @@ +#!/bin/bash +# jemacs-rc.sh — Helper functions for Claude to interact with jemacs-qt +# +# Usage: +# source scripts/jemacs-rc.sh +# jemacs-start # launch headless jemacs-qt with REPL +# jemacs-eval '(+ 1 2)' # evaluate Scheme expression +# jemacs-keys C-x 2 # send key sequence +# jemacs-screenshot # capture screenshot to /tmp/jemacs.png +# jemacs-state # query app state +# jemacs-stop # kill headless jemacs-qt + +JEMACS_REPL_PORT_FILE="$HOME/.jerboa-repl-port" +JEMACS_SCREENSHOT="/tmp/jemacs.png" +_JEMACS_EVAL_ID=0 +_JEMACS_PID="" + +jemacs-port() { + if [ -f "$JEMACS_REPL_PORT_FILE" ]; then + grep -oP '\d+' "$JEMACS_REPL_PORT_FILE" + else + echo "ERROR: no REPL port file" >&2 + return 1 + fi +} + +jemacs-eval() { + local port + port=$(jemacs-port) || return 1 + _JEMACS_EVAL_ID=$((_JEMACS_EVAL_ID + 1)) + echo "($_JEMACS_EVAL_ID eval \"$1\")" | nc -q1 127.0.0.1 "$port" 2>/dev/null +} + +jemacs-keys() { + local args="" + for key in "$@"; do + args="$args \"$key\"" + done + jemacs-eval "(send-keys!$args)" +} + +# Async key send — for commands that open a minibuffer (M-x, C-x C-f, etc.) +jemacs-keys-async() { + local args="" + for key in "$@"; do + args="$args \"$key\"" + done + jemacs-eval "(send-keys-async!$args)" +} + +jemacs-screenshot() { + local path="${1:-$JEMACS_SCREENSHOT}" + jemacs-eval "(screenshot! \"$path\")" + echo "$path" +} + +jemacs-state() { + jemacs-eval "(app-state)" +} + +jemacs-start() { + # Check if already running + if [ -f "$JEMACS_REPL_PORT_FILE" ]; then + local port + port=$(jemacs-port) + if echo "(99 eval \"#t\")" | nc -q1 127.0.0.1 "$port" >/dev/null 2>&1; then + echo "jemacs-qt already running on port $port" + return 0 + fi + fi + rm -f "$JEMACS_REPL_PORT_FILE" + + # Static binary can't use QT_QPA_PLATFORM=offscreen (only xcb is compiled in). + # Use xvfb-run to create a virtual X11 display instead. + if [ -x ./jemacs-qt ]; then + xvfb-run -a ./jemacs-qt --repl 0 & + _JEMACS_PID=$! + else + # Interpreted mode: use offscreen platform (dynamically loaded) + QT_QPA_PLATFORM=offscreen LD_PRELOAD=./qt_chez_shim.so \ + scheme --libdirs "lib:$HOME/mine/jerboa/lib:$HOME/mine/jerboa-shell/src:$HOME/mine/jerboa-coreutils:$HOME/mine/chez-gherkin:$HOME/mine/chez-pcre2:$HOME/mine/chez-scintilla/src:$HOME/mine/chez-qt" \ + --script qt-main.ss --repl 0 & + _JEMACS_PID=$! + fi + + # Wait for REPL port file to appear (up to 10s) + for i in $(seq 1 30); do + [ -f "$JEMACS_REPL_PORT_FILE" ] && break + sleep 0.3 + done + if [ -f "$JEMACS_REPL_PORT_FILE" ]; then + echo "jemacs-qt running (PID $_JEMACS_PID). REPL port: $(jemacs-port)" + else + echo "ERROR: jemacs-qt failed to start within 10s" >&2 + [ -n "$_JEMACS_PID" ] && kill "$_JEMACS_PID" 2>/dev/null + return 1 + fi +} + +jemacs-stop() { + # Try tracked PID first, then port-based lookup + if [ -n "$_JEMACS_PID" ] && kill -0 "$_JEMACS_PID" 2>/dev/null; then + kill "$_JEMACS_PID" 2>/dev/null + wait "$_JEMACS_PID" 2>/dev/null + echo "Killed jemacs-qt (PID $_JEMACS_PID)" + _JEMACS_PID="" + else + local port + port=$(jemacs-port 2>/dev/null) + if [ -n "$port" ]; then + local pid + pid=$(lsof -ti :"$port" 2>/dev/null | head -1) + if [ -n "$pid" ]; then + kill "$pid" 2>/dev/null + echo "Killed jemacs-qt (PID $pid)" + else + echo "No running jemacs-qt found" + fi + else + echo "No running jemacs-qt found" + fi + fi + rm -f "$JEMACS_REPL_PORT_FILE" +} --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -1754,8 +1754,12 @@ (buf (qt-current-buffer fr))) (if buf (buffer-name buf) "#<none>")))) ;; Automation bridge (for Claude) + ;; send-keys! : synchronous, drains inline (for non-blocking commands) + ;; send-keys-async! : fire-and-forget (for M-x, C-x C-f, etc.) (cons 'send-keys! (lambda keys (apply automation-send-keys! app keys))) + (cons 'send-keys-async! + (lambda keys (apply automation-send-keys-async! app keys))) (cons 'screenshot! (lambda (path) (automation-screenshot! app path))) (cons 'app-state --- a/src/jerboa-emacs/qt/automation.ss +++ b/src/jerboa-emacs/qt/automation.ss @@ -6,6 +6,7 @@ ;;; query application state. (export automation-send-keys! + automation-send-keys-async! automation-screenshot! automation-state automation-wait! @@ -159,38 +160,50 @@ ;;; Send a sequence of Emacs key strings as real Qt key events. ;;; Each string is parsed and sent as a press+release pair. -;;; Multi-character strings that aren't recognized as key names are -;;; sent as individual character presses (for typing text). +;;; Drains the callback queue after each key so the Scheme handler fires inline. +;;; WARNING: Do NOT use for commands that open a blocking minibuffer prompt +;;; (M-x, C-x C-f, C-s, etc.) — use automation-send-keys-async! instead. ;;; ;;; Usage: ;;; (automation-send-keys! app "C-x" "2") ; C-x 2 (split window) -;;; (automation-send-keys! app "M-x") ; open M-x -;;; (automation-send-keys! app "find-file" "RET") ; type + enter +;;; (automation-send-keys! app "hello") ; type text (def (automation-send-keys! app . key-strings) - (let* ((fr (app-state-frame app)) - (ed (qt-current-editor fr))) - (when ed - (for-each - (lambda (ks) - (if (or (<= (string-length ks) 1) - (emacs-special-key ks) - ;; Modifier prefix pattern: C-x, M-x, C-M-x, S-<f1>, etc. - (and (>= (string-length ks) 3) - (or (string=? (substring ks 0 2) "C-") - (string=? (substring ks 0 2) "M-") - (string=? (substring ks 0 2) "S-")))) - ;; Single key event - (send-one-key! app ks) - ;; Multi-char string: send each character individually - (let loop ((i 0)) - (when (< i (string-length ks)) - (send-one-key! app (string (string-ref ks i))) - (loop (+ i 1)))))) - key-strings)))) + (for-each (lambda (ks) (dispatch-key-string! app ks #t)) key-strings)) + +;;; Send keys WITHOUT draining the callback queue. +;;; The keys are queued and processed by the master timer on the next tick. +;;; Use this for commands that trigger blocking prompts (M-x, C-x C-f, etc.). +;;; Follow up with separate REPL calls to interact with the minibuffer. +;;; +;;; Usage: +;;; (automation-send-keys-async! app "M-x") ; opens M-x, returns immediately +;;; ;; ... in next REPL call, minibuffer is active ... +;;; (automation-send-keys-async! app "find-file" "RET") +(def (automation-send-keys-async! app . key-strings) + (for-each (lambda (ks) (dispatch-key-string! app ks #f)) key-strings)) + +;;; Dispatch a key string — either a single recognized key or individual chars. +(def (dispatch-key-string! app ks drain?) + (if (or (<= (string-length ks) 1) + (emacs-special-key ks) + ;; Modifier prefix pattern: C-x, M-x, C-M-x, S-<f1>, etc. + (and (>= (string-length ks) 3) + (or (string=? (substring ks 0 2) "C-") + (string=? (substring ks 0 2) "M-") + (string=? (substring ks 0 2) "S-")))) + ;; Single key event + (send-one-key! app ks drain?) + ;; Multi-char string: send each character individually + (let loop ((i 0)) + (when (< i (string-length ks)) + (send-one-key! app (string (string-ref ks i)) drain?) + (loop (+ i 1)))))) ;;; Send a single key event (press + release) to the focused widget. ;;; If the minibuffer is active, sends to the minibuffer input widget instead. -(def (send-one-key! app key-str) +;;; When drain? is #t, drains the deferred callback queue after each event +;;; so the Scheme key handler fires immediately. +(def (send-one-key! app key-str drain?) (let-values (((code mods text) (emacs-key->qt-event key-str))) (let* ((fr (app-state-frame app)) (target (if *minibuffer-active?* @@ -198,7 +211,9 @@ (qt-current-editor fr)))) (when target (qt-send-key-press! target code mods text) - (qt-send-key-release! target code mods text))))) + (when drain? (qt-drain-pending-callbacks!)) + (qt-send-key-release! target code mods text) + (when drain? (qt-drain-pending-callbacks!)))))) ;;;============================================================================ ;;; Screenshot --- a/src/jerboa-emacs/qt/echo.ss +++ b/src/jerboa-emacs/qt/echo.ss @@ -20,6 +20,7 @@ (only-in :std/srfi/13 string-contains string-suffix?) :jerboa-emacs/qt/sci-shim :jerboa-emacs/core + :jerboa-emacs/async :jerboa-emacs/qt/window) ;;;============================================================================ @@ -490,6 +491,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) ; execute enqueued signal callbacks (returnPressed, etc.) + (master-timer-tick!) ; run periodic tasks (debug REPL, etc.) (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result @@ -540,6 +542,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result @@ -589,6 +592,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result @@ -654,6 +658,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* ;; Done — extract result @@ -710,6 +715,7 @@ (let loop () (qt-app-process-events! *mb-qt-app*) (qt-drain-pending-callbacks!) + (master-timer-tick!) (thread-sleep! 0.01) (if *mb-result* (let ((text (if (pair? *mb-result*)