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

Make sure when the backend cannot be downloaded or the site resolved that we're forgiving until we try to use the provided FFI functions.

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-05 23:43:16 +02:00
parent 6af1fa208b
commit 1f4f8a1fbd
5 changed files with 131 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
example1/example.rkt
View File

@@ -10,7 +10,9 @@
(provide
(all-from-out racket/gui)
(all-from-out "../main.rkt")
example-1-window%
run-example
)
(define ww-debug displayln)

2
info.rkt
View File

@@ -1,7 +1,7 @@
#lang info
(define pkg-authors '(hnmdijkema))
(define version "0.1.1")
(define version "0.1.2")
(define license 'MIT)
(define collection "racket-webview")
(define pkg-desc "racket-webview - A Web Based GUI library, based on a Qt WebEngine backend")

2
main.rkt
View File

@@ -1,5 +1,6 @@
#lang racket/base
(require "private/racket-webview-downloader.rkt")
(require "private/racket-webview.rkt")
(require "private/wv-context.rkt")
(require "private/wv-window.rkt")
@@ -18,6 +19,7 @@
"private/rgba.rkt"
"private/mimetypes.rkt"
"private/menu.rkt"
"private/racket-webview-downloader.rkt"
)
webview-set-loglevel
webview-version

16
private/racket-webview-downloader.rkt
View File

@@ -4,6 +4,7 @@
net/sendurl
net/url
net/url-connect
net/dns
racket/file
racket/system
racket/string
@@ -15,6 +16,7 @@
racket-webview-qt-directory
racket-webview-qt-is-available?
racket-webview-qt-is-downloadable?
racket-webview-qt-resolves?
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -101,20 +103,30 @@
(define (racket-webview-qt-directory)
(if (racket-webview-qt-is-available?)
(build-path (format "~a/~a-~a" install-path rkt-qt-os rkt-qt-arch))
(build-path install-path (format "~a-~a" rkt-qt-os rkt-qt-arch))
#f))
(define (racket-webview-qt-resolves?)
(if (eq? (dns-find-nameserver) #f)
#f
(with-handlers ([exn:fail? (λ (e) #f)])
(dns-get-address (dns-find-nameserver) rkt-qt-download-site)
#t)
)
)
(define (racket-webview-qt-version)
(if (racket-webview-qt-is-available?)
(file->value version-file)
#f))
(define (racket-webview-qt-is-downloadable?)
(with-handlers ([exn:fail? (λ (e) #f)])
(let ((in (download-port rkt-download-url)))
(let ((d (input-port? in)))
(when d
(close-input-port in))
d)))
d))))
(define (download-racket-webview-qt)
(let ((in (download-port rkt-download-url)))

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

@@ -14,6 +14,7 @@
racket/path
"utils.rkt"
"racket-webview-downloader.rkt"
openssl/libssl
)
(provide rkt-wv
@@ -55,12 +56,44 @@
(define lib-type 'release)
;; Check if racket-webview-qt backend is available or downloadable
(define do-ffi #t)
(define reason "")
(unless (racket-webview-qt-is-available?)
(unless (racket-webview-qt-is-downloadable?)
(error (format "There is no version of the racket-webview Qt backend available for OS '~a', Architectur '~a'"
(if (racket-webview-qt-resolves?)
(if (racket-webview-qt-is-downloadable?)
(begin
(set! do-ffi (download-racket-webview-qt))
(when (eq? do-ffi #f)
(set! reason "Racket Webview Qt backend could not be downloaded"))
)
(begin
(displayln "There is no version of the racket-webview Qt backend available\n")
(displayln
(format "for OS '~a', Architecture '~a'"
(system-type 'os*)
(system-type 'arch))))
(download-racket-webview-qt))
(system-type 'arch)))
(set! do-ffi #f)
(set! reason (format
"There is no version of Racket Webview Qt for os '~a', architecture '~a' available"
(system-type 'os*)
(system-type 'arch)
)
)
)
)
(begin
(displayln "Warning: Cannot resolve racket webview download site.")
(displayln "Cannot download backend libraries and programs.")
(set! do-ffi #f)
(set! reason "Racket Webview Qt backend download site could not be resolved")
)
)
)
;; Make sure we can load the FFI library, if at all possible (i.e. do-ffi equals #t)
(define os (system-type 'os*))
@@ -71,11 +104,11 @@
)
)
(define os-lib-dir (racket-webview-qt-directory))
(let ((files (directory-list os-lib-dir)))
(displayln (format "os-lib-dir: ~a" os-lib-dir))
(displayln (format "os-lib-dir-contents: ~a" files)))
(define os-lib-dir
(let ((dir (racket-webview-qt-directory)))
(if (eq? dir #f)
(build-path ".")
dir)))
(define (libname lib-symbol)
(build-path os-lib-dir (symbol->string lib-symbol)))
@@ -94,6 +127,8 @@
(define webview-lib-file (libname ffi-library))
(define webview-lib
(if (eq? do-ffi #f)
libssl
(with-handlers ([exn:fail?
(λ (exp)
(cond
@@ -119,16 +154,48 @@
)
)
)
)
(define-ffi-definer define-rktwebview webview-lib)
;; Make sure we are forgiving with the function loading.
;; forgiving with the function loading.
(define (make-ffi-repl id err . ret)
(let ((warned #f)
(msg (if (eq? do-ffi #t)
(string-append
"'~a' could not be loaded from "
(format "~a" webview-lib-file))
(string-append
"'~a' could not be loaded.\n"
reason)))
)
(λ () (λ args
(if err
(error (format msg id))
(begin
(unless warned
(displayln (format msg id))
(set! warned #t))
(car ret)))))))
;;; Callbacks from the OS library
;(define callback-box (box '()))
;(define (applier thunk)
; (thunk))
(define-ffi-definer define-rktwebview
webview-lib
#:default-make-fail (λ (id)
(if (eq? do-ffi #f)
(cond
((eq? id 'rkt_webview_env)
(make-ffi-repl id #f #t))
((eq? id 'rkt_webview_events_waiting)
(make-ffi-repl id #f 0))
((eq? id 'rkt_webview_init)
(make-ffi-repl id #f #t))
((eq? id 'rkt_webview_cleanup)
(make-ffi-repl id #f #t))
(else
(make-ffi-repl id #t))
)
(make-ffi-repl id #t)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types / Functions