More robust quit/exit/cleanup/finalizing handling
This commit is contained in:
@@ -265,7 +265,8 @@
|
||||
(send this set-menu! test-menu)
|
||||
(send this connect-menu! 'm-quit (λ ()
|
||||
(send this reset-counter)
|
||||
(send this close)))
|
||||
(send this close)
|
||||
(send this quit)))
|
||||
(let* ((div-open (send this element 'div-open))
|
||||
(c-open 0)
|
||||
(div-close (send this element 'div-close))
|
||||
@@ -321,3 +322,10 @@
|
||||
)
|
||||
)
|
||||
window))
|
||||
|
||||
(define (run)
|
||||
(let ((window (run-example)))
|
||||
(webview-wait-for-quit)
|
||||
(webview-exit)
|
||||
(exit)
|
||||
))
|
||||
|
||||
@@ -326,6 +326,10 @@
|
||||
(define-rktwebview rkt_webview_cleanup
|
||||
(_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);
|
||||
(define-rktwebview rkt_webview_set_loglevel
|
||||
(_fun _rkt_loglevel_t -> _void))
|
||||
@@ -578,46 +582,64 @@
|
||||
)
|
||||
|
||||
(define evt-guard-stop -93273)
|
||||
(define evt-start-polling -93274)
|
||||
|
||||
(define event-processing-kind 'sync)
|
||||
|
||||
(define (start-event-processing)
|
||||
(thread (λ ()
|
||||
(letrec
|
||||
((f
|
||||
(λ ()
|
||||
(let ((waiting (sync events-channel)))
|
||||
(if (= waiting evt-guard-stop)
|
||||
(begin
|
||||
(info-webview "got evt-guard-stop, exiting event processing")
|
||||
(set! evt-processing-thread #f)
|
||||
evt-guard-stop)
|
||||
(begin
|
||||
(set! waiting (rkt_webview_events_waiting))
|
||||
(while (> waiting 0)
|
||||
(let* ((rkt-evt (rkt_webview_get_event)))
|
||||
(if (eq? rkt-evt #f)
|
||||
(err-webview (format "Unexpected: event = nullptr"))
|
||||
(let* ((data (rkt_data_t-data rkt-evt))
|
||||
(e (union-ref data 1))
|
||||
(wv (rkt_evt_t-w e))
|
||||
(evt (cast (rkt_evt_t-evt e)
|
||||
_pointer
|
||||
_string*/utf-8))
|
||||
)
|
||||
(rkt_webview_free_data rkt-evt)
|
||||
;(displayln (format "~a ~a" wv evt))
|
||||
(if (= wv alive-error-event)
|
||||
(close-down-on-alive-error)
|
||||
(let ((cb (hash-ref evt-cb-hash wv #f)))
|
||||
(unless (eq? cb #f)
|
||||
(cb evt)))))))
|
||||
(set! waiting (- waiting 1))
|
||||
)
|
||||
(f))
|
||||
(let* ((polling #f)
|
||||
(get-evt (λ ()
|
||||
(if polling
|
||||
(begin
|
||||
(sleep 0.01)
|
||||
(os-async-channel-try-get events-channel))
|
||||
(sync events-channel))))
|
||||
)
|
||||
(letrec
|
||||
((f
|
||||
(λ ()
|
||||
(let ((waiting (get-evt)))
|
||||
(cond
|
||||
((= waiting evt-guard-stop)
|
||||
(info-webview "got evt-guard-stop, exiting event processing")
|
||||
(set! evt-processing-thread #f)
|
||||
evt-guard-stop)
|
||||
((= 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))
|
||||
(while (> waiting 0)
|
||||
(let* ((rkt-evt (rkt_webview_get_event)))
|
||||
(if (eq? rkt-evt #f)
|
||||
(err-webview (format "Unexpected: event = nullptr"))
|
||||
(let* ((data (rkt_data_t-data rkt-evt))
|
||||
(e (union-ref data 1))
|
||||
(wv (rkt_evt_t-w e))
|
||||
(evt (cast (rkt_evt_t-evt e)
|
||||
_pointer
|
||||
_string*/utf-8))
|
||||
)
|
||||
(rkt_webview_free_data rkt-evt)
|
||||
(if (= wv alive-error-event)
|
||||
(close-down-on-alive-error)
|
||||
(let ((cb (hash-ref evt-cb-hash wv #f)))
|
||||
(unless (eq? cb #f)
|
||||
(cb evt)))))))
|
||||
(set! waiting (- waiting 1))
|
||||
)
|
||||
(f))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
))
|
||||
(f))))
|
||||
))
|
||||
(f))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define evt-processing-thread (start-event-processing))
|
||||
@@ -825,7 +847,12 @@
|
||||
|
||||
|
||||
(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)
|
||||
(unless finalizer-executed
|
||||
(dbg-webview "rkt-webview-finalizer active")
|
||||
@@ -849,19 +876,55 @@
|
||||
(set! finalizer-executed #t)
|
||||
)
|
||||
)
|
||||
|#
|
||||
|
||||
(define (rkt-webview-exit . args)
|
||||
(let ((cl-w (if (null? args) #t (car args)))
|
||||
(msg (if (null? args) #f
|
||||
(if (null? (cdr args))
|
||||
(let ((close-windows (if (null? args) #t (car args)))
|
||||
(message (if (null? args) #f
|
||||
(if (null? (cdr args))
|
||||
#f
|
||||
(cadr args))))
|
||||
)
|
||||
(rkt-webview-finalizer rkt-wv-store cl-w msg)
|
||||
(unregister-custodian-shutdown rkt-wv-store custodian-finalizer)
|
||||
(dbg-webview "rkt-webview-exit active")
|
||||
|
||||
; 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
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -874,11 +937,12 @@
|
||||
|#
|
||||
|
||||
(define custodian-finalizer
|
||||
(register-custodian-shutdown rkt-wv-store
|
||||
(λ (rkt-wv-store)
|
||||
(rkt-webview-finalizer rkt-wv-store #t #f))
|
||||
#:at-exit? #t)
|
||||
)
|
||||
(register-custodian-shutdown rkt-wv-store rkt-webview-finalizer
|
||||
#:at-exit? #t))
|
||||
; (λ (rkt-wv-store)
|
||||
; (rkt-webview-finalizer rkt-wv-store #t #f))
|
||||
; #:at-exit? #t)
|
||||
; )
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -123,6 +123,8 @@
|
||||
|
||||
webview-set-loglevel
|
||||
|
||||
webview-wait-for-quit
|
||||
webview-quit
|
||||
webview-exit
|
||||
|
||||
;test
|
||||
@@ -1017,6 +1019,18 @@
|
||||
(define (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)
|
||||
(rkt-webview-exit))
|
||||
|
||||
|
||||
@@ -313,6 +313,10 @@
|
||||
(webview-close wv)
|
||||
this)
|
||||
|
||||
(define/public (quit)
|
||||
(webview-quit)
|
||||
this)
|
||||
|
||||
(define/public (run-js js)
|
||||
(webview-run-js wv js))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user