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

82
private/racket-webview.rkt
View File

@@ -48,6 +48,8 @@
webview-window-state
webview-set-title!
webview-messagebox
webview-choose-dir
webview-file-open
webview-file-save
@@ -61,6 +63,7 @@
wv-permitted-exts?
wv-permitted-exts-exts?
wv-list-of-permitted-exts?
webview-filter->exts
webview-bind!
webview-unbind!
@@ -101,6 +104,7 @@
;webview-del-attr!
webview-standard-file-getter
webview-default-boilerplate-js
webview-version
@@ -116,9 +120,14 @@
(define-runtime-path js-path "../js")
(define (default-boilerplate-js)
(define (webview-default-boilerplate-js . custom-js)
(let ((file (build-path js-path "boilerplate.js")))
(file->string file)))
(let ((bjs (file->string file)))
(let ((js (string-append bjs
(if (null? custom-js)
""
((car custom-js))))))
js))))
(define-struct wv-context
([context #:mutable]
@@ -346,7 +355,7 @@
(map (λ (e) (format "*.~a" e)) (wv-permitted-exts-exts pe))))
(string-join (map mef (if (list? list-of-pe) list-of-pe (list list-of-pe))) ";;"))
(define (filter->exts str)
(define (webview-filter->exts str)
(let ((re #px"^([^ ]+)\\s+[(]([^)]+)[)]"))
(let ((m (regexp-match re str)))
(cond ((eq? m #f)
@@ -401,7 +410,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (webview-new-context file-getter
#:boilerplate-js [bj (default-boilerplate-js)])
#:boilerplate-js [bj (webview-default-boilerplate-js)])
(->* (procedure?) (#:boilerplate-js string?) wv-context?)
(let* ((h (make-wv-context 0 0 file-getter #f #f 0
(make-lru 250 #:cmp eq?)
@@ -527,48 +536,58 @@
(def-win-func webview-present rkt-webview-present)
(def-win-func webview-window-state rkt-webview-window-state)
(define/contract (webview-messagebox wv type title message #:sub [submessage ""])
(->* (wv-win? symbol? string? string?) (#:sub string?) symbol?)
(rkt-webview-messagebox (wv-win-handle wv) title message submessage type))
(define/contract (webview-choose-dir wv title base-dir)
(-> wv-win? string? (or/c path? string?) (or/c hash? boolean?))
(-> wv-win? string? (or/c path? string?) symbol?)
(let ((bd (if (path? base-dir) (path->string base-dir) base-dir)))
(let ((res (rkt-webview-choose-dir (wv-win-handle wv) title bd)))
(if (eq? res #f)
#f
(cond ((eq? (car res) 'oke)
(let ((r (make-hash (hash->list (fromJson (cadr res))))))
(hash-set! r 'state (string->symbol (hash-ref r 'state)))
r))
(else #f))
)
)
res)
)
)
;(if (eq? res #f)
; #f
; (cond ((eq? (car res) 'oke)
; (let ((r (make-hash (hash->list (fromJson (cadr res))))))
; (hash-set! r 'state (string->symbol (hash-ref r 'state)))
; r))
; (else #f))
; )
; )
; )
; )
(define (file-open-save wv title base-dir permitted-exts open-save-f)
(let* ((bd (if (path? base-dir) (path->string base-dir) base-dir))
(ext-filter (make-exts-filter permitted-exts)))
(displayln ext-filter);
(let ((res (open-save-f (wv-win-handle wv) title bd ext-filter)))
(if (eq? res #f)
#f
(cond ((eq? (car res) 'oke)
(let* ((h (make-hash (hash->list (fromJson (cadr res))))))
(hash-set! h 'state (string->symbol (hash-ref h 'state)))
(hash-set! h 'used-filter (filter->exts (hash-ref h 'used-filter)))
h))
(else #f))
)
)
)
)
res)))
; (if (eq? res #f)
; #f
; (cond ((eq? (car res) 'oke)
; (let* ((h (make-hash (hash->list (fromJson (cadr res))))))
; (hash-set! h 'state (string->symbol (hash-ref h 'state)))
; (hash-set! h 'used-filter (filter->exts (hash-ref h 'used-filter)))
; h))
; (else #f))
; )
; )
; )
; )
(define/contract (webview-file-open wv title base-dir permitted-exts)
(-> wv-win? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(or/c hash? boolean?))
symbol?)
(file-open-save wv title base-dir permitted-exts rkt-webview-file-open))
(define/contract (webview-file-save wv title base-dir permitted-exts)
(-> wv-win? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(or/c hash? boolean?))
symbol?)
(file-open-save wv title base-dir permitted-exts rkt-webview-file-save))
@@ -655,9 +674,10 @@
(define/contract (webview-set-innerHTML! wv id html)
(-> wv-win? symbol? (or/c string? xexpr?) symbol?)
(if (string? html)
(webview-run-js wv
(with-id id el
("el.innerHTML = '~a';" (esc-quote html))))
(let ((r (webview-call-js wv
(with-id id el
("el.innerHTML = '~a'; return true;" (esc-quote html))))))
(if r 'oke 'failed))
(webview-set-innerHTML! wv id (xexpr->string html))
)
)