This commit is contained in:
2026-03-25 01:27:39 +01:00
parent eb4e15c66b
commit 8fe7e726a4
26 changed files with 1896 additions and 517 deletions

View File

@@ -1 +0,0 @@
QtWebEngineProcess

Binary file not shown.

Binary file not shown.

View File

@@ -60,6 +60,7 @@
(define-runtime-path lib-dir "lib")
#|
(define libraries-to-preload
(cond
([eq? os 'windows]
@@ -105,11 +106,12 @@
))
)
)
|#
(define ffi-library
(cond
([eq? os 'windows] 'rktwebview_qt.dll)
([eq? os 'linux] 'librktwebview_qt.so)
([eq? os 'windows] 'rktwebview.dll)
([eq? os 'linux] 'librktwebview.so)
)
)
@@ -121,16 +123,26 @@
; c:\qt\6.10.2\msvc2022_64\bin\windeployqt.exe rktwebview_qt_test.exe
(define quiet-call #t)
(define rktwebview-prg (if (eq? os 'windows)
"rktwebview_prg.exe"
"rktwebview_prg"))
(define webengine-process (if (eq? os 'windows)
"QtWebEngineProcess.exe"
"QtWebEngineProcess"))
(set! quiet-call
(when (or (eq? os 'windows) (eq? os 'linux))
(putenv "QT_PLUGIN_PATH"
(path->string (build-path os-lib-dir)))
(putenv "QTWEBENGINEPROCESS_PATH"
(path->string (build-path os-lib-dir "QtWebEngineProcess.exe")))
(path->string (build-path os-lib-dir webengine-process)))
(putenv "QTWEBENGINE_RESOURCES_PATH"
(path->string (build-path os-lib-dir "resources")))
(putenv "QTWEBENGINE_LOCALES_PATH"
(path->string (build-path os-lib-dir "translations" "qtwebengine_locales")))
(putenv "RKT_WEBVIEW_PRG"
(path->string (build-path os-lib-dir rktwebview-prg)))
(when (eq? os 'linux)
(putenv "QT_QPA_PLATFORM" "xcb")
(putenv "LD_LIBRARY_PATH"
@@ -145,6 +157,7 @@
;;; Preload libraries
#|
(for-each (λ (lib-symbol)
(let* ((libn (if (list? lib-symbol) (car lib-symbol) lib-symbol))
(versions (if (list? lib-symbol) (cons (cadr lib-symbol) '(#f)) (list #f)))
@@ -160,6 +173,7 @@
)
)
libraries-to-preload)
|#
;;; Actual FFI integration
@@ -192,9 +206,9 @@
;;; Callbacks from the OS library
(define callback-box (box '()))
(define (applier thunk)
(thunk))
;(define callback-box (box '()))
;(define (applier thunk)
; (thunk))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types / Functions
@@ -279,14 +293,23 @@
(define-rktwebview rkt_webview_cleanup
(_fun -> _void))
;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 _bytes -> _int))
;RKTWEBVIEW_QT_EXPORT void rkt_webview_process_events(int for_ms);
(define-rktwebview rkt_webview_process_events
(_fun _int -> _void))
;(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
@@ -297,13 +320,9 @@
(_fun -> _rkt_data_t-pointer))
; RKTWEBVIEW_QT_EXPORT int rkt_webview_create(rkt_wv_context_t context,
; rktwebview_t parent,
; event_cb_t js_event_cb);
; rktwebview_t parent)
(define-rktwebview rkt_webview_create
(_fun _int _int
(_fun #:keep callback-box #:async-apply applier
_rkt_data_t-pointer -> _void)
-> _int))
(_fun _int _int -> _int))
;RKTWEBVIEW_QT_EXPORT void rkt_webview_close(int wv);
(define-rktwebview rkt_webview_close
@@ -403,28 +422,72 @@
;; Initialize and start library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define process-events 'process)
;(define process-events 'process)
(define (stop-event-processing)
(set! process-events 'stop)
(while (eq? process-events 'stop)
(sleep 0.001)))
;(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)))))
(rkt_webview_init)
;(set! quiet-call (start-event-processing))
(define evt-cb-hash (make-hash))
(define (start-event-processing)
(thread (λ ()
(letrec ((f (λ ()
(rkt_webview_process_events 1)
(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.001)
(if (eq? process-events 'process)
(f)
(begin
(displayln "Stopping event processing")
(set! process-events 'stopped)
'done)))))
(f)))))
(f))
))
(f)))
)
)
(rkt_webview_init)
(set! quiet-call (start-event-processing))
(define evt-processing-thread (start-event-processing))
(define (stop-event-processing)
(kill-thread evt-processing-thread))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided features
@@ -459,18 +522,18 @@
(define (rkt-webview-new-context boilerplate-js server-cert)
(rkt_webview_new_context boilerplate-js 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
(λ (rkt-evt)
(let* ((e (union-ref (rkt_data_t-data rkt-evt) 1))
(evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8)))
(rkt_webview_free_data rkt-evt) ; Free event data ASAP
(enqueue! evt-queue evt)
)))))
(let ((wv (rkt_webview_create context parent-win)))
(hash-set! evt-cb-hash wv (λ (evt) (enqueue! evt-queue evt)))
; (λ (rkt-evt)
; (let* ((e (union-ref (rkt_data_t-data rkt-evt) 1))
; (evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8)))
; (rkt_webview_free_data rkt-evt) ; Free event data ASAP
; (enqueue! evt-queue evt)
; )))))
(let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback)))
(thread (λ ()
(sleep 1)
@@ -492,6 +555,7 @@
(define (rkt-webview-close handle)
(rkt_webview_close (rkt-wv-win handle))
(enqueue! (rkt-wv-evt-queue handle) 'quit)
(hash-remove! evt-cb-hash (rkt-wv-win handle))
((rkt-wv-close-callback handle))
#t)
@@ -608,8 +672,8 @@
(handle (cdr kv)))
(rkt-webview-close handle)))
open-windows))
(stop-event-processing)
(rkt_webview_cleanup)
(stop-event-processing)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@@ -655,6 +655,7 @@
(define (webview-call-js wv js)
(-> wv-win? string? (or/c string? list? boolean? hash?))
(let ((result (rkt-webview-call-js (wv-win-handle wv) js)))
(displayln result)
(if (webview-call-js-result? result)
(if (eq? (car result) 'oke)
(hash-ref (fromJson (cadr result)) 'result #f)