Fix backspace in file buffers, chord detection, and split-window highlighting
ober
a6f1166a6ff4d21c6fdf4307403d9760fc4c699d
--- a/CLAUDE.md +++ b/CLAUDE.md @@ -20,15 +20,19 @@ make run-qt # Build and run Qt editor make static-qt # Build static jemacs-qt binary via Docker ``` -## MANDATORY: Verify Binary After Changes +## MANDATORY: Build, Compile, and Verify After EVERY Change -After ANY code change, you MUST verify the static binary actually works — never tell the user "it's fixed" without testing. Run these steps IN ORDER: +**NEVER report a fix as "done" without completing ALL of these steps.** This is non-negotiable. -1. `make build` — rebuild `.sls` files from `.ss` sources -2. `make static-qt` — rebuild the static Docker binary -3. `./jemacs-qt --version` — verify binary launches without exceptions +After ANY code change to `.ss` files, you MUST run these steps IN ORDER before responding to the user: -If step 3 throws ANY exception (library not found, unbound variable, dynamic loading errors), the fix is NOT done. Common pitfalls: +1. `make build` — rebuild `.sls` files from `.ss` sources. Fix any errors before proceeding. +2. `make static-qt` — rebuild the static Docker binary. Fix any errors before proceeding. +3. `./jemacs-qt --version` — verify binary launches without exceptions. + +If ANY step fails, the fix is NOT done. Do NOT tell the user anything is fixed, working, or ready until all 3 steps pass. Do NOT skip step 2 or 3 — interpreted mode (`make run-qt`) does NOT prove the static binary works. + +Common pitfalls when step 3 fails: - **`library (std ...) not found`**: The Docker image has a stale jerboa `std/` tree. New modules must be added to the sync list in the `linux-static-qt-docker` Makefile target AND compiled into the WPO step in `build-binary-qt.ss`. - **`Dynamic loading not supported`**: Any `load-shared-object` call must be guarded with the `JEMACS_STATIC` env var check (the binary sets `JEMACS_STATIC=1`). @@ -198,6 +202,8 @@ src/jerboa-emacs/ 2. Follow the existing pattern: `(display "--- description ---\n")` then test forms 3. Use `check` macro: `(check expr => expected-value)` 4. For git/subprocess tests, use `make-temp-git-repo!` and `cleanup-temp-git-repo!` +5. **MANDATORY**: When fixing bugs in editing commands (backspace, delete, insert, etc.) or key dispatch (prefix keys, C-x sequences), you MUST add functional tests that reproduce the bug through the dispatch chain BEFORE claiming it is fixed. Use `execute-command!` for command-level tests and `sim-key!` with `ctrl-ev`/`char-ev` for key-dispatch-level tests (e.g., C-x 2 = `(sim-key! app (ctrl-ev #x18))` then `(sim-key! app (char-ev #\2))`). +6. Run `make build && make test-functional` after adding tests to verify they pass ## Qt Backend Notes --- a/Makefile +++ b/Makefile @@ -14,7 +14,7 @@ export CHEZ_QT_SHIM_DIR := . .PHONY: all build rebuild run test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test-extra test clean clean-generated \ test-org-duration test-org-element test-org-fold test-org-footnote \ test-org-lint test-org-num test-org-property test-org-src test-org-tempo \ - test-vtscreen test-debug-repl test-qt build-qt binary binary-qt \ + test-vtscreen test-debug-repl test-qt test-qt-e2e build-qt binary binary-qt \ test-pty test-emacs test-functional test-term-hang \ docker-deps static-qt clean-docker check-root build-jemacs-qt-static @@ -191,6 +191,10 @@ test-qt: build QT_QPA_PLATFORM=offscreen LD_PRELOAD=./qt_chez_shim.so $(SCHEME) $(LIBDIRS) --script tests/test-qt.ss QT_QPA_PLATFORM=offscreen LD_PRELOAD=./qt_chez_shim.so $(SCHEME) $(LIBDIRS) --script tests/test-qt-part2.ss +# End-to-end Qt tests: Xvfb + xdotool + IPC REPL (requires xvfb, xdotool, nc) +test-qt-e2e: + bash tests/test-qt-functional.sh ./jemacs-qt + test-emacs: $(SCHEME) $(LIBDIRS) --program tests/test-emacs.ss --- a/lib/jerboa-emacs/debug-repl.sls +++ b/lib/jerboa-emacs/debug-repl.sls @@ -3,7 +3,11 @@ ;;; Source: src/jerboa-emacs/debug-repl.ss (library (jerboa-emacs debug-repl) - (export start-debug-repl! stop-debug-repl! debug-repl-port) + (export + start-debug-repl! + stop-debug-repl! + debug-repl-port + debug-repl-bind!) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -24,6 +28,9 @@ (def *repl-port-file* (string-append (getenv "HOME") "/.jerboa-repl-port")) (def *repl-env* (interaction-environment)) + (def (debug-repl-bind! name value) + "Register a binding in the debug REPL environment so it's accessible via IPC.\n Uses Chez's define-top-level-value to inject the value directly." + (define-top-level-value name value *repl-env*)) (def ffi-chmod (foreign-procedure "chmod" (string int) int)) (def (write-repl-port-file! port-num) (delete-repl-port-file!) @@ -54,10 +61,10 @@ (set! *repl-authed* #f) (set! *repl-prompted* #f) (set! *repl-protocol* 'unknown)) (def (capture-eval expr-str) - "Evaluate expression string, capturing stdout. Returns (values status result stdout)." + "Evaluate expression string, capturing stdout. Returns (list status result stdout).\n Handles expressions that return multiple values by formatting all of them.\n Returns a LIST (not values) to avoid multi-value issues with with-catch's call/cc." (with-catch (lambda (e) - (values + (list 'error (with-catch (lambda _ "unknown error") @@ -68,18 +75,34 @@ "")) (lambda () (let* ([stdout-capture (open-output-string)] - [result (parameterize ([current-output-port - stdout-capture]) - (eval - (read (open-input-string expr-str)) - *repl-env*))] + [results (parameterize ([current-output-port + stdout-capture]) + (call-with-values + (lambda () + (eval + (read (open-input-string expr-str)) + *repl-env*)) + list))] [stdout-str (get-output-string stdout-capture)]) - (values 'ok (format "~s" result) stdout-str))))) + (list + 'ok + (if (= (length results) 1) + (format "~s" (car results)) + (let loop ([rs results] [acc ""]) + (if (null? rs) + acc + (loop + (cdr rs) + (string-append + acc + (if (string=? acc "") "" "\n") + (format "~s" (car rs))))))) + stdout-str))))) (def (capture-eval-region str) - "Evaluate multiple forms, return last result." + "Evaluate multiple forms, return last result.\n Returns a LIST (not values) to avoid multi-value issues with with-catch's call/cc." (with-catch (lambda (e) - (values + (list 'error (with-catch (lambda _ "unknown error") @@ -91,15 +114,31 @@ (lambda () (let* ([stdout-capture (open-output-string)] [p (open-input-string str)] - [result (parameterize ([current-output-port - stdout-capture]) - (let loop ([last (void)]) - (let ([form (read p)]) - (if (eof-object? form) - last - (loop (eval form *repl-env*))))))] + [results (parameterize ([current-output-port + stdout-capture]) + (let loop ([last (list (void))]) + (let ([form (read p)]) + (if (eof-object? form) + last + (loop + (call-with-values + (lambda () (eval form *repl-env*)) + list))))))] [stdout-str (get-output-string stdout-capture)]) - (values 'ok (format "~s" result) stdout-str))))) + (list + 'ok + (if (= (length results) 1) + (format "~s" (car results)) + (let loop ([rs results] [acc ""]) + (if (null? rs) + acc + (loop + (cdr rs) + (string-append + acc + (if (string=? acc "") "" "\n") + (format "~s" (car rs))))))) + stdout-str))))) (def (safe-format-value val) "Format a value to string, safely handling errors." (with-catch @@ -133,14 +172,18 @@ (case method [(ping) (list id ':ok "pong")] [(eval) - (let-values ([(status result stdout) - (capture-eval (car args))]) + (let* ([res (capture-eval (car args))] + [status (car res)] + [result (cadr res)] + [stdout (caddr res)]) (if (eq? status 'ok) (list id ':ok (list ':value result ':stdout stdout)) (list id ':error result)))] [(eval-region) - (let-values ([(status result stdout) - (capture-eval-region (car args))]) + (let* ([res (capture-eval-region (car args))] + [status (car res)] + [result (cadr res)] + [stdout (caddr res)]) (if (eq? status 'ok) (list id ':ok (list ':value result ':stdout stdout)) (list id ':error result)))] @@ -727,8 +770,10 @@ (repl-send! (string-append "ERROR: " (fmt-error e) "\n"))) (lambda () - (let-values ([(status result stdout) - (capture-eval cmd)]) + (let* ([res (capture-eval cmd)] + [status (car res)] + [result (cadr res)] + [stdout (caddr res)]) (when (and (string? stdout) (> (string-length stdout) 0)) (repl-send! stdout)) --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -88,7 +88,8 @@ (only (jerboa-emacs debug-repl) start-debug-repl! - stop-debug-repl!) + stop-debug-repl! + debug-repl-bind!) (jerboa core) (jerboa runtime)) (def *vterm-render-interval-ms* 33) (def *vterm-scrollback-limit* 100000) @@ -352,6 +353,7 @@ (def *chord-pending-code* #f) (def *chord-pending-mods* #f) (def *chord-pending-text* #f) + (def *chord-timer-fired* #f) (def *tab-bar-layout* #f) (def *tab-bar-buttons* '()) (def *tab-bar-last-state* #f) @@ -770,6 +772,7 @@ (qt-widget-set-focus! scroll))))) (begin (qt-hide-image-buffer! editor) + (qt-reapply-highlighting! editor buf) (qt-widget-set-focus! editor)))))))) (recent-files-load!) (bookmarks-load! app) @@ -808,6 +811,7 @@ [mods (normalize-qt-mods (qt-last-key-modifiers))] [raw-text (qt-last-key-text)] + [autorepeat? (qt-last-key-autorepeat?)] [text (if (= (string-length raw-text) 1) @@ -867,255 +871,369 @@ echo-label)] [else (letrec ([terminal-pty-intercept? (lambda (code - mods) - (let* ([ctrl? (not (zero? - (bitwise-and - mods - QT_MOD_CTRL)))] - [alt? (not (zero? - (bitwise-and - mods - QT_MOD_ALT)))] - [buf (qt-current-buffer - (app-state-frame - app))]) - (and ctrl? - (not alt?) - (>= code - QT_KEY_A) - (<= code - QT_KEY_Z) - (not (= code - (+ QT_KEY_A - 23))) - (not (= code - (+ QT_KEY_A - 6))) - (cond - [(terminal-buffer? - buf) - (let ([ts (hash-get - *terminal-state* - buf)]) - (and ts - (terminal-pty-busy? - ts) - (let ([ch (integer->char - (+ 1 - (- code - QT_KEY_A)))]) - (terminal-send-input! - ts - (string - ch)) - #t)))] - [(shell-buffer? - buf) - (let ([ss (hash-get - *shell-state* - buf)]) - (and ss - (shell-pty-busy? - ss) - (let ([ch (integer->char - (+ 1 - (- code - QT_KEY_A)))]) - (shell-send-input! - ss - (string - ch)) - #t)))] - [else - #f]))))] + mods + text) + (and (null? + (key-state-prefix-keys + (app-state-key-state + app))) + (let* ([ctrl? (not (zero? + (bitwise-and + mods + QT_MOD_CTRL)))] + [alt? (not (zero? + (bitwise-and + mods + QT_MOD_ALT)))] + [buf (qt-current-buffer + (app-state-frame + app))]) + (and (not (and ctrl? + (not alt?) + (or (= code + (+ QT_KEY_A + 23)) + (= code + (+ QT_KEY_A + 6))))) + (let ([send! (cond + [(terminal-buffer? + buf) + (let ([ts (hash-get + *terminal-state* + buf)]) + (and ts + (terminal-pty-busy? + ts) + (lambda (s) + (terminal-send-input! + ts + s))))] + [(shell-buffer? + buf) + (let ([ss (hash-get + *shell-state* + buf)]) + (and ss + (shell-pty-busy? + ss) + (lambda (s) + (shell-send-input! + ss + s))))] + [else + #f])]) + (and send! + (cond + [(and ctrl? + (not alt?) + (>= code + QT_KEY_A) + (<= code + QT_KEY_Z)) + (send! + (string + (integer->char + (+ 1 + (- code + QT_KEY_A))))) + #t] + [(= code + QT_KEY_UP) + (send! + "\x1B;[A") + #t] + [(= code + QT_KEY_DOWN) + (send! + "\x1B;[B") + #t] + [(= code + QT_KEY_RIGHT) + (send! + "\x1B;[C") + #t] + [(= code + QT_KEY_LEFT) + (send! + "\x1B;[D") + #t] + [(or (= code + QT_KEY_RETURN) + (= code + QT_KEY_ENTER)) + (send! + "\r") + #t] + [(= code + QT_KEY_BACKSPACE) + (send! + (string + (integer->char + 127))) + #t] + [(= code + QT_KEY_DELETE) + (send! + "\x1B;[3~") + #t] + [(= code + QT_KEY_TAB) + (send! + "\t") + #t] + [(= code + QT_KEY_ESCAPE) + (send! + "\x1B;") + #t] + [(= code + QT_KEY_HOME) + (send! + "\x1B;[H") + #t] + [(= code + QT_KEY_END) + (send! + "\x1B;[F") + #t] + [(= code + QT_KEY_PAGE_UP) + (send! + "\x1B;[5~") + #t] + [(= code + QT_KEY_PAGE_DOWN) + (send! + "\x1B;[6~") + #t] + [(and (= (string-length + text) + 1) + (> (char->integer + (string-ref + text + 0)) + 31)) + (send! + text) + #t] + [else + #f])))))))] [do-normal-key! (lambda (code mods text) (unless (terminal-pty-intercept? code - mods) - (if (and (active-repeat-map) - (let* ([ks (qt-key-event->string - code - mods - text)] - [repeat-cmd (and ks - (repeat-map-lookup - ks))]) - (if repeat-cmd - (begin - (execute-command! - app - repeat-cmd) - #t) - (begin - (clear-repeat-map!) - #f)))) - (void) - (let-values ([(action data new-state) - (qt-key-state-feed! - (app-state-key-state - app) - code - mods - text)]) - (app-state-key-state-set! - app - new-state) - (when (and *which-key-timer* - (not (eq? action - 'prefix))) - (qt-timer-stop! - *which-key-timer*) - (set! *which-key-pending-keymap* - #f)) - (if (and *qt-describe-key-pending* - (not (eq? action - 'prefix))) - (let ([ks (qt-key-event->string - code - mods - text)]) - (qt-describe-key-result! - app - ks - action - data)) - (if *qt-quoted-insert-pending* - (qt-quoted-insert-handle! - app - (if (and text - (> (string-length - text) - 0)) - text - (qt-key-event->string - code - mods - text))) - (case action - [(command) - (when (and (app-state-macro-recording - app) - (not (memq - data - '(start-kbd-macro - end-kbd-macro - call-last-kbd-macro - call-named-kbd-macro - name-last-kbd-macro - list-kbd-macros - save-kbd-macros - load-kbd-macros)))) - (app-state-macro-recording-set! - app - (cons - (cons - 'command - data) - (app-state-macro-recording - app)))) - (when (and (echo-state-message - (app-state-echo - app)) - (null? - (key-state-prefix-keys - new-state))) - (echo-clear! - (app-state-echo - app))) - (execute-command! - app - data)] - [(self-insert) - (let* ([buf (qt-current-buffer - (app-state-frame - app))] - [mode-cmd (mode-keymap-lookup - buf - data)]) - (if mode-cmd + mods + text) + (let* ([prefix-keys (key-state-prefix-keys + (app-state-key-state + app))] + [is-prefix-autorepeat? (and (pair? + prefix-keys) + (let* ([last-prefix (car (reverse + prefix-keys))] + [ks (qt-key-event->string + code + mods + text)]) + (and ks + (or (string=? + ks + last-prefix) + (and (zero? + (bitwise-and + mods + QT_MOD_CTRL)) + (zero? + (bitwise-and + mods + QT_MOD_ALT)) + (>= (string-length + last-prefix) + 3) + (string=? + ks + (substring + last-prefix + (- (string-length + last-prefix) + 1) + (string-length + last-prefix))))))))]) + (if is-prefix-autorepeat? + (begin + (verbose-log! + "PREFIX-AUTOREPEAT ignored key=" + (qt-key-event->string + code + mods + text) + " prefix=" + (car (reverse + prefix-keys))) + (void)) + (if (and (active-repeat-map) + (let* ([ks (qt-key-event->string + code + mods + text)] + [repeat-cmd (and ks + (repeat-map-lookup + ks))]) + (if repeat-cmd + (begin (execute-command! app - mode-cmd) - (begin - (when (app-state-macro-recording - app) - (app-state-macro-recording-set! - app + repeat-cmd) + #t) + (begin + (clear-repeat-map!) + #f)))) + (void) + (let-values ([(action data new-state) + (qt-key-state-feed! + (app-state-key-state + app) + code + mods + text)]) + (app-state-key-state-set! + app + new-state) + (when (and *which-key-timer* + (not (eq? action + 'prefix))) + (qt-timer-stop! + *which-key-timer*) + (set! *which-key-pending-keymap* + #f)) + (if (and *qt-describe-key-pending* + (not (eq? action + 'prefix))) + (let ([ks (qt-key-event->string + code + mods + text)]) + (qt-describe-key-result! + app + ks + action + data)) + (if *qt-quoted-insert-pending* + (qt-quoted-insert-handle! + app + (if (and text + (> (string-length + text) + 0)) + text + (qt-key-event->string + code + mods + text))) + (case action + [(command) + (when (and (app-state-macro-recording + app) + (not (memq + data + '(start-kbd-macro + end-kbd-macro + call-last-kbd-macro + call-named-kbd-macro + name-last-kbd-macro + list-kbd-macros + save-kbd-macros + load-kbd-macros)))) + (app-state-macro-recording-set! + app + (cons (cons - (cons - 'self-insert - data) - (app-state-macro-recording - app)))) - (let* ([ed (qt-current-editor - (app-state-frame - app))] - [ch (string-ref - data - 0)] - [close-ch (and *auto-pair-mode* - (let ([cc (auto-pair-char - (char->integer - ch))]) - (and cc - (integer->char - cc))))] - [n (get-prefix-arg - app)]) - (cond - [(dired-buffer? - buf) - (void)] - [(image-buffer? - buf) - (void)] - [(repl-buffer? - buf) - (let* ([pos (qt-plain-text-edit-cursor-position - ed)] - [rs (hash-get - *repl-state* - buf)]) - (when (and rs - (>= pos - (repl-state-prompt-pos - rs))) - (let loop ([i 0]) - (when (< i - n) - (qt-plain-text-edit-insert-text! - ed - (string - ch)) - (loop - (+ i - 1))))))] - [(eshell-buffer? - buf) - (let loop ([i 0]) - (when (< i - n) - (qt-plain-text-edit-insert-text! - ed - (string - ch)) - (loop - (+ i - 1))))] - [(terminal-buffer? - buf) - (let ([ts (hash-get - *terminal-state* - buf)]) - (if (and ts - (terminal-pty-busy? - ts)) - (terminal-send-input! - ts - (string - ch)) + 'command + data) + (app-state-macro-recording + app)))) + (when (and (echo-state-message + (app-state-echo + app)) + (null? + (key-state-prefix-keys + new-state))) + (echo-clear! + (app-state-echo + app))) + (execute-command! + app + data)] + [(self-insert) + (let* ([buf (qt-current-buffer + (app-state-frame + app))] + [mode-cmd (mode-keymap-lookup + buf + data)]) + (if mode-cmd + (execute-command! + app + mode-cmd) + (begin + (when (app-state-macro-recording + app) + (app-state-macro-recording-set! + app + (cons + (cons + 'self-insert + data) + (app-state-macro-recording + app)))) + (let* ([ed (qt-current-editor + (app-state-frame + app))] + [ch (string-ref + data + 0)] + [close-ch (and *auto-pair-mode* + (let ([cc (auto-pair-char + (char->integer + ch))]) + (and cc + (integer->char + cc))))] + [n (get-prefix-arg + app)]) + (cond + [(dired-buffer? + buf) + (void)] + [(image-buffer? + buf) + (void)] + [(repl-buffer? + buf) + (let* ([pos (qt-plain-text-edit-cursor-position + ed)] + [rs (hash-get + *repl-state* + buf)]) + (when (and rs + (>= pos + (repl-state-prompt-pos + rs))) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed + (string + ch)) + (loop + (+ i + 1))))))] + [(eshell-buffer? + buf) (let loop ([i 0]) (when (< i n) @@ -1125,383 +1243,451 @@ ch)) (loop (+ i - 1))))))] - [(shell-buffer? - buf) - (let ([ss (hash-get - *shell-state* - buf)]) - (if (and ss - (shell-pty-busy? - ss)) - (shell-send-input! - ss - (string - ch)) - (let loop ([i 0]) - (when (< i - n) - (qt-plain-text-edit-insert-text! + 1))))] + [(terminal-buffer? + buf) + (let ([ts (hash-get + *terminal-state* + buf)]) + (if (and ts + (terminal-pty-busy? + ts)) + (terminal-send-input! + ts + (string + ch)) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed + (string + ch)) + (loop + (+ i + 1))))))] + [(shell-buffer? + buf) + (let ([ss (hash-get + *shell-state* + buf)]) + (if (and ss + (shell-pty-busy? + ss)) + (shell-send-input! + ss + (string + ch)) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed + (string + ch)) + (loop + (+ i + 1))))))] + [else + (when (not *qt-delete-selection-enabled*) + (let ([pos (qt-plain-text-edit-cursor-position + ed)]) + (sci-send ed - (string - ch)) - (loop - (+ i - 1))))))] - [else - (when (not *qt-delete-selection-enabled*) - (let ([pos (qt-plain-text-edit-cursor-position - ed)]) - (sci-send - ed - SCI_SETSEL - pos - pos))) - (cond - [(and *auto-pair-mode* - (= n - 1) - (auto-pair-closing? - (char->integer - ch))) - (let* ([pos (qt-plain-text-edit-cursor-position - ed)] + SCI_SETSEL + pos + pos))) + (cond + [(and *auto-pair-mode* + (= n + 1) + (auto-pair-closing? + (char->integer + ch))) + (let* ([pos (qt-plain-text-edit-cursor-position + ed)] + [text (qt-plain-text-edit-text + ed)] + [next-ch (and (< pos + (string-length + text)) + (string-ref + text + pos))]) + (if (and next-ch + (char=? + next-ch + ch)) + (qt-plain-text-edit-set-cursor-position! + ed + (+ pos + 1)) + (qt-plain-text-edit-insert-text! + ed + (string + ch))))] + [(and close-ch + (= n + 1)) + (let ([pos (qt-plain-text-edit-cursor-position + ed)]) + (qt-plain-text-edit-insert-text! + ed + (string + ch + close-ch)) + (qt-plain-text-edit-set-cursor-position! + ed + (+ pos