Stage 2 (Qt): app-wide key capture → poll queue → emacs dispatch
ober
572e2577cb7cc2647231062bf9687c9974c449af
--- a/.build.yml +++ b/.build.yml @@ -103,5 +103,16 @@ tasks: export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" make test-commands + - test-keys: | + cd jerboa-browser + # Stage 2 end-to-end key capture: REAL synthetic Qt key events flow through + # the app-wide event filter → poll queue → emacs keymap/command dispatch + # (offscreen, hermetic). Proves the GUI's key path, not just the controller. + export QT_QPA_PLATFORM=offscreen JWB_TEST_NO_NETWORK=1 + export QTWEBENGINE_DISABLE_SANDBOX=1 + export QTWEBENGINE_CHROMIUM_FLAGS="--no-sandbox --disable-gpu" + export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" + export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" + make test-keys # Stage all harness snapshots (stage0 + stage1 + stage2) as an artifact. tar czf gui-snapshots.tar.gz test-artifacts --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ JERBOA_HOME ?= $(realpath $(CURDIR)/../jerboa) SCHEME ?= $(JERBOA_HOME)/.chez/bin/scheme LIBDIRS := $(CURDIR)/scheme:$(JERBOA_HOME)/lib -.PHONY: binary test test-keymap test-minibuffer test-commands test-gui test-buffers repl clean help +.PHONY: binary test test-keymap test-minibuffer test-commands test-keys test-gui test-buffers repl clean help .DEFAULT_GOAL := help # Build the self-contained native ./jerboa-browser (Chez + boot + (browser)). @@ -27,6 +27,12 @@ test-commands: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-commands-test.ss +# Stage 2 end-to-end Qt key-capture test: real synthetic Qt key events flow +# through the app-wide filter → poll queue → controller (offscreen, headless). +test-keys: + QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-keys-test.ss + # Offline Qt GUI / snapshot harness (headless). Writes PNGs to ./test-artifacts. test-gui: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ --- a/ROADMAP.md +++ b/ROADMAP.md @@ -119,18 +119,32 @@ minibuffer line). `jerboa-browser <url>` launches into this window. `session-current-buffer` (the current index really resolves to A's view). Wired into CI (hermetic). -### Stage 2 — Keymap engine + emacs bindings + minibuffer (prompt-buffer) -The heart of the nyxt feel. -- **C++**: install a `QObject` event filter on the window that forwards - key events to a Scheme callback (keysym + modifier mask); a minibuffer - `QLineEdit` + a completion `QListView` overlay. -- **Scheme**: `(browser keymap)` — key parsing (`C-`, `M-`, `S-`, chords like - `C-x b`), a keymap tree, command dispatch; `(browser minibuffer)` — a fuzzy - prompt with sources + candidates + `C-n/C-p` + RET/`C-g`; `(browser commands)` - — the command table; bind the emacs scheme from base.lisp. -- **Tests**: inject `C-x b`, type a buffer name, RET → assert switched; inject - `M-x`, type `reload`, RET → assert reload fired; minibuffer fuzzy filter - unit tests; snapshot the open minibuffer. +### Stage 2 — Keymap engine + emacs bindings + minibuffer (prompt-buffer) ✅ DONE +The heart of the nyxt feel. The pure-Scheme engine (keymap/fuzzy/minibuffer/ +command controller) is the source of truth; Qt is a display + input surface. +- **C++** (`browser_window.cpp`): an application-wide `QObject` event filter + (`KeyFilter`) captures every key PRESS (lone modifiers excepted) into a + per-window FIFO and consumes it, so all keystrokes reach the Scheme layer + rather than the page/minibuffer line. `jwb_window_install_key_hook`/ + `_remove_key_hook`, `_poll_key` (pops `"KEY\tMODS\tTEXT"`), `_is_visible`. +- **Scheme**: + - `(browser keymap)` — token parsing (`C-`/`M-`/`S-`, chords `C-x b`), + `qt-event->token` (folds shift into single-glyph punctuation), a keymap + tree, and a chord dispatcher (`pending`/`run`/`unbound`). + - `(browser fuzzy)` — nyxt-style subsequence scoring (boundary/run bonuses). + - `(browser minibuffer)` — the prompt-buffer state machine: input, + fuzzy-filtered candidates, `C-n/C-p` wrap, RET/`C-g`. + - `(browser commands)` — the command registry (M-x lists+runs all), the + emacs keyscheme, and the `app` controller that routes each key token to the + chord dispatcher or the open prompt, plus the GUI run-loop (`app-run-loop!`: + install hook → pump Qt → drain queue → dispatch, until quit/closed). Wired + into `browser-main.ss`, so `jerboa-browser <url>` is keyboard-driven. +- **Tests**: `browser-keymap-test.ss` (33), `browser-minibuffer-test.ss` (27, + fuzzy + state machine), `browser-commands-test.ss` (15, offscreen: token → + controller → buffer state, + open-minibuffer PNG snapshot), and + `browser-keys-test.ss` (9, end-to-end: REAL synthetic Qt key events → + app-wide filter → poll queue → dispatch → assert buffer switched/quit). All + four wired into CI (`test-keymap`/`-minibuffer`/`-commands`/`-keys`). ### Stage 3 — Navigation parity - **C++**: `jwb_set_zoom(view,factor)`/`jwb_zoom`, `jwb_find_text(view,str,flags)` --- a/WISHLIST.md +++ b/WISHLIST.md @@ -9,7 +9,7 @@ offline Qt snapshot + functional tests modeled on `~/mine/jerboa-emacs`. - [x] **Offline Qt test + snapshot harness** (offscreen, grab→PNG w/ IHDR-verified size, key injection) — *Stage 0* — `make test-gui`; `--repl`-on-GUI-launch + window chrome deferred to Stage 1 - [x] **Buffer model** — QMainWindow + stacked views; open/switch/next/prev/last/close; `(browser buffers)` session — *Stage 1* — `make test-buffers` (27); `jerboa-browser <url>` launches into the window -- [ ] **Keymap engine + emacs bindings + minibuffer (prompt-buffer)** with fuzzy completion — *Stage 2* +- [x] **Keymap engine + emacs bindings + minibuffer (prompt-buffer)** with fuzzy completion — *Stage 2* — `(browser keymap/fuzzy/minibuffer/commands)`; app-wide Qt key filter → poll queue → emacs dispatch; `make test-keymap/-minibuffer/-commands/-keys` (84 cases); `jerboa-browser <url>` is keyboard-driven - [ ] **Navigation parity** — scroll, zoom, find-in-page, history, reload, copy url/title — *Stage 3* - [ ] **Hint-mode** — link hinting / follow (`f`, `M-g`, `; f`) via JS overlay — *Stage 4* - [ ] **Password manager** — in-process, memory-only (no env, no config/file), autofill — *Stage 5* --- a/include/jerboa_browser.h +++ b/include/jerboa_browser.h @@ -205,6 +205,25 @@ JWB_API int jwb_window_set_status(JwbHandle window, const char *utf8_text); JWB_API int jwb_window_set_minibuffer(JwbHandle window, const char *utf8_text, int show); +/* --- keyboard capture (Stage 2 keymap dispatch) -------------------------- * + * The browser is keyboard-driven: an application-wide event filter captures + * every key PRESS (lone modifier keys excepted) into a per-window queue and + * consumes it, so all keystrokes flow to the Scheme keymap/command layer + * rather than to the page or the minibuffer line edit. The Scheme run-loop + * pumps Qt events, then drains this queue and feeds canonical key tokens to + * the command controller. (Forwarding unbound keys to the page is future + * work; for now capture is exhaustive while installed.) */ +JWB_API int jwb_window_install_key_hook(JwbHandle window); /* 1 ok / 0 fail */ +JWB_API int jwb_window_remove_key_hook(JwbHandle window); +/* Pop the oldest queued key event as "KEY\tMODS\tTEXT" (decimal KEY/MODS = + * Qt::Key / Qt::KeyboardModifiers; TEXT is the event's UTF-8 text, possibly + * empty). Returns "" when the queue is empty. The returned pointer is a + * thread-local buffer valid until the next call. */ +JWB_API const char *jwb_window_poll_key(JwbHandle window); +/* 1 while the window is mapped/visible; 0 once the user closes it. Lets the + * Scheme run-loop exit when the window is dismissed. */ +JWB_API int jwb_window_is_visible(JwbHandle window); + #ifdef __cplusplus } /* extern "C" */ #endif --- a/qt-webengine/src/browser_window.cpp +++ b/qt-webengine/src/browser_window.cpp @@ -11,9 +11,12 @@ #include "browser_objects.h" #include <QApplication> +#include <QEvent> +#include <QKeyEvent> #include <QLabel> #include <QLineEdit> #include <QMainWindow> +#include <QObject> #include <QPixmap> #include <QStackedWidget> #include <QString> @@ -21,10 +24,33 @@ #include <QWidget> #include <cstring> +#include <deque> +#include <string> #include <vector> namespace jwb { +struct Window; // fwd + +// One captured key press, kept until Scheme drains it (jwb_window_poll_key). +struct KeyEvt { + int key; + int mods; + std::string text; +}; + +// Application-wide event filter: while its window is capturing, every key PRESS +// (apart from lone modifier keys) is queued onto the window and consumed, so the +// Scheme keymap layer — not the focused widget — decides what each key does. +class KeyFilter : public QObject { +public: + explicit KeyFilter(Window *w) : win_(w) {} + bool eventFilter(QObject *obj, QEvent *ev) override; + +private: + Window *win_; +}; + // A window owns its Qt widget tree (QMainWindow + children); it does NOT own the // views in `views` — those stay owned by their handles. `views` parallels the // stack's widget order, so index i in `views` is stack widget i. @@ -34,8 +60,30 @@ struct Window { QLabel *status; QLineEdit *minibuffer; std::vector<JwbHandle> views; + std::deque<KeyEvt> keys; // captured key presses awaiting Scheme drain + KeyFilter *filter; // installed app-wide event filter, or nullptr + bool capturing; // whether `filter` enqueues + consumes keys }; +bool KeyFilter::eventFilter(QObject *obj, QEvent *ev) { + (void)obj; + if (win_->capturing && ev->type() == QEvent::KeyPress) { + auto *ke = static_cast<QKeyEvent *>(ev); + int k = ke->key(); + // Don't enqueue a press of a bare modifier — only real chords/keys. + if (k == Qt::Key_Control || k == Qt::Key_Shift || k == Qt::Key_Alt || + k == Qt::Key_Meta || k == Qt::Key_AltGr || k == 0) + return false; + KeyEvt e; + e.key = k; + e.mods = static_cast<int>(ke->modifiers()); + e.text = ke->text().toStdString(); + win_->keys.push_back(e); + return true; // consume: the page / line edit never sees it + } + return false; +} + inline bool get_window(JwbHandle h, Window **out, JwbStatus *err) { void *p = nullptr; if (!handle_lookup(h, HandleKind::Window, &p, err)) return false; @@ -77,6 +125,8 @@ JWB_API JwbHandle jwb_window_open(void) { layout->addWidget(w->minibuffer, 0); w->win->setCentralWidget(central); w->win->resize(1024, 768); + w->filter = nullptr; + w->capturing = false; return jwb::handle_alloc(jwb::HandleKind::Window, w); } @@ -86,6 +136,14 @@ JWB_API int jwb_window_close(JwbHandle window) { JwbStatus st = JWB_OK; if (!jwb::handle_release(window, jwb::HandleKind::Window, &obj, &st)) return 0; auto *w = static_cast<jwb::Window *>(obj); + // Uninstall + drop the key-capture filter before tearing down the widgets. + if (w->filter) { + if (auto *app = QApplication::instance()) app->removeEventFilter(w->filter); + delete w->filter; + w->filter = nullptr; + } + w->capturing = false; + w->keys.clear(); // Detach (don't delete) every view so its handle stays valid + singly-owned. while (w->stack->count() > 0) jwb::detach_view_widget(w->stack, w->stack->widget(0)); @@ -232,4 +290,58 @@ JWB_API int jwb_window_set_minibuffer(JwbHandle window, const char *utf8_text, return 1; } +JWB_API int jwb_window_install_key_hook(JwbHandle window) { + jwb::clear_last_error(); + jwb::Window *w = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_window(window, &w, &st)) return 0; + auto *app = QApplication::instance(); + if (!app) { + jwb::set_last_error("install_key_hook: no QApplication"); + return 0; + } + if (!w->filter) { + w->filter = new jwb::KeyFilter(w); + app->installEventFilter(w->filter); // app-wide: sees keys before any widget + } + w->capturing = true; + return 1; +} + +JWB_API int jwb_window_remove_key_hook(JwbHandle window) { + jwb::clear_last_error(); + jwb::Window *w = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_window(window, &w, &st)) return 0; + if (w->filter) { + if (auto *app = QApplication::instance()) app->removeEventFilter(w->filter); + delete w->filter; + w->filter = nullptr; + } + w->capturing = false; + return 1; +} + +JWB_API const char *jwb_window_poll_key(JwbHandle window) { + static thread_local std::string out; + out.clear(); + jwb::clear_last_error(); + jwb::Window *w = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_window(window, &w, &st)) return out.c_str(); + if (w->keys.empty()) return out.c_str(); // "" == no event queued + jwb::KeyEvt e = w->keys.front(); + w->keys.pop_front(); + out = std::to_string(e.key) + "\t" + std::to_string(e.mods) + "\t" + e.text; + return out.c_str(); +} + +JWB_API int jwb_window_is_visible(JwbHandle window) { + jwb::clear_last_error(); + jwb::Window *w = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_window(window, &w, &st)) return 0; + return w->win->isVisible() ? 1 : 0; +} + } // extern "C" new file mode 100644 --- /dev/null +++ b/scheme/browser-keys-test.ss @@ -0,0 +1,168 @@ +#!chezscheme +;;; browser-keys-test.ss — Stage 2 end-to-end Qt key-capture test. +;;; +;;; The deepest functional proof: synthesize REAL Qt key events (jwb_send_key), +;;; let the installed application-wide event filter capture them, drain the +;;; queue (jwb_window_poll_key) into canonical tokens, and feed them through the +;;; very same controller the GUI uses (app-pump-keys! → app-feed-token!). Then +;;; assert the window's buffer state changed. This closes the loop the earlier +;;; command tests stubbed by calling app-feed-token! directly. +;;; +;;; Offscreen + synchronous; hermetic (empty-URL buffers, no network). sendEvent +;;; reaches app-level filters without an event loop, so we inject + drain inline. +;;; +;;; Run: QT_QPA_PLATFORM=offscreen make test-keys +;;; Exits 0 on success, 1 on any failed case. + +(import (chezscheme) (browser) (browser buffers) + (browser keymap) (browser minibuffer) (browser commands)) + +;;; ─── tiny test framework (shared shape with the other test files) ───────── +(define *pass* 0) +(define *fail* 0) +(define *test-name* "(none)") + +(define-syntax test-group + (syntax-rules () + [(_ name body ...) + (begin (display "\n=== ") (display name) (display " ===\n") + (flush-output-port (current-output-port)) body ...)])) + +(define (run-test-case name thunk) + (set! *test-name* name) + (let ((ok (guard (e (#t + (set! *fail* (+ *fail* 1)) + (display " FAIL: ") (display name) (newline) + (display " error: ") + (display (if (message-condition? e) (condition-message e) + (format "~s" e))) + (newline) (flush-output-port (current-output-port)) #f)) + (thunk) #t))) + (when ok + (set! *pass* (+ *pass* 1)) + (display " pass: ") (display name) (newline) + (flush-output-port (current-output-port))))) + +(define-syntax test-case + (syntax-rules () [(_ name body ...) (run-test-case name (lambda () body ...))])) + +(define-syntax check + (syntax-rules (=> ?) + [(_ expr => expected) + (let ((got expr) (exp expected)) + (unless (equal? got exp) + (error 'check (format "~a: expected ~s, got ~s" *test-name* exp got))))] + [(_ expr ? pred) + (let ((got expr)) + (unless (pred got) (error 'check (format "~a: predicate failed for ~s" *test-name* got))))])) + +;;; ─── setup (offscreen) ───────────────────────────────────────────────────── +(unless (getenv "QT_QPA_PLATFORM") (setenv "QT_QPA_PLATFORM" "offscreen")) + +;; Qt::Key codes (letters are always the uppercase code; case lives in text()). +(define K-x 88) (define K-b 66) (define K-t 84) (define K-c 67) (define K-k 75) +(define K-n 78) (define K-p 80) (define K-g 71) (define K-l 76) +(define K-0 48) (define K-1 49) (define K-2 50) +(define K-RET 16777220) ; Qt::Key_Return +(define K-ESC 16777216) ; Qt::Key_Escape +(define K-CTRL 16777249) ; Qt::Key_Control (a lone modifier) +(define ctrl qt-mod-control) +(define meta qt-mod-alt) + +;; A fresh session with `n` empty-URL buffers (labels "buffer 0".."buffer n-1"), +;; a controller, and the key hook installed — then drained body, then teardown. +(define-syntax with-keys + (syntax-rules () + [(_ (app s win n) body ...) + (let ((s (open-browser-session))) + (do ((i 0 (+ i 1))) ((= i n)) (session-open-buffer s "")) + (let ((app (make-browser-app s)) (win (session-window s))) + (browser-window-install-key-hook win) + body ... + (browser-window-remove-key-hook win) + (close-browser-session! s)))])) + +;; Inject one real Qt key event (press+release) at the current view; the +;; app-wide filter captures it. `text` is the produced glyph ("" for chords). +(define (inject app key mods text) + (let ((v (buffer-view (session-current-buffer (app-session app))))) + (browser-send-key v key mods text))) + +;; Inject then drain in one step (FIFO order is preserved by the queue). +(define (key app key mods text) (inject app key mods text) (app-pump-keys! app)) + +;;; ─── the capture/encode/decode pipeline ──────────────────────────────────── +(test-group "capture pipeline (filter → queue → token)" + (test-case "a chord key is queued, encoded, and decodes to its token" + (with-keys (app s win 1) + (inject app K-x ctrl "") ; Ctrl+X + (check (browser-window-poll-key win) => "88\t67108864\t"))) + (test-case "lone modifier presses are not queued" + (with-keys (app s win 1) + (inject app K-CTRL ctrl "") ; bare Ctrl + (check (browser-window-poll-key win) => ""))) + (test-case "window visibility tracks show/hide (run-loop exit signal)" + (with-keys (app s win 1) + (check (browser-window-visible? win) => #f) + (browser-window-show win) + (check (browser-window-visible? win) => #t) + (browser-window-hide win) + (check (browser-window-visible? win) => #f)))) + +;;; ─── real key events drive real buffer state ────────────────────────────── +(test-group "C-x b (real Qt events) opens the prompt-buffer" + (test-case "the captured chord opens the switch-buffer prompt" + (with-keys (app s win 3) + (key app K-x ctrl "") ; C-x → pending + (key app K-b 0 "b") ; b → run switch-buffer + (check (minibuffer? (app-minibuffer app)) => #t) + (check (minibuffer-prompt (app-minibuffer app)) => "Switch to buffer: ") + (check (minibuffer-candidate-count (app-minibuffer app)) => 3)))) + +(test-group "full real-key flow: C-x b, type label, RET switches buffer" + (test-case "synthetic keystrokes switch the current buffer to buffer 0" + (with-keys (app s win 3) + (check (session-current-index s) => 2) ; last opened is focused + ;; queue the whole sequence, then drain once — FIFO replays it in order + (inject app K-x ctrl "") + (inject app K-b 0 "b") + (inject app K-0 0 "0") ; filters to "buffer 0" + (inject app K-RET 0 "") + (app-pump-keys! app) + (check (app-minibuffer app) => #f) ; prompt closed + (check (session-current-index s) => 0) + (check (eq? (session-current-buffer s) (car (session-buffer-list s))) => #t)))) + +(test-group "direct motion + creation chords (real keys)" + (test-case "M-n switches to the next buffer" + (with-keys (app s win 3) + (check (session-current-index s) => 2) + (key app K-n meta "n") ; M-n + (check (session-current-index s) => 0))) ; (2+1) mod 3 + (test-case "C-t opens and focuses a new buffer" + (with-keys (app s win 2) + (check (session-buffer-count s) => 2) + (key app K-t ctrl "") ; C-t + (check (session-buffer-count s) => 3) + (check (session-current-index s) => 2)))) + +(test-group "abort with escape (real key)" + (test-case "escape closes an open prompt" + (with-keys (app s win 2) + (key app K-x ctrl "") (key app K-b 0 "b") + (check (minibuffer? (app-minibuffer app)) => #t) + (key app K-ESC 0 "") ; escape → abort + (check (app-minibuffer app) => #f)))) + +(test-group "quit chord (real keys) sets the run-loop exit flag" + (test-case "C-x C-c flips app-should-quit?" + (with-keys (app s win 1) + (check (app-should-quit? app) => #f) + (key app K-x ctrl "") + (key app K-c ctrl "") ; C-x C-c + (check (app-should-quit? app) => #t)))) + +(newline) +(display "browser-keys-test: ") (display *pass*) (display " passed, ") +(display *fail*) (display " failed") (newline) +(exit (if (zero? *fail*) 0 1)) --- a/scheme/browser-main.ss +++ b/scheme/browser-main.ss @@ -14,7 +14,7 @@ ;;; jerboa-browser test run the (browser) test suite ;;; jerboa-browser run FILE run a Jerboa script with (browser) available -(import (chezscheme) (browser) (browser buffers) (std repl)) +(import (chezscheme) (browser) (browser buffers) (browser commands) (std repl)) ;; Directory of argv[0], or "." when it has no slash / is unavailable. (define (exe-dir) @@ -103,7 +103,12 @@ (when (browser-ok? tr) (display (browser-value tr)) (newline))) (close-browser-session! s) (exit 0)) (begin - (browser-exec) ; blocks until the window is closed + ;; Keyboard-driven: build the controller and run the keymap loop + ;; (installs the app-wide key hook, pumps Qt events, drains the + ;; key queue → emacs keymap/command dispatch) until the window is + ;; closed or C-x C-c quits. + (let ((app (make-browser-app s))) + (app-run-loop! app)) (close-browser-session! s) (exit 0)))))))) (define (usage port code) --- a/scheme/browser.ss +++ b/scheme/browser.ss @@ -73,6 +73,10 @@ browser-window-set-title browser-window-set-status browser-window-set-minibuffer + browser-window-install-key-hook + browser-window-remove-key-hook + browser-window-poll-key + browser-window-visible? browser-window? browser-window-handle) @@ -188,6 +192,10 @@ (define-c-lambda %win-set-title (uint64 char-string) int "jwb_window_set_title") (define-c-lambda %win-set-status (uint64 char-string) int "jwb_window_set_status") (define-c-lambda %win-set-minibuf (uint64 char-string int) int "jwb_window_set_minibuffer") + (define-c-lambda %win-install-keys (uint64) int "jwb_window_install_key_hook") + (define-c-lambda %win-remove-keys (uint64) int "jwb_window_remove_key_hook") + (define-c-lambda %win-poll-key (uint64) char-string "jwb_window_poll_key") + (define-c-lambda %win-visible (uint64) int "jwb_window_is_visible") ;; --- tagged results ----------------------------------------------------- (def (ok* v) (list 'ok v)) @@ -447,4 +455,24 @@ (int-ok "window set-minibuffer" (%win-set-minibuf (browser-window-handle w) text (if show? 1 0)))) + ;; Install / remove the app-wide key-capture filter (Stage 2 keymap dispatch). + (def (browser-window-install-key-hook w) + (require-window 'browser-window-install-key-hook w) + (int-ok "install-key-hook" (%win-install-keys (browser-window-handle w)))) + (def (browser-window-remove-key-hook w) + (require-window 'browser-window-remove-key-hook w) + (int-ok "remove-key-hook" (%win-remove-keys (browser-window-handle w)))) + + ;; Pop the oldest queued key event as the raw "KEY\tMODS\tTEXT" string, or "" + ;; when the queue is empty. (Plain string, not a tagged result: it is drained + ;; in a hot loop and "" cleanly signals "nothing pending".) + (def (browser-window-poll-key w) + (require-window 'browser-window-poll-key w) + (%win-poll-key (browser-window-handle w))) + + ;; #t while the window is mapped; #f after the user closes it. + (def (browser-window-visible? w) + (require-window 'browser-window-visible? w) + (= 1 (%win-visible (browser-window-handle w)))) + ) ; library (browser) --- a/scheme/browser/commands.ss +++ b/scheme/browser/commands.ss @@ -18,6 +18,7 @@ make-browser-app app? app-session app-keymap app-dispatcher app-minibuffer app-echo app-should-quit? app-feed-token! app-type! app-render! + app-pump-keys! app-run-loop! emacs-keymap buffer-label register-command! command-ref command-names command? command-name command-doc command-proc @@ -151,6 +152,55 @@ (def (app-type! app str) (string-for-each (lambda (ch) (app-feed-token! app (string ch))) str)) + ;; --- live Qt key drain (GUI run-loop) ----------------------------------- + ;; Split "KEY\tMODS\tTEXT" (jwb_window_poll_key's encoding) into its fields; + ;; TEXT (the trailing field) may be empty and is never itself a tab. + (def (split-tab s) + (let ((n (string-length s))) + (let loop ((i 0) (start 0) (acc '())) + (cond + ((= i n) (reverse (cons (substring s start n) acc))) + ((char=? (string-ref s i) #\tab) + (loop (+ i 1) (+ i 1) (cons (substring s start i) acc))) + (else (loop (+ i 1) start acc)))))) + + ;; Decode one polled event string into a canonical key token, or #f. + (def (decode-key-event s) + (let ((parts (split-tab s))) + (and (>= (length parts) 2) + (let ((key (string->number (list-ref parts 0))) + (mods (string->number (list-ref parts 1))) + (text (if (>= (length parts) 3) (list-ref parts 2) ""))) + (and (integer? key) (integer? mods) + (qt-event->token key mods text)))))) + + ;; Drain every queued Qt key event from the window into the controller. The + ;; GUI run-loop calls this each tick; the C++ filter is the producer. + (def (app-pump-keys! app) + (let ((win (session-window (app-session app)))) + (let loop () + (let ((s (browser-window-poll-key win))) + (when (and (string? s) (> (string-length s) 0)) + (let ((tok (decode-key-event s))) + (when tok (app-feed-token! app tok))) + (loop)))))) + + ;; The interactive GUI loop: install key capture, then pump Qt events + drain + ;; keys until the quit command fires or the user closes the window. Replaces a + ;; bare browser-exec so keystrokes route through the keymap. `tick-ms` is the + ;; per-iteration Qt pump budget (default ~60fps). + (def (app-run-loop! app . opt) + (let ((win (session-window (app-session app))) + (tick-ms (if (pair? opt) (car opt) 16))) + (browser-window-install-key-hook win) + (app-render! app) + (let loop () + (browser-pump tick-ms) + (app-pump-keys! app) + (unless (or (app-should-quit? app) (not (browser-window-visible? win))) + (loop))) + (browser-window-remove-key-hook win))) + ;; --- command implementations -------------------------------------------- (def (buffer-label b) (let ((title (buffer-title b)) (url (buffer-url b)))