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

Add HTML examples.

Browse Source 
Merge branch 'main' of https://github.com/hdijkema/web-racket

# Conflicts:
#	private/webui-wire-download.rkt

Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>
This commit is contained in:
Hans Dijkema
2025-11-12 15:35:03 +01:00
parent 7492defaab
commit 51c8ef5aa1
8 changed files with 451 additions and 204 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
example1/example-1.html Normal file
View File

@@ -0,0 +1,67 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>This is Example 1</title>
<script>
window.setInterval(function() {
let el = document.getElementById('pos');
el.innerHTML = window.screenX + ", " + window.screenY;
}, 250);
</script>
</head>
<body>
<h1>This is Example 1</h1>
<p><span id="pos">screen coöords</span></p>
<h2>Opening a link to some website</h2>
<p>
<ul>
<li><a href="https://wikipedia.org">To Wikipedia</a></li>
</ul>
</p>
<h2>Opening a second page</h2>
<div class="buttons">
<button class="btn-1" onclick="window.location.href='example-second.html';">Open the second page using javascript</button>
<button class="btn-2"><a href="example-second.html" id="click-url" style="color:green;">Open the second page uring url</a></button>
</div>
<h2>And some other buttons</h2>
<div class="buttons">
<button class="btn-2" id="dialog-button">Open a dialog</button>
<button class="btn-1" id="select-dir-button">Select a directory</button>
</div>
<h2>Menu responses</h2>
<table>
<tr>
<td colspan="3" class="counter" id="div-counter">counter = 0</td>
</tr>
<tr>
<td id="div-open">Open</td>
<td id="div-close">Close</td>
<td></td>
</tr>
<tr>
<td id="div-copy">Copy</td>
<td id="div-cut">Cut</td>
<td id="div-paste">Paste</td>
</tr>
</table>
<h2>Some inputs</h2>
<div style="margin:0.5em; border: 1px solid #909090; padding: 5px;" id="my-id">
<p>This is <span id="spanner">replacable</span> text</p>
<input type="text" id="input-name" name="input-name" value="a" /><br>
<input type="text" id="inp2" value="i2" />
<input type="date" id="date-input" /><br>
<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>

122
example1/example.rkt
View File

@@ -1,7 +1,27 @@
#lang racket/gui #lang racket/gui
(require "../main.rkt"
racket/runtime-path
racket/gui
)
(define m (menu (menu-item 'm-file "File" (provide
(all-from-out racket/gui)
example-1-window%
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-runtime-path html-start "example-1.html")
(define-runtime-path dialog-html "example-1-dialog.html")
(displayln html-start)
(displayln dialog-html)
(define test-menu (menu (menu-item 'm-file "File"
#:submenu #:submenu
(menu (menu-item 'm-open "Open File") (menu (menu-item 'm-open "Open File")
(menu-item 'm-close "Close File") (menu-item 'm-close "Close File")
@@ -12,4 +32,102 @@
(menu-item 'm-cut "Cut") (menu-item 'm-cut "Cut")
(menu-item 'm-paste "Paste") (menu-item 'm-paste "Paste")
(menu-item 'm-prefs "Preferences" #:separator #t) (menu-item 'm-prefs "Preferences" #:separator #t)
)))) ))
(menu-item 'm-auto "Processes"
#:submenu
(menu (menu-item 'm-start "Start counter")
(menu-item 'm-stop "Stop counter")
))
))
(define test-dialog%
(class ww-webview%
(super-new [html-file dialog-html]
[width 400]
[height 300])
(define/override (html-loaded)
(super html-loaded)
(ww-debug "html-loaded for test-dialog%")
(let* ((btn (send this element 'ok-btn)))
(send btn connect 'click (λ (data)
(send this close)))))
))
(define-syntax inc
(syntax-rules ()
((_ var)
(λ ()
(set! var (+ var 1))
var))))
(define example-1-window%
(class ww-webview%
(super-new [html-file (begin (displayln html-start) html-start)])
(define/override (html-loaded)
(ww-debug "HTML LOADED")
(super html-loaded)
(ww-debug "CONNECTING BUTTONS")
(let* ((dialog-btn (send this element 'app-button))
)
(send dialog-btn connect 'click (λ (data)
(new test-dialog% [parent this])))
)
(ww-debug "SETTING MENU")
(let* ((div-open (send this element 'div-open))
(c-open 0)
(div-close (send this element 'div-close))
(c-close 0)
(div-copy (send this element 'div-copy))
(c-copy 0)
(div-cut (send this element 'div-cut))
(c-cut 0)
(div-paste (send this element 'div-paste))
(c-paste 0)
(div-counter (send this element 'div-counter))
(go-on-counter #f)
(c-counter 0)
(counter-thread #f)
)
(send this set-menu! test-menu)
(send this connect-menu! 'm-quit (λ () (send this close)))
(let ((make-menu-executor (λ (item elem string count)
(send this connect-menu! item
(λ ()
(send elem set-inner-html (format "~a ~a" string (count)))))))
)
(make-menu-executor 'm-open div-open "Open file" (inc c-open))
(make-menu-executor 'm-close div-close "Close file" (inc c-close))
(make-menu-executor 'm-copy div-copy "Edit Copy" (inc c-copy))
(make-menu-executor 'm-cut div-cut "Edit Cut" (inc c-cut))
(make-menu-executor 'm-paste div-paste "Edit Paste" (inc c-paste))
(send this connect-menu! 'm-start
(λ ()
(set! counter-thread
(thread (λ ()
(letrec ((f (λ ()
(when go-on-counter
(set! c-counter (+ c-counter 1))
(send div-counter set-inner-html (format "Count = ~a" c-counter))
(sleep 0.01)
(f)))))
(set! go-on-counter #t)
(f)))))))
(send this connect-menu! 'm-stop
(λ ()
(set! go-on-counter #f)))
)
)
)
(begin
(displayln html-start)
)
)
)

11
main.rkt
View File

@@ -1,4 +1,11 @@
#lang racket/base #lang racket/base
(require "private/web-wire.rkt") (require "private/web-racket.rkt"
(provide (all-from-out "private/web-wire.rkt")) "private/web-racket-version.rkt"
)
(provide
(all-from-out "private/web-racket.rkt")
(all-from-out "private/web-racket-version.rkt")
)

16
private/web-racket-version.rkt
View File

@@ -6,10 +6,10 @@
ww-version-major ww-version-major
ww-version-minor ww-version-minor
ww-version-patch ww-version-patch
ww-ffi-version ww-wire-version
ww-ffi-version-major ww-wire-version-major
ww-ffi-version-minor ww-wire-version-minor
ww-ffi-version-patch ww-wire-version-patch
) )
@@ -36,10 +36,10 @@
;; Web Wire FFI Version ;; Web Wire FFI Version
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ww-ffi-version-major 0) (define ww-wire-version-major 0)
(define ww-ffi-version-minor 2) (define ww-wire-version-minor 2)
(define ww-ffi-version-patch 1) (define ww-wire-version-patch 8)
(define ww-ffi-version (mk-version ww-ffi-version-major ww-ffi-version-minor ww-ffi-version-patch)) (define ww-wire-version (mk-version ww-wire-version-major ww-wire-version-minor ww-wire-version-patch))
) )

97
private/web-racket.rkt
View File

@@ -5,16 +5,18 @@
"css.rkt" "css.rkt"
"menu.rkt" "menu.rkt"
"../utils/sprintf.rkt" "../utils/sprintf.rkt"
"webui-wire-download.rkt"
html-printer html-printer
(prefix-in g: gregor) (prefix-in g: gregor)
(prefix-in g: gregor/time) (prefix-in g: gregor/time)
gregor-utils gregor-utils
net/sendurl net/sendurl
racket/path
) )
(provide ww-element% (provide ww-element%
ww-input% ww-input%
ww-window% ww-webview%
ww-start ww-start
ww-stop ww-stop
@@ -23,6 +25,11 @@
ww-error ww-error
(all-from-out "css.rkt") (all-from-out "css.rkt")
(all-from-out "menu.rkt")
ww-set-custom-webui-wire-command!
ww-display-log
ww-tail-log
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -232,7 +239,6 @@
)) ))
;;;; Time input ;;;; Time input
(define ww-input-time% (define ww-input-time%
(class ww-input% (class ww-input%
@@ -283,7 +289,12 @@
(super-new) (super-new)
)) ))
(define ww-window%
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Classes representing WebView Windows.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ww-webview%
(class object% (class object%
(init-field [profile 'default-profile] (init-field [profile 'default-profile]
@@ -455,11 +466,19 @@
(ww-set-icon win-id icn)) (ww-set-icon win-id icn))
(define/public (set-html-file! file) (define/public (set-html-file! file)
(ww-debug (format "set-html-file! ~a" file)) (let* ((full-path (if (string? file)
(set! html-file file) (string->path file)
(set! html-handle (ww-set-html win-id html-file)) file))
(ww-debug (format "html file set to ~a" html-file)) (folder (path-only full-path))
(the-file (file-name-from-path full-path))
) )
(ww-debug (format "set-html-file! ~a, ~a" folder the-file))
(set! html-file file)
(when folder
(ww-cwd folder))
(set! html-handle (ww-set-html win-id the-file))
(ww-debug (format "html file set to ~a" the-file))
))
(define/public (set-url url) (define/public (set-url url)
(send-url url)) (send-url url))
@@ -578,9 +597,20 @@
(hash-set! windows-evt-handlers (ww-win-id win-id) event-handler) (hash-set! windows-evt-handlers (ww-win-id win-id) event-handler)
(hash-set! windows (ww-win-id win-id) this) (hash-set! windows (ww-win-id win-id) this)
(ww-move win-id x y)
(ww-resize win-id width height) (ww-resize win-id width height)
(when parent
(let* ((parent-width (send parent get-width))
(parent-height (send parent get-height))
(parent-x (send parent get-x))
(parent-y (send parent get-y))
)
(set! x (+ parent-x (/ (- parent-width width) 2)))
(set! y (+ parent-y (/ (- parent-height height) 2)))
)
)
(ww-move win-id x y)
(send this set-title! title) (send this set-title! title)
(unless (eq? icon #f) (unless (eq? icon #f)
@@ -603,55 +633,4 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Testing stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define test-menu (menu (menu-item 'm-file "File"
#:submenu
(menu (menu-item 'm-open "Open File")
(menu-item 'm-close "Close File")
(menu-item 'm-quit "Quit" #:separator #t)))
(menu-item 'm-edit "Edit"
#:submenu
(menu (menu-item 'm-copy "Copy")
(menu-item 'm-cut "Cut")
(menu-item 'm-paste "Paste")
(menu-item 'm-prefs "Preferences" #:separator #t)
))))
(define test-dialog%
(class ww-window%
(super-new [html-file "../../web-wire/test/dialog.html"]
[width 400]
[height 300])
(define/override (html-loaded)
(super html-loaded)
(ww-debug "html-loaded for test-dialog%")
(let* ((btn (send this element 'ok-btn)))
(send btn connect 'click (λ (data)
(send this close)))))
))
(define test-window%
(class ww-window%
(super-new [html-file "../../web-wire/test/test1.html"])
(define/override (html-loaded)
(ww-debug "HTML LOADED")
(super html-loaded)
(let* ((btn (send this element 'app-button)))
(send btn connect 'click (λ (data)
(new test-dialog% [parent this]))))
(ww-debug "SETTING MENU")
(send this set-menu! test-menu)
(send this connect-menu! 'm-quit (λ () (send this close)))
)
(begin
)
)
)
); end of module ); end of module

56
private/web-wire.rkt
View File

@@ -26,6 +26,8 @@
ww-cmd ww-cmd
ww-cmd-nok? ww-cmd-nok?
ww-cwd
ww-protocol ww-protocol
ww-log-level ww-log-level
ww-set-stylesheet ww-set-stylesheet
@@ -104,11 +106,20 @@
(string-replace s* "\\\"" "\""))) (string-replace s* "\\\"" "\"")))
(define (to-server-file html-file) (define (to-server-file html-file)
(let* ((path (build-path html-file)) (let ((to-file (λ (p) (string-replace (format "~a" p) "\\" "/")))
(complete-p (path->complete-path path)) (file-path (build-path (format "~a" html-file))))
(a-file (format "~a" complete-p)) (if (absolute-path? file-path)
(the-file (string-replace a-file "\\" "/"))) (to-file file-path)
the-file)) (let* ((cwd (ww-cwd))
(full-file (build-path cwd (format "~a" html-file))))
(if (file-exists? full-file)
(to-file html-file)
(to-file (path->complete-path (build-path html-file)))
)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; web-wire handling (interaction with the library) ;; web-wire handling (interaction with the library)
@@ -218,6 +229,8 @@
) )
) )
(define evt-hdlr 0)
(define (event-handler h) (define (event-handler h)
(parameterize ([current-eventspace (current-eventspace)]) (parameterize ([current-eventspace (current-eventspace)])
(thread (thread
@@ -225,10 +238,17 @@
(letrec ((f (lambda () (letrec ((f (lambda ()
(semaphore-wait evt-sem) (semaphore-wait evt-sem)
(queue-callback (queue-callback
(lambda () (process-event h (dequeue! evt-fifo)))) (lambda ()
(letrec ((queue-loop (λ ()
(when (> (queue-length evt-fifo) 0)
(process-event h (dequeue! evt-fifo))
(queue-loop)))))
(queue-loop))))
(f)))) (f))))
(f)))))) (f)))
)
)
)
(define (ensure-fifo) (define (ensure-fifo)
(if (> (queue-length log-fifo) log-fifo-max) (if (> (queue-length log-fifo) log-fifo-max)
@@ -314,6 +334,9 @@
(define (ww-start* type args) (define (ww-start* type args)
(when (eq? ww-current-handle #f) (when (eq? ww-current-handle #f)
(set! evt-sem (make-semaphore))
(set! evt-fifo (make-queue))
(set! log-fifo (make-queue))
(let ((h (make-web-rkt (if (eq? type 'ipc) (let ((h (make-web-rkt (if (eq? type 'ipc)
(webui-ipc event-queuer-ipc process-log-ipc) (webui-ipc event-queuer-ipc process-log-ipc)
(error "ffi integration not implemented")) (error "ffi integration not implemented"))
@@ -451,7 +474,15 @@
r))) r)))
(define (html-file-exists? f) (define (html-file-exists? f)
(file-exists? f)) (if (file-exists? f)
#t
(let* ((cwd (ww-cwd))
(full-file (build-path cwd f)))
(ww-debug (format "file-exists? '~a'" full-file))
(file-exists? full-file)
)
)
)
(define (html-or-file? v) (define (html-or-file? v)
(if (file-exists? v) (if (file-exists? v)
@@ -515,15 +546,15 @@
((eq? type 'ww-win) (make-ww-win (string->number str))) ((eq? type 'ww-win) (make-ww-win (string->number str)))
((eq? type 'void) 'void) ((eq? type 'void) 'void)
((eq? type 'css-style) (string->css-style str)) ((eq? type 'css-style) (string->css-style str))
((eq? type 'path) (string->path str)) ((eq? type 'path) (string->path (substring (substring str 0 (- (string-length str) 1)) 1)))
(else str))) (else str)))
(define (check-cmd-type v vname type typename) (define (check-cmd-type v vname type typename)
(let ((is-type (type v))) (let ((is-type (type v)))
(unless is-type (unless is-type
(error (error
(format "Expected ~a of type ~a" (format "Expected ~a of type ~a, got '~a'"
vname typename))) vname typename v)))
#t)) #t))
(define (convert-arg-to-cmd v vname type) (define (convert-arg-to-cmd v vname type)
@@ -793,6 +824,7 @@
;; Set inner html of an Id of the HTML in the window ;; Set inner html of an Id of the HTML in the window
(def-cmd ww-set-inner-html (def-cmd ww-set-inner-html
set-inner-html ((win-id ww-win?) set-inner-html ((win-id ww-win?)
(element-id symbol-or-string?)
(html-of-file html-or-file?)) () -> void) (html-of-file html-or-file?)) () -> void)

195
private/webui-wire-download.rkt
View File

@@ -5,65 +5,112 @@
net/url net/url
file/unzip file/unzip
racket/file racket/file
"web-racket-version.rkt"
racket/system
)
(provide ww-set-custom-webui-wire-command!
ww-get-webui-wire-command
) )
(provide ww-current-win-release (define (ww-get-webui-wire-command)
ww-download-if-needed (unless (webui-wire-exists?)
ww-set-web-wire-location! (error "webui-wire needs to be installed in order to use web-racket"))
ww-webui-wire (get-webui-wire-cmd))
)
;(define (current-release os) (define user-webui-wire-command #f)
(define (ww-webui-wire) (define (ww-set-custom-webui-wire-command! cmd)
(list "C:/devel/racket/webui-wire/build/Release/webui-wire.exe") (set! user-webui-wire-command cmd)
;(list "/home/hans/src/racket/webui-wire/build/Release/webui-wire") user-webui-wire-command)
;(list "/usr/bin/flatpak" "run" "nl.dijkewijk.webui-wire")
;(list "/Users/hans/src/webui-wire/build/Release/webui-wire")
)
(define ww-current-win-release "https://github.com/hdijkema/web-wire/releases/download/0.1/web-wire-0.1-win64.zip") (define (get-webui-wire-cmd)
(if (eq? user-webui-wire-command #f)
(let ((os (system-type 'os*)))
(if (eq? os 'linux)
"flatpak run nl.dijkewijk.webui-wire"
(format "~a"
(build-path (webui-wire-dir) (if (eq? os 'windows)
"webui-wire.exe"
"webui-wire")))))
user-webui-wire-command))
(define user-web-wire-location #f) (define (webui-wire-dir)
(define (ww-set-web-wire-location! path-or-dir)
(set! user-web-wire-location (build-path path-or-dir))
user-web-wire-location)
(define (os)
(format "~a-~a" (system-type) (system-type 'word)))
(define (web-wire-exe)
(if (eq? (system-type) 'windows)
"web-wire.exe"
"web-wire"))
(define (web-wire-dir)
(if (eq? user-web-wire-location #f)
(let* ((cache-dir (find-system-path 'cache-dir)) (let* ((cache-dir (find-system-path 'cache-dir))
(os-dir (build-path cache-dir (os))) (ww-dir (build-path cache-dir "webui-wire"))
(web-wire-prg (build-path os-dir (web-wire-exe)))
) )
(unless (file-exists? web-wire-prg) (unless (directory-exists? ww-dir)
(error "Web wire executable not found: '~a'" web-wire-prg)) (make-directory ww-dir))
os-dir) ww-dir))
(let ((web-wire-prg (build-path user-web-wire-location (web-wire-exe))))
(unless (file-exists? web-wire-prg)
(error "Web wire executable not found: '~a'" web-wire-prg))
user-web-wire-location)
))
(define (web-wire-prg) (define (flatpak-ok? str)
(build-path (web-wire-dir) (web-wire-exe))) (let* ((re #px"([0-9]+)[.]([0-9]+)[.]([0-9]+)$")
(m (regexp-match re str))
(v (if (eq? m #f)
0
(let ((l (map string->number (cdr m))))
(+ (* (car l) 10000) (* (cadr l) 100) (caddr l))))))
(>= 11000)))
(define (do-download-and-extract release version os-dir)
(let* ((url (string->url release)) (define (webui-wire-exists?)
(let ((os (system-type 'os*)))
(if (eq? os 'linux)
(webui-wire-exists-linux?)
(error "Currently not implemented for other systems than Linux")
)
)
)
(define (webui-wire-exists-linux?)
(let ((flatpak (call-with-values (lambda () (process "flatpak --version"))
(lambda (args)
(let ((out (car args)))
(read-line out))))))
(unless (string? flatpak)
(error "Please install flatpak to use web-racket"))
(unless (flatpak-ok? flatpak)
(error (format "Not the right flatpak version installed: ~a" flatpak)))
(let ((webui-wire (call-with-values (lambda () (process "flatpak list --user | grep webui-wire"))
(lambda (args)
(let ((out (car args)))
(read-line out))))))
(if (string? webui-wire)
(let ((webui-wire-version (call-with-values (lambda () (process "flatpak run nl.dijkewijk.webui-wire --version"))
(lambda (args)
(let ((out (car args))
(in (cadr args)))
(displayln "exit" in)
(flush-output in)
(read-line out))))))
(if (string=? webui-wire-version ww-wire-version)
#t
(begin
(system "flatpak uninstall --user --noninteractive --assumeyes nl.dijkewijk.webui-wire")
(download-webui-wire-linux)))
)
(download-webui-wire-linux)))
)
)
(define (download-webui-wire-linux)
(let* ((download-link (current-webui-wire-link))
(filepath (do-download download-link "webui-wire.flatpak")))
(system (format "flatpak install --user --assumeyes --noninteractive \"~a\"" filepath))
#t
)
)
(define (do-download link filename)
(let* ((url (string->url link))
(port-in (get-pure-port url #:redirections 10)) (port-in (get-pure-port url #:redirections 10))
(release-file (build-path os-dir "release.zip")) (filepath (build-path (webui-wire-dir) filename))
(port-out (open-output-file release-file #:exists 'replace)) (port-out (open-output-file filepath #:exists 'replace))
) )
(letrec ((f (lambda (count next-c len) (letrec ((downloader-func (λ (count next-c len)
(let ((bytes (read-bytes 16384 port-in))) (let ((bytes (read-bytes 16384 port-in)))
(if (eof-object? bytes) (if (eof-object? bytes)
count count
@@ -75,42 +122,34 @@
(set! next-c (+ count len))) (set! next-c (+ count len)))
(write-bytes bytes port-out) (write-bytes bytes port-out)
) )
(f count next-c len))))) (downloader-func count next-c len)))))
)) ))
(display "Downloading web-wire...") (display (format "Downloading webui-wire (~a)..." link))
(let ((count (f 0 0 10000000))) (let ((count (downloader-func 0 0 10000)))
(displayln (format "~a downloaded" count))) (displayln (format "~a downloaded" count)))
(close-input-port port-in) (close-input-port port-in)
(close-output-port port-out) (close-output-port port-out)
(display "Unzipping...") filepath)))
(unzip release-file
(make-filesystem-entry-reader #:dest os-dir
#:strip-count 1
#:exists 'replace)
)
(display "removing zip file...")
(delete-file release-file)
(displayln "done")
)))
(define (ww-download-if-needed release) (define (current-webui-wire-link)
(let* ((os-dir (web-wire-dir)) (let* ((os (system-type 'os*))
(re #px"web[-]wire[-]([0-9.]+)[-]") (arch (system-type 'arch))
) )
(unless (directory-exists? os-dir) (when (eq? os #f)
(make-directory* os-dir)) (error "Operating system not automatically supported by webui-wire, you can compile it yourself and use 'ww-set-custom-webui-wire-command!'"))
(let ((m (regexp-match re release))) (let ((os-str (symbol->string os))
(unless (eq? m #f) (arch-str (symbol->string arch))
(let* ((version-file (build-path os-dir "version")) (ext (if (eq? os 'linux)
(version (cadr m)) ".flatpak"
(has-version #f)) (if (eq? os 'win64)
(when (file-exists? version-file) ".exe"
(let ((file-version (file->value version-file))) ""))))
(when (string=? file-version version) (string-append "https://github.com/hdijkema/webui-wire/releases/download/v"
(set! has-version #t)))) ww-wire-version "/webui-wire-v" ww-wire-version
(unless has-version "-" os-str "-" arch-str ext)
(do-download-and-extract release version os-dir) )
(write-to-file version version-file) )
)) )
))))
) )

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

@@ -2,6 +2,7 @@
(require "webui-wire-download.rkt" (require "webui-wire-download.rkt"
racket/string racket/string
racket/system
) )
(provide webui-ipc) (provide webui-ipc)
@@ -61,12 +62,16 @@
) )
(define (webui-ipc event-queuer log-processor) (define (webui-ipc event-queuer log-processor)
(let* ((webui-wire-exe (ww-webui-wire)) (let ((webui-wire-cmd (ww-get-webui-wire-command)))
(proc-args (append (list #f #f #f) webui-wire-exe))
)
(call-with-values (call-with-values
(λ () (apply subprocess proc-args)) (λ () (process webui-wire-cmd))
(λ (pid process-stdout process-stdin process-stderr) (λ (args)
(let ((process-stdout (car args))
(process-stdin (cadr args))
(pid (caddr args))
(process-stderr (cadddr args))
(signal-func (car (cddddr args)))
)
(let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor))) (let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor)))
(λ (cmd) (λ (cmd)
(displayln cmd process-stdin) (displayln cmd process-stdin)
@@ -82,7 +87,7 @@
) )
(read-eol process-stdout) (read-eol process-stdout)
input))))) input)))))
)) )))
) )