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

-

Browse Source
This commit is contained in:
Hans Dijkema
2026-03-09 10:30:32 +01:00
parent 2b617cf4f5
commit cbb2220b32
2 changed files with 29 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -315,7 +315,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-struct rkt-wv
(win evt-queue callback [valid #:mutable])
(win evt-queue callback [valid #:mutable] [close-callback #:mutable])
#:transparent
)
@@ -337,14 +337,14 @@
)
'done))
(define (rkt-webview-create parent evt-callback)
(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)))
(let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback)))
(thread (λ ()
(sleep 1)
(letrec ((f (λ ()
@@ -365,6 +365,7 @@
(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)

33
private/racket-webview.rkt
View File

@@ -229,8 +229,9 @@
(let* ((cert-path (let ((p (build-path (find-system-path 'pref-dir) "racket-webview" (wv-context h))))
(make-directory* p)
p))
(f1 (build-path cert-path "self-signed.cert"))
(f2 (build-path cert-path "self-signed.key"))
(window-nr (wv-window-nr h))
(f1 (build-path cert-path (format "self-signed-~a.cert" window-nr)))
(f2 (build-path cert-path (format "self-signed-~a.key" window-nr)))
(fh1 (open-output-file f1 #:exists 'replace #:permissions #o600))
(fh2 (open-output-file f2 #:exists 'replace #:permissions #o600)))
(display (certificate cert) fh1)
@@ -252,6 +253,19 @@
)
)
(define (remove-cert-files h)
(let* ((cert-path (build-path (find-system-path 'pref-dir)
"racket-webview"
(wv-context h)))
(window-nr (wv-window-nr h))
(f1 (build-path cert-path (format "self-signed-~a.cert" window-nr)))
(f2 (build-path cert-path (format "self-signed-~a.key" window-nr)))
)
(delete-file f1)
(delete-file f2)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utilities
@@ -368,6 +382,15 @@
(cert (generate-self-signed-cert 2048 365 '("127.0.0.1" "localhost")
"NL" "Dijkema"
#:ou (wv-cert-ou-token h)))
(event-processor (λ (wv evt)
(event-callback h (util-parse-event evt))))
(close-callback (λ ()
(remove-cert-files h)))
(ph (if (wv? p) (wv-handle p) #f))
(wv (let ((internal-handle (rkt-webview-create ph event-processor close-callback)))
(set-wv-handle! h internal-handle)
(set-wv-window-nr! h (rkt-wv-win internal-handle))
internal-handle))
(channel (make-async-channel))
(server (let ((s (start-web-server h channel cert)))
(sleep 1) ;;; TODO: Check if web server is up.
@@ -375,14 +398,8 @@
(port-nr (let ((pn (async-channel-get channel)))
(set-wv-port! h pn)
pn))
(event-processor (λ (wv evt)
(event-callback h (util-parse-event evt))))
(ph (if (wv? p) (wv-handle p) #f))
(wv (rkt-webview-create ph event-processor))
(base-req (format "https://127.0.0.1:~a" (wv-port h)))
)
(set-wv-handle! h wv)
(set-wv-window-nr! h (rkt-wv-win wv))
(set-wv-webserver-thread! h server)
(rkt-webview-set-ou-token (wv-handle h) (wv-cert-ou-token h))
(rkt-webview-set-url! (wv-handle h) base-req)