From 1ecb678e38ae6e2372aaf787234a2e3573481963 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 3 Aug 2026 08:20:56 +0200 Subject: [PATCH] Omzetting naar stdio. --- README.md | 25 +- info.rkt | 18 +- racket-webview-downloader.rkt | 4 +- racket-webview-qt.rkt | 1716 ++++++++++++++-------------- scrbl/racket-webview-intro.scrbl | 9 +- scrbl/racket-webview-qt.scrbl | 128 +-- scrbl/racket-webview.scrbl | 5 +- scrbl/rktwebview-api.scrbl | 7 +- scrbl/rktwebviewqt-internals.scrbl | 295 ++--- 9 files changed, 989 insertions(+), 1218 deletions(-) diff --git a/README.md b/README.md index dccf5b2..bf61a30 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,22 @@ # racket-webview -Webview integration for racket +Webview integration for Racket. -## Release v0.1.8 +## Release v0.1.10 -Uses release v0.2.2 of racket-webview-qt. -QtWebEngine select popup rendering issue observed with older Qt 6.x. -Symptom: native HTML ` popup could keep growing or repainting while open while +the QtWebEngine process remained busy. Upgrading to Qt 6.11.1 resolved this. diff --git a/info.rkt b/info.rkt index 8d7733b..220233e 100644 --- a/info.rkt +++ b/info.rkt @@ -1,8 +1,8 @@ #lang info (define pkg-authors '(hnmdijkema)) -(define version "0.1.9") -(define license 'MIT) +(define version "0.1.10") +(define license 'MIT) (define collection "racket-webview") (define pkg-desc "racket-webview - A Web Based GUI library, based on a Qt WebEngine backend") @@ -13,13 +13,13 @@ ) (define deps - '("racket/base" - "http-easy" - "gregor" - "racket/gui" - "html-printer-lib" - "racket/net" - "simple-ini" + '("racket/base" + "http-easy" + "gregor" + "racket/gui" + "html-printer-lib" + "racket/net" + "simple-ini" "gregor-utils" "racket-sprintf" "lru-cache" diff --git a/racket-webview-downloader.rkt b/racket-webview-downloader.rkt index cd93a7e..63104b8 100644 --- a/racket-webview-downloader.rkt +++ b/racket-webview-downloader.rkt @@ -26,7 +26,7 @@ (define rkt-qt-version-major 0) (define rkt-qt-version-minor 2) -(define rkt-qt-version-patch (if (eq? (system-type 'os) 'windows) 2 1)) +(define rkt-qt-version-patch 3) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal functions @@ -164,7 +164,7 @@ (let ((out (open-output-file version-file #:exists 'replace))) (write version out) (close-output-port out))) - (displayln "Version file written; ready for FFI integration") + (displayln "Version file written; backend process is ready") #t ) ) diff --git a/racket-webview-qt.rkt b/racket-webview-qt.rkt index 0d953e7..97885ac 100644 --- a/racket-webview-qt.rkt +++ b/racket-webview-qt.rkt @@ -1,24 +1,17 @@ #lang racket/base -(require ffi/unsafe - ffi/unsafe/define - ffi/unsafe/atomic - ffi/unsafe/os-thread - ffi/unsafe/os-async-channel - ffi/unsafe/cvector - ffi/unsafe/custodian - racket/async-channel - racket/runtime-path - racket/port - data/queue +(require data/queue json - racket/string + racket/async-channel + racket/file + racket/list racket/path + racket/port + racket/string + racket/system "private/utils.rkt" "racket-webview-downloader.rkt" - "menu.rkt" - openssl/libssl - ) + "menu.rkt") (provide rkt-wv rkt-wv-win @@ -52,960 +45,915 @@ rkt-webview-version rkt-webview-set-loglevel rkt-webview-info - ; tray specific + rkt-webview-tray-create rkt-webview-tray-set-icon! rkt-webview-tray-set-tooltip! rkt-webview-tray-show-message - rkt-webview-tray-set-menu! - ) + rkt-webview-tray-set-menu!) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; FFI Library +;; Protocol constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define lib-type 'release) +(define cmd-handle-is-valid 1) +(define cmd-quit 2) +(define cmd-context-new 3) +(define cmd-create-wv 4) +(define cmd-close-wv 5) +(define cmd-set-url 6) +(define cmd-set-html 7) +(define cmd-run-js 8) +(define cmd-call-js 9) +(define cmd-open-devtools 10) +(define cmd-move 11) +(define cmd-resize 12) +(define cmd-hide 13) +(define cmd-show 14) +(define cmd-present 15) +(define cmd-maximize 16) +(define cmd-minimize 17) +(define cmd-show-normal 18) +(define cmd-window-state 19) +(define cmd-set-title 20) +(define cmd-choose-dir 21) +(define cmd-file-open 22) +(define cmd-file-save 23) +(define cmd-set-ou-token 24) +(define cmd-msg-box 25) +(define cmd-set-loglevel 26) +(define cmd-info 27) +(define cmd-set-icon 28) +(define cmd-create-tray 29) +(define cmd-tray-set-icon 30) +(define cmd-tray-set-tooltip 31) +(define cmd-tray-show-message 32) +(define cmd-tray-set-menu 33) +(define cmd-tray-clear-menu 34) -;; Check if racket-webview-qt backend is available or downloadable +(define stdio-protocol-version 1) -(define do-ffi #t) -(define reason "") +(define (result-code->symbol code) + (case code + ((-1) 'no_result_yet) + ((0) 'oke) + ((1) 'set_html_failed) + ((2) 'set_navigate_failed) + ((3) 'eval_js_failed) + ((4) 'no_devtools_on_platform) + ((5) 'no_delegate_for_context) + ((6) 'webview_missing_dependency) + ((7) 'webview_canceled) + ((8) 'webview_invalid_state) + ((9) 'webview_invalid_argument) + ((10) 'webview_unspecified) + ((11) 'webview_dispatch_failed) + ((12) 'move_failed) + ((13) 'resize_failed) + ((14) 'choose_dir_failed) + ((15) 'open_file_failed) + ((16) 'save_file_failed) + ((17) 'failed) + ((18) 'invalid_handle) + (else 'failed))) -(unless (racket-webview-qt-is-available?) - (if (racket-webview-qt-resolves?) - (if (racket-webview-qt-is-downloadable?) - (begin - (set! do-ffi (download-racket-webview-qt)) - (when (eq? do-ffi #f) - (set! reason "Racket Webview Qt backend could not be downloaded")) - ) - (begin - (displayln "There is no version of the racket-webview Qt backend available\n") - (displayln - (format "for OS '~a', Architecture '~a'" - (system-type 'os*) - (system-type 'arch))) - (set! do-ffi #f) - (set! reason (format - "There is no version of Racket Webview Qt for os '~a', architecture '~a' available" - (system-type 'os*) - (system-type 'arch) - ) - ) - ) - ) - (begin - (displayln "Warning: Cannot resolve racket webview download site.") - (displayln "Cannot download backend libraries and programs.") - (set! do-ffi #f) - (set! reason "Racket Webview Qt backend download site could not be resolved") - ) - ) - ) +(define (window-state-code->symbol code) + (case code + ((-1) 'invalid) + ((0) 'normal) + ((1) 'minimized) + ((2) 'maximized) + ((3) 'hidden) + ((16) 'normal_active) + ((18) 'maximized_active) + (else 'invalid))) -;; Make sure we can load the FFI library, if at all possible (i.e. do-ffi equals #t) +(define (loglevel->integer level) + (case level + ((error) 1) + ((warning) 2) + ((info) 3) + ((debug) 4) + (else (error 'rkt-webview-set-loglevel + "expected 'error, 'warning, 'info or 'debug; got ~a" + level)))) + +(define (messagetype->integer type) + (case type + ((info) 1) + ((error) 2) + ((warning) 3) + ((yes-no) 4) + ((oke-cancel) 5) + (else (error 'rkt-webview-messagebox + "unknown message type: ~a" + type)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Backend location and child environment +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define os (system-type 'os*)) -(define ffi-library - (cond - ([eq? os 'windows] 'rktwebview.dll) - ([eq? os 'linux] 'librktwebview.so) - ) - ) +(define rktwebview-prg + (if (eq? os 'windows) + "rktwebview_prg.exe" + "rktwebview_prg")) -(define os-lib-dir - (let ((dir (racket-webview-qt-directory))) - (if (eq? dir #f) - (build-path ".") - dir))) +(define webengine-process + (if (eq? os 'windows) + "QtWebEngineProcess.exe" + "QtWebEngineProcess")) -(define (libname lib-symbol) - (build-path os-lib-dir (symbol->string lib-symbol))) +(define backend-program #f) +(define backend-directory #f) -(define quiet-call #t) +(define (executable-file? path) + ;; Let subprocess report a platform-specific execute error. Checking only + ;; existence also works for Windows and for unpacked Unix release archives. + (and path (file-exists? path))) -(define rktwebview-prg (if (eq? os 'windows) - "rktwebview_prg.exe" - "rktwebview_prg")) +(define (ensure-backend-program!) + (unless backend-program + (let ((override (getenv "RKT_WEBVIEW_PRG"))) + (cond + ((and override (executable-file? override)) + (set! backend-program (path->complete-path override)) + (set! backend-directory (path-only backend-program))) -(define webengine-process (if (eq? os 'windows) - "QtWebEngineProcess.exe" - "QtWebEngineProcess")) + (override + (error 'racket-webview + "RKT_WEBVIEW_PRG does not point to an executable file: ~a" + override)) -;;; Actual FFI integration + (else + (unless (racket-webview-qt-is-available?) + (cond + ((not (racket-webview-qt-resolves?)) + (error 'racket-webview + "Cannot resolve the racket-webview-qt download site")) + ((not (racket-webview-qt-is-downloadable?)) + (error 'racket-webview + (string-append + "No downloadable racket-webview-qt backend is available " + "for OS ~a and architecture ~a") + os + (system-type 'arch))) + ((not (download-racket-webview-qt)) + (error 'racket-webview + "The racket-webview-qt backend could not be downloaded")))) -(define webview-lib-file (libname ffi-library)) -(define webview-lib - (if (eq? do-ffi #f) - libssl - (with-handlers ([exn:fail? - (λ (exp) - (cond - ([eq? os 'linux] - (error (format - (string-append "Cannot load ~a.\n" - "Make sure you installed Qt6 on your system\n" - "NB. the minimum Qt version that is supported is Qt 6.10.\n" - "This probably means you will need to install it separately from\n" - "the standard distro packages (e.g. libqt6webenginewidgets6 on\n" - "debian based systems).\n" - "\n" - "Exception:\n\n~a") - ffi-library exp))) - (else (error - (format "Cannot load ~a for os ~a\n\nException:\n\n~a" - ffi-library os exp)))) - ) - ]) - (ffi-lib webview-lib-file '("6" #f) - #:get-lib-dirs (list os-lib-dir) - ;#:custodian (current-custodian) - ) - ) - ) - ) + (set! backend-directory (racket-webview-qt-directory)) + (set! backend-program (build-path backend-directory rktwebview-prg)) + (unless (executable-file? backend-program) + (error 'racket-webview + "The racket-webview-qt executable is missing: ~a" + backend-program))))))) -;; Make sure we are forgiving with the function loading. -;; forgiving with the function loading. +(define (environment-set-string! environment name value) + (environment-variables-set! environment + (string->bytes/utf-8 name) + (string->bytes/utf-8 value))) -(define (make-ffi-repl id err . ret) - (let ((warned #f) - (msg (if (eq? do-ffi #t) - (string-append - "'~a' could not be loaded from " - (format "~a" webview-lib-file)) - (string-append - "'~a' could not be loaded.\n" - reason))) - ) - (λ () (λ args - (if err - (error (format msg id)) - (begin - (unless warned - (displayln (format msg id)) - (set! warned #t)) - (car ret))))))) +(define (make-backend-environment) + (define environment + (environment-variables-copy (current-environment-variables))) + (define directory-string (path->string backend-directory)) -(define-ffi-definer define-rktwebview - webview-lib - #:default-make-fail (λ (id) - (if (eq? do-ffi #f) - (cond - ((eq? id 'rkt_webview_env) - (make-ffi-repl id #f #t)) - ((eq? id 'rkt_webview_events_waiting) - (make-ffi-repl id #f 0)) - ((eq? id 'rkt_webview_init) - (make-ffi-repl id #f #t)) - ((eq? id 'rkt_webview_cleanup) - (make-ffi-repl id #f #t)) - (else - (make-ffi-repl id #t)) - ) - (make-ffi-repl id #t))) - ) + (environment-set-string! environment "QT_PLUGIN_PATH" directory-string) + (environment-set-string! environment + "QTWEBENGINEPROCESS_PATH" + (path->string + (build-path backend-directory webengine-process))) + (environment-set-string! environment + "QTWEBENGINE_RESOURCES_PATH" + (path->string + (build-path backend-directory "resources"))) + (environment-set-string! environment + "QTWEBENGINE_LOCALES_PATH" + (path->string + (build-path backend-directory + "translations" + "qtwebengine_locales"))) + + (when (eq? os 'linux) + (let* ((old-library-path + (environment-variables-ref environment #"LD_LIBRARY_PATH")) + (added-library-path + (string-append + directory-string + ":" + (path->string (build-path backend-directory "platforms"))))) + (environment-set-string! environment "QT_QPA_PLATFORM" "xcb") + (environment-set-string! + environment + "LD_LIBRARY_PATH" + (if old-library-path + (string-append added-library-path + ":" + (bytes->string/utf-8 old-library-path)) + added-library-path)))) + + environment) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Types / Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define _rkt_loglevel_t - (_enum '(error = 1 - warning = 2 - info = 3 - debug = 4) - ) - ) - -(define _rkt_result_t - (_enum '(no_result_yet = -1 - oke = 0 - set_html_failed = 1 - set_navigate_failed = 2 - eval_js_failed = 3 - no_devtools_on_platform = 4 - no_delegate_for_context = 5 - webview_missing_dependency = 6 - webview_canceled = 7 - webview_invalid_state = 8 - webview_invalid_argument = 9 - webview_unspecified = 10 - webview_dispatch_failed = 11 - move_failed = 12 - resize_failed = 13 - choose_dir_failed = 14 - open_file_failed = 15 - save_file_failed = 16 - failed = 17 - invalid_handle = 18 - ) - ) - ) - -(define _rkt_window_state_t - (_enum '(invalid = -1 - normal = 0 - minimized = 1 - maximized = 2 - hidden = 3 - normal_active = 16 - maximized_active = 18 - ) - ) - ) - -(define _rkt_data_kind - (_enum '(version = -1 - event = 2 - js-result = 3 - metrics = 4 - ) - ) - ) - -(define _rkt_messagetype_t - (_enum '(info = 1 - error = 2 - warning = 3 - yes-no = 4 - oke-cancel = 5 - ) - ) - ) - -(define-cstruct _rkt_version_t - ( - [api-major _int] - [api-minor _int] - [api-patch _int] - ) - ) - -(define-cstruct _rkt_metrics_t - ([shm_usage _int] - [shm_free_depth _int] - [shm_free_size _int] - [shm_item_depth _int] - [shm_item_size _int] - [shm_item_usage_factor _double] - [open_windows _int] - [function_calls _int] - [events _int] - [log_file _string*/utf-8] - ) - ) - -(define-cstruct _rkt_evt_t - ([w _int] - [evt _pointer] - )) - -(define-cstruct _rkt_js_result_t - ([result _rkt_result_t] - [value _pointer] - )) - -(define-cstruct _rkt_data_t - ([kind _rkt_data_kind] - [data (_union _rkt_version_t _rkt_evt_t _rkt_js_result_t _rkt_metrics_t)] - ) - ) - -(define (evt-apply thunk) - (thunk)) - -;RKTWEBVIEW_EXPORT void rkt_webview_env(const char *env_cmds[]); -(define-rktwebview rkt_webview_env - (_fun _cvector -> _void)) - -;RKTWEBVIEW_QT_EXPORT void rkt_webview_register_evt_callback(void (*f)(int)); -(define-rktwebview rkt_webview_register_evt_callback - (_fun (_fun #:async-apply evt-apply #:atomic? #t - _int -> _void) -> _int)) - -;RKTWEBVIEW_QT_EXPORT void rkt_webview_init(const char *from); -(define-rktwebview rkt_webview_init - (_fun _string/utf-8 -> _void)) - -;RKTWEBVIEW_QT_EXPORT void rkt_webview_cleanup(); -(define-rktwebview rkt_webview_cleanup - (_fun -> _void)) - -;RKTWEBVIEW_EXPORT void rkt_webview_exit_done(int done); -(define-rktwebview rkt_webview_exit_done - (_fun _int -> _void)) - -;RKTWEBVIEW_EXPORT void rkt_webview_set_loglevel(rkt_webview_loglevel_t l); -(define-rktwebview rkt_webview_set_loglevel - (_fun _rkt_loglevel_t -> _void)) - -;RKTWEBVIEW_EXPORT rkt_data_t *rkt_webview_info(); -(define-rktwebview rkt_webview_info - (_fun -> _rkt_data_t-pointer/null)) - -;RKTWEBVIEW_EXPORT int rkt_webview_events_waiting(); -(define-rktwebview rkt_webview_events_waiting - (_fun -> _int)) - -;RKTWEBVIEW_EXPORT rkt_data_t *rkt_webview_get_event(); -(define-rktwebview rkt_webview_get_event - (_fun -> _rkt_data_t-pointer/null)) - -;RKTWEBVIEW_QT_EXPORT rkt_wv_context_t rkt_webview_new_context(const char *boilerplate_js, -; const char *optional_server_cert_pem); -(define-rktwebview rkt_webview_new_context - (_fun _string/utf-8 _string/utf-8 -> _int)) - -;RKTWEBVIEW_QT_EXPORT void rkt_webview_process_events(int for_ms); -;(define-rktwebview rkt_webview_process_events -; (_fun _int -> _void)) - -;RKTWEBVIEW_QT_EXPORT void rkt_webview_free_data(rkt_data_t *d); -(define-rktwebview rkt_webview_free_data - (_fun _rkt_data_t-pointer -> _void)) - -;RKTWEBVIEW_QT_EXPORT rkt_data_t *rkt_webview_version(); -(define-rktwebview rkt_webview_version - (_fun -> _rkt_data_t-pointer)) - -; RKTWEBVIEW_QT_EXPORT int rkt_webview_create(rkt_wv_context_t context, -; rktwebview_t parent) -(define-rktwebview rkt_webview_create - (_fun _int _int -> _int)) - -;RKTWEBVIEW_QT_EXPORT void rkt_webview_close(int wv); -(define-rktwebview rkt_webview_close - (_fun _int -> _void)) - -;void rkt_webview_set_ou_token(rktwebview_t wv, const char *token) -(define-rktwebview rkt_webview_set_ou_token - (_fun _int _string/utf-8 -> _void)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_set_url(int wv, const char *url); -(define-rktwebview rkt_webview_set_url - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_set_html(int wv, const char *html); -(define-rktwebview rkt_webview_set_html - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_run_js(int wv, const char *js); -(define-rktwebview rkt_webview_run_js - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_call_js(rktwebview_t wv, const char *js); -(define-rktwebview rkt_webview_call_js - (_fun _int _string/utf-8 -> _rkt_data_t-pointer)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_open_devtools(int wv); -(define-rktwebview rkt_webview_open_devtools - (_fun _int -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_move(rktwebview_t w, int x, int y); -(define-rktwebview rkt_webview_move - (_fun _int _int _int -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_resize(rktwebview_t w, int width, int height); -(define-rktwebview rkt_webview_resize - (_fun _int _int _int -> _rkt_result_t)) - -(define-syntax def-rkt-wv - (syntax-rules () - ((_ name) - (define-rktwebview name - (_fun _int -> _rkt_result_t))))) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_hide(rktwebview_t w); -(def-rkt-wv rkt_webview_hide) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_show(rktwebview_t w); -(def-rkt-wv rkt_webview_show) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_show_normal(rktwebview_t w); -(def-rkt-wv rkt_webview_show_normal) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_present(rktwebview_t w); -(def-rkt-wv rkt_webview_present) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_maximize(rktwebview_t w); -(def-rkt-wv rkt_webview_maximize) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_minimize(rktwebview_t w); -(def-rkt-wv rkt_webview_minimize) - -;RKTWEBVIEW_QT_EXPORT bool rkt_webview_valid(rktwebview_t wv); -(define-rktwebview rkt_webview_valid - (_fun _int -> _int)) - -;RKTWEBVIEW_QT_EXPORT window_state_t rkt_webview_window_state(rktwebview_t w); -(define-rktwebview rkt_webview_window_state - (_fun _int -> _rkt_window_state_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_set_title(rktwebview_t wv, const char *title); -(define-rktwebview rkt_webview_set_title - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_set_icon(rktwebview_t wv, const char *icon-file); -(define-rktwebview rkt_webview_set_icon - (_fun _int _string/utf-8 -> _rkt_result_t)) - - -;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_choose_dir(rktwebview_t w, const char *title, const char *base_dir); -(define-rktwebview rkt_webview_choose_dir - (_fun _int _string/utf-8 _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_file_open(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts); -(define-rktwebview rkt_webview_file_open - (_fun _int _string/utf-8 _string/utf-8 _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_file_save(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts); -(define-rktwebview rkt_webview_file_save - (_fun _int _string/utf-8 _string/utf-8 _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_message_box( -; rktwebview_t w, -; const char *title, -; const char *message, -; const char *submessage, -; rkt_messagetype_t type); -(define-rktwebview rkt_webview_message_box - (_fun _int _string/utf-8 _string/utf-8 _string/utf-8 _rkt_messagetype_t -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT rktwebview_t rkt_webview_tray_create(const char *icon_file, const char *tooltip); -(define-rktwebview rkt_webview_tray_create - (_fun _string/utf-8 _string/utf-8 -> _int)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_set_icon( rktwebview_t tray, const char *icon_file); -(define-rktwebview rkt_webview_tray_set_icon - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_set_tooltip(rktwebview_t tray, const char *tooltip); -(define-rktwebview rkt_webview_tray_set_tooltip - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_show_message(rktwebview_t tray, const char *title, const char *message); -(define-rktwebview rkt_webview_tray_show_message - (_fun _int _string/utf-8 _string/utf-8 -> _rkt_result_t)) - -;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_tray_set_menu(rktwebview_t tray, const char *menu_json); -(define-rktwebview rkt_webview_tray_set_menu - (_fun _int _string/utf-8 -> _rkt_result_t)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Initialize and start library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;(define process-events 'process) - -;(define (stop-event-processing) -; (set! process-events 'stop) -; (while (eq? process-events 'stop) -; (sleep 0.001))) - -;(define (start-event-processing) -; (thread (λ () -; (letrec ((f (λ () -; (rkt_webview_process_events 1) -; (sleep 0.001) -; (if (eq? process-events 'process) -; (f) -; (begin -; (displayln "Stopping event processing") -; (set! process-events 'stopped) -; 'done))))) -; (f))))) - -(define rkt_env - (when (or (eq? os 'windows) (eq? os 'linux)) - (let ((env (list (string-append "QT_PLUGIN_PATH=" (path->string (build-path os-lib-dir))) - (string-append "QTWEBENGINEPROCESS_PATH=" (path->string (build-path os-lib-dir webengine-process))) - (string-append "QTWEBENGINE_RESOURCES_PATH=" (path->string (build-path os-lib-dir "resources"))) - (string-append "QTWEBENGINE_LOCALES_PATH=" (path->string (build-path os-lib-dir "translations" "qtwebengine_locales"))) - (string-append "RKT_WEBVIEW_PRG=" (path->string (build-path os-lib-dir rktwebview-prg)))))) - (when (eq? os 'linux) - (set! env (append - env - (list - (string-append "QT_QPA_PLATFORM=" "xcb") - (string-append "LD_LIBRARY_PATH=" - (string-append - (path->string (build-path os-lib-dir)) ":" - (path->string (build-path os-lib-dir "platforms")) - ))))) - ) - (append env (list #f))))) - -;(define env_array (_array _string/utf-8 (length rkt_env))) - -;(let ((i 0)) -; (while (< i (length rkt_env)) -; (array-set! env_array i (list-ref rkt_env i)) -; (set! i (+ i 1)))) - -(rkt_webview_env (list->cvector rkt_env _string/utf-8)) -(rkt_webview_init "racket") - -(define events-channel (make-os-async-channel)) - -(define (event-callback num) - (os-async-channel-put events-channel num)) - -(void - (while (= (rkt_webview_register_evt_callback event-callback) 0) - (sleep 0.1) - )) - -;(set! quiet-call (start-event-processing)) -(define evt-cb-hash (make-hash)) - - -;; TODO Make this more semaphore like.. -;; EG callback from library. - -#| -(define (start-event-processing) - (thread (λ () - (letrec ((f (λ () - (let ((waiting (rkt_webview_events_waiting))) - ;(displayln (format "Events waiting: ~a" waiting)) - (while (> waiting 0) - (let* ((rkt-evt (rkt_webview_get_event))) - ;(displayln rkt-evt) - (if (eq? rkt-evt #f) - (displayln (format "Unexpected: event = nullptr")) - (let ((data (rkt_data_t-data rkt-evt))) - ;(displayln data) - (let ((e (union-ref data 1))) -; (displayln e) - (let ((wv (rkt_evt_t-w e))) - ;(displayln wv) - (let ((evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8))) -; (displayln evt) - (rkt_webview_free_data rkt-evt) - (let ((cb (hash-ref evt-cb-hash wv #f))) - (unless (eq? cb #f) - (cb evt))))) - ) - ) - ) - ) - (set! waiting (- waiting 1)) - ) - ) - (sleep 0.05) - (f)) - )) - (f))) - ) - ) -|# - -(define alive-error-event -94328) - -(define (close-down-on-alive-error) - (rkt-webview-exit #f - "rktwebview_prg has stopped working, cannot continue" - ) ; close without closing windows - ) - -(define evt-guard-stop -93273) -(define evt-start-polling -93274) - -(define event-processing-kind 'sync) - -(define (start-event-processing) - (thread (λ () - (let* ((polling #f) - (get-evt (λ () - (if polling - (begin - (sleep 0.01) - (let ((w (os-async-channel-try-get events-channel))) - (if (eq? w #f) - 0 - w))) - (sync events-channel)))) - ) - (letrec - ((f - (λ () - (let ((waiting (get-evt))) - (cond - ((= waiting evt-guard-stop) - (info-webview "got evt-guard-stop, exiting event processing") - (set! evt-processing-thread #f) - evt-guard-stop) - ((= waiting evt-start-polling) - (info-webview "got evt-start-polling, starting to poll instead of waiting on channel") - (set! polling #t) - (set! event-processing-kind 'poll) - (f)) - (else - (set! waiting (rkt_webview_events_waiting)) - (while (> waiting 0) - (let* ((rkt-evt (rkt_webview_get_event))) - (if (eq? rkt-evt #f) - (err-webview (format "Unexpected: event = nullptr")) - (let* ((data (rkt_data_t-data rkt-evt)) - (e (union-ref data 1)) - (wv (rkt_evt_t-w e)) - (evt (cast (rkt_evt_t-evt e) - _pointer - _string*/utf-8)) - ) - (rkt_webview_free_data rkt-evt) - (if (= wv alive-error-event) - (close-down-on-alive-error) - (let ((cb (hash-ref evt-cb-hash wv #f))) - (unless (eq? cb #f) - (cb evt))))))) - (set! waiting (- waiting 1)) - ) - (f)) - ) - ) - ) - )) - (f)) - ) - ) - ) - ) - -(define evt-processing-thread (start-event-processing)) - -(define (stop-event-processing) - (unless (eq? evt-processing-thread #f) - (kill-thread evt-processing-thread)) - (set! evt-processing-thread #f)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Provided features +;; Handles and event dispatch ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-struct rkt-wv (win evt-queue callback [valid #:mutable] [close-callback #:mutable]) - #:transparent - ) + #:transparent) (define rkt-wv-store (make-hash)) +(define evt-cb-hash (make-hash)) -#| -(define (rkt-process-events handle) - (if (> (queue-length (rkt-wv-evt-queue handle)) 0) - (let ((evt (dequeue! (rkt-wv-evt-queue handle)))) - (if (symbol? evt) - (if (eq? evt 'quit) - (begin - (hash-remove! rkt-wv-store (rkt-wv-win handle)) - 'quit) - (begin - (warn-webview "Unexpected data in event queue: ~a" evt) - (rkt-process-events handle))) - (begin - ((rkt-wv-callback handle) handle evt) - (rkt-process-events handle))) - ) - 'done) - ) -|# +(define state-lock (make-semaphore 1)) + +(define (with-state-lock thunk) + (call-with-semaphore state-lock thunk)) + +(define event-channel (make-async-channel)) + +(define event-thread + (thread + (lambda () + (let loop () + ;; Capture the callback while reading stdout. In particular, a + ;; "closed" event is written before the corresponding close result; + ;; the handle may already have been removed by the time this thread runs. + (define event (async-channel-get event-channel)) + (define callback (vector-ref event 0)) + (define data (vector-ref event 1)) + (when callback + (with-handlers ((exn:fail? + (lambda (exception) + (err-webview + "Exception in webview event callback: ~a" + (exn-message exception))))) + (callback data))) + (loop))))) + +(define (invalidate-all-handles!) + (with-state-lock + (lambda () + (for ([(wv handle) (in-hash rkt-wv-store)]) + (set-rkt-wv-valid! handle #f)) + (hash-clear! evt-cb-hash) + (hash-clear! rkt-wv-store)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Stdio transport +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define backend-process #f) +(define backend-in #f) +(define backend-out #f) +(define backend-error-in #f) +(define backend-reader-thread #f) +(define backend-error-thread #f) +(define backend-watcher-thread #f) + +(define backend-failure #f) +(define backend-closing? #f) +(define backend-ready? #f) +(define backend-ready-status #f) +(define backend-ready-semaphore (make-semaphore 0)) + +(define startup-lock (make-semaphore 1)) +(define write-lock (make-semaphore 1)) +(define pending-lock (make-semaphore 1)) +(define pending-responses (make-hash)) +(define request-id 0) +(define function-calls 0) +(define event-count 0) + +(define (make-backend-exception message) + (exn:fail message (current-continuation-marks))) + +(define (with-pending-lock thunk) + (call-with-semaphore pending-lock thunk)) + +(define (fail-pending-requests! exception) + (define channels + (with-pending-lock + (lambda () + (define result + (for/list ([(id channel) (in-hash pending-responses)]) + channel)) + (hash-clear! pending-responses) + result))) + (for-each (lambda (channel) + (async-channel-put channel exception)) + channels)) + +(define (backend-active?) + (and backend-process + backend-in + backend-out + (not backend-failure))) + +(define (backend-ended! message) + ;; Preserve the first failure. Every pending and future command must see + ;; the same terminal backend exception. + (define exception + (or backend-failure + (make-backend-exception message))) + + (unless backend-ready? + (set! backend-ready-status exception) + (semaphore-post backend-ready-semaphore)) + + (unless backend-closing? + (unless backend-failure + (set! backend-failure exception) + (err-webview "racket-webview-qt backend stopped: ~a" message) + (invalidate-all-handles!))) + + (fail-pending-requests! exception) + exception) + +(define (dispatch-protocol-message message) + (unless (hash? message) + (error 'racket-webview "Backend emitted a non-object JSON value")) + + (let ((type (hash-ref message 'type #f))) + (cond + ((equal? type "ready") + (set! backend-ready-status (hash-ref message 'protocol #f)) + (semaphore-post backend-ready-semaphore)) + + ((equal? type "result") + (let* ((id (hash-ref message 'id #f)) + (channel + (and id + (with-pending-lock + (lambda () + (define result (hash-ref pending-responses id #f)) + (when result + (hash-remove! pending-responses id)) + result))))) + (if channel + (async-channel-put channel message) + (warn-webview "Result for unknown request id ~a" id)))) + + ((equal? type "event") + (let* ((wv (hash-ref message 'wv -1)) + (callback + (with-state-lock + (lambda () + (hash-ref evt-cb-hash wv #f))))) + (set! event-count (add1 event-count)) + (when callback + (async-channel-put event-channel + (vector callback + (hash-ref message 'data "")))))) + + ((equal? type "protocol-error") + (let* ((id (hash-ref message 'id #f)) + (text (hash-ref message 'message "unknown error")) + (exception + (make-backend-exception + (format "Backend protocol error: ~a" text))) + (channel + (and id + (with-pending-lock + (lambda () + (define result (hash-ref pending-responses id #f)) + (when result + (hash-remove! pending-responses id)) + result))))) + (if channel + (async-channel-put channel exception) + (err-webview "Backend protocol error: ~a" text)))) + + (else + (warn-webview "Unknown backend message type: ~a" type))))) + +(define (start-protocol-reader!) + (set! + backend-reader-thread + (thread + (lambda () + (with-handlers + ((exn:fail? + (lambda (exception) + (backend-ended! + (format "cannot read backend stdout: ~a" + (exn-message exception)))))) + (let loop () + (define message (read-json backend-in)) + (if (eof-object? message) + (backend-ended! "stdout was closed") + (begin + (dispatch-protocol-message message) + (loop))))))))) + +(define (log-backend-line line) + (cond + ((regexp-match? #rx"^ERROR[ ]*:" line) + (err-webview "qt: ~a" line)) + ((regexp-match? #rx"^WARNING[ ]*:" line) + (warn-webview "qt: ~a" line)) + ((regexp-match? #rx"^INFO[ ]*:" line) + (info-webview "qt: ~a" line)) + ((regexp-match? #rx"^DEBUG[ ]*:" line) + (dbg-webview "qt: ~a" line)) + (else + (dbg-webview "qt: ~a" line)))) + +(define (start-error-forwarder!) + (set! + backend-error-thread + (thread + (lambda () + (with-handlers + ((exn:fail? + (lambda (exception) + (warn-webview "Cannot read backend stderr: ~a" + (exn-message exception))))) + (let loop () + (define line (read-line backend-error-in 'any)) + (unless (eof-object? line) + (log-backend-line line) + (loop)))))))) + +(define (start-process-watcher!) + (set! + backend-watcher-thread + (thread + (lambda () + (with-handlers + ((exn:fail? + (lambda (exception) + (backend-ended! + (format "cannot wait for backend process: ~a" + (exn-message exception)))))) + (subprocess-wait backend-process) + (define status (subprocess-status backend-process)) + (unless backend-closing? + (backend-ended! + (format "process exited with status ~a" status)))))))) + +(define (reset-backend-state!) + (set! backend-process #f) + (set! backend-in #f) + (set! backend-out #f) + (set! backend-error-in #f) + (set! backend-reader-thread #f) + (set! backend-error-thread #f) + (set! backend-watcher-thread #f) + (set! backend-failure #f) + (set! backend-closing? #f) + (set! backend-ready? #f) + (set! backend-ready-status #f)) + +(define (stop-failed-backend-start!) + (when backend-out + (with-handlers ((exn:fail? void)) + (close-output-port backend-out))) + (when backend-process + (with-handlers ((exn:fail? void)) + (subprocess-kill backend-process #t)) + (with-handlers ((exn:fail? void)) + (subprocess-wait backend-process))) + (when backend-reader-thread + (with-handlers ((exn:fail? void)) + (thread-wait backend-reader-thread))) + (when backend-error-thread + (with-handlers ((exn:fail? void)) + (thread-wait backend-error-thread))) + (when backend-watcher-thread + (with-handlers ((exn:fail? void)) + (thread-wait backend-watcher-thread))) + (reset-backend-state!)) + +(define (start-backend!) + (ensure-backend-program!) + + (set! backend-failure #f) + (set! backend-closing? #f) + (set! backend-ready? #f) + (set! backend-ready-status #f) + (set! backend-ready-semaphore (make-semaphore 0)) + + (let-values (((process stdout stdin stderr) + (parameterize ((current-environment-variables + (make-backend-environment)) + (current-directory backend-directory)) + (subprocess #f #f #f backend-program)))) + (set! backend-process process) + (set! backend-in stdout) + (set! backend-out stdin) + (set! backend-error-in stderr) + + (start-error-forwarder!) + (start-protocol-reader!) + (start-process-watcher!) + + (unless (sync/timeout 15 backend-ready-semaphore) + (stop-failed-backend-start!) + (error 'racket-webview + "The racket-webview-qt backend did not complete its stdio handshake")) + + (when (exn:fail? backend-ready-status) + (let ((exception backend-ready-status)) + (stop-failed-backend-start!) + (raise exception))) + + (unless (equal? backend-ready-status stdio-protocol-version) + (let ((actual backend-ready-status)) + (stop-failed-backend-start!) + (error 'racket-webview + "Unsupported backend stdio protocol ~a; expected ~a" + actual + stdio-protocol-version))) + + (set! backend-ready? #t))) + +(define (ensure-backend!) + (call-with-semaphore + startup-lock + (lambda () + ;; A backend failure is terminal for this transport instance. Do not + ;; silently start a fresh process: callers with stale webview handles + ;; must receive the original exception instead. + (when backend-failure + (raise backend-failure)) + (unless (backend-active?) + (start-backend!))))) + +(define (send-command command data) + (ensure-backend!) + + (let ((response-channel (make-async-channel)) + (id #f)) + (call-with-semaphore + write-lock + (lambda () + (set! request-id (add1 request-id)) + (set! id request-id) + (set! function-calls (add1 function-calls)) + + (with-pending-lock + (lambda () + (hash-set! pending-responses id response-channel))) + + (with-handlers + ((exn:fail? + (lambda (exception) + (define failure + (backend-ended! + (format "cannot write backend stdin: ~a" + (exn-message exception)))) + (raise failure)))) + (write-json (hasheq 'type "command" + 'id id + 'command command + 'data data) + backend-out) + (newline backend-out) + (flush-output backend-out)))) + + (let ((response (async-channel-get response-channel))) + (when (exn:fail? response) + (raise response)) + response))) + +(define (command-integer-result command data) + (hash-ref (send-command command data) 'result 17)) + +(define (command-symbol-result command data) + (result-code->symbol (command-integer-result command data))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Public low-level API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (rkt-webview-new-context boilerplate-js server-cert) - ;(dbg-webview (format "boilerplate js: ~a" boilerplate-js)) - ;(dbg-webview (format "server-cert : ~a" server-cert)) - (let ((r (rkt_webview_new_context boilerplate-js server-cert))) - r)) + (command-integer-result + cmd-context-new + (hasheq 'boilerplate_js boilerplate-js + 'has_pem_cert (and server-cert #t) + 'pem_cert (or server-cert "")))) (define (rkt-webview-create context parent evt-callback close-callback) - (let* ((evt-queue (make-queue)) - (parent-win (if (eq? parent #f) 0 (rkt-wv-win parent))) - ) - (let ((wv (rkt_webview_create context parent-win))) - ;(λ (evt) (enqueue! evt-queue evt))) - - (let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback))) - (hash-set! evt-cb-hash wv (λ (evt) (evt-callback handle evt))) - ;(thread (λ () - ; (sleep 0.01) - ; (letrec ((f (λ () - ; (let ((r (rkt-process-events handle))) - ; (if (eq? r 'quit) - ; (begin - ; (set-rkt-wv-valid! handle #f) - ; (info-webview "Quitting event loop") - ; 'done) - ; (begin - ; ;(displayln "Waiting for events.") - ; (sleep 0.01) - ; (f))))))) - ; (f)))) - (hash-set! rkt-wv-store (rkt-wv-win handle) handle) - handle)))) + (define parent-win + (if parent + (rkt-wv-win parent) + 0)) + (define wv + (command-integer-result + cmd-create-wv + (hasheq 'context context + 'parent parent-win))) + (define handle + (make-rkt-wv wv + (make-queue) + evt-callback + #t + close-callback)) + (with-state-lock + (lambda () + (hash-set! evt-cb-hash + wv + (lambda (event) + (evt-callback handle event))) + (hash-set! rkt-wv-store wv handle))) + handle) (define (rkt-webview-close handle) - (rkt_webview_close (rkt-wv-win handle)) - (let ((evt-cb (hash-ref evt-cb-hash (rkt-wv-win handle) (λ args #t)))) - (let ((evt (format - (string-append "{ \"event\": \"closed\", " - " \"elaped\": -1.0, " - " \"evt-id\": -98832, " - " \"timestamp\": ~a }") - (current-milliseconds)))) - (evt-cb evt))) - (set-rkt-wv-valid! handle #f) - (hash-remove! evt-cb-hash (rkt-wv-win handle)) - (hash-remove! rkt-wv-store (rkt-wv-win handle)) - ((rkt-wv-close-callback handle)) + (when (rkt-wv-valid handle) + (with-handlers ((exn:fail? + (lambda (exception) + (warn-webview "Could not close backend handle ~a: ~a" + (rkt-wv-win handle) + (exn-message exception))))) + (command-integer-result + cmd-close-wv + (hasheq 'wv (rkt-wv-win handle)))) + + (set-rkt-wv-valid! handle #f) + (with-state-lock + (lambda () + (hash-remove! evt-cb-hash (rkt-wv-win handle)) + (hash-remove! rkt-wv-store (rkt-wv-win handle)))) + ((rkt-wv-close-callback handle))) #t) -(define (rkt-webview-set-loglevel l) - (rkt_webview_set_loglevel l)) +(define (rkt-webview-set-loglevel level) + (command-integer-result + cmd-set-loglevel + (hasheq 'wv (loglevel->integer level))) + (void)) (define (rkt-webview-info) - (let* ((d (rkt_webview_info)) - (r (union-ref (rkt_data_t-data d) 3)) - ) - (let ((res - (list (list 'shm-usage (rkt_metrics_t-shm_usage r)) - (list 'shm-freelist (rkt_metrics_t-shm_free_depth r) (rkt_metrics_t-shm_free_size r)) - (list 'shm-alloc (rkt_metrics_t-shm_item_depth r) (rkt_metrics_t-shm_item_size r) (rkt_metrics_t-shm_item_usage_factor r)) - (list 'open-windows (rkt_metrics_t-open_windows r)) - (list 'calls (rkt_metrics_t-function_calls r)) - (list 'events (rkt_metrics_t-events r)) - (list 'log-file (rkt_metrics_t-log_file r)) - ))) - (rkt_webview_free_data d) - res))) + (define open-windows + (command-integer-result cmd-info (hasheq))) + (list (list 'transport 'stdio) + (list 'shm-usage 0) + (list 'shm-freelist 0 0) + (list 'shm-alloc 0 0 0.0) + (list 'open-windows open-windows) + (list 'calls function-calls) + (list 'events event-count) + (list 'log-file "stderr"))) (define (rkt-webview-set-ou-token handle token) - (rkt_webview_set_ou_token (rkt-wv-win handle) token) + (command-integer-result + cmd-set-ou-token + (hasheq 'wv (rkt-wv-win handle) + 'token token)) #t) -(define (rkt-webview-set-url! wv url) - (rkt_webview_set_url (rkt-wv-win wv) url)) +(define (rkt-webview-set-url! handle url) + (command-symbol-result + cmd-set-url + (hasheq 'wv (rkt-wv-win handle) + 'url url))) -(define (rkt-webview-set-html! wv html) - (rkt_webview_set_html (rkt-wv-win wv) html)) +(define (rkt-webview-set-html! handle html) + (command-symbol-result + cmd-set-html + (hasheq 'wv (rkt-wv-win handle) + 'html html))) -(define (rkt-webview-set-title! wv title) - (rkt_webview_set_title (rkt-wv-win wv) title)) +(define (rkt-webview-set-title! handle title) + (command-symbol-result + cmd-set-title + (hasheq 'wv (rkt-wv-win handle) + 'title title))) -(define (rkt-webview-set-icon! wv icon-file) - (rkt_webview_set_icon (rkt-wv-win wv) icon-file)) +(define (rkt-webview-set-icon! handle icon-file) + (command-symbol-result + cmd-set-icon + (hasheq 'wv (rkt-wv-win handle) + 'icon icon-file))) -(define (rkt-webview-run-js wv js) - (rkt_webview_run_js (rkt-wv-win wv) js)) +(define (rkt-webview-run-js handle js) + (command-symbol-result + cmd-run-js + (hasheq 'wv (rkt-wv-win handle) + 'js js))) -(define (rkt-webview-call-js wv js) - (let* ((d (rkt_webview_call_js (rkt-wv-win wv) js)) - (r (union-ref (rkt_data_t-data d) 2)) - (value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8)) - (result (rkt_js_result_t-result r))) - (rkt_webview_free_data d) - (list result value))) +(define (rkt-webview-call-js handle js) + (define response + (send-command + cmd-call-js + (hasheq 'wv (rkt-wv-win handle) + 'js js))) + (list (result-code->symbol (hash-ref response 'result 17)) + (hash-ref response 'data ""))) -(define (rkt-webview-resize wv w h) - (rkt_webview_resize (rkt-wv-win wv) w h)) +(define (rkt-webview-resize handle width height) + (command-symbol-result + cmd-resize + (hasheq 'wv (rkt-wv-win handle) + 'w width + 'h height))) -(define (rkt-webview-move wv x y) - (rkt_webview_move (rkt-wv-win wv) x y)) +(define (rkt-webview-move handle x y) + (command-symbol-result + cmd-move + (hasheq 'wv (rkt-wv-win handle) + 'x x + 'y y))) -(define-syntax def-rkt-wrapper-wv - (syntax-rules () - ((_ name c-name) - (define (name wv) - (c-name (rkt-wv-win wv)))))) +(define (handle-command-symbol-result command handle) + (command-symbol-result command (hasheq 'wv (rkt-wv-win handle)))) -(def-rkt-wrapper-wv rkt-webview-show rkt_webview_show) -(def-rkt-wrapper-wv rkt-webview-hide rkt_webview_hide) -(def-rkt-wrapper-wv rkt-webview-show-normal rkt_webview_show_normal) -(def-rkt-wrapper-wv rkt-webview-minimize rkt_webview_minimize) -(def-rkt-wrapper-wv rkt-webview-maximize rkt_webview_maximize) -(def-rkt-wrapper-wv rkt-webview-present rkt_webview_present) -(def-rkt-wrapper-wv rkt-webview-window-state rkt_webview_window_state) +(define (rkt-webview-show handle) + (handle-command-symbol-result cmd-show handle)) -(define (rkt-webview-open-devtools wv) - (rkt_webview_open_devtools (rkt-wv-win wv))) +(define (rkt-webview-hide handle) + (handle-command-symbol-result cmd-hide handle)) -(define (rkt-webview-choose-dir wv title base-dir) - (rkt_webview_choose_dir (rkt-wv-win wv) title base-dir)) -; (let* ((d (rkt_webview_choose_dir (rkt-wv-win wv) title base-dir)) -; (r (union-ref (rkt_data_t-data d) 2)) -; (value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8)) -; (result (rkt_js_result_t-result r))) -; (rkt_webview_free_data d) -; (list result value))) +(define (rkt-webview-show-normal handle) + (handle-command-symbol-result cmd-show-normal handle)) -(define (rkt-webview-file-open wv title base-dir permitted-exts) - (rkt_webview_file_open (rkt-wv-win wv) title base-dir permitted-exts)) -; (let* ((d (rkt_webview_file_open (rkt-wv-win wv) title base-dir permitted-exts)) -; (r (union-ref (rkt_data_t-data d) 2)) -; (value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8)) -; (result (rkt_js_result_t-result r))) -; (rkt_webview_free_data d) -; (list result value))) +(define (rkt-webview-minimize handle) + (handle-command-symbol-result cmd-minimize handle)) -(define (rkt-webview-file-save wv title base-dir permitted-exts) - (rkt_webview_file_save (rkt-wv-win wv) title base-dir permitted-exts)) -; (let* ((d (rkt_webview_file_save (rkt-wv-win wv) title base-dir permitted-exts)) -; (r (union-ref (rkt_data_t-data d) 2)) -; (value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8)) -; (result (rkt_js_result_t-result r))) -; (rkt_webview_free_data d) -; (list result value))) +(define (rkt-webview-maximize handle) + (handle-command-symbol-result cmd-maximize handle)) -(define (rkt-webview-messagebox wv title message submessage type) - (rkt_webview_message_box (rkt-wv-win wv) title message submessage type)) +(define (rkt-webview-present handle) + (handle-command-symbol-result cmd-present handle)) + +(define (rkt-webview-window-state handle) + (window-state-code->symbol + (command-integer-result + cmd-window-state + (hasheq 'wv (rkt-wv-win handle))))) + +(define (rkt-webview-open-devtools handle) + (handle-command-symbol-result cmd-open-devtools handle)) + +(define (rkt-webview-choose-dir handle title base-dir) + (command-symbol-result + cmd-choose-dir + (hasheq 'wv (rkt-wv-win handle) + 'title title + 'base_dir base-dir))) + +(define (rkt-webview-file-open handle title base-dir permitted-exts) + (command-symbol-result + cmd-file-open + (hasheq 'wv (rkt-wv-win handle) + 'title title + 'base_dir base-dir + 'permitted_exts permitted-exts))) + +(define (rkt-webview-file-save handle title base-dir permitted-exts) + (command-symbol-result + cmd-file-save + (hasheq 'wv (rkt-wv-win handle) + 'title title + 'base_dir base-dir + 'permitted_exts permitted-exts))) + +(define (rkt-webview-messagebox handle title message submessage type) + (command-symbol-result + cmd-msg-box + (hasheq 'wv (rkt-wv-win handle) + 'title title + 'message message + 'submessage submessage + 'type (messagetype->integer type)))) (define (rkt-webview-version) - (let ((d (rkt_webview_version))) - (let ((v (union-ref (rkt_data_t-data d) 0))) - (let ((api-major (rkt_version_t-api-major v)) - (api-minor (rkt_version_t-api-minor v)) - (api-patch (rkt_version_t-api-patch v)) - ) - (rkt_webview_free_data d) - (list (list 'webview-c-api api-major api-minor api-patch)) - ) - ) - ) - ) + (list (list 'webview-stdio-api 1 0 0) + (list 'racket-webview-qt 0 2 3))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tray specific -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tray API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (rkt-webview-tray-create icon-file tooltip evt-callback) - (let* ((evt-queue (make-queue)) - (tray (rkt_webview_tray_create icon-file tooltip)) - (handle (make-rkt-wv tray evt-queue evt-callback #t (lambda () #t)))) - (hash-set! evt-cb-hash tray (lambda (evt) (evt-callback handle evt))) - (hash-set! rkt-wv-store tray handle) - handle)) + (define tray + (command-integer-result + cmd-create-tray + (hasheq 'icon icon-file + 'tooltip tooltip))) + (define handle + (make-rkt-wv tray + (make-queue) + evt-callback + #t + (lambda () #t))) + (with-state-lock + (lambda () + (hash-set! evt-cb-hash + tray + (lambda (event) + (evt-callback handle event))) + (hash-set! rkt-wv-store tray handle))) + handle) (define (rkt-webview-tray-set-icon! tray icon-file) - (rkt_webview_tray_set_icon (rkt-wv-win tray) icon-file)) + (command-symbol-result + cmd-tray-set-icon + (hasheq 'wv (rkt-wv-win tray) + 'icon icon-file))) (define (rkt-webview-tray-set-tooltip! tray tooltip) - (rkt_webview_tray_set_tooltip (rkt-wv-win tray) tooltip)) + (command-symbol-result + cmd-tray-set-tooltip + (hasheq 'wv (rkt-wv-win tray) + 'tooltip tooltip))) (define (rkt-webview-tray-show-message tray title message) - (rkt_webview_tray_show_message (rkt-wv-win tray) title message)) + (command-symbol-result + cmd-tray-show-message + (hasheq 'wv (rkt-wv-win tray) + 'title title + 'message message))) (define (rkt-webview-tray-set-menu! tray menu) - (let ((json (if (wv-menu? menu) - (if (wv-menu-empty? menu) - #f - (wv-menu->json menu)) - (if (eq? menu #f) - #f - (error "rkt-webview-tray-set-menu! must be called with a wv-menu or #f") - ))) - ) - (rkt_webview_tray_set_menu (rkt-wv-win tray) json))) + (define menu-json + (cond + ((wv-menu? menu) + (and (not (wv-menu-empty? menu)) + (wv-menu->json menu))) + ((not menu) #f) + (else + (error 'rkt-webview-tray-set-menu! + "expected a wv-menu or #f; got ~a" + menu)))) -;; Furthermore: rkt-webview-close, rkt-webview-valid?, rkt-webview-show and rkt-webview-hide apply also to tray + (if menu-json + (command-symbol-result + cmd-tray-set-menu + (hasheq 'wv (rkt-wv-win tray) + 'menu_json menu-json)) + (command-symbol-result + cmd-tray-clear-menu + (hasheq 'wv (rkt-wv-win tray))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Administration and cleanup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (rkt-webview-valid? handle) + (and (rkt-wv-valid handle) + (not (= 0 + (command-integer-result + cmd-handle-is-valid + (hasheq 'wv (rkt-wv-win handle))))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Administration -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (rkt-webview-valid? wv) - (if (eq? (rkt-wv-valid wv) #f) - #f - (if (= (rkt_webview_valid (rkt-wv-win wv)) 0) - #f - #t))) - - -(define finalizer-executed #f) (define webview-exit-done #f) -(define (rkt-webview-finalizer rkt-wv-store) - (rkt_webview_exit_done (if (eq? webview-exit-done #f) 0 1))) +(define (wait-for-backend-and-reset!) + (when backend-out + (with-handlers ((exn:fail? void)) + (close-output-port backend-out))) + (when backend-process + (with-handlers ((exn:fail? void)) + (subprocess-wait backend-process))) + (when backend-reader-thread + (with-handlers ((exn:fail? void)) + (thread-wait backend-reader-thread))) + (when backend-error-thread + (with-handlers ((exn:fail? void)) + (thread-wait backend-error-thread))) + (when backend-watcher-thread + (with-handlers ((exn:fail? void)) + (thread-wait backend-watcher-thread))) + (reset-backend-state!)) +(define (rkt-webview-exit . arguments) + (define close-windows + (if (null? arguments) + #t + (car arguments))) + (define message + (if (or (null? arguments) + (null? (cdr arguments))) + #f + (cadr arguments))) -(define (rkt-webview-exit . args) - (let ((close-windows (if (null? args) #t (car args))) - (message (if (null? args) #f - (if (null? (cdr args)) - #f - (cadr args)))) - ) - (dbg-webview "rkt-webview-exit active") + (set! backend-closing? #t) - ; Clear event callback function in C library, i.e. we're now going to - ; poll for events. - (dbg-webview "Start event polling instead of using an event callback") - (dbg-webview "To make sure the library does not get stuck on a dangling callback") - (event-callback evt-start-polling) + (when close-windows + (let ((handles + (with-state-lock + (lambda () + (for/list ([(wv handle) (in-hash rkt-wv-store)]) + handle))))) + (for-each rkt-webview-close handles))) - ; Set callback to null, but as an event can be in progress, - ; we need to check if the mutex lock could be aquired. - ; otherwise we wait. - (while (= (rkt_webview_register_evt_callback #f) 0) - (sleep 0.1)) - (while (eq? event-processing-kind 'sync) - (sleep 0.1)) - (sync-log-webview) - - ; When asked to, close all windows - (when close-windows - (dbg-webview "closing all open windows on request") - (let ((open-windows (hash->list rkt-wv-store))) - (for-each (λ (kv) - (let ((win (car kv)) - (handle (cdr kv))) - (rkt-webview-close handle))) - open-windows))) - (sync-log-webview) - - ; Stop event processing - (dbg-webview "Stop the event processor") - (event-callback evt-guard-stop) - (dbg-webview "Waiting for thread to stop") - (while (not (eq? evt-processing-thread #f)) - (dbg-webview "evt-processing-thread = ~a" evt-processing-thread) - (sleep 0.25)) - (dbg-webview "Event processing stopped") - (sync-log-webview) - - ; cleanup the library - (dbg-webview "cleanup of the rkt-webview-qt library") - (sync-log-webview) ; Wait for all messages to have been processed before calling rkt_webview_cleanup - - (rkt_webview_cleanup) - - ; Maybe get in error state - (unless (eq? message #f) - (error message)) - - ; Exit done - (set! webview-exit-done #t) - (info-webview "webview-exit done") - (sync-log-webview) - ) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Cleanup on exit -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -#| -(set! quiet-call - (plumber-add-flush! (current-plumber) - (λ (handle) - (rkt-webview-exit)))) -|# - -;(define custodian-finalizer -; (register-custodian-shutdown rkt-wv-store rkt-webview-finalizer -; #:at-exit? #t)) + (when (backend-active?) + (with-handlers ((exn:fail? + (lambda (exception) + (warn-webview "Could not stop backend cleanly: ~a" + (exn-message exception))))) + (send-command cmd-quit (hasheq)))) + (when backend-process + (wait-for-backend-and-reset!)) + (invalidate-all-handles!) + (set! webview-exit-done #t) + (info-webview "webview-exit done") + (when message + (error message))) diff --git a/scrbl/racket-webview-intro.scrbl b/scrbl/racket-webview-intro.scrbl index acab561..732730d 100644 --- a/scrbl/racket-webview-intro.scrbl +++ b/scrbl/racket-webview-intro.scrbl @@ -35,10 +35,11 @@ This documentation is provided for version @bold{@version} of racket webview. Racket Webview is a class-oriented webview library built on top of a Qt-based native runtime. -The library is layered. At the lowest level a native FFI layer is used. On top -of that, @racketmodname[racket-webview/racket-webview] provides a functional API. The -class-oriented API described in this manual is built from smaller modules on top -of that layer. +The library is layered. At the lowest level, Racket starts a separate Qt helper +process and exchanges line-delimited JSON messages through stdin and stdout. +On top of that, @racketmodname[racket-webview/racket-webview] provides a +functional API. The class-oriented API described in this manual is built from +smaller modules on top of that layer. @section{Core Concepts} diff --git a/scrbl/racket-webview-qt.scrbl b/scrbl/racket-webview-qt.scrbl index f0e2283..5ce26e4 100644 --- a/scrbl/racket-webview-qt.scrbl +++ b/scrbl/racket-webview-qt.scrbl @@ -2,23 +2,24 @@ @defmodule{racket-webview/racket-webview-qt} -@title{Racket FFI Interface for @tt{rktwebview_qt}} +@title{Racket Process Interface for @tt{rktwebview_prg}} @author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] @section{Overview} -The module @tt{racket-webview-qt.rkt} provides a Racket FFI wrapper around the -native @tt{rktwebview_qt} library. It loads the shared library, initializes the -native runtime, and exposes Racket functions for creating and controlling -webview windows. +The module @tt{racket-webview-qt.rkt} provides the low-level Racket interface to +the Qt helper process @tt{rktwebview_prg}. It keeps the existing command numbers, +JSON command payloads, result symbols, event strings, and public Racket +procedures, but no longer loads a shared library through FFI. -If the Qt backend is available locally, it is loaded directly. Otherwise the -module attempts to resolve and download the backend. If that is not possible, -the module continues in a degraded mode in which a limited subset of the -FFI entry points will only display a warning and perform a no-op. All others will fail. +The helper process is started lazily when the first backend operation is +requested. Commands are written as one JSON object per line to the process +stdin. Results and asynchronous events are read from stdout. Backend diagnostics +are copied from stderr to the current Racket error port. -The wrapper translates the low-level C interface into a Racket-oriented API -based on structures, callbacks, and ordinary Racket values. +Each command has a request identifier. The identifier is transport metadata and +does not alter the existing command payload. It makes it possible to associate +a result with the correct caller when multiple Racket threads use the backend. The module provides: @@ -30,77 +31,35 @@ The module provides: @item{window geometry and visibility control} @item{native dialogs} @item{asynchronous event delivery} - @item{version and cleanup utilities} -] - -@section{Requirements} - -The native backend requires Qt version @tt{6.10.2} or newer. - -The shared library @tt{rktwebview_qt} must therefore be built against Qt -@tt{6.10.2} or a compatible later release. - -Earlier Qt versions are not supported. + @item{version and cleanup utilities}] @section{Backend Availability} -The module first checks whether the expected @tt{racket-webview-qt} backend is -already installed. +The environment variable @tt{RKT_WEBVIEW_PRG} may name an explicit backend +executable. This is useful during development and testing. -If it is not installed, the module attempts to resolve the configured download -site. If the site can be resolved and the configured archive is downloadable, -the backend is downloaded automatically. - -If the download site cannot be resolved, if no archive is available for the -current operating system and machine architecture, or if the download fails, the -module does not immediately abort module loading. Instead it switches to a -degraded mode in which native FFI loading is disabled. - -In that degraded mode, a textual reason is stored internally and selected FFI -entry points are replaced by fallback implementations. - -When the backend cannot be loaded, the module defines fallback implementations -for missing FFI entry points through @racket[define-ffi-definer] and -@racket[#:default-make-fail]. - -These fallbacks behave in two different ways. - -For a small set of initialization and shutdown functions, a non-failing fallback -is installed: - -@itemlist[#:style 'compact - @item{@racket[rkt_webview_env] returns @racket[#t]} - @item{@racket[rkt_webview_events_waiting] returns @racket[0]} - @item{@racket[rkt_webview_init] returns @racket[#t]} - @item{@racket[rkt_webview_cleanup] returns @racket[#t]}] - -All other missing FFI functions raise an exception when called. - -Fallback warnings are emitted at most once per function. If native loading was -disabled because the backend was unavailable, the warning message includes the -recorded reason. If native loading was enabled but a specific symbol could not -be loaded from the library, the error names the library file. +Without that variable, the module uses the existing downloader and installation +directory. Availability is checked when the first backend operation is made, +not while the module is loaded. If the configured backend cannot be found or +downloaded, that operation raises an exception with the reason. @section{Module Initialization} -Loading the module performs several initialization steps automatically. +Starting the backend performs the following steps: @itemlist[#:style 'compact - @item{determines the operating system and architecture} - @item{sets Qt runtime environment variables} - @item{loads the @tt{rktwebview_qt} shared library} - @item{initializes the native runtime} - @item{starts a background thread that processes native events} -] + @item{locates or downloads @tt{rktwebview_prg}} + @item{sets the Qt runtime environment for the child process} + @item{starts the child with separate stdin, stdout, and stderr pipes} + @item{starts a stdout protocol reader} + @item{starts a stderr forwarding thread} + @item{waits for the protocol-version handshake} + @item{starts an independent Racket event-dispatch thread}] -Currently the wrapper supports the following platforms: +Stdout is reserved for protocol records. Human-readable backend logging is +written only to stderr. -@itemlist[#:style 'compact - @item{@tt{'linux}} - @item{@tt{'windows}} -] - -If the current system is unsupported, loading the module raises an error. +Currently the wrapper supports @tt{'linux} and @tt{'windows} release layouts. @section{Data Model} @@ -200,8 +159,9 @@ Events generated by the native layer are delivered asynchronously through Requests that the webview window be closed. -The wrapper forwards the request to the native backend and schedules cleanup of -the event-processing loop. +The wrapper forwards the request to the helper process. The Qt-generated +@tt{"closed"} event is delivered asynchronously, after which the Racket handle +is removed. Returns @racket[#t]. } @@ -370,7 +330,7 @@ Opens the browser developer tools window. @section{Native Dialogs} -Dialog functions return immediately with a status code. +Dialog functions return immediately with a status code. The user’s choice is delivered asynchronously through the event callback. @defproc[(rkt-webview-choose-dir @@ -450,14 +410,14 @@ The wrapper does not parse the JSON payload. @defproc[(rkt-webview-version) (list/c list? list?)]{ -Returns version information for the native backend. +Returns the stdio protocol version and the expected Qt backend release. Example result: @racketblock[ (list - (list 'webview-c-api 1 0 0) - (list 'qt 6 10 2)) + (list 'webview-stdio-api 1 0 0) + (list 'racket-webview-qt 0 2 3)) ] } @@ -482,14 +442,14 @@ Example result: @section{Summary} -The FFI module provides a thin Racket interface to the native -@tt{rktwebview_qt} backend. +The module provides a thin Racket interface to the separate +@tt{rktwebview_prg} process. Key characteristics: @itemlist[#:style 'compact - @item{thin wrapper around the native C API} - @item{asynchronous event delivery} - @item{JSON-based event payloads} - @item{simple Racket structures for webviews} -] \ No newline at end of file + @item{line-delimited JSON over stdin and stdout} + @item{request identifiers for concurrent synchronous calls} + @item{asynchronous event delivery on a separate Racket thread} + @item{unchanged JSON event payloads} + @item{simple Racket structures for webviews}] diff --git a/scrbl/racket-webview.scrbl b/scrbl/racket-webview.scrbl index c932eb5..b6e8b0d 100644 --- a/scrbl/racket-webview.scrbl +++ b/scrbl/racket-webview.scrbl @@ -589,7 +589,8 @@ Returns runtime information. @defproc[(webview-set-loglevel [l (or/c 'error 'warning 'info 'debug)]) void?]{ -Sets the native log level. +Sets the Qt backend log level. -The native log file path can be obtained via @racket[webview-info]. +Backend diagnostics are written to stderr. The destination reported by +@racket[webview-info] is @tt{"stderr"}. } \ No newline at end of file diff --git a/scrbl/rktwebview-api.scrbl b/scrbl/rktwebview-api.scrbl index a46e81c..e44b57b 100644 --- a/scrbl/rktwebview-api.scrbl +++ b/scrbl/rktwebview-api.scrbl @@ -6,9 +6,10 @@ @title{C API for Racket Integration} -This section describes the C API exactly as defined in @tt{rktwebview.h} and -@tt{rktwebview_types.h}. The API is used from Racket through FFI, but is -documented here in its native C/C++ form. +This section documents the legacy C API defined in @tt{rktwebview.h} and +@tt{rktwebview_types.h}. The source remains in the backend repository for +reference and comparison, but the current build no longer exposes this shared +library to Racket. The active integration uses the stdio process protocol. The interface is deliberately small. Handles are integers, most operations return a @tt{result_t}, and structured values are returned as @tt{rkt_data_t *}. diff --git a/scrbl/rktwebviewqt-internals.scrbl b/scrbl/rktwebviewqt-internals.scrbl index 1cdb367..258273b 100644 --- a/scrbl/rktwebviewqt-internals.scrbl +++ b/scrbl/rktwebviewqt-internals.scrbl @@ -1,265 +1,114 @@ #lang scribble/manual -@(require racket/runtime-path) @defmodule{racket-webview/internals} @title{Qt WebView Backend Architecture} @author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] -@section{Introduction} - -It would, of course, be preferable to place everything within a single process, -under a unified structure. This would be elegant. It is not how things are. - -@(define-runtime-path img-path ".") -@(define img (path->string (build-path img-path - "rktwebview-shared-memory-diagram-simple.svg" - ))) -@;@(displayln (format "image: '~a'" img)) - -@centered{ - @image[#:scale 0.45]{@img} -} - -Qt WebEngine establishes its own order: threads, event loops, internal state. -Once set in motion, it does not easily yield. It persists, and it expects its -environment to adapt accordingly. These conditions are accepted. - -The Racket process, however, is of a different nature. It is light, precise, -capable of starting and stopping without residue. It must remain so. - -So a boundary is drawn. - -On one side, Qt: a large, immovable instrument—something like an organ. Once it -begins to sound, it fills the space, and it is not easily silenced. On the other, -Racket: a violin, agile and expressive, able to begin and end a phrase at will. - -They do not become the same instrument. They are allowed to play together. -Communication is arranged accordingly. A shared memory region, containing three -queues: commands, results, and events. A command is issued. It crosses the boundary. It is taken up and executed. A result returns. -Events also arise, independently, and must be handled when they appear. - -Within this structure, the violin may move freely—provided it does not attempt to -reconfigure the organ. No attempt is made to unify the instruments. Such efforts would not improve the music. Instead, the composition is written so that each plays its part. - -From the outside, one hears only a simple exchange: a call, a response. Internally, the balance is carefully maintained. For now, this is sufficient. And it holds. - @section{Overview} -This backend provides a webview implementation by delegating all GUI and browser -functionality to a separate Qt process. +The runtime consists of two processes. The Racket process owns the public API, +contexts used by the local HTTPS server, handle wrappers, and user callbacks. +The helper process @tt{rktwebview_prg} owns @tt{QApplication}, Qt widgets, +@tt{QWebEngineProfile} objects, and all browser state. -The embedding Racket process does not manipulate Qt widgets directly. Instead, -it communicates with a helper process that owns the Qt event loop and all -@tt{QWebEngine} objects. +The processes communicate through standard pipes. There is no shared library, +shared-memory queue, or callback from native code into the Racket runtime. -This design exists to work around limitations of Qt WebEngine in combination with -the lifecycle model of the DrRacket environment. +@section{Standard Streams} -@section{Execution Model} +The streams have fixed roles: -The runtime consists of two processes: the embedding Racket process and a helper -process running Qt and Qt WebEngine. +@itemlist[#:style 'compact + @item{child stdin carries commands from Racket} + @item{child stdout carries the handshake, command results, and events} + @item{child stderr carries diagnostic logging}] -All GUI state lives in the helper process. The embedding side holds no direct -references to Qt objects. Communication is explicit and happens through shared -memory. +Messages on stdin and stdout are compact UTF-8 JSON objects, one object per +line. Stdout must not contain ordinary logging because the Racket protocol +reader treats every value there as a protocol record. -@section{Shared Memory and Queues} +@section{Protocol Compatibility} -A shared memory region is created during initialization. Inside that region, -three FIFO queues are established: a command queue, a result queue, and an event -queue. +The command identifiers in @tt{rkt_protocol.h} and the JSON objects used as +command payloads are unchanged. The process transport adds an outer message +object with a type and, for commands and results, a request identifier. -Each message consists of a numeric code and a payload, typically JSON: +A command has this form: -@centerline{@tt{(code, payload)}} +@verbatim|{{"type":"command","id":17,"command":6,"data":{"wv":1,"url":"https://example.test"}}}| -The queues have distinct roles. The @italic{command queue} carries requests from the embedding process to the Qt process, for example creating a window, loading a URL, or executing JavaScript. The @italic{result queue} carries direct replies to those commands. A synchronous call on the embedding side blocks until a corresponding result is available. The @italic{event queue} carries asynchronous notifications generated by the Qt side, such as page load completion, navigation requests, window movement, or events -originating from JavaScript. +A corresponding result has this form: + +@verbatim|{{"type":"result","id":17,"result":0,"data":null}}| + +The request identifier prevents concurrent calls from consuming each other's +results. It is not visible in the public API. @section{Command Execution} -A function call on the embedding side is translated into a command and written to -the command queue. +A Racket caller registers a private response channel, writes a command while +holding the transport write lock, and waits on that channel. -From there the flow is fixed: (1) the command is read by a worker thread in the -helper process, (2) it is reposted onto the Qt GUI thread, (3) the GUI thread -executes the operation, and (4) the result is written back to the result queue. +The Qt process has a command-reader thread. That thread parses stdin records and +calls the existing @tt{Rktwebview_qt} methods. Those methods post commands to the +Qt GUI thread and wait for completion. The command-reader thread then writes the +result record to stdout. -The worker thread never manipulates Qt objects. All GUI work happens on the GUI -thread. - -From the caller’s perspective, a synchronous call returns only after the GUI -thread has completed the action. +The Racket stdout reader is the only thread that reads protocol output. It uses +the request identifier to forward each result to the correct waiting caller. @section{Event Delivery} -Many relevant events are not tied to a specific command. Page loading, navigation -attempts, window movement, and JavaScript-originated events are delivered through -the event queue. +Qt events remain the original JSON strings. The Qt callback converts them only +into this transport record: -Events are retrieved explicitly by polling. +@verbatim|{{"type":"event","wv":1,"data":"{...original event JSON...}"}}| -Each event contains a name, an identifier, and optional fields depending on its -type. Events are delivered in FIFO order. +The stdout reader captures the callback associated with the handle and places +the callback plus event string on an asynchronous Racket channel. A separate +event thread invokes user callbacks. Therefore a slow user callback cannot block +protocol parsing or prevent command results from being received. -@section{Contexts and Webviews} +Capturing the callback while the event record is read is important for window +closure. Qt writes the @tt{"closed"} event before the result of the close command. +The handle can be removed immediately after the result reaches its caller, but +the already captured callback still receives the event. -The backend uses a two-level model consisting of contexts and webviews. +@section{Contexts and Handles} -A context represents a browser environment and corresponds to a -@tt{QWebEngineProfile}. It defines how pages run, including injected scripts and optional trust configuration using explicitly trusted self-signed certificates. +A context corresponds to a @tt{QWebEngineProfile} and is identified by an +integer. A webview or tray icon is also identified by an integer handle. Only +these numbers cross the process boundary; Qt object pointers never do. -Each context is identified by an integer handle. +The existing Racket @tt{rkt-wv} structure is retained so the higher layers do +not need to change. -Within a context, one or more webviews can be created. A webview represents a -window containing a browser view. Webviews are also identified by integer -handles. +@section{Lifecycle and Failure Handling} -A webview always belongs to exactly one context. When creating a webview, the -context handle must be provided. +The backend writes a protocol-version handshake after initialization. Racket +waits for this handshake before sending application commands. -Webviews may optionally have a parent webview. If a parent is specified, the -resulting window is created as a modal child of that parent; otherwise it is -created as a top-level window. +For normal shutdown, Racket closes open handles, sends the existing quit +command, waits for its result, closes the child's stdin, and waits for the child +process and reader threads. -From the Racket side, this means that a context must be created first. That -context handle is then used to create webviews, which are subsequently addressed -through their own handles. +If Racket terminates unexpectedly, the operating system closes the stdin pipe. +The command-reader thread sees EOF, closes all Qt windows, and quits the Qt event +loop. This replaces the former shared-memory alive and alive-ack queues. -All Qt objects remain internal to the helper process; only these integer handles -cross the process boundary. +If stdout closes unexpectedly, Racket marks all handles invalid and delivers an +exception to every command still waiting for a result. -@section{JavaScript Bridge} +@section{Logging} -Each context installs a small JavaScript bridge into every page, allowing -JavaScript code to send structured data to the host via: +The Qt backend writes its existing log messages to stderr. Racket forwards that +stream to its current error port. The @racket[rkt-webview-info] result reports +@tt{"stderr"} as the backend log destination and retains zero-valued +shared-memory metrics for compatibility with callers that display those fields. -@centerline{@tt{window.rkt_send_event(obj)}} +@section{Development Override} -The objects are collected and forwarded to the event queue. - -@section{Navigation and Window Behavior} - -User actions are not always executed immediately; navigation initiated by the -user may result in a @tt{"navigation-request"} event instead of being followed -automatically, and closing a window may result in a @tt{"can-close?"} event. The -Racket side is expected to decide how to handle these situations. - -@section{Design Considerations} - -@bold{Qt WebEngine lifecycle.} -Qt WebEngine cannot be safely reinitialized within a single process. - -In practice, once a @tt{QApplication} using WebEngine has been started and shut -down, the WebEngine runtime cannot be started again. This is a known and -documented limitation (see for example QTBUG-70519, QTBUG-87460, -QTBUG-145033). The underlying cause is that WebEngine starts internal threads -and resources that are not fully released, even after application shutdown. - -Attempts to reinitialize WebEngine in the same process result in undefined -behavior, including crashes, hangs, or inconsistent state. - -In the DrRacket environment, where components may be restarted under a -custodian, this makes an in-process design fundamentally unsuitable. Even when -libraries are loaded and unloaded using @tt{#:custodian}, the WebEngine runtime -cannot be reset to a clean state. - -By moving Qt and WebEngine into a separate process, this limitation is avoided -entirely: each start of the backend creates a fresh runtime, and terminating the -helper process guarantees that all associated threads and resources are released -by the operating system. - -@bold{Event loop and threading.} -Qt requires that GUI operations are performed on the Qt GUI thread. - -Instead of attempting to integrate Qt’s event loop with Racket, the design -isolates Qt completely and runs it in its own process. - -Within that process, a worker thread receives commands and forwards them to the -GUI thread using Qt’s event mechanism (via @tt{postEvent}). The Racket side never -interacts with Qt objects directly. - -@bold{Failure isolation.} -Qt WebEngine is a large subsystem with its own internal processes (including the -Chromium-based @tt{QtWebEngineProcess}) and is generally stable in practice. - -Running the Qt side in a separate process provides isolation: if the helper -process terminates, the embedding Racket process remains unaffected and can -decide how to recover. - -@bold{Shared memory communication.} -The communication pattern consists of commands, results, and events, mapped onto -shared memory FIFO queues, keeping the model simple and explicit. - -@bold{JSON encoding.} -All payloads are encoded as JSON, providing a natural bridge between JavaScript, -Qt/C++, and Racket: JavaScript produces JSON natively, Qt maps it to variant -types, and Racket can decode it easily. - -For control commands, payload sizes are small and infrequent, so serialization -cost is negligible compared to GUI-thread execution and WebEngine processing; for -dynamic data such as JavaScript results and custom events, JSON is the -appropriate representation. A binary protocol would reduce overhead but increase -complexity and reduce inspectability. - -@section{Shared Memory Architecture} - -Communication between the Racket process and @tt{rktwebview_prg} is implemented -using a shared memory region. This region serves three purposes at once: it -stores shared data structures, it provides a simple allocator, and it hosts the -FIFO queues used for message passing. - -At the start of the shared memory block, a small administration area is stored, -including a pointer to the current end of allocated memory, a list of active -allocations, a free list, and a fixed slot table. The slot table acts as a -directory of shared objects; queues are created once, stored in slots, and can be -retrieved by both processes using only the slot number. - -Memory allocation inside the shared block is intentionally simple. Each -allocation is preceded by a small header containing size information and links -for a double-linked list. Allocation first attempts to reuse a block from the -free list; if no suitable block is available, memory is taken from the unused -tail of the region. Freed blocks are returned to the free list and may later be -reused. Blocks are not compacted or coalesced. This is not a general-purpose -heap; it is a small, predictable allocator for queue items and payload strings. - -Shared objects are referenced primarily through offsets (via @tt{ShmPlace}) -rather than raw pointers. This makes the layout independent of the virtual -address at which the shared memory is mapped in each process. - -Queues are built directly on top of this allocator. Each queue consists of a -small header containing the first item, the last item, and a count, followed by a -linked list of queue items. Each item stores a numeric command or event code, a -pointer to its payload in shared memory, and links to neighboring items. - -Synchronization is split into two layers. A shared lock protects allocator and -queue metadata, while each queue has its own semaphore indicating whether items -are available. One mechanism protects the structure; the other tells you whether -there is anything worth reading. - -On POSIX systems such as Linux, shared memory is implemented using -@tt{shm_open}, @tt{ftruncate}, and @tt{mmap}, with synchronization via named -POSIX semaphores created using @tt{sem_open}. The owner process initializes these -objects and removes them again using @tt{shm_unlink} and @tt{sem_unlink}. - -On Windows, the same model is implemented using @tt{CreateFileMappingA} and -@tt{MapViewOfFile} for shared memory, and @tt{CreateSemaphoreA} or -@tt{OpenSemaphoreA} for synchronization. The design is identical, but the kernel -objects follow the Windows lifetime model and are released when the last handle -is closed. - -The shared memory region has a fixed size (currently 10MB) and is not resized at -runtime. Although the use of @tt{ShmPlace} offsets would in principle allow -relocation, resizing would require coordinated remapping in both processes while -all activity is paused. The current design therefore treats the region as -fixed-size and relies on reuse of freed blocks. - -This implies that the communication channel is bounded. Payloads such as -@tt{set_html} or large JavaScript results must fit within the available free -space in the shared memory block. In practice, the usable limit is somewhat below -the nominal 10MB due to allocator overhead, queue administration, and concurrent -messages. - -This is a message transport, not an infinite sack of HTML. +Setting @tt{RKT_WEBVIEW_PRG} to a backend executable bypasses the installed +release directory. This makes it possible to test a newly compiled backend +without repackaging or changing the downloader first.