diff --git a/example1/example.rkt b/example1/example.rkt index 112a7f9..e217a31 100644 --- a/example1/example.rkt +++ b/example1/example.rkt @@ -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) + )) diff --git a/racket-webview-qt.rkt b/racket-webview-qt.rkt index 386f404..cf792fb 100644 --- a/racket-webview-qt.rkt +++ b/racket-webview-qt.rkt @@ -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,48 +582,66 @@ ) (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)) (define (stop-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) +; ) diff --git a/racket-webview.rkt b/racket-webview.rkt index e9fab5a..86082e0 100644 --- a/racket-webview.rkt +++ b/racket-webview.rkt @@ -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)) diff --git a/wv-window.rkt b/wv-window.rkt index 4390b0b..d351e4b 100644 --- a/wv-window.rkt +++ b/wv-window.rkt @@ -313,6 +313,10 @@ (webview-close wv) this) + (define/public (quit) + (webview-quit) + this) + (define/public (run-js js) (webview-run-js wv js))