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.
This commit is contained in:
@@ -10,7 +10,9 @@
|
|||||||
|
|
||||||
(provide
|
(provide
|
||||||
(all-from-out racket/gui)
|
(all-from-out racket/gui)
|
||||||
|
(all-from-out "../main.rkt")
|
||||||
example-1-window%
|
example-1-window%
|
||||||
|
run-example
|
||||||
)
|
)
|
||||||
|
|
||||||
(define ww-debug displayln)
|
(define ww-debug displayln)
|
||||||
|
|||||||
2
info.rkt
2
info.rkt
@@ -1,7 +1,7 @@
|
|||||||
#lang info
|
#lang info
|
||||||
|
|
||||||
(define pkg-authors '(hnmdijkema))
|
(define pkg-authors '(hnmdijkema))
|
||||||
(define version "0.1.1")
|
(define version "0.1.2")
|
||||||
(define license 'MIT)
|
(define license 'MIT)
|
||||||
(define collection "racket-webview")
|
(define collection "racket-webview")
|
||||||
(define pkg-desc "racket-webview - A Web Based GUI library, based on a Qt WebEngine backend")
|
(define pkg-desc "racket-webview - A Web Based GUI library, based on a Qt WebEngine backend")
|
||||||
|
|||||||
2
main.rkt
2
main.rkt
@@ -1,5 +1,6 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
|
(require "private/racket-webview-downloader.rkt")
|
||||||
(require "private/racket-webview.rkt")
|
(require "private/racket-webview.rkt")
|
||||||
(require "private/wv-context.rkt")
|
(require "private/wv-context.rkt")
|
||||||
(require "private/wv-window.rkt")
|
(require "private/wv-window.rkt")
|
||||||
@@ -18,6 +19,7 @@
|
|||||||
"private/rgba.rkt"
|
"private/rgba.rkt"
|
||||||
"private/mimetypes.rkt"
|
"private/mimetypes.rkt"
|
||||||
"private/menu.rkt"
|
"private/menu.rkt"
|
||||||
|
"private/racket-webview-downloader.rkt"
|
||||||
)
|
)
|
||||||
webview-set-loglevel
|
webview-set-loglevel
|
||||||
webview-version
|
webview-version
|
||||||
|
|||||||
@@ -4,6 +4,7 @@
|
|||||||
net/sendurl
|
net/sendurl
|
||||||
net/url
|
net/url
|
||||||
net/url-connect
|
net/url-connect
|
||||||
|
net/dns
|
||||||
racket/file
|
racket/file
|
||||||
racket/system
|
racket/system
|
||||||
racket/string
|
racket/string
|
||||||
@@ -15,6 +16,7 @@
|
|||||||
racket-webview-qt-directory
|
racket-webview-qt-directory
|
||||||
racket-webview-qt-is-available?
|
racket-webview-qt-is-available?
|
||||||
racket-webview-qt-is-downloadable?
|
racket-webview-qt-is-downloadable?
|
||||||
|
racket-webview-qt-resolves?
|
||||||
)
|
)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -101,20 +103,30 @@
|
|||||||
|
|
||||||
(define (racket-webview-qt-directory)
|
(define (racket-webview-qt-directory)
|
||||||
(if (racket-webview-qt-is-available?)
|
(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))
|
#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)
|
(define (racket-webview-qt-version)
|
||||||
(if (racket-webview-qt-is-available?)
|
(if (racket-webview-qt-is-available?)
|
||||||
(file->value version-file)
|
(file->value version-file)
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
(define (racket-webview-qt-is-downloadable?)
|
(define (racket-webview-qt-is-downloadable?)
|
||||||
|
(with-handlers ([exn:fail? (λ (e) #f)])
|
||||||
(let ((in (download-port rkt-download-url)))
|
(let ((in (download-port rkt-download-url)))
|
||||||
(let ((d (input-port? in)))
|
(let ((d (input-port? in)))
|
||||||
(when d
|
(when d
|
||||||
(close-input-port in))
|
(close-input-port in))
|
||||||
d)))
|
d))))
|
||||||
|
|
||||||
(define (download-racket-webview-qt)
|
(define (download-racket-webview-qt)
|
||||||
(let ((in (download-port rkt-download-url)))
|
(let ((in (download-port rkt-download-url)))
|
||||||
|
|||||||
@@ -14,6 +14,7 @@
|
|||||||
racket/path
|
racket/path
|
||||||
"utils.rkt"
|
"utils.rkt"
|
||||||
"racket-webview-downloader.rkt"
|
"racket-webview-downloader.rkt"
|
||||||
|
openssl/libssl
|
||||||
)
|
)
|
||||||
|
|
||||||
(provide rkt-wv
|
(provide rkt-wv
|
||||||
@@ -55,12 +56,44 @@
|
|||||||
|
|
||||||
(define lib-type 'release)
|
(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-available?)
|
||||||
(unless (racket-webview-qt-is-downloadable?)
|
(if (racket-webview-qt-resolves?)
|
||||||
(error (format "There is no version of the racket-webview Qt backend available for OS '~a', Architectur '~a'"
|
(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 'os*)
|
||||||
(system-type 'arch))))
|
(system-type 'arch)))
|
||||||
(download-racket-webview-qt))
|
(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*))
|
(define os (system-type 'os*))
|
||||||
|
|
||||||
@@ -71,11 +104,11 @@
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
(define os-lib-dir (racket-webview-qt-directory))
|
(define os-lib-dir
|
||||||
|
(let ((dir (racket-webview-qt-directory)))
|
||||||
(let ((files (directory-list os-lib-dir)))
|
(if (eq? dir #f)
|
||||||
(displayln (format "os-lib-dir: ~a" os-lib-dir))
|
(build-path ".")
|
||||||
(displayln (format "os-lib-dir-contents: ~a" files)))
|
dir)))
|
||||||
|
|
||||||
(define (libname lib-symbol)
|
(define (libname lib-symbol)
|
||||||
(build-path os-lib-dir (symbol->string 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-file (libname ffi-library))
|
||||||
(define webview-lib
|
(define webview-lib
|
||||||
|
(if (eq? do-ffi #f)
|
||||||
|
libssl
|
||||||
(with-handlers ([exn:fail?
|
(with-handlers ([exn:fail?
|
||||||
(λ (exp)
|
(λ (exp)
|
||||||
(cond
|
(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)))))))
|
||||||
|
|
||||||
|
(define-ffi-definer define-rktwebview
|
||||||
;;; Callbacks from the OS library
|
webview-lib
|
||||||
|
#:default-make-fail (λ (id)
|
||||||
;(define callback-box (box '()))
|
(if (eq? do-ffi #f)
|
||||||
;(define (applier thunk)
|
(cond
|
||||||
; (thunk))
|
((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
|
;; Types / Functions
|
||||||
|
|||||||
Reference in New Issue
Block a user