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

4
example1/example-1-dialog.html
View File

@@ -3,10 +3,10 @@
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>This is test 1 Dialog</title>
<title>This is a Dialog for Example 1</title>
</head>
<body>
<h1>Dialog test 1</h1>
<h1>Preferences for Example 1</h1>
<table>
<tr><th>Input 1</th><td><input type="text" id="inp1" /></td></tr>
<tr><th>Input 2</th><td><input type="text" id="inp2" /></td></tr>

10
example1/example-1.html
View File

@@ -14,6 +14,9 @@
</head>
<body>
<h1>This is Example 1</h1>
<div class="right">
<img class="logo" src="racket-logo.png" />
</div>
<p><span id="pos">screen coöords</span></p>
<h2>Opening a link to some website</h2>
<p>
@@ -60,12 +63,5 @@
<input type="datetime-local" id="dt-input" />
<input type="time" id="time-inp" />
</div>
<h2>Some pictures</h2>
<div id="ff">
<img src="ff.jpg" >
</div>
<div id="f1">
<img src="f1.png" />
</div>
</body>
</html>

80
example1/example.rkt
View File

@@ -3,6 +3,7 @@
(require "../main.rkt"
racket/runtime-path
racket/gui
simple-ini/class
)
(provide
@@ -38,18 +39,35 @@
))
(define example-1-dialog%
(class ww-webview%
(class ww-webview-dialog%
(inherit-field settings)
(super-new [html-file dialog-html]
[width 400]
[height 300])
(define/override (html-loaded)
(super html-loaded)
(ww-debug "html-loaded for example-1-dialog%")
(let* ((btn (send this element 'ok-btn)))
(send btn connect 'click (λ (data)
(send this close)))))
))
(send this close))))
(let* ((inp1 (send this element 'inp1))
(inp2 (send this element 'inp2))
(inp3 (send this element 'inp3)))
(send inp1 set! (send settings get 'inp1 "<input 1 not set yet>"))
(send inp2 set! (send settings get 'inp2 "<input 2 not set yet>"))
(send inp3 set! (send settings get 'inp3 "<input 3 not set yet>"))
(send inp1 on-change!
(λ (val)
(send settings set! 'inp1 val)))
(send inp2 on-change! (λ (val) (send settings set! 'inp2 val)))
(send inp3 on-change! (λ (val) (send settings set! 'inp3 val)))
)
)
)
)
(define-syntax inc
(syntax-rules ()
@@ -60,14 +78,18 @@
(define example-1-window%
(class ww-webview%
(inherit-field settings)
(super-new [html-file html-start]
)
(define go-on-counter #f)
(define c-counter 0)
(define counter-inc 1)
(define counter-thread #f)
(define div-counter #f)
(define my-dir ".")
(super-new [html-file html-start])
(define my-dir (send settings get 'folder "."))
(define/override (can-close?)
(eq? counter-thread #f))
@@ -104,14 +126,6 @@
(css-style '((color white) (background red) (font-size 120%) (font-weight bold)))))
)
(define/public (set-folder new-dir)
(set! my-dir new-dir)
(let ((el (send this element 'folder)))
(send el set-inner-html! (format "Selected folder: <b>~a</b>" my-dir))
)
)
(define/public (start-counter)
(set! counter-thread
(thread
@@ -125,6 +139,22 @@
(f)))))
)
(define/public (set-folder new-dir)
(set! my-dir new-dir)
(send settings set 'folder new-dir)
(let ((el (send this element 'folder)))
(send el set-inner-html! (format "Selected folder: <b>~a</b>" my-dir))
)
)
(define/override (choose-dir)
(let ((new-dir (super choose-dir "Select a folder" my-dir)))
(unless (eq? new-dir #f)
(send this set-folder new-dir))))
(define/public (prefs)
(new example-1-dialog% [parent this] [settings (send this clone-settings 'example-1-dialog)]))
(define/override (handle-navigate url type kind)
(send this reset-counter)
(super handle-navigate url type kind))
@@ -140,10 +170,10 @@
(ww-debug "CONNECTING BUTTONS")
(let* ((dialog-btn (send this element 'dialog-button))
(start-stop-btn (send this element 'start-stop-button))
(choose-dir-btn (send this element 'select-dir-button))
)
(send dialog-btn connect 'click
(λ (data)
(new example-1-dialog% [parent this])))
(λ (data) (send this prefs)))
(send start-stop-btn connect 'click
(λ (data)
@@ -157,6 +187,9 @@
)
)
)
(send choose-dir-btn connect 'click
(λ (data)
(send this choose-dir)))
)
(ww-debug "SETTING MENU")
@@ -196,21 +229,24 @@
(λ () (send this reset-counter)))
(send this connect-menu! 'm-prefs
(λ () (new example-1-dialog% [parent this])))
(λ () (send this prefs)))
(send this connect-menu! 'm-select-dir
(λ ()
(let ((new-dir (send this choose-dir "Select a folder" my-dir)))
(unless (eq? new-dir #f)
(send this set-folder new-dir)))))
(λ () (send this choose-dir)))
)
)
)
(begin
(displayln html-start)
(displayln "Yes this works!")
)
)
)
(define (run-example)
(let* ((ini (new ini% [file 'web-racket-example1]))
(settings (new ww-simple-ini% [ini ini] [section 'example-1-window]))
(window (new example-1-window% [settings settings]))
)
window))

BIN
example1/racket-logo.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 142 KiB

9
example1/styles.css
View File

@@ -57,3 +57,12 @@ td span.counter {
border: 1px solid grey;
}
.right {
float: right;
}
.right img.logo {
margin: 2em;
border: 2px solid grey;
max-width: 250px;
}

2
info.rkt
View File

@@ -13,7 +13,7 @@
)
(define deps
'("racket/base" "net/http-easy" "file/unzip" "gregor" "html-printer"))
'("racket/base" "net/http-easy" "gregor" "html-printer" "simple-ini"))
(define build-deps
'("racket-doc"

2
main.rkt
View File

@@ -2,10 +2,12 @@
(require "private/web-racket.rkt"
"private/web-racket-version.rkt"
"settings/web-racket-ini.rkt"
)
(provide
(all-from-out "private/web-racket.rkt")
(all-from-out "private/web-racket-version.rkt")
(all-from-out "settings/web-racket-ini.rkt")
)

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)

39
settings/web-racket-ini.rkt Normal file
View File

@@ -0,0 +1,39 @@
(module web-racket-ini racket/gui
(require simple-ini/class
"../private/web-racket.rkt"
)
(provide ww-simple-ini%)
(define ww-simple-ini%
(class ww-settings%
(init-field [ini (error "Initialize this ww-simple-ini% with a ini% object of the simple-ini package")]
[section (error "Initialize this ww-simple-ini% with a section to use in the ini")]
)
(super-new)
(define/override (set key value)
(send ini set! section key value)
this
)
(define/override (get key . default)
(let ((d (if (null? default) #f (car default))))
(send ini get section key d)))
(define/override (clone new-section)
(new ww-simple-ini% [ini ini] [section new-section]))
(begin
(unless (is-a? ini ini%)
(error "ini must be of type ini%"))
(unless (symbol? section)
(error "section must be a symbol"))
))
)
) ; end of module