468 lines
15 KiB
Racket
468 lines
15 KiB
Racket
#lang racket/base
|
|
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
ffi/unsafe/atomic
|
|
ffi/unsafe/os-thread
|
|
racket/async-channel
|
|
racket/runtime-path
|
|
racket/port
|
|
data/queue
|
|
json
|
|
racket/string
|
|
racket/path
|
|
)
|
|
|
|
(provide rkt-wv
|
|
rkt-wv-win
|
|
|
|
rkt-webview-create
|
|
rkt-webview-close
|
|
rkt-webview-set-ou-token
|
|
rkt-webview-set-url!
|
|
rkt-webview-set-html!
|
|
rkt-webview-run-js
|
|
rkt-webview-call-js
|
|
rkt-webview-move
|
|
rkt-webview-resize
|
|
rkt-webview-show
|
|
rkt-webview-hide
|
|
rkt-webview-show-normal
|
|
rkt-webview-maximize
|
|
rkt-webview-minimize
|
|
rkt-webview-window-state
|
|
rkt-webview-set-title!
|
|
rkt-webview-present
|
|
rkt-webview-exit
|
|
rkt-webview-valid?
|
|
rkt-webview-open-devtools
|
|
rkt-webview-choose-dir
|
|
rkt-webview-file-open
|
|
rkt-webview-file-save
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; FFI Library
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define lib-type 'release)
|
|
|
|
(define os (system-type 'os*))
|
|
(define supported-os '(windows linux))
|
|
|
|
(unless (ormap (λ (o) (eq? os o)) supported-os)
|
|
(error (format "OS currently not supported: ~a. Supported: ~a." os supported-os)))
|
|
|
|
(define-runtime-path lib-dir "lib")
|
|
|
|
(define libraries-to-preload
|
|
(cond
|
|
([eq? os 'windows]
|
|
'(Qt6Core.dll
|
|
Qt6Positioning.dll
|
|
Qt6Gui.dll
|
|
Qt6Widgets.dll
|
|
Qt6Svg.dll
|
|
Qt6Network.dll
|
|
Qt6OpenGL.dll
|
|
Qt6PrintSupport.dll
|
|
Qt6Qml.dll
|
|
Qt6QmlModels.dll
|
|
Qt6QmlWorkerScript.dll
|
|
Qt6QmlMeta.dll
|
|
Qt6Quick.dll
|
|
Qt6QuickWidgets.dll
|
|
Qt6WebChannel.dll
|
|
Qt6WebEngineCore.dll
|
|
Qt6WebEngineWidgets.dll
|
|
))
|
|
([eq? os 'linux]
|
|
'())
|
|
)
|
|
)
|
|
|
|
(define ffi-library
|
|
(cond
|
|
([eq? os 'windows] 'rktwebview_qt.dll)
|
|
([eq? os 'linux] 'librktwebview_qt.so)
|
|
)
|
|
)
|
|
|
|
(define (libname lib-symbol)
|
|
(build-path lib-dir (symbol->string os) (symbol->string lib-symbol)))
|
|
|
|
; c:\qt\6.10.2\msvc2022_64\bin\windeployqt.exe rktwebview_qt_test.exe
|
|
(when (eq? os 'windows)
|
|
(putenv "QT_PLUGIN_PATH"
|
|
(path->string (build-path lib-dir (symbol->string os))))
|
|
(putenv "QTWEBENGINEPROCESS_PATH"
|
|
(path->string (build-path lib-dir (symbol->string os) "QtWebEngineProcess.exe")))
|
|
(putenv "QTWEBENGINE_RESOURCES_PATH"
|
|
(path->string (build-path lib-dir (symbol->string os) "resources")))
|
|
(putenv "QTWEBENGINE_LOCALES_PATH"
|
|
(path->string (build-path lib-dir (symbol->string os) "translations" "qtwebengine_locales")))
|
|
)
|
|
|
|
;;; Preload libraries
|
|
|
|
(for-each (λ (lib-symbol)
|
|
(let ((load-lib (libname lib-symbol)))
|
|
(ffi-lib load-lib)))
|
|
libraries-to-preload)
|
|
|
|
;;; Actual FFI integration
|
|
|
|
(define webview-lib-file (libname ffi-library))
|
|
(define webview-lib
|
|
(with-handlers ([exn:fail?
|
|
(λ (exp)
|
|
(cond
|
|
([eq? os 'linux]
|
|
(error (format
|
|
(string-append "Cannot load ~a.\n"
|
|
"Make sure you installed Qt6on your system\n"
|
|
"e.g. on debian 'sudo apt install libqt6webenginewidgets6'\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)))
|
|
|
|
(define-ffi-definer define-rktwebview webview-lib)
|
|
|
|
;;; Callbacks from the OS library
|
|
|
|
(define callback-box (box '()))
|
|
(define (applier thunk)
|
|
(thunk))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Types / Functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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
|
|
move_failed = 12
|
|
resize_failed = 13
|
|
)
|
|
)
|
|
)
|
|
|
|
(define _rkt_window_state_t
|
|
(_enum '(invalid = -1
|
|
normal = 0
|
|
minimized = 1
|
|
maximized = 2
|
|
hidden = 3
|
|
normal_active = 16
|
|
maximized_active = 18
|
|
)
|
|
)
|
|
)
|
|
|
|
(define-cstruct _rkt_evt_t
|
|
([w _int]
|
|
[evt _pointer]
|
|
))
|
|
|
|
(define-cstruct _rkt_js_result_t
|
|
([result _rkt_result_t]
|
|
[value _pointer]
|
|
))
|
|
|
|
;RKTWEBVIEW_QT_EXPORT void rkt_webview_init(int &argc, char **argv);
|
|
(define-rktwebview rkt_webview_init
|
|
(_fun -> _void))
|
|
|
|
;RKTWEBVIEW_QT_EXPORT void rkt_webview_process_events(int for_ms);
|
|
(define-rktwebview rkt_webview_process_events
|
|
(_fun _int -> _void))
|
|
|
|
;RKTWEBVIEW_QT_EXPORT int rkt_webview_create(int parent);
|
|
(define-rktwebview rkt_webview_create
|
|
(_fun _int (_fun #:keep callback-box #:async-apply applier
|
|
_rkt_evt_t-pointer -> _void) -> _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_js_result_t-pointer))
|
|
|
|
;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_destroy_js_result(rkt_js_result_t *r);
|
|
(define-rktwebview rkt_webview_destroy_js_result
|
|
(_fun _rkt_js_result_t-pointer -> _rkt_result_t))
|
|
|
|
;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_destroy_event(rkt_event_t e);
|
|
(define-rktwebview rkt_webview_destroy_event
|
|
(_fun _rkt_evt_t-pointer -> _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 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_js_result_t-pointer))
|
|
|
|
;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_js_result_t-pointer))
|
|
|
|
;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_js_result_t-pointer))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Initialize and start library
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define process-events #t)
|
|
|
|
(define (stop-event-processing)
|
|
(set! process-events #f))
|
|
|
|
(define (start-event-processing)
|
|
(thread (λ ()
|
|
(letrec ((f (λ ()
|
|
(rkt_webview_process_events 1)
|
|
(sleep 0.001)
|
|
(if process-events
|
|
(f)
|
|
(begin
|
|
(displayln "Stopping event processing")
|
|
'done)))))
|
|
(f)))))
|
|
|
|
(rkt_webview_init)
|
|
(start-event-processing)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided features
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-struct rkt-wv
|
|
(win evt-queue callback [valid #:mutable] [close-callback #:mutable])
|
|
#:transparent
|
|
)
|
|
|
|
(define rkt-wv-store (make-hash))
|
|
|
|
(define (rkt-process-events handle)
|
|
(if (> (queue-length (rkt-wv-evt-queue handle)) 0)
|
|
(let ((e (dequeue! (rkt-wv-evt-queue handle))))
|
|
(if (symbol? e)
|
|
(if (eq? e 'quit)
|
|
(begin
|
|
(hash-remove! rkt-wv-store (rkt-wv-win handle))
|
|
'quit)
|
|
(rkt-process-events handle))
|
|
(let ((evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8)))
|
|
((rkt-wv-callback handle) handle evt)
|
|
(rkt_webview_destroy_event e)
|
|
(rkt-process-events handle)))
|
|
)
|
|
'done))
|
|
|
|
(define (rkt-webview-create 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 parent-win
|
|
(λ (rkt-evt)
|
|
(enqueue! evt-queue rkt-evt)))))
|
|
(let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback)))
|
|
(thread (λ ()
|
|
(sleep 1)
|
|
(letrec ((f (λ ()
|
|
(let ((r (rkt-process-events handle)))
|
|
(if (eq? r 'quit)
|
|
(begin
|
|
(set-rkt-wv-valid! handle #f)
|
|
(displayln "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 (rkt-webview-close handle)
|
|
(rkt_webview_close (rkt-wv-win handle))
|
|
(enqueue! (rkt-wv-evt-queue handle) 'quit)
|
|
((rkt-wv-close-callback handle))
|
|
#t)
|
|
|
|
(define (rkt-webview-set-ou-token handle token)
|
|
(rkt_webview_set_ou_token (rkt-wv-win handle) token)
|
|
#t)
|
|
|
|
(define (rkt-webview-set-url! wv url)
|
|
(rkt_webview_set_url (rkt-wv-win wv) url))
|
|
|
|
(define (rkt-webview-set-html! wv html)
|
|
(rkt_webview_set_html (rkt-wv-win wv) html))
|
|
|
|
(define (rkt-webview-set-title! wv title)
|
|
(rkt_webview_set_title (rkt-wv-win wv) title))
|
|
|
|
(define (rkt-webview-run-js wv js)
|
|
(rkt_webview_run_js (rkt-wv-win wv) js))
|
|
|
|
(define (rkt-webview-call-js wv js)
|
|
(let* ((r (rkt_webview_call_js (rkt-wv-win wv) js))
|
|
(value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
|
|
(result (rkt_js_result_t-result r)))
|
|
(rkt_webview_destroy_js_result r)
|
|
(list result value)))
|
|
|
|
(define (rkt-webview-resize wv w h)
|
|
(rkt_webview_resize (rkt-wv-win wv) w h))
|
|
|
|
(define (rkt-webview-move wv x y)
|
|
(rkt_webview_move (rkt-wv-win wv) x y))
|
|
|
|
(define-syntax def-rkt-wrapper-wv
|
|
(syntax-rules ()
|
|
((_ name c-name)
|
|
(define (name wv)
|
|
(c-name (rkt-wv-win wv))))))
|
|
|
|
(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-open-devtools wv)
|
|
(rkt_webview_open_devtools (rkt-wv-win wv)))
|
|
|
|
(define (rkt-webview-choose-dir wv title base-dir)
|
|
(let* ((r (rkt_webview_choose_dir (rkt-wv-win wv) title base-dir))
|
|
(value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
|
|
(result (rkt_js_result_t-result r)))
|
|
(rkt_webview_destroy_js_result r)
|
|
(list result value)))
|
|
|
|
(define (rkt-webview-file-open wv title base-dir permitted-exts)
|
|
(let* ((r (rkt_webview_file_open (rkt-wv-win wv) title base-dir permitted-exts))
|
|
(value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
|
|
(result (rkt_js_result_t-result r)))
|
|
(rkt_webview_destroy_js_result r)
|
|
(list result value)))
|
|
|
|
(define (rkt-webview-file-save wv title base-dir permitted-exts)
|
|
(let* ((r (rkt_webview_file_save (rkt-wv-win wv) title base-dir permitted-exts))
|
|
(value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
|
|
(result (rkt_js_result_t-result r)))
|
|
(rkt_webview_destroy_js_result r)
|
|
(list result value)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Administration
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (rkt-webview-valid? wv)
|
|
(if (eq? (rkt-wv-valid wv) #f)
|
|
#f
|
|
(if (= (rkt_webview_valid wv) 0)
|
|
#f
|
|
#t)))
|
|
|
|
(define (rkt-webview-exit)
|
|
(let ((open-windows (hash->list rkt-wv-store)))
|
|
(for-each (λ (kv)
|
|
(let ((win (car kv))
|
|
(handle (cdr kv)))
|
|
(rkt-webview-close handle)))
|
|
open-windows))
|
|
(stop-event-processing))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Cleanup on exit
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(plumber-add-flush! (current-plumber)
|
|
(λ (handle)
|
|
(rkt-webview-exit)))
|
|
|
|
|
|
|