Stage 6: polish — status modes, echo area, palette docs, bookmarks, help
ober
d599ff0f24f8e10d0f51fe0330b3da59f56a8de6
--- a/.build.yml +++ b/.build.yml @@ -148,5 +148,17 @@ tasks: export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" make test-pass + - test-polish: | + cd jerboa-browser + # Stage 6 polish: in-RAM bookmarks + commands, M-x command palette docs, + # status modes + echo-area wiring, and the describe-bindings help page + # rendered offline into a new buffer (offscreen, hermetic). --disable-gpu + # is required: the bindings page would otherwise FATAL the GPU surface. + 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-polish # 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-nav test-hint test-pass test-gui test-buffers repl clean help +.PHONY: binary test test-keymap test-minibuffer test-commands test-keys test-nav test-hint test-pass test-polish test-gui test-buffers repl clean help .DEFAULT_GOAL := help # Build the self-contained native ./jerboa-browser (Chez + boot + (browser)). @@ -51,6 +51,12 @@ test-pass: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-pass-test.ss +# Stage 6 polish functional tests: in-RAM bookmarks + commands, M-x docs, the +# status modes + echo-area wiring, and the describe-bindings help page. +test-polish: + QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-polish-test.ss + # Offline Qt GUI / snapshot harness (headless). Writes PNGs to ./test-artifacts. test-gui: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ --- a/README.md +++ b/README.md @@ -7,6 +7,59 @@ future Servo backend could implement the same `jwb_*` C ABI). The pane loads pages, navigates, evaluates JavaScript, and enforces a deny-by-default capability policy on top of the Chromium sandbox. +On top of that pane sits a **keyboard-driven, nyxt-style browser**: buffers (not +tabs), a fuzzy minibuffer/prompt, an emacs-default keymap, link-hinting, and an +in-process (RAM-only) password manager. The pure-Scheme engine +(`scheme/browser/{keymap,fuzzy,minibuffer,commands,passwords,bookmarks}.ss`) is +the source of truth; Qt is only a display + input surface. + +```sh +jerboa-browser https://example.com # opens the window, keyboard-driven +``` + +## Keyboard (emacs keyscheme) + +The minibuffer line doubles as the echo area; the status line shows +`[modes] [i/n] title — url`. `C-g` aborts a half-typed chord, a prompt, or +hint-mode. `C-h b` opens a buffer listing every binding. + +| Key | Command | | +|-----|---------|--| +| `C-l` / `M-l` | set URL (this / new buffer) | navigation | +| `C-r` | reload | | +| `C-b` / `C-f` | history back / forward | | +| `C-x b` / `C-x C-b` | switch buffer (fuzzy) | buffers | +| `M-n` / `M-p` / `` C-` `` | next / previous / last buffer | | +| `C-t` | new buffer | | +| `C-x k` / `C-x C-k` | delete buffer (pick / current) | | +| `C-n` / `C-p` | scroll line down / up | motion | +| `C-v` / `M-v` | scroll page down / up | | +| `M-<` / `M->` | scroll to top / bottom | | +| `C-+` `C-=` / `C--` / `C-0` | zoom in / out / reset | zoom | +| `C-s` / `C-M-s` / `C-M-r` | find / find-next / find-prev | find | +| `C-c u` / `C-c t` | copy URL / title | clipboard | +| `f` / `M-g` (or `; f`) | follow hint (this / new buffer) | hint-mode | +| `C-c p s` / `C-c p f` / `C-c p k` | save / fill / forget login (RAM only) | passwords | +| `C-x r m` / `C-x r b` | bookmark current / open bookmark | bookmarks | +| `M-x` | run command by name (shows docs) | palette | +| `C-h b` | describe all bindings | help | +| `C-x C-c` | quit | | + +Passwords are held **in RAM only** — never written to env, config, or disk — +XOR-masked in the heap with a per-session pad and zeroed immediately after each +use. Bookmarks are likewise in-RAM (opt-in encrypted persistence is a later item). + +## Build / test + +```sh +make binary # the self-contained native ./jerboa-browser +make test # (browser) unit suite; also test-{keymap,minibuffer,…,polish} +make test-gui # offline Qt snapshot harness (offscreen, headless) +``` + +The functional suites run offscreen (`QT_QPA_PLATFORM=offscreen`) and hermetic +(`JWB_TEST_NO_NETWORK=1`), modeled on the jerboa-emacs Qt test harness. + ## Layout ``` --- a/ROADMAP.md +++ b/ROADMAP.md @@ -218,10 +218,35 @@ any sort** — in-RAM only, zeroed after use, never disk/env/config/argv. save → autofill (`#u`=alice, `#p`=hunter2 read back) → forget. Hermetic data: form. By construction the module writes no secret to env/config/disk. -### Stage 6 — Polish -Status bar (url + buffer index + modes), echo-area messages/errors, complete the -command palette (`execute-command` lists all commands with docs), bookmarks -(`set-url-from-bookmark`), help (`describe-bindings`), README/keybinding docs. +### Stage 6 — Polish ✅ DONE +The final stage: surface the controller state in the chrome, finish the palette, +and add bookmarks + help + docs. +- **Status modes**: `session-update-status!` gained an optional modes string; + `app-render!` passes `app-modes-string` (always `emacs`, `+ hint` while + hinting), rendering `[emacs hint] [i/n] title — url`. Default (no modes) is + unchanged, so the buffer tests still hold. +- **Echo area**: the minibuffer line now doubles as the echo area (as in emacs). + `app-render!` shows the open prompt when one is up, else the last `app-echo` + message (hidden when empty) — so pending-chord prefixes, errors, and command + results are visible without a prompt. +- **Command palette**: `execute-command` now renders candidates as `name — doc` + via `command-label` (the key proc), so M-x shows + fuzzy-matches docs while RET + still yields the bare name to dispatch. +- **Bookmarks** (`(browser bookmarks)`, in-RAM, newest-first, deduped by url): + `bookmark-current` (`C-x r m`) bookmarks the page; `set-url-from-bookmark` + (`C-x r b`) fuzzy-picks one and loads it. Opt-in encrypted persistence is a + documented later item. +- **Help**: `describe-bindings` (`C-h b`) renders the whole keymap (binding alist + + command docs) as a width-bounded HTML page loaded into a new buffer via a + `data:` URL (`url-encode`/`html-escape`; `table-layout:fixed` so it can't blow + up the offscreen GPU surface). +- **Docs**: README gained a keyboard section + the full keymap table. +- **Tests** (`make test-polish`, 14): bookmark store (order/dedupe/remove/clear); + M-x candidates carry docs; status-modes prefixing + echo-area (prefix echo, + message render); `C-x r m` then `C-x r b` loads the marked page (JS marker + confirms); `describe-bindings` opens a `data:text/html` buffer whose innerText + lists keys + commands; the new chords resolve. Needs `--disable-gpu` (the + bindings page would otherwise FATAL the offscreen GPU surface). --- --- a/WISHLIST.md +++ b/WISHLIST.md @@ -13,7 +13,7 @@ offline Qt snapshot + functional tests modeled on `~/mine/jerboa-emacs`. - [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) - [x] **Hint-mode** — link hinting / follow (`f`, `M-g`, `; f`) via JS overlay; home-row labels, follow this/new buffer, C-g/escape cancels — *Stage 4* — `make test-hint` (10) - [x] **Password manager** — in-process, memory-only (no env, no config/file), masked entry, autofill; secrets XOR-masked in RAM + zeroed after use — *Stage 5* — `(browser passwords)`; `C-c p s/f/k`; `make test-pass` (12) -- [ ] **Polish** — status bar, echo-area messages, command-palette completeness, bookmarks, docs — *Stage 6* +- [x] **Polish** — status modes (`[emacs hint] [i/n] title — url`), echo-area wiring (minibuffer line = echo area), M-x palette shows docs, in-RAM bookmarks (`C-x r m/b`), `describe-bindings` (`C-h b`) help page, README keymap — *Stage 6* — `(browser bookmarks)`; `make test-polish` (14) Later / maybe: vi keyscheme parity, AppImage packaging, history persistence (opt-in, encrypted), search-engine prefixes, download manager, ad/JS toggles. --- a/scheme/browser-commands-test.ss +++ b/scheme/browser-commands-test.ss @@ -171,7 +171,9 @@ (check (session-current-index s) => 2) (check (app-feed-token! app "M-x") => '(ran . execute-command)) (app-type! app "switch-buffer-next") - (check (minibuffer-selected-string (app-minibuffer app)) => "switch-buffer-next") + ;; the palette now renders "name — doc" (Stage 6); RET still yields the name + (check (minibuffer-selected-string (app-minibuffer app)) + => "switch-buffer-next — Switch to the next buffer (cyclic).") (app-feed-token! app "RET") (check (app-minibuffer app) => #f) (check (session-current-index s) => 0)))) ; (2+1) mod 3 new file mode 100644 --- /dev/null +++ b/scheme/browser-polish-test.ss @@ -0,0 +1,239 @@ +#!chezscheme +;;; browser-polish-test.ss — Stage 6 polish functional tests. +;;; +;;; Covers the final-stage polish: the in-RAM bookmark store + its commands, the +;;; M-x command palette now showing docs, the status-line modes string + the +;;; echo-area wiring (the minibuffer line doubles as the echo area), and the +;;; describe-bindings help page rendered offline into a new buffer. +;;; +;;; Run: QT_QPA_PLATFORM=offscreen make test-polish +;;; Exits 0 on success, 1 on any failed case. + +(import (chezscheme) (browser) (browser buffers) + (browser keymap) (browser minibuffer) + (browser bookmarks) (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-polish)")) + +;; 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))))))) + +;; Does any string in `xs` contain `needle`? +(define (any-has? xs needle) + (let loop ((xs xs)) + (cond ((null? xs) #f) + ((str-has? (car xs) needle) #t) + (else (loop (cdr xs)))))) + +;; A hermetic page: no-network session, window shown + sized + pumped, controller. +(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* ((app (make-browser-app s)) + (v (buffer-view (session-current-buffer s)))) + body ... + (close-browser-session! s)))])) + +(define (cur-view s) (buffer-view (session-current-buffer s))) + +;; A page with a <title> and a marker element, so a load can be confirmed by JS. +(define mark-page + (string-append + "data:text/html,<html><head><title>BMARKPAGE</title></head>" + "<body><h1%20id=%22mark%22>hello</h1></body></html>")) +(define blank-page "data:text/html,<html><body>blank</body></html>") + +(define (has-mark? v) + (let ((r (browser-eval v "''+(!!document.getElementById('mark'))"))) + (and (browser-ok? r) (string=? (browser-value r) "true")))) + +;;; ─── bookmark store (pure, in-RAM) ────────────────────────────────────────── +(test-group "bookmarks: in-RAM store, newest-first, deduped by url" + (test-case "make/empty; add/list-order/count" + (let ((bm (make-bookmarks))) + (check (bookmarks? bm) => #t) + (check (bookmarks-count bm) => 0) + (bookmarks-add! bm "https://a.com" "A") + (bookmarks-add! bm "https://b.com" "B") + (check (bookmarks-count bm) => 2) + ;; newest first + (check (bookmark-url (car (bookmarks-list bm))) => "https://b.com") + (check (bookmark-title (car (bookmarks-list bm))) => "B"))) + + (test-case "re-bookmarking dedupes by url, refreshes title + recency" + (let ((bm (make-bookmarks))) + (bookmarks-add! bm "https://a.com" "A") + (bookmarks-add! bm "https://b.com" "B") + (bookmarks-add! bm "https://a.com" "A2") ; move to front + retitle + (check (bookmarks-count bm) => 2) + (check (bookmark-url (car (bookmarks-list bm))) => "https://a.com") + (check (bookmark-title (car (bookmarks-list bm))) => "A2"))) + + (test-case "blank url ignored; remove! / clear!" + (let ((bm (make-bookmarks))) + (bookmarks-add! bm "" "nope") + (check (bookmarks-count bm) => 0) + (bookmarks-add! bm "https://a.com" "A") + (bookmarks-add! bm "https://b.com" "B") + (bookmarks-remove! bm "https://a.com") + (check (bookmarks-count bm) => 1) + (check (bookmark-url (car (bookmarks-list bm))) => "https://b.com") + (bookmarks-clear! bm) + (check (bookmarks-count bm) => 0)))) + +;;; ─── command palette: completeness + docs ─────────────────────────────────── +(test-group "M-x lists every command WITH its doc string" + (test-case "new Stage 6 commands are registered + reachable" + (for-each (lambda (n) (check (and (command-ref n) #t) => #t)) + '(bookmark-current set-url-from-bookmark describe-bindings))) + (test-case "the M-x prompt renders candidates as \"name — doc\"" + (with-page (app s v) blank-page + (run-command-by-name app "execute-command") + (check (and (app-minibuffer app) #t) => #t) + (let ((strs (minibuffer-candidate-strings (app-minibuffer app) 500))) + ;; docs are shown + searchable; bare names alone would lack " — ". + (check (any-has? strs "set-url — ") => #t) + (check (any-has? strs "bookmark-current — ") => #t))))) + +;;; ─── status modes + echo-area wiring ──────────────────────────────────────── +(test-group "status modes string + echo area (minibuffer line)" + (test-case "session-update-status! prepends [MODES] only when given; default unchanged" + (with-page (app s v) blank-page + ;; both forms must succeed against the live window status bar + (check (browser-ok? (session-update-status! s)) => #t) + (check (browser-ok? (session-update-status! s "emacs hint")) => #t))) + (test-case "a pending chord prefix shows in the echo area" + (with-page (app s v) blank-page + (app-feed-token! app "C-x") ; incomplete chord → prefix echoed + (check (> (string-length (app-echo app)) 0) => #t) + (app-feed-token! app "g") ; C-x g unbound → echoes "undefined" + (check (str-has? (app-echo app) "undefined") => #t))) + (test-case "a command message renders cleanly in the echo area (no prompt)" + (with-page (app s v) blank-page + (app-feed-token! app "C-g") ; keyboard-quit from root → "Quit" + (check (app-echo app) => "Quit") + (app-render! app) ; drives the echo (not prompt) branch + (check (> (string-length (app-echo app)) 0) => #t)))) + +;;; ─── bookmarks: commands end-to-end ───────────────────────────────────────── +(test-group "bookmark-current then set-url-from-bookmark loads it" + (test-case "C-x r m bookmarks the page (title from <title>); dedupes" + (with-page (app s v) mark-page + (app-feed-token! app "C-x") (app-feed-token! app "r") (app-feed-token! app "m") + (check (bookmarks-count (app-bookmarks app)) => 1) + (check (bookmark-title (car (bookmarks-list (app-bookmarks app)))) => "BMARKPAGE") + ;; bookmarking again is idempotent (same url) + (run-command-by-name app "bookmark-current") + (check (bookmarks-count (app-bookmarks app)) => 1))) + + (test-case "C-x r b prompts with the bookmark and loads it into the current buffer" + (with-page (app s v) mark-page + ;; bookmark the marker page, then move to a blank buffer + (run-command-by-name app "bookmark-current") + (session-open-buffer s blank-page) + (browser-pump 300) + (check (has-mark? (cur-view s)) => #f) ; blank buffer: no marker + ;; C-x r b → prompt populated with the bookmark + (app-feed-token! app "C-x") (app-feed-token! app "r") (app-feed-token! app "b") + (check (and (app-minibuffer app) #t) => #t) + (check (any-has? (minibuffer-candidate-strings (app-minibuffer app) 50) "BMARKPAGE") => #t) + ;; RET selects it → loads the marker page into THIS (blank) buffer + (app-feed-token! app "RET") + (check (app-minibuffer app) => #f) + (browser-pump 300) + (check (has-mark? (cur-view s)) => #t))) + + (test-case "set-url-from-bookmark with none saved reports cleanly" + (with-page (app s v) blank-page + (run-command-by-name app "set-url-from-bookmark") + (check (app-minibuffer app) => #f) ; no prompt opened + (check (str-has? (app-echo app) "No bookmarks") => #t)))) + +;;; ─── help: describe-bindings ──────────────────────────────────────────────── +(test-group "describe-bindings renders the keymap into a new buffer" + (test-case "C-h b opens a data: page listing keys + commands" + (with-page (app s v) blank-page + (let ((before (session-buffer-count s))) + (app-feed-token! app "C-h") (app-feed-token! app "b") + (check (session-buffer-count s) => (+ before 1))) + (browser-pump 400) + (let ((bv (cur-view s))) + (check (str-has? (buffer-url (session-current-buffer s)) "data:text/html") => #t) + (let ((r (browser-eval bv "''+document.body.innerText"))) + (check (browser-ok? r) => #t) + (check (str-has? (browser-value r) "Key Bindings") => #t) + (check (str-has? (browser-value r) "set-url") => #t) + (check (str-has? (browser-value r) "C-l") => #t)))))) + +;;; ─── bindings registered for Stage 6 chords ───────────────────────────────── +(test-group "Stage 6 key chords resolve to their commands" + (test-case "C-x r m / C-x r b → bookmark-current / set-url-from-bookmark" + (define km (emacs-keymap)) + (let ((d (make-key-dispatcher km))) + (check (dispatcher-feed! d "C-x") => 'pending) + (check (dispatcher-feed! d "r") => 'pending) + (check (dispatcher-feed! d "m") => '(run . bookmark-current))) + (let ((d (make-key-dispatcher km))) + (dispatcher-feed! d "C-x") (dispatcher-feed! d "r") + (check (dispatcher-feed! d "b") => '(run . set-url-from-bookmark)))) + (test-case "C-h b → describe-bindings" + (define km (emacs-keymap)) + (let ((d (make-key-dispatcher km))) + (check (dispatcher-feed! d "C-h") => 'pending) + (check (dispatcher-feed! d "b") => '(run . describe-bindings))))) + +(newline) +(display "browser-polish-test: ") (display *pass*) (display " passed, ") +(display *fail*) (display " failed") (newline) +(exit (if (zero? *fail*) 0 1)) new file mode 100644 --- /dev/null +++ b/scheme/browser/bookmarks.ss @@ -0,0 +1,66 @@ +#!chezscheme +;;; (browser bookmarks) — an in-RAM bookmark store (url + title), newest-first. +;;; +;;; A bookmark is just a (url, title) pair. The store keeps them in a list, +;;; most-recently-added first, de-duplicated by url: re-bookmarking a page moves +;;; it to the front and refreshes its title. Like nyxt's bookmark list, this is +;;; the candidate source for `set-url-from-bookmark`. +;;; +;;; Kept in RAM only for now (no disk format), matching the rest of Stage 6; +;;; opt-in encrypted persistence is a documented later item (see WISHLIST). +;;; +;;; Usage: +;;; (import (browser bookmarks)) +;;; (define bm (make-bookmarks)) +;;; (bookmarks-add! bm "https://example.com" "Example") +;;; (bookmarks-list bm) ; => (#<bookmark> …) newest first +;;; (bookmark-url (car (bookmarks-list bm))) ; => "https://example.com" + +(library (browser bookmarks) + (export + make-bookmarks bookmarks? + bookmark? bookmark-url bookmark-title + bookmarks-add! bookmarks-list bookmarks-count + bookmarks-remove! bookmarks-clear!) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?)) + + ;; A bookmark: a url and a display title (title may be ""). + (defstruct bookmark (url title)) + ;; Opaque store: a mutable list of bookmarks, newest first. + (defstruct %bookmarks (items)) + + (def (make-bookmarks) (make-%bookmarks '())) + (def (bookmarks? x) (%bookmarks? x)) + (def (bookmarks-list bm) (%bookmarks-items bm)) + (def (bookmarks-count bm) (length (%bookmarks-items bm))) + + ;; Add (or move-to-front + retitle) a bookmark for `url`. De-dupes by url so a + ;; page is bookmarked once; re-bookmarking refreshes its title + recency. A + ;; blank url is ignored. Returns the store. + (def (bookmarks-add! bm url title) + (when (and (string? url) (> (string-length url) 0)) + (let ((rest (filter (lambda (b) (not (string=? (bookmark-url b) url))) + (%bookmarks-items bm)))) + (%bookmarks-items-set! bm (cons (make-bookmark url title) rest)))) + bm) + + ;; Drop the bookmark for `url` (no-op if absent). Returns the store. + (def (bookmarks-remove! bm url) + (%bookmarks-items-set! bm + (filter (lambda (b) (not (string=? (bookmark-url b) url))) + (%bookmarks-items bm))) + bm) + + (def (bookmarks-clear! bm) (%bookmarks-items-set! bm '()) bm) + + ) ; library (browser bookmarks) --- a/scheme/browser/buffers.ss +++ b/scheme/browser/buffers.ss @@ -156,16 +156,23 @@ (when (> n 0) (session-switch-index! s (- n 1))))) ;; --- status line -------------------------------------------------------- - ;; Render "[i/n] TITLE — URL" of the current buffer into the window status bar. - (def (session-update-status! s) - (let ((b (session-current-buffer s)) - (n (session-buffer-count s)) - (i (session-current-index s))) + ;; Render the current buffer's status into the window status bar, nyxt-style: + ;; [MODES] [i/n] TITLE — URL + ;; `opt = (modes)` is an optional active-modes string (e.g. "emacs hint"); when + ;; absent or empty the leading "[MODES] " segment is omitted, preserving the + ;; original "[i/n] TITLE — URL" form the buffer tests assert. + (def (session-update-status! s . opt) + (let* ((modes (if (pair? opt) (car opt) "")) + (pre (if (> (string-length modes) 0) (string-append "[" modes "] ") "")) + (b (session-current-buffer s)) + (n (session-buffer-count s)) + (i (session-current-index s))) (browser-window-set-status (session-window s) (if b - (string-append "[" (number->string (+ i 1)) "/" (number->string n) "] " + (string-append pre + "[" (number->string (+ i 1)) "/" (number->string n) "] " (buffer-title b) " — " (buffer-url b)) - "(no buffers)")))) + (string-append pre "(no buffers)"))))) ) ; library (browser buffers) --- a/scheme/browser/commands.ss +++ b/scheme/browser/commands.ss @@ -17,7 +17,7 @@ (export make-browser-app app? app-session app-keymap app-dispatcher app-minibuffer app-echo app-should-quit? - app-hints app-hint-buf app-vault + app-hints app-hint-buf app-vault app-bookmarks app-feed-token! app-type! app-render! app-pump-keys! app-run-loop! emacs-keymap buffer-label @@ -39,7 +39,8 @@ (browser buffers) (browser keymap) (browser minibuffer) - (browser passwords)) + (browser passwords) + (browser bookmarks)) ;; --- string helpers ----------------------------------------------------- (def (substr? hay needle) @@ -82,24 +83,33 @@ ;; hint-buf : chars typed so far toward a hint label ;; hint-new : #t when a followed hint should open in a new buffer ;; vault : the in-RAM, memory-only credential store (browser passwords) + ;; bookmarks : the in-RAM bookmark store (browser bookmarks) (defstruct app (session keymap dispatcher minibuffer prompt-action echo quit search - hints hint-buf hint-new vault)) + hints hint-buf hint-new vault bookmarks)) (def (make-browser-app session) (let* ((km (emacs-keymap)) (d (make-key-dispatcher km))) - (make-app session km d #f #f "" #f #f #f "" #f (make-vault)))) + (make-app session km d #f #f "" #f #f #f "" #f (make-vault) (make-bookmarks)))) (def (app-should-quit? app) (and (app-quit app) #t)) (def (app-window app) (session-window (app-session app))) - ;; Reflect controller state into the window chrome: show the prompt line while - ;; a minibuffer is open (hide it otherwise) and refresh the status line. + ;; Active minor modes, nyxt-style, for the status line: the base keyscheme is + ;; always on; hint-mode shows while hinting. (Shown as "[emacs]" / "[emacs hint]".) + (def (app-modes-string app) + (string-append "emacs" (if (app-hints app) " hint" ""))) + + ;; Reflect controller state into the window chrome. The minibuffer line doubles + ;; as the echo area (as in emacs): while a prompt is open it shows the prompt; + ;; otherwise it shows the last echo message (hidden when there is none). The + ;; status line carries the active modes + buffer index + title/url. (def (app-render! app) (let ((mb (app-minibuffer app)) (win (app-window app))) (if mb (browser-window-set-minibuffer win (minibuffer-render mb) #t) - (browser-window-set-minibuffer win "" #f)) - (session-update-status! (app-session app)))) + (let ((e (app-echo app))) + (browser-window-set-minibuffer win e (> (string-length e) 0)))) + (session-update-status! (app-session app) (app-modes-string app)))) ;; opt = (mask?). A masked prompt (password entry) renders input as bullets. (def (open-prompt! app prompt candidates key action . opt) @@ -452,6 +462,79 @@ "pw.dispatchEvent(new Event('change',{bubbles:true}));" "return 'filled';})(" (js-quote user) "," (js-quote pass) ")")) + ;; --- command palette + bookmark labels (Stage 6) ------------------------ + ;; M-x candidates are the bare command names; this is the *display* (and fuzzy + ;; match) string — "name — doc" — so the palette shows docs and is searchable + ;; by description, while RET still yields the bare name to dispatch. + (def (command-label name) + (let ((c (command-ref (string->symbol name)))) + (if c (string-append name " — " (command-doc c)) name))) + + ;; A bookmark's display string: "Title — url" (or just the url when untitled). + (def (bookmark-label b) + (let ((title (bookmark-title b)) (url (bookmark-url b))) + (if (> (string-length title) 0) (string-append title " — " url) url))) + + ;; --- help: describe-bindings (Stage 6) ---------------------------------- + ;; Render the whole keymap as an offline HTML page (loaded via a data: URL into + ;; a new buffer, nyxt-style). Built from the binding alist + the command docs. + (def (hex2 n) + (let ((h "0123456789ABCDEF")) + (string (string-ref h (bitwise-and (bitwise-arithmetic-shift-right n 4) 15)) + (string-ref h (bitwise-and n 15))))) + + ;; Percent-encode all but the URL-unreserved set, so arbitrary HTML rides + ;; safely in a `data:text/html,` URL (the page content is ASCII). + (def (url-encode s) + (let ((out (open-output-string))) + (string-for-each + (lambda (ch) + (if (or (char-alphabetic? ch) (char-numeric? ch) + (memv ch '(#\- #\_ #\. #\~))) + (display ch out) + (begin (display #\% out) (display (hex2 (char->integer ch)) out)))) + s) + (get-output-string out))) + + ;; Escape the HTML metacharacters in text cells (keys like "M-<" / "M->"). + (def (html-escape s) + (let ((out (open-output-string))) + (string-for-each + (lambda (ch) + (cond ((char=? ch #\<) (display "<" out)) + ((char=? ch #\>) (display ">" out)) + ((char=? ch #\&) (display "&" out)) + (else (display ch out)))) + s) + (get-output-string out))) + + (def (describe-bindings-html) + (let ((out (open-output-string))) + (display (string-append + "<html><head><meta charset=utf-8><title>Key Bindings</title>" + ;; width-bounded layout: table-layout:fixed + word wrap keep the + ;; page within the viewport (an unbounded width FATALs the + ;; offscreen GPU surface during tests). + "<style>body{font:14px monospace;padding:1em;max-width:760px;overflow-wrap:anywhere}" + "table{width:100%;table-layout:fixed;border-collapse:collapse}" + "td{padding:2px 8px 2px 0;vertical-align:top;word-break:break-word}" + "th{text-align:left}" + "kbd{background:#eee;padding:0 4px;border:1px solid #ccc}</style></head>" + "<body><h1>Jerboa Browser — Key Bindings</h1>" + "<table><tr><th>Key</th><th>Command</th><th>Description</th></tr>") + out) + (for-each + (lambda (bnd) + (let* ((key (car bnd)) (name (symbol->string (cdr bnd))) + (c (command-ref (cdr bnd))) (doc (if c (command-doc c) ""))) + (display (string-append + "<tr><td><kbd>" (html-escape key) "</kbd></td><td>" + (html-escape name) "</td><td>" (html-escape doc) "</td></tr>") + out))) + emacs-bindings) + (display "</table></body></html>" out) + (get-output-string out))) + ;; --- 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. @@ -494,6 +577,11 @@ ("C-c p s" . save-login) ("C-c p f" . fill-login) ("C-c p k" . forget-login) + ;; bookmarks (Stage 6) — emacs register/bookmark prefix C-x r {m,b} + ("C-x r m" . bookmark-current) + ("C-x r b" . set-url-from-bookmark) + ;; help (Stage 6) — C-h b lists all key bindings (emacs parity) + ("C-h b" . describe-bindings) ("C-x C-c" . quit) ("C-g" . keyboard-quit))) @@ -629,6 +717,40 @@ (app-echo-set! app (string-append "Forgot login for " key))) (app-echo-set! app (string-append "No saved login for " key)))))) + ;; --- bookmarks (Stage 6, in-RAM) ---------------------------------------- + (register-command! 'bookmark-current "Bookmark the current buffer (kept in RAM)." + (lambda (app) + (let ((v (current-view app))) + (if (not v) + (app-echo-set! app "No buffer") + (let* ((b (session-current-buffer (app-session app))) + (url (current-url app)) + (title (if b (buffer-label b) url))) + (if (= (string-length url) 0) + (app-echo-set! app "No URL to bookmark") + (begin + (bookmarks-add! (app-bookmarks app) url title) + (app-echo-set! app (string-append "Bookmarked " title))))))))) + + (register-command! 'set-url-from-bookmark "Load a bookmark in the current buffer (fuzzy)." + (lambda (app) + (let ((bms (bookmarks-list (app-bookmarks app)))) + (if (null? bms) + (app-echo-set! app "No bookmarks") + (open-prompt! app "Bookmark: " bms bookmark-label + (lambda (app bm) + (let ((v (current-view app))) + (when (and v (bookmark? bm)) + (browser-load v (bookmark-url bm)) + (app-echo-set! app (string-append "Loaded " (bookmark-url bm))))))))))) + + ;; --- help (Stage 6) ----------------------------------------------------- + (register-command! 'describe-bindings "Show all key bindings in a new buffer." + (lambda (app) + (session-open-buffer (app-session app) + (string-append "data:text/html," (url-encode (describe-bindings-html)))) + (app-echo-set! app "Key bindings"))) + (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)." @@ -636,9 +758,9 @@ (register-command! 'switch-buffer-last "Switch to the most recently opened buffer." (lambda (app) (session-switch-last! (app-session app)))) - (register-command! 'execute-command "Run a command by name (fuzzy)." + (register-command! 'execute-command "Run a command by name (fuzzy; shows docs)." (lambda (app) - (open-prompt! app "M-x " (command-names) (lambda (x) x) + (open-prompt! app "M-x " (command-names) command-label (lambda (app name) (run-command-by-name app name))))) (register-command! 'keyboard-quit "Abort the current chord / prompt / hint; clear find highlight."