OO framework
This commit is contained in:
11
main.rkt
Normal file
11
main.rkt
Normal file
@@ -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"
|
||||
)
|
||||
)
|
||||
11
private/racket-webview-version.rkt
Normal file
11
private/racket-webview-version.rkt
Normal file
@@ -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)
|
||||
|
||||
128
private/rgba.rkt
Normal file
128
private/rgba.rkt
Normal file
@@ -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))
|
||||
|
||||
|
||||
42
private/wv-context.rkt
Normal file
42
private/wv-context.rkt
Normal file
@@ -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]))
|
||||
)
|
||||
)
|
||||
)
|
||||
53
private/wv-dialog.rkt
Normal file
53
private/wv-dialog.rkt
Normal file
@@ -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)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
93
private/wv-element.rkt
Normal file
93
private/wv-element.rkt
Normal file
@@ -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)
|
||||
)
|
||||
)
|
||||
|
||||
52
private/wv-input.rkt
Normal file
52
private/wv-input.rkt
Normal file
@@ -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)
|
||||
38
private/wv-settings.rkt
Normal file
38
private/wv-settings.rkt
Normal file
@@ -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)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
460
private/wv-window.rkt
Normal file
460
private/wv-window.rkt
Normal file
@@ -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)
|
||||
)
|
||||
|
||||
|
||||
65
rktwebview_qt/install-linux.sh
Executable file
65
rktwebview_qt/install-linux.sh
Executable file
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user