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

24
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?)
(let ((in (download-port rkt-download-url)))
(let ((d (input-port? in)))
(when d
(close-input-port in))
d)))
(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))))
(define (download-racket-webview-qt)
(let ((in (download-port rkt-download-url)))

149
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'"
(system-type 'os*)
(system-type 'arch))))
(download-racket-webview-qt))
(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)))
(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,41 +127,75 @@
(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 Qt6 on your system\n"
"NB. the minimum Qt version that is supported is Qt 6.10.\n"
"This probably means you will need to install it separately from\n"
"the standard distro packages (e.g. libqt6webenginewidgets6 on\n"
"debian based systems).\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 '("6" #f)
#:get-lib-dirs (list os-lib-dir)
;#:custodian (current-custodian)
)
)
(if (eq? do-ffi #f)
libssl
(with-handlers ([exn:fail?
(λ (exp)
(cond
([eq? os 'linux]
(error (format
(string-append "Cannot load ~a.\n"
"Make sure you installed Qt6 on your system\n"
"NB. the minimum Qt version that is supported is Qt 6.10.\n"
"This probably means you will need to install it separately from\n"
"the standard distro packages (e.g. libqt6webenginewidgets6 on\n"
"debian based systems).\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 '("6" #f)
#:get-lib-dirs (list os-lib-dir)
;#:custodian (current-custodian)
)
)
)
)
(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