Changeset 5541

Timestamp:

Nov 9, 2006, 2:43:29 PM (18 years ago)

Author:

Gary Byers

Message:

Change the quit protocol.

Location:

trunk/ccl/examples

Files:

• cocoa-window.lisp (modified) (3 diffs)
• cocoa.lisp (modified) (1 diff)

trunk/ccl/examples/cocoa-window.lisp

@@ -115 +115 @@
               :wait-until-done t)))))
 
-#+apple-objc
-(define-objc-method ("_shouldTerminate" lisp-application)
-  (:<BOOL>)
-  (with-slots (termp) self
-      (setq termp (objc-message-send-super (super) "_shouldTerminate" :<BOOL>))))
-
-(define-objc-method ((:<BOOL> termp) lisp-application)
-  (with-slots (termp) self
-      termp))
+
+
 
 (defloadvar *default-ns-application-proxy-class-name*
@@ -186 +179 @@
         (send (the ns-application self) :stop (%null-ptr))))))
 
-(define-objc-method ((:void :terminate sender)
-                     lisp-application)
-  (declare (ignore sender))
-  (quit))
+
 
 (define-objc-method ((:void :show-preferences sender) lisp-application)
@@ -207 +197 @@
 
 
-#+apple-objc
-(defmethod process-verify-quit ((process appkit-process))
-  (let* ((app *NSApp*))
-    (or
-     (null app)
-     (not (send app 'is-running))
-     (eql (pref app :<NSA>pplication._app<F>lags._app<D>ying) #$YES)
-     (eql (pref app
-                :<NSA>pplication._app<F>lags._dont<S>end<S>hould<T>erminate)
-          #$YES)
-     (progn
-       (send
-        app
-        :perform-selector-on-main-thread (@selector "_shouldTerminate")
-        :with-object (%null-ptr)
-        :wait-until-done t)
-       (send app 'termp)))))
-
-#+apple-objc
+
+
 (defmethod process-exit-application ((process appkit-process) thunk)
   (when (eq process *initial-process*)
-    (prepare-to-quit)
     (%set-toplevel thunk)
-    (send (the lisp-application *NSApp*) 'shutdown)
+    (send (the lisp-application *NSApp*) :terminate (%null-ptr))
     ))
 

trunk/ccl/examples/cocoa.lisp

@@ -30 +30 @@
   (declare (ignore notification))
   (initialize-user-interface))
+
+(define-objc-method ((:void :application-will-terminate (:id notification))
+                     lisp-application-delegate)
+  (declare (ignore notification))
+  ;; UI has decided to quit; terminate other lisp threads.
+  (prepare-to-quit))
 
 (define-objc-method ((:void :new-listener sender) lisp-application-delegate)