hans/web-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Example further and also message box preparation.

Browse Source 
NB. does not work currently with the linux flatpak stuff.

Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>
This commit is contained in:
Hans Dijkema
2025-11-13 16:28:17 +01:00
parent 2aa6db7423
commit f8057fccc5
11 changed files with 217 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
private/web-racket.rkt
View File

@@ -17,6 +17,9 @@
(provide ww-element%
ww-input%
ww-webview%
ww-webview-dialog%
ww-settings%
ww-webview-message%
ww-start
ww-stop
@@ -178,11 +181,17 @@
(define ww-input%
(class ww-element%
(define cb #f)
(define val #f)
(define/public (get)
val)
(define/public (on-change! callback)
(inp-set! cb callback)
(cb val)
)
(define/public (set! v)
(inp-set! val v)
(ww-set-value (send this get-win-id)
@@ -204,11 +213,15 @@
(inp-set! val (ww-get-value (send this get-win-id)
(send this get-id)))
(send this connect 'input (λ (data)
(ww-debug data)
(let ((js-evt (hash-ref data 'js-evt #f)))
(let ((js-evt (hash-ref data 'js_evt #f)))
(unless (eq? js-evt #f)
(when (hash-has-key? js-evt 'value)
(inp-set! val (hash-ref js-evt 'value)))))))
(let ((v (hash-ref js-evt 'value)))
(inp-set! val v)
(unless (eq? cb #f)
(cb v))
))))
))
(send (send this win) bind 'input (format "#~a" (send this get-id)))
)
))
@@ -299,14 +312,15 @@
(class object%
(init-field [profile 'default-profile]
[settings #f]
[use-browser #f]
[parent-id #f]
[parent #f]
[title "Racket HTML Window"]
[x _std_x]
[y _std_y]
[width _std_w]
[height _std_h]
[x (if (eq? settings #f) _std_x (send settings get 'window-x _std_x))]
[y (if (eq? settings #f) _std_y (send settings get 'window-y _std_y))]
[width (if (eq? settings #f) _std_w (send settings get 'window-width _std_w))]
[height (if (eq? settings #f) _std_h (send settings get 'window-height _std_h))]
[icon #f]
[menu #f]
[html-file #f]
@@ -317,6 +331,11 @@
(define menu-cbs (make-hash))
(define elements (make-hash))
(define html-handle #f)
(define/public (clone-settings section)
(if (eq? settings #f)
#f
(send settings clone section)))
(define (event-handler evt content)
(ww-debug (format "win-id=~a '~a ~a" win-id evt content))
@@ -335,12 +354,19 @@
(height* (hash-ref content 'height))
)
(set! width width*)
(set! height height*)))
(set! height height*)
(unless (eq? settings #f)
(send settings set 'window-width width)
(send settings set 'window-height height))
))
([eq? evt 'moved] (let* ((x* (hash-ref content 'x))
(y* (hash-ref content 'y))
)
(set! x x*)
(set! y y*)
(unless (eq? settings #f)
(send settings set 'window-x x)
(send settings set 'window-y y))
))
([eq? evt 'close-request] (when (send this can-close?)
(send this close)))
@@ -477,10 +503,20 @@
(set! html-file file)
(when folder
(ww-cwd folder))
(set! html-handle (ww-set-html win-id the-file))
(set! html-handle (ww-set-html-file win-id the-file))
(ww-debug (format "html file set to ~a" the-file))
))
(define/public (set-html html)
(let* ((tmpfile "/tmp/test.html")
(fh (open-output-file tmpfile #:exists 'replace)))
(displayln tmpfile)
(display html fh)
(close-output-port fh)
(send this set-html-file! tmpfile)
)
)
(define/public (set-url url)
(send-url url))
@@ -568,13 +604,17 @@
(if (eq? r 'cmd-nok)
#f
r)))
(define/public (inherit-checks)
#t)
; Supers first
(super-new)
; construct
(begin
(send this inherit-checks)
(when (= (hash-count windows) 0)
(ww-start))
@@ -626,12 +666,54 @@
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Classes representing WebView Dialogs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ww-webview-dialog%
(class ww-webview%
(super-new)
(inherit-field parent)
(define/override (inherit-checks)
(when (eq? parent #f)
(error "A parent must be given")))
))
(define ww-webview-message%
(class ww-webview-dialog%
(super-new)
(send this set-html
"<html><head><title>Message</title></head><body><h3 id=\"msg\">[msg]</h3><p id=\"submsg\">[submsg]</p></body></html>"
)
)
)
(define (set-global-stylesheet st)
(ww-set-stylesheet st))
(define (get-global-stylesheet)
(ww-get-stylesheet))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Classes for settings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ww-settings%
(class object%
(super-new)
(define/public (set key value)
(error "ww-settings%: set not implemented, override in your specific subclass"))
(define/public (get key . default)
(error "ww-settings%: get not implemented, override in your specific subclass"))
(define/public (clone new-section)
(error "ww-settings%: clone not implemented, override in your specific subclass"))
(define/public (set! key value)
(send this set key value))
)
)
); end of module

12
private/web-wire.rkt
View File

@@ -43,7 +43,7 @@
ww-set-menu
ww-set-html
ww-set-html-file
ww-set-url
ww-set-inner-html
@@ -98,8 +98,9 @@
#f)))
(define (as-string s)
(let ((s* (format "~a" s)))
(with-output-to-string (lambda () (write s*)))))
(format "~a" s))
;(let ((s* (format "~a" s)))
; (with-output-to-string (lambda () (write s*)))))
(define (ww-from-string s)
(let ((s* (substring s 1 (- (string-length s) 1))))
@@ -814,13 +815,12 @@
set-url ((win-id ww-win?)
(url string?)) () -> void)
;; Set html of window
(def-cmd ww-set-html
;; Set html of window to file
(def-cmd ww-set-html-file
set-html ((win-id ww-win?)
(html-file html-file-exists?)) ()
-> number)
;; Set inner html of an Id of the HTML in the window
(def-cmd ww-set-inner-html
set-inner-html ((win-id ww-win?)

6
private/webui-wire-ipc.rkt
View File

@@ -34,7 +34,8 @@
(if (and (string? colon) (string=? colon ":") (is-int? str-length))
; process line
(let* ((length (string->number str-length))
(input (read-string length process-stderr))
(input-bytes (read-bytes length process-stderr))
(input (bytes->string/utf-8 input-bytes))
(m (regexp-match re-kind input))
)
(read-eol process-stderr)
@@ -88,7 +89,8 @@
(semaphore-post sem)
(error "Unexpected input from webui-wire executable"))
(let* ((length (string->number str-length))
(input (read-string length process-stdout))
(input-bytes (read-bytes length process-stdout))
(input (bytes->string/utf-8 input-bytes))
)
(read-eol process-stdout)
(semaphore-post sem)