More robust quit/exit/cleanup/finalizing handling
This commit is contained in:
@@ -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)
|
||||||
|
))
|
||||||
|
|||||||
@@ -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)
|
||||||
|
; )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -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))
|
||||||
|
|
||||||
|
|||||||
@@ -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))
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user