hans/racket-webview
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Asynchronous messages, file dialogs and call/cc stuff

Browse Source
This commit is contained in:
Hans Dijkema
2026-03-12 17:08:20 +01:00
parent d99c5a1725
commit 2cbf6fb98b
11 changed files with 363 additions and 199 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
private/racket-webview-qt.rkt
View File

@@ -40,6 +40,7 @@
rkt-webview-choose-dir
rkt-webview-file-open
rkt-webview-file-save
rkt-webview-messagebox
rkt-webview-version
)
@@ -226,6 +227,16 @@
)
)
(define _rkt_messagetype_t
(_enum '(info = 1
error = 2
warning = 3
yes-no = 4
oke-cancel = 5
)
)
)
(define-cstruct _rkt_version_t
([qt-major _int]
[qt-minor _int]
@@ -357,15 +368,24 @@
;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_data_t-pointer))
(_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_data_t-pointer))
(_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_data_t-pointer))
(_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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -405,20 +425,21 @@
(define (rkt-process-events handle)
(if (> (queue-length (rkt-wv-evt-queue handle)) 0)
(let ((data (dequeue! (rkt-wv-evt-queue handle))))
(if (symbol? data)
(if (eq? data 'quit)
(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)
(rkt-process-events handle))
(let* ((e (union-ref (rkt_data_t-data data) 1))
(evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8)))
(begin
(displayln (format "Unexpected data in event queue: ~a" evt))
(rkt-process-events handle)))
(begin
((rkt-wv-callback handle) handle evt)
(rkt_webview_free_data data)
(rkt-process-events handle)))
)
'done))
'done)
)
(define (rkt-webview-new-context boilerplate-js server-cert)
@@ -431,7 +452,11 @@
)
(let ((wv (rkt_webview_create context parent-win
(λ (rkt-evt)
(enqueue! evt-queue 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)
@@ -504,28 +529,34 @@
(rkt_webview_open_devtools (rkt-wv-win wv)))
(define (rkt-webview-choose-dir 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)))
(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-file-open 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)))
(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-file-save 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)))
(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-messagebox wv title message submessage type)
(rkt_webview_message_box (rkt-wv-win wv) title message submessage type))
(define (rkt-webview-version)
(let ((d (rkt_webview_version)))