Compare commits
2 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 hans
|
9a670acf15 | ||
|
hans
|
d71f326d88 |
@@ -28,6 +28,7 @@
|
||||
"web-server-lib"
|
||||
"net-cookies-lib"
|
||||
"simple-log"
|
||||
"js-maker"
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
+218
-98
@@ -401,7 +401,9 @@
|
||||
(syntax-rules ()
|
||||
((_ id el e1 ...)
|
||||
(js (let ((el (send document getElementById (eval id))))
|
||||
e1 ...)))))
|
||||
e1 ...)))
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax with-id
|
||||
(syntax-rules ()
|
||||
@@ -427,9 +429,13 @@
|
||||
(define-syntax with-selector
|
||||
(syntax-rules ()
|
||||
((_ selector func)
|
||||
(format "return window.rkt_with_selector('~a', ~a)"
|
||||
(esc-quote selector)
|
||||
func))))
|
||||
(js
|
||||
(return (send window rkt_with_selector (eval selector) func))))
|
||||
)
|
||||
)
|
||||
; (format "return window.rkt_with_selector('~a', ~a)"
|
||||
; (esc-quote selector)
|
||||
; func))))
|
||||
|
||||
(define (make-exts-filter list-of-pe)
|
||||
(define (mef pe)
|
||||
@@ -579,22 +585,26 @@
|
||||
(define/contract (webview-set-menu! wv menu)
|
||||
(-> wv-win? is-wv-menu? symbol?)
|
||||
(let* ((json (wv-menu->json menu))
|
||||
(js (string-append "window._web_wire_menu('"
|
||||
json
|
||||
"');"))
|
||||
(js-code (js (send window _web_wire_menu (eval json))))
|
||||
;(string-append "window._web_wire_menu('"
|
||||
; json
|
||||
; "');"))
|
||||
)
|
||||
(webview-run-js wv js)
|
||||
(webview-run-js wv js-code)
|
||||
)
|
||||
)
|
||||
|
||||
(define/contract (webview-popup-menu! wv menu x y)
|
||||
(-> wv-win? is-wv-menu? number? number? symbol?)
|
||||
(let* ((json (wv-menu->json menu))
|
||||
(js (string-append "window._web_wire_popup_menu(JSON.parse('"
|
||||
json "'), " (format "~a, ~a" x y)
|
||||
");"))
|
||||
(js-code (js (send window _web_wire_popup_menu
|
||||
(send JSON parse (eval json))
|
||||
(eval x) (eval y))))
|
||||
;(string-append "window._web_wire_popup_menu(JSON.parse('"
|
||||
; json "'), " (format "~a, ~a" x y)
|
||||
; ");"))
|
||||
)
|
||||
(webview-run-js wv js)))
|
||||
(webview-run-js wv js-code)))
|
||||
|
||||
(define (loglevel? x)
|
||||
(and (symbol? x)
|
||||
@@ -624,8 +634,10 @@
|
||||
(define/contract (webview-navigate! wv place)
|
||||
(-> wv-win? string? symbol?)
|
||||
(webview-run-js wv
|
||||
(format "window.location = '~a';"
|
||||
(esc-quote place))))
|
||||
(js (set! (js-dot window location) (eval place)))
|
||||
;(format "window.location = '~a';"
|
||||
; (esc-quote place))))
|
||||
))
|
||||
|
||||
(define/contract (webview-base-url wv)
|
||||
(-> wv-win? url?)
|
||||
@@ -796,7 +808,7 @@
|
||||
(let ((r (webview-call-js wv
|
||||
(with-id->el id el
|
||||
(set! (js-dot el innerHTML) (eval html))
|
||||
#t))))
|
||||
(return #t)))))
|
||||
;(with-id id el
|
||||
; ("el.innerHTML = '~a'; return true;"
|
||||
; (esc-quote html))))))
|
||||
@@ -808,6 +820,26 @@
|
||||
(define/contract (webview-set-value! wv id val)
|
||||
(-> wv-win? symbol? (or/c symbol? string? number? boolean? g:date? g:time? g:datetime? rgba?) symbol?)
|
||||
(webview-run-js wv
|
||||
(with-id->el id el
|
||||
(if (or
|
||||
(= (js-dot el type) "checkbox")
|
||||
(= (js-dot el type) "radio"))
|
||||
(set! (js-dot el checked)
|
||||
(eval
|
||||
(if (eq? val #f) #f #t)))
|
||||
(set! (js-dot el value)
|
||||
(eval
|
||||
(cond
|
||||
((g:date? val) (date->string val))
|
||||
((g:time? val) (time->string val))
|
||||
((g:datetime? val) (datetime->string val))
|
||||
((rgba? val) (rgba->hex val))
|
||||
(else val)))))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
#|
|
||||
(with-id id el
|
||||
((string-append
|
||||
"if (el.type == 'checkbox' || el.type == 'radio') {\n"
|
||||
@@ -831,19 +863,25 @@
|
||||
)
|
||||
)
|
||||
)
|
||||
|#
|
||||
|
||||
(define/contract (webview-value wv id)
|
||||
(-> wv-win? symbol? (or/c string? boolean?))
|
||||
(let ((v (webview-call-js wv
|
||||
(with-id id el
|
||||
((string-append "let f = function() {\n"
|
||||
" if (el.type == 'checkbox' || el.type == 'radio') {\n"
|
||||
" return '' + el.checked;\n"
|
||||
" } else {\n"
|
||||
" return el.value;\n"
|
||||
" }\n"
|
||||
"};\n"))
|
||||
-> "f()"))))
|
||||
(with-id->el id el
|
||||
(if (or (= (js-dot el type) "checkbox")
|
||||
(= (js-dot el type) "radio"))
|
||||
(return (js-dot el checked))
|
||||
(return (js-dot el value)))))))
|
||||
;(with-id id el
|
||||
; ((string-append "let f = function() {\n"
|
||||
; " if (el.type == 'checkbox' || el.type == 'radio') {\n"
|
||||
; " return '' + el.checked;\n"
|
||||
; " } else {\n"
|
||||
; " return el.value;\n"
|
||||
; " }\n"
|
||||
; "};\n"))
|
||||
; -> "f()"))))
|
||||
(if (eq? v #f)
|
||||
#f
|
||||
v)))
|
||||
@@ -875,94 +913,151 @@
|
||||
(let ((sel (if (symbol? id-or-selector)
|
||||
(format "#~a" id-or-selector)
|
||||
id-or-selector))
|
||||
(cl (mk-js-array class))
|
||||
;(cl (mk-js-array class))
|
||||
(cl (if (list? class) class (list class)))
|
||||
)
|
||||
(webview-call-js wv (with-selector sel
|
||||
(format
|
||||
(js-code
|
||||
"function(id, el) {"
|
||||
" let cl = ~a;"
|
||||
" cl.forEach(function(c) {"
|
||||
" el.classList.add(c);"
|
||||
" });"
|
||||
" return id;"
|
||||
"}") cl)))
|
||||
(λ (id el)
|
||||
(let ((cl (eval cl)))
|
||||
(send cl forEach
|
||||
(λ (c)
|
||||
(send (js-dot el classList) add c)
|
||||
)
|
||||
)
|
||||
(return id))))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
; (format
|
||||
; (js-code
|
||||
; "function(id, el) {"
|
||||
; " let cl = ~a;"
|
||||
; " cl.forEach(function(c) {"
|
||||
; " el.classList.add(c);"
|
||||
; " });"
|
||||
; " return id;"
|
||||
; "}") cl)))
|
||||
; )
|
||||
; )
|
||||
|
||||
(define/contract (webview-remove-class! wv id-or-selector class)
|
||||
(-> wv-win? (or/c symbol? string?) (or/c symbol? string? list?) (or/c hash? boolean?))
|
||||
(let ((sel (if (symbol? id-or-selector)
|
||||
(format "#~a" id-or-selector)
|
||||
id-or-selector))
|
||||
(cl (mk-js-array class))
|
||||
(cl (if (list? class) class (list class)))
|
||||
)
|
||||
(webview-call-js wv
|
||||
(with-selector sel
|
||||
(format
|
||||
(js-code
|
||||
"function(id, el) {"
|
||||
" let cl = ~a;"
|
||||
" cl.forEach(function(c) {"
|
||||
" el.classList.remove(c);"
|
||||
" });"
|
||||
" return id;"
|
||||
"}") cl))
|
||||
)
|
||||
(λ (id el)
|
||||
(let ((cl (eval cl)))
|
||||
(send cl forEach
|
||||
(λ (c)
|
||||
(send (js-dot el classList) remove c))))
|
||||
id)))
|
||||
)
|
||||
)
|
||||
|
||||
; (with-selector sel
|
||||
; (format
|
||||
;; (js-code
|
||||
; "function(id, el) {"
|
||||
; " let cl = ~a;"
|
||||
; " cl.forEach(function(c) {"
|
||||
; " el.classList.remove(c);"
|
||||
; " });"
|
||||
; " return id;"
|
||||
; "}") cl))
|
||||
; )
|
||||
; )
|
||||
; )
|
||||
|
||||
(define/contract (webview-set-style! wv selector style-entries)
|
||||
(-> wv-win? (or/c symbol? string?) (or/c kv? list-of-kv?) (or/c hash? boolean?))
|
||||
(let ((sel (if (symbol? selector)
|
||||
(format "#~a" selector)
|
||||
selector))
|
||||
(cl (mk-js-array (if (kv? style-entries)
|
||||
;(cl (mk-js-array (if (kv? style-entries)
|
||||
; (list style-entries)
|
||||
; style-entries)))
|
||||
(cl (if (kv? style-entries)
|
||||
(list style-entries)
|
||||
style-entries)))
|
||||
style-entries))
|
||||
)
|
||||
(webview-call-js wv
|
||||
(with-selector sel
|
||||
(format
|
||||
(js-code
|
||||
"function(id, el) {"
|
||||
" let cl = ~a;"
|
||||
" cl.forEach(function(st) {"
|
||||
" el.style[st[0]] = st[1];"
|
||||
" });"
|
||||
" return id;"
|
||||
"}") cl))
|
||||
(λ (id el)
|
||||
(let ((cl (eval cl)))
|
||||
(send cl forEach
|
||||
(λ (st)
|
||||
(set! (js-ref
|
||||
(js-dot el style)
|
||||
(js-ref st 0))
|
||||
(js-ref st 1))))
|
||||
id)))
|
||||
)
|
||||
)
|
||||
)
|
||||
; (format
|
||||
; (js-code
|
||||
; "function(id, el) {"
|
||||
; " let cl = ~a;"
|
||||
; " cl.forEach(function(st) {"
|
||||
; " el.style[st[0]] = st[1];"
|
||||
; " });"
|
||||
; " return id;"
|
||||
; "}") cl))
|
||||
; )
|
||||
; )
|
||||
; )
|
||||
|
||||
(define/contract (webview-get-style wv selector styles)
|
||||
(-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) (or/c list? hash?))
|
||||
(let ((sel (if (symbol? selector)
|
||||
(format "#~a" selector)
|
||||
selector))
|
||||
(cl (mk-js-array (if (symbol? styles)
|
||||
(cl (if (symbol? styles)
|
||||
(list styles)
|
||||
styles)))
|
||||
styles))
|
||||
;(cl (mk-js-array (if (symbol? styles)
|
||||
; (list styles)
|
||||
; styles)))
|
||||
)
|
||||
(let ((r (webview-call-js wv
|
||||
(with-selector sel
|
||||
(format
|
||||
(js-code
|
||||
"function(id, el) {"
|
||||
" let cl = ~a;"
|
||||
" let r = {};"
|
||||
" cl.forEach(function(st) {"
|
||||
" let stl = window.getComputedStyle(el);"
|
||||
" r[st] = stl[st];"
|
||||
" });"
|
||||
" return { id: id, style: r };"
|
||||
"}") cl))
|
||||
)))
|
||||
(λ (id el)
|
||||
(let ((cl (eval cl))
|
||||
(r (make-hash)))
|
||||
(send cl forEach
|
||||
(λ (st)
|
||||
(let ((stl (send window getComputedStyle el)))
|
||||
(set! (js-ref r st) (js-ref stl st)))))
|
||||
(make-hash (list
|
||||
(list 'id id)
|
||||
(list 'style r))))))
|
||||
)
|
||||
))
|
||||
; (format
|
||||
; (js-code
|
||||
; "function(id, el) {"
|
||||
; " let cl = ~a;"
|
||||
; " let r = {};"
|
||||
; " cl.forEach(function(st) {"
|
||||
; " let stl = window.getComputedStyle(el);"
|
||||
; " r[st] = stl[st];"
|
||||
; " });"
|
||||
; " return { id: id, style: r };"
|
||||
; "}") cl))
|
||||
; )))
|
||||
(if (eq? r #f)
|
||||
#f
|
||||
(let ((h (hash-ref r 'with-ids)))
|
||||
(let ((l (map (λ (e) (cons (string->symbol (hash-ref e 'id)) (hash-ref e 'style))) h)))
|
||||
(let ((l (map (λ (e)
|
||||
(cons
|
||||
(string->symbol (hash-ref e 'id))
|
||||
(hash-ref e 'style))) h)))
|
||||
(if (symbol? selector)
|
||||
(cdr (car l))
|
||||
l))))
|
||||
@@ -976,25 +1071,35 @@
|
||||
(let ((sel (if (symbol? selector)
|
||||
(format "#~a" selector)
|
||||
selector))
|
||||
(cl (mk-js-array (if (symbol? style-entries)
|
||||
(cl (if (symbol? style-entries)
|
||||
(list style-entries)
|
||||
style-entries)))
|
||||
style-entries))
|
||||
)
|
||||
(webview-call-js wv
|
||||
(with-selector sel
|
||||
(format
|
||||
(js-code
|
||||
"function(id, el) {"
|
||||
" let cl = ~a;"
|
||||
" cl.forEach(function(st) {"
|
||||
" el.style[st] = '';"
|
||||
" });"
|
||||
" return id;"
|
||||
"}") cl)
|
||||
)
|
||||
)
|
||||
(λ (id el)
|
||||
(let ((cl (eval cl)))
|
||||
(send cl forEach
|
||||
(λ (st)
|
||||
(set! (js-ref
|
||||
(js-dot el style)
|
||||
st) "")))
|
||||
id))))
|
||||
)
|
||||
)
|
||||
; (format
|
||||
; (js-code
|
||||
; "function(id, el) {"
|
||||
; " let cl = ~a;"
|
||||
; " cl.forEach(function(st) {"
|
||||
; " el.style[st] = '';"
|
||||
; " });"
|
||||
; " return id;"
|
||||
; "}") cl)
|
||||
; )
|
||||
; )
|
||||
; )
|
||||
; )
|
||||
|
||||
(define/contract (webview-set-attr! wv selector attr-entries)
|
||||
(-> wv-win? (or/c symbol? string?)
|
||||
@@ -1013,29 +1118,44 @@
|
||||
([rgba? v] (rgba->hex v))
|
||||
(else (format "~a" v))))
|
||||
)) ae*))
|
||||
(cl (mk-js-array ae**))
|
||||
;(cl (mk-js-array ae**))
|
||||
(cl ae**)
|
||||
)
|
||||
(display cl)
|
||||
(webview-call-js wv
|
||||
(with-selector sel
|
||||
(format
|
||||
(js-code
|
||||
"function(id, el) {"
|
||||
" let cl = ~a;"
|
||||
" cl.forEach(function(av) {"
|
||||
" el.setAttribute(av[0], av[1]);"
|
||||
" });"
|
||||
" return id;"
|
||||
"}") cl))
|
||||
)
|
||||
(λ (id el)
|
||||
(let ((cl (eval cl)))
|
||||
(send cl forEach
|
||||
(λ (av)
|
||||
(send el setAttribute (js-ref av 0)
|
||||
(js-ref av 1))))
|
||||
id))))
|
||||
)
|
||||
)
|
||||
|
||||
; (with-selector sel
|
||||
; (format
|
||||
; (js-code
|
||||
; "function(id, el) {"
|
||||
; " let cl = ~a;"
|
||||
; " cl.forEach(function(av) {"
|
||||
; " el.setAttribute(av[0], av[1]);"
|
||||
; " });"
|
||||
; " return id;"
|
||||
; "}") cl))
|
||||
; )
|
||||
; )
|
||||
; )
|
||||
|
||||
(define/contract (webview-attr wv id attr)
|
||||
(-> wv-win? symbol? (or/c symbol? string?) (or/c string? boolean?))
|
||||
(let ((v (webview-call-js wv
|
||||
(with-id id el
|
||||
-> (format "el.getAttribute('~a');" attr))
|
||||
)))
|
||||
(with-id->el id el
|
||||
(return (send el getAttribute (eval attr)))))))
|
||||
;(with-id id el
|
||||
; -> (format "el.getAttribute('~a');" attr))
|
||||
;)))
|
||||
(if (eq? v 'null)
|
||||
#f
|
||||
v)
|
||||
|
||||
Reference in New Issue
Block a user