diff --git a/example1/example.rkt b/example1/example.rkt index e467f79..f272120 100644 --- a/example1/example.rkt +++ b/example1/example.rkt @@ -10,7 +10,9 @@ (provide (all-from-out racket/gui) + (all-from-out "../main.rkt") example-1-window% + run-example ) (define ww-debug displayln) diff --git a/info.rkt b/info.rkt index aec9cb7..da624cb 100644 --- a/info.rkt +++ b/info.rkt @@ -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") diff --git a/main.rkt b/main.rkt index bb44d12..ce1b375 100644 --- a/main.rkt +++ b/main.rkt @@ -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 diff --git a/private/racket-webview-downloader.rkt b/private/racket-webview-downloader.rkt index b06689b..c55d3c1 100644 --- a/private/racket-webview-downloader.rkt +++ b/private/racket-webview-downloader.rkt @@ -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))) diff --git a/private/racket-webview-qt.rkt b/private/racket-webview-qt.rkt index 7e32bcb..78e8a44 100644 --- a/private/racket-webview-qt.rkt +++ b/private/racket-webview-qt.rkt @@ -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