Better logging small bug in wv-dialog, conversion to stdio.

This commit is contained in:
2026-08-03 13:44:01 +02:00
parent 1ecb678e38
commit dbf108a601
8 changed files with 78 additions and 19 deletions
+7
View File
@@ -20,3 +20,10 @@ built backend executable during development.
QtWebEngine select popup rendering issues were observed with older Qt 6.x. The
native HTML `<select>` popup could keep growing or repainting while open while
the QtWebEngine process remained busy. Upgrading to Qt 6.11.1 resolved this.
### Qt backend logging
Structured stderr records from `rktwebview_prg` are logged through `simple-log`
under the separate topic `webview-backend`. Ordinary Racket-side messages keep
the topic `webview`. Unstructured stderr lines are accepted and logged at debug
level under `webview-backend`.
+3 -2
View File
@@ -310,7 +310,8 @@
(webview-set-loglevel 'debug)
(define log-file (build-path (find-system-path 'temp-dir) "example1.log"))
(displayln (format "logging to ~a" log-file))
(sl-log-to-file log-file)
;(sl-log-to-file log-file)
(define store (sl-log-to-store 10000))
(define (run-example)
(let* ((ini (new ini% [file 'web-racket-example1]))
@@ -327,5 +328,5 @@
(let ((window (run-example)))
(webview-wait-for-quit)
(webview-exit)
(exit)
;(exit)
))
+8
View File
@@ -41,10 +41,18 @@
fatal-webview
sync-log-webview
dbg-webview-backend
err-webview-backend
info-webview-backend
warn-webview-backend
fatal-webview-backend
sync-log-webview-backend
)
(sl-def-log webview)
(sl-def-log webview-backend)
(define-syntax while
(syntax-rules ()
+45 -5
View File
@@ -448,18 +448,58 @@
(dispatch-protocol-message message)
(loop)))))))))
(define (log-backend-message level message [elapsed #f])
(define formatted
(if (number? elapsed)
(format "~a: ~a" elapsed message)
message))
(case level
((error err)
(err-webview-backend "~a" formatted))
((warning warn)
(warn-webview-backend "~a" formatted))
((info)
(info-webview-backend "~a" formatted))
(else
(dbg-webview-backend "~a" formatted))))
(define (log-structured-backend-line line)
(with-handlers
((exn:fail?
(lambda (exception)
(warn-webview-backend
"Invalid structured backend log: ~a; line: ~a"
(exn-message exception)
line))))
(define entry (string->jsexpr (substring line 5)))
(unless (hash? entry)
(error 'log-structured-backend-line "JSON object expected"))
(define level-value (hash-ref entry 'level "debug"))
(define level
(cond
((symbol? level-value) level-value)
((string? level-value) (string->symbol (string-downcase level-value)))
(else 'debug)))
(define message (hash-ref entry 'message ""))
(define elapsed (hash-ref entry 'elapsed #f))
(log-backend-message level (format "~a" message) elapsed)))
(define (log-backend-line line)
(cond
((string-prefix? line "json:")
(log-structured-backend-line line))
((regexp-match? #rx"^ERROR[ ]*:" line)
(err-webview "qt: ~a" line))
(err-webview-backend "~a" line))
((regexp-match? #rx"^WARNING[ ]*:" line)
(warn-webview "qt: ~a" line))
(warn-webview-backend "~a" line))
((regexp-match? #rx"^INFO[ ]*:" line)
(info-webview "qt: ~a" line))
(info-webview-backend "~a" line))
((regexp-match? #rx"^DEBUG[ ]*:" line)
(dbg-webview "qt: ~a" line))
(dbg-webview-backend "~a" line))
(else
(dbg-webview "qt: ~a" line))))
;; Libraries used by Qt may occasionally write unstructured text to
;; stderr. Keep it visible without confusing it with protocol output.
(dbg-webview-backend "~a" line))))
(define (start-error-forwarder!)
(set!
+4 -4
View File
@@ -1042,7 +1042,7 @@
(return (list (list 'id id)
(list 'style (send Object entries r))))))))
)
(displayln js-code)
;(displayln js-code)
(let ((r (webview-call-js wv js-code)))
; (format
; (js-code
@@ -1056,7 +1056,7 @@
; " return { id: id, style: r };"
; "}") cl))
; )))
(display "Result: ") (write r) (newline)
; (display "Result: ") (write r) (newline)
(if (eq? r #f)
#f
(let ((h (hash-ref r 'with-ids)))
@@ -1067,8 +1067,8 @@
(make-hash (map (λ (e) (cons (to-symbol (car e)) (cadr e))) (cadr style-rec)))
)
)) h)))
(displayln (format "l = ~a" l))
(write l)(newline)
;(displayln (format "l = ~a" l))
;(write l)(newline)
; l = ((volume-meter . #hash((display . none))))
; ((volume-meter . #hash(("display" . "none"))))
(if (symbol? selector)
+7 -5
View File
@@ -16,7 +16,7 @@
Dialog-window wrapper built on top of @racket[wv-window%].
This module exports the @racket[wv-dialog%] class. It is a specialized window
class whose initial size and position are derived from its parent window.
class whose initial size and position are derived from its parent window. Closing a dialog does not quit the application by default.
@section{Overview}
@@ -25,7 +25,7 @@ a dialog relative to its parent window.
The class inherits the window lifecycle, event handling, navigation, and dialog
support from @racket[wv-window%]. Its only specialization in the current source
is the implementation of @racket[init-size].
is the implementation of @racket[init-size]. A dialog also changes the inherited @racket[quit-on-close] default to @racket[#f].
@section{Class: wv-dialog%}
@@ -37,12 +37,14 @@ The class inherits the fields @racket[parent], @racket[settings],
@racket[wv-context], @racket[html-path], @racket[x], @racket[y],
@racket[width], and @racket[height] from @racket[wv-window%].
@defconstructor[()]{
@defconstructor[([quit-on-close any/c #f])]{
Creates a dialog window.
The constructor does not define additional initialization arguments of its own.
Construction is delegated to @racket[wv-window%] through @racket[super-new].
The inherited @racket[quit-on-close] initialization argument defaults to
@racket[#f] for dialogs. Closing a dialog therefore closes only that dialog and
does not release @racket[webview-wait-for-quit]. Pass @racket[#t] explicitly
only when closing this dialog should terminate the application.
}
@defmethod[(init-size) any/c]{
+2 -1
View File
@@ -14,9 +14,10 @@
(define wv-dialog%
(class wv-window%
(init [quit-on-close #f])
(inherit-field parent settings wv-context html-path x y width height)
(super-new)
(super-new [quit-on-close quit-on-close])
(define/override (init-size)
(dbg-webview "init-size")
+2 -2
View File
@@ -53,11 +53,11 @@
(let ((d* (string->symbol (format "~a" (car d)))))
(webview-set-style! wv element-id (list 'display d*))))
(let ((style-hash (webview-get-style wv element-id 'display)))
(displ "style-hash: ") (write style-hash) (newline)
;(displ "style-hash: ") (write style-hash) (newline)
(let ((display-style (hash-ref (if (eq? style-hash #f)
(make-hash)
style-hash) 'display #f)))
(displayln display-style)
;(displayln display-style)
(if (eq? display-style #f)
#f
(string->symbol display-style)))))