Stage 3: navigation parity — scroll, zoom, find-in-page, copy url/title
ober
8a87203450d2ce0c76d54559432831d24736d8ac
--- a/.build.yml +++ b/.build.yml @@ -114,5 +114,16 @@ tasks: export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" make test-keys + - test-nav: | + cd jerboa-browser + # Stage 3 navigation parity: scroll/zoom/find-in-page/copy driven through + # the command controller against rendered data: pages (offscreen, hermetic + # — data: bypasses the no-network policy; find needs a rendered frame). + 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-nav # 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-keys test-gui test-buffers repl clean help +.PHONY: binary test test-keymap test-minibuffer test-commands test-keys test-nav test-gui test-buffers repl clean help .DEFAULT_GOAL := help # Build the self-contained native ./jerboa-browser (Chez + boot + (browser)). @@ -33,6 +33,12 @@ test-keys: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-keys-test.ss +# Stage 3 navigation-parity functional tests: scroll/zoom/find/copy driven +# through the command controller against rendered data: pages (offscreen). +test-nav: + QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-nav-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 @@ -146,16 +146,25 @@ command controller) is the source of truth; Qt is a display + input surface. 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)` - + find-result callback (`QWebEnginePage::findText`), `jwb_scroll(view,dx,dy)` - (or JS), `jwb_clipboard_set(text)` (`QClipboard`). -- **Scheme + bindings**: scroll (`C-up/C-down`, page), zoom - (`C-+/C-=/C-hyphen/C-0`), find (`C-s`/`C-f`, next/prev, remove-marks), - history (`back`/`forward` already), `copy-url` (`C-M-l`), `copy-title` - (`C-M-t`). -- **Tests**: find on example.com → assert match count; zoom → assert factor; - copy-url → assert clipboard. +### Stage 3 — Navigation parity ✅ DONE +- **C++**: `jwb_view_set_zoom`/`_get_zoom` (integer percent, clamped [25,500]), + `jwb_view_find(view,text,flags,timeout)` — a synchronous wrapper over the + async `QWebEnginePage::findText` (pumps until the `QWebEngineFindTextResult` + callback delivers the match count), and the global `jwb_clipboard_set`/`_get` + (`QClipboard`). Scroll is pure JS (`window.scrollBy/scrollTo`), no C entry. +- **Scheme + bindings**: `(browser)` adds `browser-set-zoom`/`browser-zoom`/ + `browser-find`/`browser-clear-find`/`browser-clipboard-set!`/`browser-clipboard`. + `(browser commands)` adds the commands + emacs keys: scroll `C-n`/`C-p` (line), + `C-v`/`M-v` (page), `M-<`/`M->` (top/bottom); zoom `C-+`/`C-=` in, `C--` out, + `C-0` reset; find `C-s` (prompt → highlight + match count), `C-M-s`/`C-M-r` + next/prev, `C-g` clears the highlight; copy `C-c u` (url) / `C-c t` (title). + History `C-b`/`C-f` already existed. +- **Tests** (`browser-nav-test.ss`, `make test-nav`, 10 cases): registry + + keymap bindings (incl. the `C-c u`/`C-c t` chords); zoom set/get round-trip + + in/out/reset; find match counts + case flag on a rendered data: page; the + `C-s` find prompt (type query, RET → echoes "N matches"); scroll moves + `window.scrollY` on a tall page; clipboard round-trip + `copy-url`/`copy-title`. + Hermetic (data: pages, window shown so findText sees a rendered frame); CI-wired. ### Stage 4 — Hint-mode nyxt-style link hinting. --- a/WISHLIST.md +++ b/WISHLIST.md @@ -10,7 +10,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 - [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* +- [x] **Navigation parity** — scroll (`C-n/C-p/C-v/M-v/M-</M->`), zoom (`C-+/C--/C-0`), find-in-page (`C-s`, `C-M-s/r`), copy url/title (`C-c u/t`); history/reload already — *Stage 3* — `make test-nav` (10) - [ ] **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* - [ ] **Polish** — status bar, echo-area messages, command-palette completeness, bookmarks, docs — *Stage 6* --- a/include/jerboa_browser.h +++ b/include/jerboa_browser.h @@ -181,6 +181,26 @@ JWB_API int jwb_view_grab_png(JwbHandle view, const char *path); JWB_API int jwb_send_key(JwbHandle view, int qt_key, int modifiers, const char *text); +/* === Navigation parity (Stage 3) ======================================= + * Zoom, find-in-page, and the global clipboard. Scroll is done in Scheme via + * jwb_eval (window.scrollBy/scrollTo), so it needs no C entry point. */ +/* Zoom the view's web content. `percent` is 100 = 1.0x, clamped to [25,500]. + * jwb_view_set_zoom returns 1/0; jwb_view_get_zoom returns the current percent + * (-1 on error). */ +JWB_API int jwb_view_set_zoom(JwbHandle view, int percent); +JWB_API int jwb_view_get_zoom(JwbHandle view); +/* Find `text` on the page (synchronous: pumps the event loop until the result + * callback fires or `timeout_ms` elapses). `flags` bit0 = search backward, + * bit1 = case-sensitive. Returns the number of matches (0 if none), or -1 on + * error/timeout. Passing "" clears the highlight and returns 0. */ +JWB_API int jwb_view_find(JwbHandle view, const char *text, int flags, + uint32_t timeout_ms); +/* The global window-system clipboard (QClipboard). jwb_clipboard_set returns + * 1/0; jwb_clipboard_get returns the current text in a thread-local buffer + * (borrowed until this thread's next clipboard_get call, never freed). */ +JWB_API int jwb_clipboard_set(const char *utf8_text); +JWB_API const char *jwb_clipboard_get(void); + /* === Window / buffer chrome (Stage 1) ================================== * A BrowserWindow is a QMainWindow hosting a QStackedWidget of views (the * nyxt "buffers" model: one window, many buffers, one visible at a time) plus --- a/qt-webengine/src/browser_automation.cpp +++ b/qt-webengine/src/browser_automation.cpp @@ -7,13 +7,17 @@ // rendering (assert page state via jwb_eval instead), but Qt chrome grabs fine. #include "browser_objects.h" +#include <QClipboard> #include <QCoreApplication> #include <QApplication> +#include <QGuiApplication> #include <QKeyEvent> #include <QPixmap> #include <QString> #include <QWidget> +#include <string> + extern "C" { // Resize the view widget. A never-shown view defaults to 0x0, which grabs @@ -72,4 +76,54 @@ JWB_API int jwb_send_key(JwbHandle view, int qt_key, int modifiers, return 1; } +// --- zoom (Stage 3) ------------------------------------------------------ +// Zoom the web content. `percent` is 100 = 1.0x; WebEngine clamps the factor +// to [0.25, 5.0], so we mirror that as [25, 500]. +JWB_API int jwb_view_set_zoom(JwbHandle view, int percent) { + jwb::clear_last_error(); + jwb::View *v = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_view(view, &v, &st)) return 0; + if (percent < 25 || percent > 500) { + jwb::set_last_error("zoom: percent must be in [25,500]"); + return 0; + } + v->view->setZoomFactor(percent / 100.0); + return 1; +} + +JWB_API int jwb_view_get_zoom(JwbHandle view) { + jwb::clear_last_error(); + jwb::View *v = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_view(view, &v, &st)) return -1; + return static_cast<int>(v->view->zoomFactor() * 100.0 + 0.5); +} + +// --- clipboard (Stage 3) ------------------------------------------------- +// The global window-system clipboard. Under QT_QPA_PLATFORM=offscreen Qt +// provides an in-process clipboard, so copy-url/copy-title round-trip in tests. +JWB_API int jwb_clipboard_set(const char *utf8_text) { + jwb::clear_last_error(); + if (!utf8_text) { + jwb::set_last_error("clipboard_set: text is null"); + return 0; + } + QClipboard *cb = QGuiApplication::clipboard(); + if (!cb) { + jwb::set_last_error("clipboard unavailable"); + return 0; + } + cb->setText(QString::fromUtf8(utf8_text)); + return 1; +} + +JWB_API const char *jwb_clipboard_get(void) { + jwb::clear_last_error(); + static thread_local std::string buf; + QClipboard *cb = QGuiApplication::clipboard(); + buf = cb ? cb->text().toUtf8().constData() : ""; + return buf.c_str(); +} + } // extern "C" --- a/qt-webengine/src/browser_page.cpp +++ b/qt-webengine/src/browser_page.cpp @@ -9,6 +9,7 @@ #include <QString> #include <QUrl> #include <QVariant> +#include <QWebEngineFindTextResult> #include <functional> #include <string> @@ -157,4 +158,37 @@ JWB_API char *jwb_current_url_sync(JwbHandle view, JwbStatus *out_status) { JWB_API void jwb_string_free(char *s) { std::free(s); } +// --- find-in-page (Stage 3) ---------------------------------------------- +// Synchronous wrapper over the async QWebEnginePage::findText: kick the find, +// pump until the result callback delivers the match count. Empty `text` clears +// the current highlight (returns 0). -1 signals error/timeout. +JWB_API int jwb_view_find(JwbHandle view, const char *text, int flags, + uint32_t timeout_ms) { + jwb::clear_last_error(); + jwb::View *v = nullptr; + JwbStatus st = JWB_OK; + if (!jwb::get_view(view, &v, &st)) return -1; + + QString needle = text ? QString::fromUtf8(text) : QString(); + if (needle.isEmpty()) { + v->page->findText(QString()); // clear highlight + return 0; + } + QWebEnginePage::FindFlags f; + if (flags & 1) f |= QWebEnginePage::FindBackward; + if (flags & 2) f |= QWebEnginePage::FindCaseSensitively; + + bool done = false; + int matches = 0; + v->page->findText(needle, f, [&](const QWebEngineFindTextResult &r) { + matches = r.numberOfMatches(); + done = true; + }); + if (!pump_until(done, timeout_ms)) { + jwb::set_last_error("find timed out"); + return -1; + } + return matches; +} + } // extern "C" new file mode 100644 --- /dev/null +++ b/scheme/browser-nav-test.ss @@ -0,0 +1,200 @@ +#!chezscheme +;;; browser-nav-test.ss — Stage 3 navigation-parity functional tests. +;;; +;;; Drives the real command controller + (browser) FFI against rendered data: +;;; pages (hermetic — data: bypasses the no-network policy): scroll, zoom, +;;; find-in-page, and copy url/title to the clipboard. find/zoom need a shown, +;;; rendered page (findText searches the rendered frame, not just the DOM), so +;;; the harness shows + sizes the window and pumps before asserting. +;;; +;;; Run: QT_QPA_PLATFORM=offscreen make test-nav +;;; 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))))])) + +;;; ─── helpers ─────────────────────────────────────────────────────────────── +(unless (getenv "QT_QPA_PLATFORM") (error 'setup "run under QT_QPA_PLATFORM=offscreen (use: make test-nav)")) + +;; Is `needle` a substring of `hay`? +(define (str-has? hay needle) + (let ((hn (string-length hay)) (nn (string-length needle))) + (let loop ((i 0)) + (cond ((> (+ i nn) hn) #f) + ((string=? (substring hay i (+ i nn)) needle) #t) + (else (loop (+ i 1))))))) + +;; Qt::Key codes used by the chord-driven cases. +(define ctrl qt-mod-control) +(define meta qt-mod-alt) +(define K-c 67) (define K-u 85) (define K-s 83) (define K-RET 16777220) + +;; A hermetic page: a no-network session (data: still loads), window shown + +;; sized so the page renders (find/zoom require a rendered frame), the buffer +;; opened + given time to paint, and a controller over it. Then body, teardown. +(define-syntax with-page + (syntax-rules () + [(_ (app s v) url body ...) + (let* ((s (open-browser-session (browser-capabilities))) ; no network + (win (session-window s))) + (browser-window-resize win 800 600) + (browser-window-show win) + (session-open-buffer s url) + (browser-pump 300) ; let it paint + (let* ((app (make-browser-app s)) + (v (buffer-view (session-current-buffer s)))) + body ... + (close-browser-session! s)))])) + +;; Content page: foo×3 + bar×1, with a <title>. (find searches rendered text.) +(define find-page + (string-append "data:text/html,<html><head><title>T</title></head>" + "<body>foo%20foo%20foo%20bar</body></html>")) +;; A page taller than the 600px viewport, so scrollY can move. +(define tall-page + "data:text/html,<body%20style=%22margin:0;height:6000px%22>x</body>") + +;; scrollY of the current view, as a number. +(define (scroll-y v) + (let ((r (browser-eval v "''+window.scrollY"))) + (and (browser-ok? r) (string->number (browser-value r))))) + +;;; ─── command registry + emacs bindings (no page needed) ──────────────────── +(test-group "Stage 3 commands are registered" + (test-case "scroll/zoom/find/copy commands exist" + (for-each (lambda (n) (check (and (command-ref (string->symbol n)) #t) => #t)) + '("scroll-down" "scroll-up" "scroll-page-down" "scroll-page-up" + "scroll-to-top" "scroll-to-bottom" + "zoom-in" "zoom-out" "zoom-reset" + "find-in-page" "find-next" "find-previous" + "copy-url" "copy-title")))) + +(test-group "emacs keymap binds the Stage 3 keys" + (define km (emacs-keymap)) + (test-case "single-key motion/zoom bindings resolve" + (check (keymap-ref km "C-n") => 'scroll-down) + (check (keymap-ref km "C-v") => 'scroll-page-down) + (check (keymap-ref km "M-v") => 'scroll-page-up) + (check (keymap-ref km "M-<") => 'scroll-to-top) + (check (keymap-ref km "M->") => 'scroll-to-bottom) + (check (keymap-ref km "C-+") => 'zoom-in) + (check (keymap-ref km "C-=") => 'zoom-in) + (check (keymap-ref km "C-0") => 'zoom-reset) + (check (keymap-ref km "C-s") => 'find-in-page) + (check (keymap-ref km "C-M-s") => 'find-next)) + (test-case "C-c u / C-c t are chords to copy-url / copy-title" + (let ((d (make-key-dispatcher km))) + (check (dispatcher-feed! d "C-c") => 'pending) + (check (dispatcher-feed! d "u") => '(run . copy-url))) + (let ((d (make-key-dispatcher km))) + (check (dispatcher-feed! d "C-c") => 'pending) + (check (dispatcher-feed! d "t") => '(run . copy-title))))) + +;;; ─── zoom ────────────────────────────────────────────────────────────────── +(test-group "zoom: set/get round-trip + zoom-in/out/reset commands" + (test-case "set-zoom 150 reads back 150; reset → 100; in → 110; out → 100" + (with-page (app s v) find-page + (check (browser-value (browser-set-zoom v 150)) => 150) + (check (browser-value (browser-zoom v)) => 150) + (run-command-by-name app "zoom-reset") + (check (browser-value (browser-zoom v)) => 100) + (run-command-by-name app "zoom-in") + (check (browser-value (browser-zoom v)) => 110) + (run-command-by-name app "zoom-out") + (check (browser-value (browser-zoom v)) => 100)))) + +;;; ─── find-in-page ────────────────────────────────────────────────────────── +(test-group "find: match counts + flags (rendered page)" + (test-case "browser-find counts matches; case flag respected" + (with-page (app s v) find-page + (check (browser-value (browser-find v "foo")) => 3) + (check (browser-value (browser-find v "bar")) => 1) + (check (browser-value (browser-find v "zzz")) => 0) + (check (browser-value (browser-find v "FOO" 2)) => 0) ; case-sensitive + (check (browser-value (browser-find v "FOO" 0)) => 3)))) ; case-insensitive + +(test-group "find-in-page command: C-s, type query, RET → echoes count" + (test-case "the find prompt searches and reports the match count" + (with-page (app s v) find-page + (app-feed-token! app "C-s") ; open the Search: prompt + (check (minibuffer? (app-minibuffer app)) => #t) + (check (minibuffer-prompt (app-minibuffer app)) => "Search: ") + (app-type! app "foo") ; type the query + (app-feed-token! app "RET") ; run the find + (check (app-minibuffer app) => #f) + (check (str-has? (app-echo app) "3 match") => #t) + ;; find-next repeats the stored query (still 3 matches for "foo") + (run-command-by-name app "find-next") + (check (str-has? (app-echo app) "for foo") => #t)))) + +;;; ─── scroll ────────────────────────────────────────────────────────────────── +(test-group "scroll: commands move window.scrollY on a tall page" + (test-case "scroll-to-bottom moves down, scroll-to-top returns to 0" + (with-page (app s v) tall-page + (check (scroll-y v) => 0) + (run-command-by-name app "scroll-to-bottom") + (check (scroll-y v) ? (lambda (y) (and y (> y 0)))) + (run-command-by-name app "scroll-to-top") + (check (scroll-y v) => 0) + (run-command-by-name app "scroll-down") ; one line down from the top + (check (scroll-y v) ? (lambda (y) (and y (> y 0))))))) + +;;; ─── clipboard + copy commands ────────────────────────────────────────────── +(test-group "clipboard round-trips; copy-url / copy-title fill it" + (test-case "browser-clipboard-set! / browser-clipboard round-trip" + (browser-clipboard-set! "clip-rt-123") + (check (browser-clipboard) => "clip-rt-123")) + (test-case "copy-url (via C-c u chord) copies the buffer URL" + (with-page (app s v) find-page + (browser-clipboard-set! "") + (app-feed-token! app "C-c") (app-feed-token! app "u") + (check (browser-clipboard) => (browser-value (browser-url v))))) + (test-case "copy-title copies the page <title>" + (with-page (app s v) find-page + (browser-clipboard-set! "") + (run-command-by-name app "copy-title") + (check (browser-clipboard) => "T")))) + +(newline) +(display "browser-nav-test: ") (display *pass*) (display " passed, ") +(display *fail*) (display " failed") (newline) +(exit (if (zero? *fail*) 0 1)) --- a/scheme/browser.ss +++ b/scheme/browser.ss @@ -58,6 +58,13 @@ browser-resize browser-grab-png browser-send-key + ;; navigation parity (Stage 3) + browser-set-zoom + browser-zoom + browser-find + browser-clear-find + browser-clipboard-set! + browser-clipboard ;; window / buffer chrome browser-window-open browser-window-close @@ -177,6 +184,11 @@ (define-c-lambda %view-resize (uint64 int int) int "jwb_view_resize") (define-c-lambda %grab-png (uint64 char-string) int "jwb_view_grab_png") (define-c-lambda %send-key (uint64 int int char-string) int "jwb_send_key") + (define-c-lambda %set-zoom (uint64 int) int "jwb_view_set_zoom") + (define-c-lambda %get-zoom (uint64) int "jwb_view_get_zoom") + (define-c-lambda %find (uint64 char-string int uint32) int "jwb_view_find") + (define-c-lambda %clip-set (char-string) int "jwb_clipboard_set") + (define-c-lambda %clip-get () char-string "jwb_clipboard_get") ;; window / buffer chrome (browser_window.cpp) (define-c-lambda %win-open () uint64 "jwb_window_open") (define-c-lambda %win-close (uint64) int "jwb_window_close") @@ -371,6 +383,44 @@ (ok* #t) (err* (string-append "send-key: " (%last-error))))) + ;; --- navigation parity (Stage 3) --------------------------------------- + ;; Zoom the web content to `percent` (100 = 1.0x; clamped to [25,500]); the + ;; same 1=ok/0=fail + jwb_last_error convention as the automation hooks. + (def (browser-set-zoom view percent) + (require-view 'browser-set-zoom view) + (if (= 1 (%set-zoom (browser-view-handle view) percent)) + (ok* percent) + (err* (string-append "set-zoom: " (%last-error))))) + + ;; Current zoom percent; (ok PERCENT) or (err …) (get returns -1 on error). + (def (browser-zoom view) + (require-view 'browser-zoom view) + (let ((p (%get-zoom (browser-view-handle view)))) + (if (>= p 0) (ok* p) (err* (string-append "zoom: " (%last-error)))))) + + ;; Find `text` on the page; (ok MATCH-COUNT) or (err …). opt = (flags timeout): + ;; flags bit0 = search backward, bit1 = case-sensitive. + (def (browser-find view text . opt) + (require-view 'browser-find view) + (let ((flags (if (pair? opt) (car opt) 0)) + (timeout (if (and (pair? opt) (pair? (cdr opt))) (cadr opt) default-eval-timeout))) + (let ((n (%find (browser-view-handle view) text flags timeout))) + (if (>= n 0) (ok* n) (err* (string-append "find: " (%last-error))))))) + + ;; Clear the current find highlight. + (def (browser-clear-find view) + (require-view 'browser-clear-find view) + (%find (browser-view-handle view) "" 0 default-eval-timeout) + (ok* #t)) + + ;; The global clipboard (not view-scoped). Set: (ok #t)/(err …). Get: the raw + ;; text string ("" when empty) — read in tests right after a copy command. + (def (browser-clipboard-set! text) + (if (= 1 (%clip-set text)) + (ok* #t) + (err* (string-append "clipboard-set: " (%last-error))))) + (def (browser-clipboard) (%clip-get)) + ;; --- window / buffer chrome (browser_window.cpp) ----------------------- ;; A browser-window is the nyxt-style single window hosting many views; the ;; (browser buffers) module layers the buffer list/switch logic on top. --- a/scheme/browser/commands.ss +++ b/scheme/browser/commands.ss @@ -75,11 +75,12 @@ ;; prompt-action : (app result) -> _, run when the open prompt accepts (RET) ;; echo : last echo-area message (status/debug; shown in Stage 6) ;; quit : set #t by the quit command - (defstruct app (session keymap dispatcher minibuffer prompt-action echo quit)) + ;; search : last find-in-page query (for find-next / find-previous) + (defstruct app (session keymap dispatcher minibuffer prompt-action echo quit search)) (def (make-browser-app session) (let* ((km (emacs-keymap)) (d (make-key-dispatcher km))) - (make-app session km d #f #f "" #f))) + (make-app session km d #f #f "" #f #f))) (def (app-should-quit? app) (and (app-quit app) #t)) (def (app-window app) (session-window (app-session app))) @@ -212,6 +213,52 @@ (let ((b (session-current-buffer (app-session app)))) (and b (buffer-view b)))) + ;; --- navigation helpers (Stage 3) --------------------------------------- + ;; Scroll/zoom/find/copy all operate on the current buffer's view. Scroll is + ;; pure JS (no C entry point); zoom/find/clipboard call the (browser) FFI. + (def (scroll-js! app js) + (let ((v (current-view app))) (when v (browser-eval v js)))) + + (def line-step "60") ; px per line-scroll, as a JS literal + + ;; Step the zoom by `delta` percent, clamped to the WebEngine range [25,500]. + (def (adjust-zoom! app delta) + (let ((v (current-view app))) + (when v + (let ((cur (browser-zoom v))) + (when (browser-ok? cur) + (let ((p (max 25 (min 500 (+ (browser-value cur) delta))))) + (browser-set-zoom v p) + (app-echo-set! app (string-append "Zoom " (number->string p) "%")))))))) + + ;; Run a find for `query` (forward unless backward?), echo the match count, + ;; and remember the query so find-next / find-previous can repeat it. + (def (do-find! app query backward?) + (let ((v (current-view app))) + (cond + ((not (and (string? query) (> (string-length query) 0))) + (app-echo-set! app "No search query")) + ((not v) (app-echo-set! app "No buffer")) + (else + (app-search-set! app query) + (let ((r (browser-find v query (if backward? 1 0)))) + (app-echo-set! app + (if (browser-ok? r) + (let ((n (browser-value r))) + (string-append (number->string n) + (if (= n 1) " match for " " matches for ") query)) + "Find failed"))))))) + + ;; Copy the current view's url/title (via `getter`) to the clipboard + echo. + (def (copy-current! app what getter) + (let ((v (current-view app))) + (when v + (let ((r (getter v))) + (when (browser-ok? r) + (let ((s (browser-value r))) + (browser-clipboard-set! s) + (app-echo-set! app (string-append "Copied " what ": " s)))))))) + ;; --- the emacs keyscheme (from nyxt source/mode/base.lisp) --------------- ;; Defined before the command registrations below because an R6RS library body ;; must place every definition ahead of any (register-command! …) expression. @@ -230,6 +277,22 @@ ("M-x" . execute-command) ("C-b" . history-backwards) ("C-f" . history-forwards) + ;; navigation parity (Stage 3) — emacs motion/zoom/find/copy + ("C-n" . scroll-down) + ("C-p" . scroll-up) + ("C-v" . scroll-page-down) + ("M-v" . scroll-page-up) + ("M-<" . scroll-to-top) + ("M->" . scroll-to-bottom) + ("C-+" . zoom-in) + ("C-=" . zoom-in) + ("C--" . zoom-out) + ("C-0" . zoom-reset) + ("C-s" . find-in-page) + ("C-M-s" . find-next) + ("C-M-r" . find-previous) + ("C-c u" . copy-url) + ("C-c t" . copy-title) ("C-x C-c" . quit) ("C-g" . keyboard-quit))) @@ -282,6 +345,46 @@ (register-command! 'history-forwards "Go forward in the current buffer's history." (lambda (app) (let ((v (current-view app))) (when v (browser-forward v))))) + ;; --- scrolling (JS; nyxt emacs motion keys) ----------------------------- + (register-command! 'scroll-down "Scroll down one line." + (lambda (app) (scroll-js! app (string-append "window.scrollBy(0," line-step ")")))) + (register-command! 'scroll-up "Scroll up one line." + (lambda (app) (scroll-js! app (string-append "window.scrollBy(0,-" line-step ")")))) + (register-command! 'scroll-page-down "Scroll down one page." + (lambda (app) (scroll-js! app "window.scrollBy(0,Math.round(window.innerHeight*0.9))"))) + (register-command! 'scroll-page-up "Scroll up one page." + (lambda (app) (scroll-js! app "window.scrollBy(0,-Math.round(window.innerHeight*0.9))"))) + (register-command! 'scroll-to-top "Scroll to the top of the page." + (lambda (app) (scroll-js! app "window.scrollTo(0,0)"))) + (register-command! 'scroll-to-bottom "Scroll to the bottom of the page." + (lambda (app) (scroll-js! app "window.scrollTo(0,document.body.scrollHeight)"))) + + ;; --- zoom --------------------------------------------------------------- + (register-command! 'zoom-in "Zoom the page in (+10%)." + (lambda (app) (adjust-zoom! app 10))) + (register-command! 'zoom-out "Zoom the page out (-10%)." + (lambda (app) (adjust-zoom! app -10))) + (register-command! 'zoom-reset "Reset the page zoom to 100%." + (lambda (app) + (let ((v (current-view app))) + (when v (browser-set-zoom v 100) (app-echo-set! app "Zoom 100%"))))) + + ;; --- find-in-page ------------------------------------------------------- + (register-command! 'find-in-page "Search the page for text (highlights matches)." + (lambda (app) + (open-prompt! app "Search: " '() (lambda (x) x) + (lambda (app q) (do-find! app q #f))))) + (register-command! 'find-next "Repeat the last search forward." + (lambda (app) (do-find! app (app-search app) #f))) + (register-command! 'find-previous "Repeat the last search backward." + (lambda (app) (do-find! app (app-search app) #t))) + + ;; --- copy url / title --------------------------------------------------- + (register-command! 'copy-url "Copy the current buffer's URL to the clipboard." + (lambda (app) (copy-current! app "URL" browser-url))) + (register-command! 'copy-title "Copy the current buffer's title to the clipboard." + (lambda (app) (copy-current! app "title" browser-title))) + (register-command! 'switch-buffer-next "Switch to the next buffer (cyclic)." (lambda (app) (session-switch-next! (app-session app)))) (register-command! 'switch-buffer-previous "Switch to the previous buffer (cyclic)." @@ -294,9 +397,10 @@ (open-prompt! app "M-x " (command-names) (lambda (x) x) (lambda (app name) (run-command-by-name app name))))) - (register-command! 'keyboard-quit "Abort the current chord / prompt." + (register-command! 'keyboard-quit "Abort the current chord / prompt; clear find highlight." (lambda (app) (dispatcher-reset! (app-dispatcher app)) + (let ((v (current-view app))) (when v (browser-clear-find v))) (app-echo-set! app "Quit"))) (register-command! 'quit "Quit the browser."