Stage 4: hint-mode — nyxt-style link hinting / follow
ober
1d36a616ad8a07330d2cf375310b11f7d312f066
--- a/.build.yml +++ b/.build.yml @@ -125,5 +125,17 @@ tasks: export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" make test-nav + - test-hint: | + cd jerboa-browser + # Stage 4 hint-mode: JS link-hint overlay + follow (this/new buffer) driven + # through the command controller against rendered data: pages (offscreen, + # hermetic — data: bypasses the no-network policy; the overlay reads + # getBoundingClientRect, so the harness shows + sizes + pumps first). + 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-hint # 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-gui test-buffers repl clean help +.PHONY: binary test test-keymap test-minibuffer test-commands test-keys test-nav test-hint test-gui test-buffers repl clean help .DEFAULT_GOAL := help # Build the self-contained native ./jerboa-browser (Chez + boot + (browser)). @@ -39,6 +39,12 @@ test-nav: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-nav-test.ss +# Stage 4 hint-mode functional tests: JS link-hint overlay + follow (this/new +# buffer) driven through the command controller against rendered data: pages. +test-hint: + QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-hint-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 @@ -166,13 +166,28 @@ command controller) is the source of truth; Qt is a display + input surface. `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. -- **Scheme/JS**: inject JS that overlays hint labels on links/inputs, then a - transient keymap collects the hint chars and follows (`follow-hint`), - `; f`/`M-G` open in a new buffer. -- **Tests**: load a page with known links, enter hint-mode, snapshot the - overlay, send the hint keys, assert navigation to the link target. +### Stage 4 — Hint-mode ✅ DONE +nyxt-style link hinting, JS-only (rides on `browser-eval`; no new C entry point). +- **Overlay** (`hint-overlay-js` in `(browser commands)`): `querySelectorAll` + over `a[href],button,input,textarea,select,[onclick],[role=button]`, filters to + elements visible in the viewport (`getBoundingClientRect`), assigns home-row + labels (`asdfghjkl…`, 2-char once >26), draws fixed-position badges, stashes + `label→{el,href}` on `window.__jwbHints`, and returns `LABEL\thref` lines. +- **Controller**: `follow-hint` (`f`) / `follow-hint-new-buffer` (`M-g`, `; f`) + parse those into an alist on the `app` (`hints`/`hint-buf`/`hint-new` fields); + `feed-hint` collects typed chars (prefix-matched, case-folded) until one label + matches, then navigates the href via `browser-load` (this buffer) or + `session-open-buffer` (new), or JS-clicks a control with no href. A typo is + ignored (stays in hint-mode); `C-g`/`escape` cancels and clears the overlay. +- **Routing**: `app-feed-token!` gained a hint branch (minibuffer → hints → + command) so the same code the Qt key filter drives is exercised by the tests. +- **Tests** (`make test-hint`, 10): registry + keymap bindings (incl. the `; f` + chord), overlay labels 2 links + draws 2 badges, follow this-buffer (title → + HINT1), follow new-buffer (buffer count +1, title → HINT2), `C-g`/`escape` + cancel + badge removal, 27-link page → 2-char labels followed by full label, + link-less page → "No hints". Hermetic: data: pages with data: link targets. +- **Deferred**: form-field passthrough (when an input is focused, route keys to + the page instead of the keymap) — a focus-mode concern, not needed for parity. ### Stage 5 — Password manager (in-process, memory-only) - **Scheme**: `(browser passwords)` — an in-RAM table keyed by origin → --- a/WISHLIST.md +++ b/WISHLIST.md @@ -11,7 +11,7 @@ offline Qt snapshot + functional tests modeled on `~/mine/jerboa-emacs`. - [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 - [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* +- [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) - [ ] **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* new file mode 100644 --- /dev/null +++ b/scheme/browser-hint-test.ss @@ -0,0 +1,222 @@ +#!chezscheme +;;; browser-hint-test.ss — Stage 4 hint-mode functional tests. +;;; +;;; Drives the real command controller + (browser) FFI against rendered data: +;;; pages (hermetic — data: bypasses the no-network policy): enter hint-mode, +;;; assert the JS overlay labelled the links (badges in the DOM + a label→href +;;; alist on the app), type a label, and assert navigation to the link target +;;; (this buffer or a new one). The overlay reads getBoundingClientRect, so the +;;; harness shows + sizes the window and pumps before hinting (same as Stage 3). +;;; +;;; Run: QT_QPA_PLATFORM=offscreen make test-hint +;;; 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-hint)")) + +(define ctrl qt-mod-control) +(define meta qt-mod-alt) +(define K-g 71) (define K-f 70) (define K-semi 59) + +;; The number of hint badges currently in the page DOM. +(define (badge-count v) + (let ((r (browser-eval v "''+document.querySelectorAll('.jwb-hint').length"))) + (and (browser-ok? r) (string->number (browser-value r))))) + +;; Feed each character of a hint label as its own self-insert token (lowercase, +;; as a real keypress would arrive — the controller upcases to match). +(define (type-label! app label) + (string-for-each + (lambda (ch) (app-feed-token! app (string (char-downcase ch)))) label)) + +;; A hermetic page: no-network session (data: still loads), window shown + sized +;; so the page renders (the overlay reads getBoundingClientRect), buffer opened +;; + pumped 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 400) ; let it paint + (let* ((app (make-browser-app s)) + (v (buffer-view (session-current-buffer s)))) + body ... + (close-browser-session! s)))])) + +;; data: link targets carry a <title> so navigation is assertable by title. +;; (The outer page is itself a data: URL, so Qt percent-decodes its content when +;; parsing — getAttribute('href') therefore returns the *decoded* form, which is +;; what the overlay captures and what we assert against below.) +(define target1 "data:text/html,%3Ctitle%3EHINT1%3C/title%3Eone") +(define target2 "data:text/html,%3Ctitle%3EHINT2%3C/title%3Etwo") +(define target1-decoded "data:text/html,<title>HINT1</title>one") +(define two-link-page + (string-append + "data:text/html,<html><body>" + "<a href=\"" target1 "\">One</a> " + "<a href=\"" target2 "\">Two</a>" + "</body></html>")) +(define no-link-page + "data:text/html,<html><head><title>NL</title></head><body>just text</body></html>") + +;; A page with `n` anchors; the LAST points to `last-target`, the rest are dummy +;; data: URLs. With n>26 the overlay assigns 2-character labels. +(define (many-link-page n last-target) + (let loop ((i 0) (acc '())) + (if (= i n) + (apply string-append "data:text/html,<html><body>" + (append (reverse acc) '("</body></html>"))) + (let ((href (if (= i (- n 1)) last-target + (string-append "data:text/html," (number->string i))))) + (loop (+ i 1) + (cons (string-append "<a href=\"" href "\">" (number->string i) "</a> ") + acc)))))) + +;;; ─── command registry + keymap bindings (no page needed) ──────────────────── +(test-group "Stage 4 commands are registered" + (test-case "follow-hint / follow-hint-new-buffer exist" + (check (and (command-ref 'follow-hint) #t) => #t) + (check (and (command-ref 'follow-hint-new-buffer) #t) => #t))) + +(test-group "emacs keymap binds the hint keys" + (define km (emacs-keymap)) + (test-case "f → follow-hint; M-g → follow-hint-new-buffer" + (check (keymap-ref km "f") => 'follow-hint) + (check (keymap-ref km "M-g") => 'follow-hint-new-buffer)) + (test-case "; f is a chord to follow-hint-new-buffer" + (let ((d (make-key-dispatcher km))) + (check (dispatcher-feed! d ";") => 'pending) + (check (dispatcher-feed! d "f") => '(run . follow-hint-new-buffer))))) + +;;; ─── overlay ───────────────────────────────────────────────────────────────── +(test-group "hint overlay labels the links + draws badges" + (test-case "f enters hint-mode: 2 hints captured, 2 badges in the DOM" + (with-page (app s v) two-link-page + (check (app-hints app) => #f) ; not hinting yet + (app-feed-token! app "f") ; follow-hint + (check (and (app-hints app) #t) => #t) + (check (length (app-hints app)) => 2) + (check (badge-count v) => 2) + (check (app-hint-buf app) => "") + ;; first label maps to target1's href (DOM order; decoded — see above) + (check (cdr (car (app-hints app))) => target1-decoded) + (browser-eval v "(function(){document.querySelectorAll('.jwb-hint').forEach(e=>e.remove());})()")))) + +;;; ─── follow: same buffer ───────────────────────────────────────────────────── +(test-group "follow a hint in the current buffer (f + label)" + (test-case "typing the first label navigates this buffer to its target" + (with-page (app s v) two-link-page + (app-feed-token! app "f") + (let ((label (car (car (app-hints app))))) ; e.g. "A" + (type-label! app label)) + (check (app-hints app) => #f) ; hint-mode cleared + (check (badge-count v) => 0) ; badges removed + (browser-pump 400) + (check (browser-value (browser-title v)) => "HINT1")))) + +;;; ─── follow: new buffer ────────────────────────────────────────────────────── +(test-group "follow a hint in a NEW buffer (M-g + label)" + (test-case "M-g then the second label opens target2 in a new buffer" + (with-page (app s v) two-link-page + (let ((before (length (session-buffer-list s)))) + (app-feed-token! app "M-g") ; follow-hint-new-buffer + (check (and (app-hints app) #t) => #t) + (let ((label2 (car (list-ref (app-hints app) 1)))) ; second label, "S" + (type-label! app label2)) + (check (app-hints app) => #f) + (check (length (session-buffer-list s)) => (+ before 1)) + (browser-pump 400) + (check (browser-value (browser-title (buffer-view (session-current-buffer s)))) + => "HINT2"))))) + +;;; ─── cancel ────────────────────────────────────────────────────────────────── +(test-group "C-g / escape cancels hint-mode and clears the overlay" + (test-case "C-g exits hint-mode and removes the badges" + (with-page (app s v) two-link-page + (app-feed-token! app "f") + (check (badge-count v) => 2) + (app-feed-token! app "C-g") + (check (app-hints app) => #f) + (check (badge-count v) => 0) + (check (app-echo app) => "Quit"))) + (test-case "escape also cancels hint-mode" + (with-page (app s v) two-link-page + (app-feed-token! app "f") + (app-feed-token! app "escape") + (check (app-hints app) => #f) + (check (badge-count v) => 0)))) + +;;; ─── multi-character labels ────────────────────────────────────────────────── +(test-group "27 links → 2-character labels; full label follows the last link" + (test-case "the last (27th) link's 2-char label navigates to its target" + (with-page (app s v) (many-link-page 27 target2) + (app-feed-token! app "f") + (check (length (app-hints app)) => 27) + (let* ((hints (app-hints app)) + (last-label (car (list-ref hints (- (length hints) 1))))) + (check (string-length last-label) => 2) ; 2-char once >26 links + ;; typing the first char alone must NOT follow (ambiguous prefix) + (app-feed-token! app (string (char-downcase (string-ref last-label 0)))) + (check (and (app-hints app) #t) => #t) ; still hinting + (app-feed-token! app (string (char-downcase (string-ref last-label 1)))) + (check (app-hints app) => #f)) ; now followed + (browser-pump 400) + (check (browser-value (browser-title v)) => "HINT2")))) + +;;; ─── no hints ──────────────────────────────────────────────────────────────── +(test-group "a page with no links: hint-mode reports No hints and stays off" + (test-case "f on a link-less page echoes No hints, app-hints stays #f" + (with-page (app s v) no-link-page + (app-feed-token! app "f") + (check (app-hints app) => #f) + (check (app-echo app) => "No hints")))) + +(newline) +(display "browser-hint-test: ") (display *pass*) (display " passed, ") +(display *fail*) (display " failed") (newline) +(exit (if (zero? *fail*) 0 1)) --- a/scheme/browser/commands.ss +++ b/scheme/browser/commands.ss @@ -17,6 +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-feed-token! app-type! app-render! app-pump-keys! app-run-loop! emacs-keymap buffer-label @@ -76,11 +77,15 @@ ;; echo : last echo-area message (status/debug; shown in Stage 6) ;; quit : set #t by the quit command ;; search : last find-in-page query (for find-next / find-previous) - (defstruct app (session keymap dispatcher minibuffer prompt-action echo quit search)) + ;; hints : hint-mode label→href alist while hinting, else #f + ;; hint-buf : chars typed so far toward a hint label + ;; hint-new : #t when a followed hint should open in a new buffer + (defstruct app (session keymap dispatcher minibuffer prompt-action echo quit search + hints hint-buf hint-new)) (def (make-browser-app session) (let* ((km (emacs-keymap)) (d (make-key-dispatcher km))) - (make-app session km d #f #f "" #f #f))) + (make-app session km d #f #f "" #f #f #f "" #f))) (def (app-should-quit? app) (and (app-quit app) #t)) (def (app-window app) (session-window (app-session app))) @@ -107,9 +112,9 @@ ;; Returns a status for the tests/GUI: ;; 'pending | 'unbound | 'continue | 'abort | 'accepted | (cons 'ran NAME) (def (app-feed-token! app token) - (let ((r (if (app-minibuffer app) - (feed-minibuffer app token) - (feed-command app token)))) + (let ((r (cond ((app-minibuffer app) (feed-minibuffer app token)) + ((app-hints app) (feed-hint app token)) + (else (feed-command app token))))) (app-render! app) r)) @@ -259,6 +264,139 @@ (browser-clipboard-set! s) (app-echo-set! app (string-append "Copied " what ": " s)))))))) + ;; --- hint-mode (Stage 4) ------------------------------------------------- + ;; nyxt-style link hinting: inject JS that labels every visible link/control + ;; with a home-row badge and stashes label→{el,href} on window.__jwbHints, + ;; returning "LABEL\thref" lines. The controller parses those, then collects + ;; typed chars until exactly one label matches and follows it (navigate the + ;; href in this or a new buffer; click controls that carry no href). C-g / + ;; escape cancels. JS-only — no new C entry point (it rides on browser-eval). + (def hint-overlay-js + (string-append + "(function(){" + "var A='asdfghjklqwertyuiopzxcvbnm';" + "document.querySelectorAll('.jwb-hint').forEach(function(e){e.remove();});" + "window.__jwbHints={};" + "var sel='a[href],button,input:not([type=hidden]),textarea,select,[onclick],[role=button]';" + "var els=Array.prototype.slice.call(document.querySelectorAll(sel));" + "var vis=els.filter(function(el){var r=el.getBoundingClientRect();" + "return r.width>0&&r.height>0&&r.bottom>=0&&r.right>=0&&r.top<=innerHeight&&r.left<=innerWidth;});" + "function lab(i,n){if(n<=A.length)return A[i];return A[Math.floor(i/A.length)]+A[i%A.length];}" + "var out=[];vis.forEach(function(el,i){var L=lab(i,vis.length).toUpperCase();" + "var r=el.getBoundingClientRect();var b=document.createElement('div');" + "b.className='jwb-hint';b.textContent=L;" + "b.style.cssText='position:fixed;z-index:2147483647;left:'+Math.max(0,r.left)+'px;top:'+Math.max(0,r.top)" + "+'px;background:#ff0;color:#000;font:bold 11px monospace;padding:0 2px;border:1px solid #000;';" + "document.body.appendChild(b);var h=el.getAttribute('href')||'';" + "window.__jwbHints[L]={el:el,href:h};out.push(L+'\\t'+h);});" + "return out.join('\\n');})()")) + + (def hint-clear-js + (string-append + "(function(){document.querySelectorAll('.jwb-hint').forEach(function(e){e.remove();});" + "window.__jwbHints={};return 'ok';})()")) + + ;; Focus+click the control for `label` in the page (used when it carries no + ;; href — buttons/inputs/selects). Anchors are navigated Scheme-side instead. + (def (hint-click-js label) + (string-append + "(function(l){var h=window.__jwbHints&&window.__jwbHints[l];" + "if(h&&h.el){h.el.focus();h.el.click();return '#click';}return '';})('" label "')")) + + ;; Split `text` into substrings on every occurrence of `ch`. + (def (split-on text ch) + (let ((n (string-length text))) + (let loop ((i 0) (start 0) (acc '())) + (cond + ((= i n) (reverse (cons (substring text start n) acc))) + ((char=? (string-ref text i) ch) + (loop (+ i 1) (+ i 1) (cons (substring text start i) acc))) + (else (loop (+ i 1) start acc)))))) + + ;; Is `pre` a prefix of `s`? + (def (str-prefix? pre s) + (let ((pn (string-length pre)) (sn (string-length s))) + (and (<= pn sn) (string=? pre (substring s 0 pn))))) + + ;; Parse the overlay's "LABEL\thref\n…" payload into an ((LABEL . href) …) alist. + (def (parse-hints text) + (if (or (not (string? text)) (= (string-length text) 0)) + '() + (let loop ((lines (split-on text #\newline)) (acc '())) + (if (null? lines) + (reverse acc) + (let ((parts (split-on (car lines) #\tab))) + (loop (cdr lines) + (if (and (pair? parts) (> (string-length (car parts)) 0)) + (cons (cons (car parts) + (if (>= (length parts) 2) (cadr parts) "")) + acc) + acc))))))) + + ;; Enter hint-mode: render the overlay and capture the label→href alist. `new?` + ;; routes a followed hint into a new buffer instead of the current one. + (def (start-hint-mode! app new?) + (let ((v (current-view app))) + (if (not v) + (app-echo-set! app "No buffer") + (let ((r (browser-eval v hint-overlay-js))) + (if (not (browser-ok? r)) + (app-echo-set! app "Hint failed") + (let ((hints (parse-hints (browser-value r)))) + (if (null? hints) + (app-echo-set! app "No hints") + (begin + (app-hints-set! app hints) + (app-hint-buf-set! app "") + (app-hint-new-set! app new?) + (app-echo-set! app "Follow hint:"))))))))) + + (def (cancel-hint! app) + (let ((v (current-view app))) (when v (browser-eval v hint-clear-js))) + (app-hints-set! app #f) (app-hint-buf-set! app "") + (app-echo-set! app "Quit")) + + ;; Resolve `label`: navigate its href (this/new buffer) or click a control. + (def (follow-hint! app label) + (let* ((v (current-view app)) (new? (app-hint-new app)) + (cell (assoc label (app-hints app))) + (href (if cell (cdr cell) ""))) + (app-hints-set! app #f) (app-hint-buf-set! app "") + (cond + ((not v) (app-echo-set! app "No buffer")) + ((> (string-length href) 0) + (browser-eval v hint-clear-js) ; remove badges before nav + (if new? + (session-open-buffer (app-session app) href) + (browser-load v href)) + (app-echo-set! app (string-append "Followed " href))) + (else ; control with no href: click + (browser-eval v (hint-click-js label)) + (browser-eval v hint-clear-js) + (app-echo-set! app "Followed hint"))))) + + ;; Hint-mode key routing: collect chars until one label matches, then follow; + ;; C-g / escape cancels. An unmatched char is ignored (buffer left intact), so + ;; a typo doesn't drop you out of hint-mode. + (def (feed-hint app token) + (cond + ((or (string=? token "C-g") (string=? token "escape")) + (cancel-hint! app) 'abort) + ((and (= (string-length token) 1) + (let ((c (string-ref token 0))) + (or (char-alphabetic? c) (char-numeric? c)))) + (let* ((buf (string-append (app-hint-buf app) (string-upcase token))) + (matches (filter (lambda (h) (str-prefix? buf (car h))) (app-hints app)))) + (cond + ((null? matches) + (app-echo-set! app (string-append "No hint: " buf)) 'continue) + ((and (= (length matches) 1) (string=? (caar matches) buf)) + (follow-hint! app buf) 'accepted) + (else + (app-hint-buf-set! app buf) + (app-echo-set! app (string-append "Follow hint: " buf)) 'continue)))) + (else 'continue))) + ;; --- 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. @@ -293,6 +431,10 @@ ("C-M-r" . find-previous) ("C-c u" . copy-url) ("C-c t" . copy-title) + ;; hint-mode (Stage 4) — nyxt link hinting / follow + ("f" . follow-hint) + ("M-g" . follow-hint-new-buffer) + ("; f" . follow-hint-new-buffer) ("C-x C-c" . quit) ("C-g" . keyboard-quit))) @@ -385,6 +527,12 @@ (register-command! 'copy-title "Copy the current buffer's title to the clipboard." (lambda (app) (copy-current! app "title" browser-title))) + ;; --- hint-mode commands ------------------------------------------------- + (register-command! 'follow-hint "Hint links/controls and follow the chosen one." + (lambda (app) (start-hint-mode! app #f))) + (register-command! 'follow-hint-new-buffer "Hint links and open the chosen one in a new buffer." + (lambda (app) (start-hint-mode! app #t))) + (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)." @@ -397,9 +545,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; clear find highlight." + (register-command! 'keyboard-quit "Abort the current chord / prompt / hint; clear find highlight." (lambda (app) (dispatcher-reset! (app-dispatcher app)) + (when (app-hints app) (cancel-hint! app)) (let ((v (current-view app))) (when v (browser-clear-find v))) (app-echo-set! app "Quit")))