More robust quit/exit/cleanup/finalizing handling

This commit is contained in:
2026-04-20 09:53:28 +02:00
parent 95a5faa49e
commit 69785e923e
4 changed files with 137 additions and 47 deletions

View File

@@ -265,7 +265,8 @@
(send this set-menu! test-menu) (send this set-menu! test-menu)
(send this connect-menu! 'm-quit (λ () (send this connect-menu! 'm-quit (λ ()
(send this reset-counter) (send this reset-counter)
(send this close))) (send this close)
(send this quit)))
(let* ((div-open (send this element 'div-open)) (let* ((div-open (send this element 'div-open))
(c-open 0) (c-open 0)
(div-close (send this element 'div-close)) (div-close (send this element 'div-close))
@@ -321,3 +322,10 @@
) )
) )
window)) window))
(define (run)
(let ((window (run-example)))
(webview-wait-for-quit)
(webview-exit)
(exit)
))

View File

@@ -326,6 +326,10 @@
(define-rktwebview rkt_webview_cleanup (define-rktwebview rkt_webview_cleanup
(_fun -> _void)) (_fun -> _void))
;RKTWEBVIEW_EXPORT void rkt_webview_exit_done(int done);
(define-rktwebview rkt_webview_exit_done
(_fun _int -> _void))
;RKTWEBVIEW_EXPORT void rkt_webview_set_loglevel(rkt_webview_loglevel_t l); ;RKTWEBVIEW_EXPORT void rkt_webview_set_loglevel(rkt_webview_loglevel_t l);
(define-rktwebview rkt_webview_set_loglevel (define-rktwebview rkt_webview_set_loglevel
(_fun _rkt_loglevel_t -> _void)) (_fun _rkt_loglevel_t -> _void))
@@ -578,19 +582,35 @@
) )
(define evt-guard-stop -93273) (define evt-guard-stop -93273)
(define evt-start-polling -93274)
(define event-processing-kind 'sync)
(define (start-event-processing) (define (start-event-processing)
(thread (λ () (thread (λ ()
(let* ((polling #f)
(get-evt (λ ()
(if polling
(begin
(sleep 0.01)
(os-async-channel-try-get events-channel))
(sync events-channel))))
)
(letrec (letrec
((f ((f
(λ () (λ ()
(let ((waiting (sync events-channel))) (let ((waiting (get-evt)))
(if (= waiting evt-guard-stop) (cond
(begin ((= waiting evt-guard-stop)
(info-webview "got evt-guard-stop, exiting event processing") (info-webview "got evt-guard-stop, exiting event processing")
(set! evt-processing-thread #f) (set! evt-processing-thread #f)
evt-guard-stop) evt-guard-stop)
(begin ((= waiting evt-start-polling)
(info-webview "got evt-start-polling, starting to poll instead of waiting on channel")
(set! polling #t)
(set! event-processing-kind 'poll)
(f))
(else
(set! waiting (rkt_webview_events_waiting)) (set! waiting (rkt_webview_events_waiting))
(while (> waiting 0) (while (> waiting 0)
(let* ((rkt-evt (rkt_webview_get_event))) (let* ((rkt-evt (rkt_webview_get_event)))
@@ -604,7 +624,6 @@
_string*/utf-8)) _string*/utf-8))
) )
(rkt_webview_free_data rkt-evt) (rkt_webview_free_data rkt-evt)
;(displayln (format "~a ~a" wv evt))
(if (= wv alive-error-event) (if (= wv alive-error-event)
(close-down-on-alive-error) (close-down-on-alive-error)
(let ((cb (hash-ref evt-cb-hash wv #f))) (let ((cb (hash-ref evt-cb-hash wv #f)))
@@ -617,7 +636,10 @@
) )
) )
)) ))
(f)))) (f))
)
)
)
) )
(define evt-processing-thread (start-event-processing)) (define evt-processing-thread (start-event-processing))
@@ -825,7 +847,12 @@
(define finalizer-executed #f) (define finalizer-executed #f)
(define webview-exit-done #f)
(define (rkt-webview-finalizer rkt-wv-store)
(rkt_webview_exit_done (if (eq? webview-exit-done #f) 0 1)))
#|
(define (rkt-webview-finalizer rkt-wv-store close-windows message) (define (rkt-webview-finalizer rkt-wv-store close-windows message)
(unless finalizer-executed (unless finalizer-executed
(dbg-webview "rkt-webview-finalizer active") (dbg-webview "rkt-webview-finalizer active")
@@ -849,19 +876,55 @@
(set! finalizer-executed #t) (set! finalizer-executed #t)
) )
) )
|#
(define (rkt-webview-exit . args) (define (rkt-webview-exit . args)
(let ((cl-w (if (null? args) #t (car args))) (let ((close-windows (if (null? args) #t (car args)))
(msg (if (null? args) #f (message (if (null? args) #f
(if (null? (cdr args)) (if (null? (cdr args))
#f #f
(cadr args)))) (cadr args))))
) )
(rkt-webview-finalizer rkt-wv-store cl-w msg) (dbg-webview "rkt-webview-exit active")
(unregister-custodian-shutdown rkt-wv-store custodian-finalizer)
; Clear event callback function in C library, i.e. we're now going to
; poll for events.
(dbg-webview "Start event polling instead of using an event callback")
(dbg-webview "To make sure the library does not get stuck on a dangling callback")
(event-callback evt-start-polling)
(rkt_webview_register_evt_callback #f)
(while (eq? event-processing-kind 'sync)
(sleep 0.01))
; When asked to, close all windows
(when close-windows
(dbg-webview "closing all open windows on request")
(let ((open-windows (hash->list rkt-wv-store)))
(for-each (λ (kv)
(let ((win (car kv))
(handle (cdr kv)))
(rkt-webview-close handle)))
open-windows)))
; Stop event processing
(dbg-webview "Stop the event processor")
(event-callback evt-guard-stop)
(dbg-webview "Waiting for thread to stop")
(while (not (eq? evt-processing-thread #f))
(sleep 0.01))
(dbg-webview "Event processing stopped")
; cleanup the library
(dbg-webview "cleanup of the rkt-webview-qt library")
(rkt_webview_cleanup)
; Maybe get in error state
(unless (eq? message #f)
(error message))
) )
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cleanup on exit ;; Cleanup on exit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -874,11 +937,12 @@
|# |#
(define custodian-finalizer (define custodian-finalizer
(register-custodian-shutdown rkt-wv-store (register-custodian-shutdown rkt-wv-store rkt-webview-finalizer
(λ (rkt-wv-store) #:at-exit? #t))
(rkt-webview-finalizer rkt-wv-store #t #f)) ; (λ (rkt-wv-store)
#:at-exit? #t) ; (rkt-webview-finalizer rkt-wv-store #t #f))
) ; #:at-exit? #t)
; )

View File

@@ -123,6 +123,8 @@
webview-set-loglevel webview-set-loglevel
webview-wait-for-quit
webview-quit
webview-exit webview-exit
;test ;test
@@ -1017,6 +1019,18 @@
(define (webview-info) (define (webview-info)
(rkt-webview-info)) (rkt-webview-info))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Quitting and waiting
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define webview-quit-sem (make-semaphore))
(define (webview-wait-for-quit)
(semaphore-wait webview-quit-sem))
(define (webview-quit)
(semaphore-post webview-quit-sem))
(define (webview-exit) (define (webview-exit)
(rkt-webview-exit)) (rkt-webview-exit))

View File

@@ -313,6 +313,10 @@
(webview-close wv) (webview-close wv)
this) this)
(define/public (quit)
(webview-quit)
this)
(define/public (run-js js) (define/public (run-js js)
(webview-run-js wv js)) (webview-run-js wv js))