Fix webview frontend not exiting on C-x C-c / window close on Windows

frontends/server/main.lisp

@@ -10,11 +10,19 @@
            :run-tcp-server
            :run-stdio-server
            :run-websocket-server
+           :*exit-function*
            :main))
 (in-package :lem-server)
 
 (defvar *server-runner*)
 
+(defvar *exit-function* (lambda () (uiop:quit 0))
+  "Function called from *exit-editor-hook* after notifying clients of exit.
+The default quits the process. The webview frontend replaces it because
+uiop:quit cannot unwind the main thread while it is blocked in the native
+webview event loop; it terminates that loop instead and the main thread
+quits by itself afterwards.")
+
 (defclass server-runner ()
   ())
 
@@ -232,7 +240,7 @@ the same immutable instance for every subsequent message."
     (lem:add-hook lem:*exit-editor-hook*
                   (lambda ()
                     (notify jsonrpc "exit" nil)
-                    (uiop:quit 0)))
+                    (funcall *exit-function*)))
 
     (server-listen *server-runner* (jsonrpc-server jsonrpc))))
 

frontends/webview/main.lisp

@@ -8,6 +8,9 @@
            :webview))
 (in-package :lem-webview)
 
+(defvar *webview-handle* nil
+  "Native webview handle, bound while the window's event loop is running.")
+
 (defclass webview (lem-server:jsonrpc lem-core:implementation)
   ()
   (:documentation "Webview frontend implementation.
@@ -21,15 +24,40 @@ Combines the JSON-RPC server protocol with a native webview window."))
   "Run the webview window. FRAME-COLOR is :dark or :light (macOS only)."
   (float-features:with-float-traps-masked t
     (let ((w (webview:webview-create 0 (cffi:null-pointer))))
+      (setf *webview-handle* w)
       (unwind-protect
            (progn
              (webview:webview-set-title w title)
              (webview:webview-set-size w width height 0)
              (set-window-appearance w frame-color)
              (webview:webview-navigate w url)
              (webview:webview-run w))
+        (setf *webview-handle* nil)
         (webview:webview-destroy w)))))
 
+;; webview_dispatch callback: runs on the main (event loop) thread, where
+;; calling webview_terminate is always legal.
+(cffi:defcallback %terminate-on-main-thread :void ((w :pointer) (arg :pointer))
+  (declare (ignore arg))
+  (webview:webview-terminate w))
+
+(defun terminate-webview ()
+  "Stop the webview event loop so the main thread returns from webview-run.
+Termination is dispatched onto the event loop thread via webview_dispatch.
+A watchdog thread hard-exits the process in case the loop fails to stop
+(or the window does not exist yet)."
+  (let ((w *webview-handle*))
+    (log:info "terminate-webview: handle=~A" w)
+    (when w
+      (log:info "terminate-webview: dispatch result=~A"
+                (webview:webview-dispatch w
+                                          (cffi:callback %terminate-on-main-thread)
+                                          (cffi:null-pointer))))
+    (bt2:make-thread (lambda ()
+                       (sleep 3)
+                       (uiop:quit 0 nil))
+                     :name "lem-webview exit watchdog")))
+
 (defmethod lem-if:set-frame-color ((implementation lem-server:jsonrpc) mode)
   "Set the window frame to :dark or :light mode.
 Currently implemented for macOS via darwin.lisp; on other platforms this
@@ -38,6 +66,10 @@ is a no-op. Can be called from any thread."
 
 (defun main (&optional (args (uiop:command-line-arguments)))
   (let ((port (lem/common/socket:random-available-port)))
+    ;; uiop:quit from the editor thread cannot unwind the main thread
+    ;; while it is blocked in the native webview event loop; terminate
+    ;; the loop instead and let MAIN's own uiop:quit end the process.
+    (setf lem-server:*exit-function* 'terminate-webview)
     (bt2:make-thread (lambda ()
                        (lem-server:run-websocket-server
                         :port port
@@ -47,7 +79,9 @@ is a no-op. Can be called from any thread."
                  :url (format nil "http://127.0.0.1:~D" port)
                  :width 1024
                  :height 768)
-    (uiop:quit)))
+    ;; Hard exit: a clean exit would wait to unwind the server/editor
+    ;; threads, which may be blocked in foreign calls (socket accept).
+    (uiop:quit 0 nil)))
 
 (defun webview-main (&optional (args (uiop:command-line-arguments)))
   (let ((spec '((("url") :type string :optional nil :documentation "url")