jerboa-browser: launch the GUI directly + fix backend .so discovery
ober
5c9a8ff79cf007b6fffce6833ef7f00793471835
--- a/build-binary.ss +++ b/build-binary.ss @@ -125,10 +125,25 @@ (lambda (o) (fprintf o "/* Auto-generated — do not edit */\n") (fprintf o "#define _GNU_SOURCE\n#include <stdlib.h>\n#include <stdio.h>\n") - (fprintf o "#include <string.h>\n#include <unistd.h>\n#include \"scheme.h\"\n") + (fprintf o "#include <string.h>\n#include <unistd.h>\n#include <limits.h>\n") + (fprintf o "#if defined(__APPLE__)\n#include <mach-o/dyld.h>\n#endif\n") + (fprintf o "#ifndef PATH_MAX\n#define PATH_MAX 4096\n#endif\n") + (fprintf o "#include \"scheme.h\"\n") (fprintf o "#include \"jb_petite_boot.h\"\n#include \"jb_scheme_boot.h\"\n") (fprintf o "#include \"jb_boot.h\"\n#include \"jb_program.h\"\n\n") (fprintf o "int main(int argc, char *argv[]) {\n") + (fprintf o " /* Record the real exe path so (browser) finds its sibling lib/:\n") + (fprintf o " the embedded program runs from a temp file below, so argv[0]\n") + (fprintf o " seen by Scheme is that temp path, not this binary. */\n") + (fprintf o " { char exe[PATH_MAX];\n") + (fprintf o "#if defined(__linux__)\n") + (fprintf o " ssize_t en = readlink(\"/proc/self/exe\", exe, sizeof(exe)-1);\n") + (fprintf o " if (en > 0) { exe[en] = 0; setenv(\"JERBOA_BROWSER_EXE\", exe, 1); }\n") + (fprintf o "#elif defined(__APPLE__)\n") + (fprintf o " uint32_t esz = sizeof(exe);\n") + (fprintf o " if (_NSGetExecutablePath(exe, &esz) == 0) setenv(\"JERBOA_BROWSER_EXE\", exe, 1);\n") + (fprintf o "#endif\n") + (fprintf o " }\n") (fprintf o " char prog_path[256];\n") (fprintf o " const char *tmpdir = getenv(\"TMPDIR\"); if (!tmpdir) tmpdir = \"/tmp\";\n") (display " snprintf(prog_path, sizeof(prog_path), \"%s/jerboa-browser-XXXXXX\", tmpdir);\n" o) --- a/packaging/linux/build-tarball.sh +++ b/packaging/linux/build-tarball.sh @@ -58,6 +58,12 @@ fi cat > "$STAGE/README.txt" <<EOF Jerboa Browser $VERSION (linux-$ARCH) +Run it: + ./bin/jerboa-browser open the browser (default page) + ./bin/jerboa-browser example.com open a URL (scheme optional) + ./bin/jerboa-browser repl Jerboa REPL with (browser) preloaded + headless smoke (no window): QT_QPA_PLATFORM=offscreen JWB_BROWSE_MS=1500 ./bin/jerboa-browser example.com + Prerequisite: Qt 6 WebEngine runtime installed system-wide (e.g. apt install qt6-webengine-dev libqt6webenginewidgets6, or distro equivalent). The Chromium sandbox is left enabled. @@ -66,7 +72,7 @@ Layout: lib/libjerboa_browser.so browser backend (the native binary dlopens this) scheme/ the (browser) Jerboa module + entry points build-binary.ss, Makefile build the native binary: \`make binary\` -$([ "$HAVE_BIN" = 1 ] && echo " bin/jerboa-browser self-contained native binary (repl | test | run <file>)" || echo " bin/ (empty — build with 'make binary'; needs Chez + Jerboa)") +$([ "$HAVE_BIN" = 1 ] && echo " bin/jerboa-browser self-contained native binary (<url> | browse | repl | test | run <file>)" || echo " bin/ (empty — build with 'make binary'; needs Chez + Jerboa)") The native jerboa-browser binary embeds Chez Scheme, the boot image, and the (browser) library; only libjerboa_browser.so + system Qt 6 are external. --- a/scheme/browser-main.ss +++ b/scheme/browser-main.ss @@ -7,8 +7,10 @@ ;;; (libjerboa_browser.{dylib,so}) and a system Qt 6 WebEngine are needed; the ;;; Chromium sandbox is left on. ;;; -;;; jerboa-browser REPL with (browser) preloaded -;;; jerboa-browser repl +;;; jerboa-browser open the browser window (default page) +;;; jerboa-browser URL open the browser at URL (scheme optional) +;;; jerboa-browser browse URL same, explicit form +;;; jerboa-browser repl REPL with (browser) preloaded ;;; jerboa-browser test run the (browser) test suite ;;; jerboa-browser run FILE run a Jerboa script with (browser) available @@ -46,15 +48,83 @@ (display ";; (browser) loaded — call (browser-init) then (browser-open-context ...)\n") (jerboa-repl)) +(define default-url "https://example.com") + +;; substring search (Chez base has none): is `needle` in `hay`? +(define (str-contains? 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))))))) + +(define (about? s) (and (>= (string-length s) 6) (string=? (substring s 0 6) "about:"))) + +;; A bare first arg we should treat as a URL rather than a bad subcommand. +(define (looks-like-url? s) + (or (str-contains? s "://") (str-contains? s ".") + (string=? s "localhost") (about? s))) + +;; Add a scheme when the user typed a bare host (news.ycombinator.com). +(define (normalize-url u) + (if (or (str-contains? u "://") (about? u)) u (string-append "https://" u))) + +(define (browse-fail msg e) + (let ((p (current-error-port))) + (display "jerboa-browser: " p) (display msg p) (newline p) + (when (message-condition? e) + (display " " p) (display (condition-message e) p) + (when (and (irritants-condition? e) (pair? (condition-irritants e))) + (display ": " p) (write (car (condition-irritants e)) p)) + (newline p)) + (display " needs system Qt 6 WebEngine + a display.\n" p) + (display " Debian/Ubuntu: sudo apt install qt6-webengine-dev libqt6webenginewidgets6\n" p) + (display " headless check: QT_QPA_PLATFORM=offscreen JWB_BROWSE_MS=1500 jerboa-browser <url>\n" p) + (exit 1))) + +;; Open the GUI at `url` and hand control to the Qt event loop (the window stays +;; live until closed). Set JWB_BROWSE_MS=<ms> for a headless/no-block smoke that +;; pumps for ms, prints the page title, then exits — used by tests/CI. +(define (run-browse url) + (guard (e (#t (browse-fail "could not launch the browser" e))) + (let ((ir (browser-init))) + (unless (browser-ok? ir) (error 'browser-init (browser-value ir)))) + (let ((cr (browser-open-context (browser-capabilities 'network)))) + (unless (browser-ok? cr) (error 'browser-open-context (browser-value cr))) + (let* ((c (browser-value cr)) (vr (browser-open-view c))) + (unless (browser-ok? vr) (error 'browser-open-view (browser-value vr))) + (let ((v (browser-value vr))) + (browser-set-title v "Jerboa Browser") + (let ((lr (browser-load v url))) + (unless (browser-ok? lr) + (display (string-append "jerboa-browser: load failed: " + (browser-value lr) "\n") + (current-error-port)))) + (browser-show v) + (browser-focus v) + (let ((ms (and (getenv "JWB_BROWSE_MS") + (string->number (getenv "JWB_BROWSE_MS"))))) + (if ms + (begin + (browser-pump ms) + (let ((tr (browser-eval v "document.title"))) + (when (browser-ok? tr) (display (browser-value tr)) (newline))) + (browser-close-view v) (browser-close-context c) (exit 0)) + (begin + (browser-exec) ; blocks until the window is closed + (browser-close-view v) (browser-close-context c) (exit 0))))))))) + (define (usage port code) - (display "usage: jerboa-browser [repl|test|run <file>]\n" port) + (display "usage: jerboa-browser [<url> | browse [<url>] | repl | test | run <file>]\n" port) (exit code)) (define (main) (let ((args (cdr (command-line)))) (cond - ((or (null? args) (string=? (car args) "repl")) - (run-repl)) + ((null? args) (run-browse default-url)) + ((string=? (car args) "repl") (run-repl)) + ((string=? (car args) "browse") + (run-browse (if (pair? (cdr args)) (normalize-url (cadr args)) default-url))) ((string=? (car args) "test") (let ((f (locate "browser-test.ss"))) (if f @@ -68,6 +138,8 @@ (usage (current-error-port) 1))) ((member (car args) '("-h" "--help" "help")) (usage (current-output-port) 0)) + ((looks-like-url? (car args)) + (run-browse (normalize-url (car args)))) (else (usage (current-error-port) 1))))) --- a/scheme/browser.ss +++ b/scheme/browser.ss @@ -14,8 +14,8 @@ ;;; Usage: ;;; (import (browser)) ;;; (browser-init) -;;; (def c (browser-value (browser-open-context (browser-capabilities 'network)))) -;;; (def v (browser-value (browser-open-view c))) +;;; (define c (browser-value (browser-open-context (browser-capabilities 'network)))) +;;; (define v (browser-value (browser-open-view c))) ;;; (browser-load v "https://example.com") ;;; (browser-eval v "document.title") ; => (ok "Example Domain") ;;; (browser-close-view v) (browser-close-context c) @@ -78,15 +78,19 @@ (string=? mt "tarm64osx") (string=? mt "arm64osx")) "dylib" "so"))) - ;; Directory of argv[0] ("." when it has no slash / is unavailable). + ;; Directory of the REAL executable. The native binary launches its embedded + ;; program from a temp file, so (command-line)'s argv[0] is that temp path + ;; (e.g. /tmp/jerboa-browser-XXXXXX) — useless for locating the sibling lib/. + ;; The C bootstrap exports JERBOA_BROWSER_EXE with the true path (/proc/self/exe + ;; on Linux, _NSGetExecutablePath on macOS); fall back to argv[0] (e.g. make repl). (def (jwb-exe-dir) - (let ((cl (command-line))) - (if (pair? cl) - (let* ((p (car cl)) - (i (let loop ((i (- (string-length p) 1))) - (cond ((< i 0) #f) - ((char=? (string-ref p i) #\/) i) - (else (loop (- i 1))))))) + (let* ((cl (command-line)) + (p (or (getenv "JERBOA_BROWSER_EXE") (and (pair? cl) (car cl))))) + (if (string? p) + (let ((i (let loop ((i (- (string-length p) 1))) + (cond ((< i 0) #f) + ((char=? (string-ref p i) #\/) i) + (else (loop (- i 1))))))) (if i (substring p 0 i) ".")) "."))) @@ -97,7 +101,9 @@ (let* ((name (string-append "libjerboa_browser." (jwb-lib-ext))) (d (jwb-exe-dir)) (cands (list (string-append d "/../lib/" name) + (string-append d "/lib/" name) (string-append d "/" name) + (string-append d "/qt-webengine/build/" name) (string-append d "/../qt-webengine/build/" name) (string-append "qt-webengine/build/" name)))) (let loop ((cs cands))