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

ok

Browse Source
This commit is contained in:
Hans Dijkema
2025-08-25 14:39:11 +02:00
parent 5f8bf415ff
commit 74295f7d7e
2 changed files with 30 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
private/web-racket.rkt
View File

@@ -19,9 +19,9 @@
(all-from-out "css.rkt") (all-from-out "css.rkt")
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Regexes ;; Regexes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define re-resize #px"([0-9]+)\\s+([0-9]+)") (define re-resize #px"([0-9]+)\\s+([0-9]+)")
(define re-move re-resize) (define re-move re-resize)

31
private/web-wire.rkt
View File

@@ -15,6 +15,7 @@
(provide ww-start (provide ww-start
ww-stop ww-stop
ww-set-web-wire-location!
ww-set-debug ww-set-debug
ww-debug ww-debug
@@ -80,6 +81,11 @@
) )
(define current-win-release "https://github.com/hdijkema/web-wire/releases/download/0.1/web-wire-0.1-win64.zip") (define current-win-release "https://github.com/hdijkema/web-wire/releases/download/0.1/web-wire-0.1-win64.zip")
(define user-web-wire-location #f)
(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) (define (os)
(format "~a-~a" (system-type) (system-type 'word))) (format "~a-~a" (system-type) (system-type 'word)))
@@ -90,9 +96,22 @@
"web-wire")) "web-wire"))
(define (web-wire-dir) (define (web-wire-dir)
(let* ((cache-dir (find-system-path 'cache-dir)) (if (eq? user-web-wire-location #f)
(os-dir (build-path cache-dir (os)))) (let* ((cache-dir (find-system-path 'cache-dir))
os-dir)) (os-dir (build-path cache-dir (os)))
(web-wire-prg (build-path os-dir (web-wire-exe)))
)
(unless (file-exists? web-wire-prg)
(error "Web wire executable not found: '~a'" web-wire-prg))
os-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)
(build-path (web-wire-dir) (web-wire-exe)))
(define (do-download-and-extract release version os-dir) (define (do-download-and-extract release version os-dir)
(let* ((url (string->url release)) (let* ((url (string->url release))
@@ -150,6 +169,7 @@
(write-to-file version version-file) (write-to-file version version-file)
)) ))
)))) ))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some utils ;; Some utils
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -380,7 +400,7 @@
;; Start the web-wire process for errors and events in an other thread ;; Start the web-wire process for errors and events in an other thread
(let ((cwd (current-directory))) (let ((cwd (current-directory)))
(current-directory (web-wire-dir)) (current-directory (web-wire-dir))
(let ((ports (process (web-wire-exe)))) (let ((ports (process (format "~a" (web-wire-prg)))))
(current-directory cwd) (current-directory cwd)
(let ((from-ww (car ports)) (let ((from-ww (car ports))
(to-ww (cadr ports)) (to-ww (cadr ports))
@@ -393,6 +413,9 @@
(set! ww-from-ww from-ww) (set! ww-from-ww from-ww)
(set! ww-quit #f) (set! ww-quit #f)
(when (eq? from-ww #f)
(error (format "Process web wire did not start correctly: ~a" (web-wire-prg))))
(parameterize ([current-eventspace (current-eventspace)]) (parameterize ([current-eventspace (current-eventspace)])
(set! ww-err-thread (set! ww-err-thread
(thread (lambda () (web-wire-err-handler err-from-ww)))) (thread (lambda () (web-wire-err-handler err-from-ww))))