From 241b52f6b1d25f0d296ada7f0d413282faf8a78a Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 12 Mar 2026 20:57:31 +0100 Subject: [PATCH] OO framework --- main.rkt | 11 + private/racket-webview-version.rkt | 11 + private/rgba.rkt | 128 ++++++++ private/wv-context.rkt | 42 +++ private/wv-dialog.rkt | 53 ++++ private/wv-element.rkt | 93 ++++++ private/wv-input.rkt | 52 ++++ private/wv-settings.rkt | 38 +++ private/wv-window.rkt | 460 +++++++++++++++++++++++++++++ rktwebview_qt/install-linux.sh | 65 ++++ 10 files changed, 953 insertions(+) create mode 100644 main.rkt create mode 100644 private/racket-webview-version.rkt create mode 100644 private/rgba.rkt create mode 100644 private/wv-context.rkt create mode 100644 private/wv-dialog.rkt create mode 100644 private/wv-element.rkt create mode 100644 private/wv-input.rkt create mode 100644 private/wv-settings.rkt create mode 100644 private/wv-window.rkt create mode 100755 rktwebview_qt/install-linux.sh diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..e728138 --- /dev/null +++ b/main.rkt @@ -0,0 +1,11 @@ +#lang racket/base + +(require "private/wv-context.rkt") +(require "private/wv-window.rkt") +(require "private/wv-dialog.rkt") + +(provide (all-from-out "private/wv-context.rkt" + "private/wv-window.rkt" + "private/wv-dialog.rkt" + ) + ) diff --git a/private/racket-webview-version.rkt b/private/racket-webview-version.rkt new file mode 100644 index 0000000..adee044 --- /dev/null +++ b/private/racket-webview-version.rkt @@ -0,0 +1,11 @@ +#lang racket/base + +(provide webview-major + webview-minor + webview-patch + ) + +(define webview-major 0) +(define webview-minor 1) +(define webview-patch 0) + diff --git a/private/rgba.rkt b/private/rgba.rkt new file mode 100644 index 0000000..68e4e97 --- /dev/null +++ b/private/rgba.rkt @@ -0,0 +1,128 @@ +#lang racket/base + +(require racket/contract + racket-sprintf + ) + +(provide rgba + hex->rgba + rgba->hex + rgba? + rgba-blue + rgba-red + rgba-green + rgba-alpha + rgba-blue! + rgba-red! + rgba-green! + rgba-alpha! + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data structures +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-struct rgba* + ([red #:mutable] [green #:mutable] [blue #:mutable] [alpha #:mutable]) + #:transparent + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Support functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (between-0-255? x) + (and (integer? x) + (>= x 0) + (<= x 255))) + + +(define (optional-between-0-255? x) + (write x) + (newline) + (or (null? x) + (and (= (length x) 1) + (between-0-255? (car x))))) + +(define (hex2->int str) + (let ((s (string-downcase str)) + (sub (- (char->integer #\a) 10)) + (subnum (char->integer #\0))) + (let ((ac (string-ref s 0)) + (bc (string-ref s 1))) + (let ((a (- (char->integer ac) (if (char>=? ac #\a) sub subnum))) + (b (- (char->integer bc) (if (char>=? bc #\a) sub subnum)))) + (+ (* a 16) b))))) + +(define (hex-color? c) + (let ((re #px"[#]?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})?")) + (let ((m (regexp-match re c))) + (not (eq? m #f))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (rgba? c) + (rgba*? c)) + +(define/contract (rgba r g b . a) + (->* (between-0-255? between-0-255? between-0-255?) (between-0-255?) rgba?) + (make-rgba* r g b (if (null? a) 255 (car a))) + ) + +(define/contract (hex->rgba h) + (-> hex-color? rgba?) + (let ((re #px"[#]?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})?")) + (let ((m (regexp-match re h))) + (if (eq? m #f) + (error "Not a CSS hex color string") + (rgba (hex2->int (list-ref m 1)) + (hex2->int (list-ref m 2)) + (hex2->int (list-ref m 3)) + (if (eq? (list-ref m 4) #f) + 255 + (hex2->int (list-ref m 4)))))))) + +(define/contract (rgba->hex c) + (-> rgba? string?) + (string-append + (sprintf "#%02x%02x%02x" (rgba-red c) (rgba-green c) (rgba-blue c)) + (if (= (rgba-alpha c) 255) + "" + (sprintf "%02x" (rgba-alpha c))))) + + +(define/contract (rgba-red! c r) + (-> rgba? between-0-255? rgba?) + (set-rgba*-red! c r)) + +(define/contract (rgba-green! c g) + (-> rgba? between-0-255? rgba?) + (set-rgba*-green! c g)) + +(define/contract (rgba-blue! c b) + (-> rgba? between-0-255? rgba?) + (set-rgba*-blue! c b)) + +(define/contract (rgba-alpha! c a) + (-> rgba? between-0-255? rgba?) + (set-rgba*-alpha! c a)) + +(define/contract (rgba-red c) + (-> rgba? between-0-255?) + (rgba*-red c)) + +(define/contract (rgba-green c) + (-> rgba? between-0-255?) + (rgba*-green c)) + +(define/contract (rgba-blue c) + (-> rgba? between-0-255?) + (rgba*-blue c)) + +(define/contract (rgba-alpha c) + (-> rgba? between-0-255?) + (rgba*-alpha c)) + + diff --git a/private/wv-context.rkt b/private/wv-context.rkt new file mode 100644 index 0000000..9cee471 --- /dev/null +++ b/private/wv-context.rkt @@ -0,0 +1,42 @@ +#lang racket/base + +(require racket/class + "racket-webview.rkt" + "wv-settings.rkt" + ) + +(provide wv-context%) + +(define wv-context% + (class object% + (init-field + base-path + [file-getter (webview-standard-file-getter base-path)] + [context-js (λ () "")] + [boilerplate-js (webview-default-boilerplate-js context-js)] + [ini (error "You need to provide a 'ini' file settings interface for settings, e.g. simple-ini")] + ) + + (define wv-context #f) + (define settings-obj #f) + + (define/public (context) + wv-context) + + (define/public (settings section) + (send settings-obj clone section) + ) + + (define/public (base-url) + (wv-context-base-url wv-context)) + + (super-new) + + (begin + (set! wv-context + (webview-new-context file-getter + #:boilerplate-js boilerplate-js)) + (set! settings-obj (new wv-settings% [ini ini] [wv-context 'global])) + ) + ) + ) diff --git a/private/wv-dialog.rkt b/private/wv-dialog.rkt new file mode 100644 index 0000000..fde2f6b --- /dev/null +++ b/private/wv-dialog.rkt @@ -0,0 +1,53 @@ +#lang racket/base + +(require racket/class + "wv-window.rkt" + ) + +(provide wv-dialog% + ) + + +(define (default-w) 400) +(define (default-h) 400) + +(define wv-dialog% + (class wv-window% + (inherit-field parent settings wv-context html-path x y width height) + + (super-new) + + (define/override (init-size) + (displayln "init-size") + (let ((px (get-field x parent)) + (py (get-field y parent)) + (pw (get-field width parent)) + (ph (get-field height parent)) + ) + (displayln px) + (displayln py) + (displayln pw) + (displayln ph) + (let ((dw (send settings get 'width (if (eq? width #f) (default-w) width))) + (dh (send settings get 'height (if (eq? height #f) (default-h) height))) + ) + (displayln dw) + (displayln dh) + (let ((xx (/ (- pw dw) 2)) + (yy (/ (- ph dh) 2))) + (let ((x (inexact->exact (round (exact->inexact (+ px xx))))) + (y (inexact->exact (round (exact->inexact (+ py yy))))) + ) + (displayln "move") + (send this move x y) + (displayln "resize") + (send this resize dw dh) + ) + ) + ) + ) + ) + ) + ) + + diff --git a/private/wv-element.rkt b/private/wv-element.rkt new file mode 100644 index 0000000..751b571 --- /dev/null +++ b/private/wv-element.rkt @@ -0,0 +1,93 @@ +#lang racket/base + +(require racket/class + "racket-webview.rkt" + ) + +(provide wv-element%) + +(define wv-element% + (class object% + (init-field window + element-id + ) + + (define wv (hash-ref (send window info) 'wv)) + (define callbacks (make-hash)) + + (define/public (id) + element-id) + + (define/public (add-event-callback! evt cb) + (hash-set! callbacks evt cb)) + + (define/public (remove-event-callback! evt) + (hash-remove! callbacks evt)) + + (define/public (event-callback-count) + (hash-count callbacks)) + + (define/public (dispatch-event evt data) + (let ((cb (hash-ref callbacks evt #f))) + (if (eq? cb #f) + 'wv-unhandled-js-event + (begin + (cb this evt data) + 'wv-handled-js-event)))) + + (define/public (set-innerHTML! html) + (webview-set-innerHTML! wv element-id html) + this) + + (define/public (add-class! cl) + (webview-add-class! wv element-id cl)) + + (define/public (remove-class! cl) + (webview-remove-class! wv element-id cl)) + + (define/public (display . d) + (when (not (null? d)) + (let ((d* (string->symbol (format "~a" (car d))))) + (webview-set-style! wv element-id 'display d*))) + (webview-get-style wv element-id 'display)) + + (define/public (visibility . v) + (when (not (null? v)) + (let ((v* (string->symbol (format "~a" (car v))))) + (webview-set-style! wv element-id 'visibility v*))) + (webview-get-style wv element-id 'visibility)) + + (define/public (set-style! styles) + (webview-set-style! wv element-id styles)) + + (define/public (unset-style! styles) + (webview-unset-style! wv element-id styles)) + + (define (set-attr! attr-entries) + (webview-set-attr! wv element-id attr-entries)) + + (define (attr attr) + (webview-attr wv element-id attr)) + + (define (attr/number attr) + (webview-attr/number wv element-id attr)) + + (define (attr/symbol attr) + (webview-attr/symbol wv element-id attr)) + + (define (attr/boolean attr) + (webview-attr/boolean wv element-id attr)) + + (define (attr/date attr) + (webview-attr/date wv element-id attr)) + + (define (attr/time attr) + (webview-attr/time wv element-id attr)) + + (define (attr/datetime attr) + (webview-attr/datetime wv element-id attr)) + + (super-new) + ) + ) + diff --git a/private/wv-input.rkt b/private/wv-input.rkt new file mode 100644 index 0000000..2a50328 --- /dev/null +++ b/private/wv-input.rkt @@ -0,0 +1,52 @@ +#lang racket/base + +(require racket/class + "wv-element.rkt" + "racket-webview.rkt" + ) + +(provide wv-input/text% + wv-input/number% + wv-input/boolean% + wv-input/date% + wv-input/time% + wv-input/datetime% + wv-input/range% + wv-input/check% + wv-input/radio% + wv-input/color%) + + +(define-syntax mk-cl + (syntax-rules (wv-element%) + ((_ cl-name setter getter) + (define cl-name + (class wv-element% + (inherit-field window + element-id) + + (super-new) + + (define wv (hash-ref (send window info) 'wv)) + + (define/public (get) + (getter wv element-id)) + + (define/public (set! v) + (setter wv element-id v)) + ) + ) + ) + ) + ) + +(mk-cl wv-input/text% webview-set-value! webview-value) +(mk-cl wv-input/number% webview-set-value! webview-value/number) +(mk-cl wv-input/boolean% webview-set-value! webview-value/boolean) +(mk-cl wv-input/date% webview-set-value! webview-value/date) +(mk-cl wv-input/time% webview-set-value! webview-value/time) +(mk-cl wv-input/datetime% webview-set-value! webview-value/datetime) +(mk-cl wv-input/range% webview-set-value! webview-value/number) +(mk-cl wv-input/check% webview-set-value! webview-value/boolean) +(mk-cl wv-input/radio% webview-set-value! webview-value/boolean) +(mk-cl wv-input/color% webview-set-value! webview-value/color) diff --git a/private/wv-settings.rkt b/private/wv-settings.rkt new file mode 100644 index 0000000..5b4baa9 --- /dev/null +++ b/private/wv-settings.rkt @@ -0,0 +1,38 @@ +#lang racket/base + +(require racket/class + simple-ini/class + ) + +(provide wv-settings%) + +(define wv-settings% + (class object% + (init-field ini + wv-context + ) + + (define/public (get key . default-value) + (if (null? default-value) + (send ini get wv-context key) + (send ini get wv-context key (car default-value)))) + + (define/public (set! key value) + (send ini set! wv-context key value)) + + (define/public (get/global key . default-value) + (if (null? default-value) + (send ini get 'global key) + (send ini get 'global key (car default-value)))) + + (define/public (set/global! key value) + (send ini set! 'global key value)) + + (define/public (clone context) + (new wv-settings% [ini ini] [wv-context context])) + + (super-new) + ) + ) + + \ No newline at end of file diff --git a/private/wv-window.rkt b/private/wv-window.rkt new file mode 100644 index 0000000..f3c3bb3 --- /dev/null +++ b/private/wv-window.rkt @@ -0,0 +1,460 @@ +#lang racket/base + +(require "racket-webview.rkt" + racket/class + simple-ini/class + "wv-element.rkt" + "wv-input.rkt" + "wv-settings.rkt" + "rgba.rkt" + net/url + net/sendurl + racket/string + ) + +(provide wv-window% + (all-from-out "wv-element.rkt") + (all-from-out "wv-input.rkt") + (all-from-out "rgba.rkt") + (all-from-out "wv-settings.rkt") + webview-version + root-file-not-found-handler + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Administration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define default-x (let ((dx 100)) + (λ () + (set! dx (+ dx 25)) + dx))) +(define default-y (let ((dy 100)) + (λ () + (set! dy (+ dy 25)) + dy))) + +(define default-w (λ () 800)) +(define default-h (λ () 600)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Classes +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define wv-window% + (class object% + + (init-field [parent #f] + [wv-context (if (eq? parent #f) + (error "wv context is mandatory") + (get-field wv-context parent))] + [html-path (error "html path is mandatory")] + [settings (send wv-context settings (string->symbol (format "~a" html-path)))] + [title "Racket Webview Window"] + [width #f] + [height #f] + [x #f] + [y #f] + [wv #f] + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Administration + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define/public (context) + wv-context) + + (define/public (win-context) + (string->symbol (format "~a" html-path))) + + (define element-hash (make-weak-hash)) + + (define/public (info) + (let ((h (make-hash))) + (hash-set! h 'wv-context (context)) + (hash-set! h 'wv wv) + (hash-set! h 'html-path html-path) + (hash-set! h 'elements element-hash) + h)) + + (define/public (element id . type*) + (let ((elem (hash-ref element-hash id #f)) + (type (if (null? type*) #f (car type*)))) + (when (eq? elem #f) + (when (eq? type #f) + (let ((js-type (webview-call-js wv + (format + (string-append + "{ let el = document.getElementById('~a');\n" + " let a = el.getAttribute('type');\n" + " if (a === null) {\n" + " return false;\n" + " } else {\n" + " return a;\n" + " }\n" + "}") + id)))) + (set! type (if (eq? js-type #f) + #f + (string->symbol (string-downcase js-type)))) + ) + ) + (let ((cl (cond + ((eq? type 'text) wv-input/text%) + ((eq? type 'date) wv-input/date%) + ((eq? type 'time) wv-input/time%) + ((eq? type 'datetime-local) wv-input/datetime%) + ((eq? type 'range) wv-input/range%) + ((eq? type 'number) wv-input/number%) + ((eq? type 'checkbox) wv-input/check%) + ((eq? type 'radio) wv-input/radio%) + ((eq? type 'color) wv-input/color%) + (else wv-element%) + ))) + (set! elem (new cl [window this] [element-id id])) + (hash-set! element-hash id elem)) + ) + elem + ) + ) + + (define (connect! id type event callback) + (let ((elem (element id type))) + (send elem add-event-callback! event callback) + ) + ) + + (define (disconnect! id event) + (let ((elem (hash-ref element-hash id #f))) + (unless (eq? elem #f) + (send elem remove-event-callback! event) + (when (= (send elem event-callback-count) 0) + (hash-remove! element-hash id)) + ) + ) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Events + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (event-handler wv evt) + (let ((event (hash-ref evt 'event 'unknown-event)) + ) + (cond + ((eq? event 'resize) + (send this resized (hash-ref evt 'w) (hash-ref evt 'h))) + ((eq? event 'move) + (send this moved (hash-ref evt 'x) (hash-ref evt 'y))) + ((eq? event 'page-loaded) + (send this page-loaded (hash-ref evt 'oke))) + ((or (eq? event 'show) (eq? event 'hide) (eq? event 'maximize)) + (send this window-state-changed (webview-window-state wv))) + ((eq? event 'can-close?) + (when (send this can-close?) + (send this close))) + ((eq? event 'closed) + (send this closed)) + ((eq? event 'js-evt) + (let* ((je (hash-copy (hash-ref evt 'js-evt))) + (e (make-hash))) + (hash-set! e 'evt (string->symbol (hash-ref je 'evt))) + (hash-set! e 'id (string->symbol (hash-ref je 'id #f))) + (hash-set! e 'data (hash-ref je 'js_evt (make-hash))) + (hash-set! e 'event 'js-evt) + (when (eq? (send this js-event e) 'wv-unhandled-js-event) + (displayln (format "Unhandled javascript event: ~a" e))) + )) + ((eq? event 'navigation-request) + (let ((type (string->symbol (hash-ref evt 'type))) + (url (string->url (hash-ref evt 'url)))) + (send this navigation-request type url))) + ((or (eq? event 'file-save-ok) + (eq? event 'file-open-ok) + (eq? event 'choose-dir-ok)) + (let ((file (hash-ref evt 'choosen)) + (dir (hash-ref evt 'dir)) + (filter (webview-filter->exts (hash-ref evt 'filter)))) + (send this file-dialog-done 'ok file dir filter))) + ((or (eq? event 'file-save-cancel) + (eq? event 'file-open-cancel) + (eq? event 'choose-dir-cancel)) + (send this file-dialog-done 'canceled #f #f #f)) + ((or (eq? event 'msgbox-ok) + (eq? event 'msgbox-cancel) + (eq? event 'msgbox-yes) + (eq? event 'msgbox-no)) + (send this message-done event)) + (else + (displayln (format "Unhandled event: ~a (~a)" event evt))) + )) + ) + + (define/public (moved xx yy) + (set! x xx) + (set! y yy) + (send settings set! 'x x) + (send settings set! 'y y) + ) + + (define/public (resized w h) + (set! width w) + (set! height h) + (send settings set! 'width w) + (send settings set! 'height h) + ) + + (define/public (window-state-changed st) + #t + ) + + (define/public (page-loaded oke) + #t) + + (define/public (can-close?) + #t) + + (define/public (closed) + #t) + + (define/public (js-event js-event) + (let* ((evt (hash-ref js-event 'evt)) + (id (hash-ref js-event 'id)) + (el (hash-ref element-hash id #f)) + ) + (if (eq? el #f) + 'wv-unhandled-js-event + (send el dispatch-event evt (hash-ref js-event 'data (make-hash)))) + ) + ) + + (define/public (navigation-request type url) + (let ((u (url->string url))) + (if (string-prefix? u (send wv-context base-url)) + (begin + (webview-set-url! wv url) + 'internal) + (begin + (send-url u) + 'external) + ) + ) + ) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Commands + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define/public (add-class! selector-or-id cl) + (webview-add-class! wv selector-or-id cl) + this) + + (define/public (remove-class! selector-or-id cl) + (webview-remove-class! wv selector-or-id cl) + this) + + (define/public (devtools) + (webview-devtools wv) + this) + + (define/public (move x y) + (webview-move wv x y) + this) + + (define/public (resize w h) + (webview-resize wv w h) + this) + + (define/public (close) + (webview-close wv) + this) + + (define/public (bind! selector events callback) + (let ((items (webview-bind! wv selector events)) + (events* (if (symbol? events) (list events) events))) + (map (λ (item) + (let ((id (car item)) + (type (string->symbol (string-downcase (caddr item)))) + ) + (for-each (λ (evt) + (connect! id type evt callback)) + events*) + (hash-ref element-hash id) + )) + items) + ) + ) + + (define/public (unbind! selector events) + (let ((items (webview-unbind! wv selector events)) + (events* (if (symbol? events) (list events) events)) + ) + (for-each (λ (item) + (let ((id (car item))) + (for-each (λ (evt) + (send this disconnect! id evt)) + events*) + )) + items) + items + ) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Files / Directories + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define __file_dialog_cc__ #f) + + (define/public (file-dialog-done flag file dir filter) + (__file_dialog_cc__ (list flag file dir filter)) + ) + + (define/public (choose-dir title base-dir) + (unless (eq? __file_dialog_cc__ #f) + (error "Cannot display more than one file/directory dialog")) + (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir)) + (r (webview-choose-dir wv title bd))) + (if (eq? r 'oke) + (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c))))) + (if (void? r) + 'showing + (begin + (set! __file_dialog_cc__ #f) + (if (eq? (car r ) 'ok) + (cadr r) + #f)))) + #f) + ) + ) + + (define/public (file-open title base-dir filters) + (unless (eq? __file_dialog_cc__ #f) + (error "Cannot display more than one file/directory dialog")) + (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir)) + (r (webview-file-open wv title bd filters))) + (if (eq? r 'oke) + (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c))))) + (if (void? r) + 'showing + (begin + (set! __file_dialog_cc__ #f) + (if (eq? (car r) 'ok) + (cdr r) + #f)) + ) + ) + #f) + ) + ) + + (define/public (file-save title base-dir filters) + (unless (eq? __file_dialog_cc__ #f) + (error "Cannot display more than one file/directory dialog")) + (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir)) + (r (webview-file-save wv title bd filters))) + (if (eq? r 'oke) + (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c))))) + (if (void? r) + 'showing + (begin + (set! __file_dialog_cc__ #f) + (if (eq? (car r) 'ok) + (cdr r) + #f)) + ) + ) + #f) + ) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Messagebox + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define __msg_box_cc__ #f) + + (define/public (message-done evt) + (__msg_box_cc__ evt) + ) + + (define/public (message type title message #:sub [submessage ""]) + (unless (eq? __msg_box_cc__ #f) + (error "Cannot display more than one message box")) + (let ((r (webview-messagebox wv type title message #:sub submessage))) + (if (eq? r 'oke) + (let ((r (call/cc (λ (c) (set! __msg_box_cc__ c))))) + (if (void? r) + 'showing + (begin + (set! __msg_box_cc__ #f) + r))) + #f) + ) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Construction + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define/public (init-size) + (let ((x* (send settings get 'x (if (eq? x #f) (default-x) x))) + (y* (send settings get 'y (if (eq? y #f) (default-y) y))) + (w* (send settings get 'width (if (eq? width #f) (default-w) width))) + (h* (send settings get 'height (if (eq? height #f) (default-h) height))) + ) + (send this move x* y*) + (send this resize w* h*) + ) + ) + + (super-new) + + (begin + ;; Create window + (write (list wv-context html-path event-handler parent)) + (newline) + (set! wv (webview-create + (send wv-context context) + html-path + event-handler + #:parent (if (eq? parent #f) + #f + (get-field wv parent)))) + + ;; Move and resize window to settings + (send this init-size) + ) + ) + ) + + + +(define (root-file-not-found-handler standard-file . not-found-handler) + (letrec ((handler + (λ (file base-path path) + (if (string=? file "/") + (handler standard-file base-path (build-path base-path standard-file)) + (if (string=? file "/index.html") + (if (file-exists? path) + path + (handler standard-file base-path (build-path base-path standard-file))) + (if (file-exists? path) + path + (if (null? not-found-handler) + path + ((car not-found-handler) file base-path path) + ) + ) + ) + ) + ) + )) + handler) + ) + + \ No newline at end of file diff --git a/rktwebview_qt/install-linux.sh b/rktwebview_qt/install-linux.sh new file mode 100755 index 0000000..23a77fd --- /dev/null +++ b/rktwebview_qt/install-linux.sh @@ -0,0 +1,65 @@ +#!/bin/bash +# +ARCH=`uname -m` + +LIB="../private/lib/linux/$ARCH" + +mkdir -p $LIB +rm -f $LIB/*.so* +cp build/Release/*.so $LIB + +QT_PATH=`ldd build/Release/*.so | grep Qt | awk '{print $3}' | head -1 | sed -e 's%[/]lib[/].*%%'` +echo "QT_PATH=$QT_PATH" + +QT_PLUGINS="$QT_PATH/plugins" +PLUGINS="platforms position generic iconengines imageformats qmltooling tls xcbglintegrations" + +EXTRA_LIBS_SO=`ldd build/Release/*.so | grep Qt | awk '{ print $3 }'` +EXTRA_LIBS_PLATFORM_PLUGIN_XCB=`ldd $QT_PATH/plugins/platforms/libqxcb.so | grep Qt | awk '{print $3}'` + +for pl in $PLUGINS +do + echo "Assembling libs for $pl" + LIBS=`ls $QT_PLUGINS/$pl | grep so` + for ll in $LIBS + do + l="$QT_PLUGINS/$pl/$ll" + ELS=`ldd $l | grep Qt | grep -v no\ version\ information | awk '{print $3}'` + EXTRA_LIBS_SO="$EXTRA_LIBS_SO $ELS" + done +done + +#echo $EXTRA_LIBS_SO | less + +EXTRA_LIBS=`echo $EXTRA_LIBS_SO $EXTRA_LIBS_PLATFORM_PLUGIN_XCB | sort | uniq` + +for l in $EXTRA_LIBS; do + version_so=`basename $l` + if [ ! -r "$LIB/$version_so" ]; then + echo "Copying $l..." + cp $l $LIB + so=`echo $version_so | sed -e 's/[.]so.*$//'` + lib_so=`echo -n $so; echo ".so"` + (cd $LIB; ln -s $version_so $lib_so) + fi +done + + +for p in $PLUGINS +do + echo "Plugin $p..." + (cd $QT_PLUGINS; tar cf - $p) | (cd $LIB; tar xf -) +done + +RESOURCES="resources translations" +QT_RESOURCES="$QT_PATH" + +for r in $RESOURCES +do + echo "Resource $r..." + (cd $QT_RESOURCES; tar cf - $r) | (cd $LIB; tar xf - ) +done + +cp $QT_PATH/libexec/QtWebEngineProcess $LIB + +