diff --git a/frontends/server/main.lisp b/frontends/server/main.lisp index aa6b8570b..005f74f3b 100644 --- a/frontends/server/main.lisp +++ b/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)))) diff --git a/frontends/webview/main.lisp b/frontends/webview/main.lisp index 6beccac72..e13e37122 100644 --- a/frontends/webview/main.lisp +++ b/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,6 +24,7 @@ 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) @@ -28,8 +32,32 @@ Combines the JSON-RPC server protocol with a native webview window.")) (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")