More robust quit/exit/cleanup/finalizing handling

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)
+    ))

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
+     (let* ((polling #f)
-         ((f
+            (get-evt (λ ()
-           (λ ()
+                       (if polling
-             (let ((waiting (sync events-channel)))
+                           (begin
-               (if (= waiting evt-guard-stop)
+                             (sleep 0.01)
-                   (begin
+                             (os-async-channel-try-get events-channel))
-                     (info-webview "got evt-guard-stop, exiting event processing")
+                           (sync events-channel))))
-                     (set! evt-processing-thread #f)
+            )
-                     evt-guard-stop)
+       (letrec
-                   (begin
+           ((f
-                     (set! waiting (rkt_webview_events_waiting))
+             (λ ()
-                     (while (> waiting 0)
+               (let ((waiting (get-evt)))
-                            (let* ((rkt-evt (rkt_webview_get_event)))
+                 (cond
-                              (if (eq? rkt-evt #f)
+                   ((= waiting evt-guard-stop)
-                                  (err-webview (format "Unexpected: event = nullptr"))
+                    (info-webview "got evt-guard-stop, exiting event processing")
-                                  (let* ((data (rkt_data_t-data rkt-evt))
+                    (set! evt-processing-thread #f)
-                                         (e (union-ref data 1))
+                    evt-guard-stop)
-                                         (wv (rkt_evt_t-w e))
+                   ((= waiting evt-start-polling)
-                                         (evt (cast (rkt_evt_t-evt e)
+                    (info-webview "got evt-start-polling, starting to poll instead of waiting on channel")
-                                                    _pointer
+                    (set! polling #t)
-                                                    _string*/utf-8))
+                    (set! event-processing-kind 'poll)
-                                         )
+                    (f))
-                                    (rkt_webview_free_data rkt-evt)
+                   (else 
-                                    ;(displayln (format "~a ~a" wv evt))
+                    (set! waiting (rkt_webview_events_waiting))
-                                    (if (= wv alive-error-event)
+                    (while (> waiting 0)
-                                        (close-down-on-alive-error)
+                           (let* ((rkt-evt (rkt_webview_get_event)))
-                                        (let ((cb (hash-ref evt-cb-hash wv #f)))
+                             (if (eq? rkt-evt #f)
-                                          (unless (eq? cb #f)
+                                 (err-webview (format "Unexpected: event = nullptr"))
-                                            (cb evt)))))))
+                                 (let* ((data (rkt_data_t-data rkt-evt))
-                            (set! waiting (- waiting 1))
+                                        (e (union-ref data 1))
-                            )
+                                        (wv (rkt_evt_t-w e))
-                     (f))
+                                        (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)))
+  (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
                      (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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -874,11 +937,12 @@
 |#
 
 (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)
+;  )
 
 
 

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))
 

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))