[Openmcl-cvs-notifications] r15281 - in /trunk/source/cocoa-ide: cocoa-listener.lisp cocoa-utils.lisp

[rme at clozure.com]

Author: rme
Date: Wed Mar 28 13:28:58 2012
New Revision: 15281

Log:
Add a slot before-close-function to sequence-window-controller,
and funcall its contents at the right time.

Use a before-close-function when creating a restarts window
that clears out the reference to the about-to-be-closed window
controller stored in (car (ccl::bt.restarts context)).

Also have the result-callback close the restarts window.

Fixes ticket:919.

Modified:
    trunk/source/cocoa-ide/cocoa-listener.lisp
    trunk/source/cocoa-ide/cocoa-utils.lisp

Modified: trunk/source/cocoa-ide/cocoa-listener.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-listener.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-listener.lisp Wed Mar 28 13:28:58 2012
@@ -602,7 +602,12 @@
          (process (ccl::tcr->process tcr)))
     (make-instance 'sequence-window-controller
       :sequence (cdr (ccl::bt.restarts context))
+      :before-close-function #'(lambda (wc)
+                                 (declare (ignore wc))
+                                 (setf (car (ccl::bt.restarts context)) ni=
l))
       :result-callback #'(lambda (r)
+                           (execute-in-gui #'(lambda ()
+                                               (#/close (car (ccl::bt.rest=
arts context)))))
                            (process-interrupt
                             process
                             #'invoke-restart-interactively

Modified: trunk/source/cocoa-ide/cocoa-utils.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-utils.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-utils.lisp Wed Mar 28 13:28:58 2012
@@ -25,7 +25,8 @@
      (sequence :initform nil :initarg :sequence :type sequence :reader seq=
uence-window-controller-sequence)
      (result-callback :initarg :result-callback)
      (display :initform #'(lambda (item stream) (prin1 item stream)) :init=
arg :display)
-     (title :initform "Sequence dialog" :initarg :title))
+     (title :initform "Sequence dialog" :initarg :title)
+     (before-close-function :initarg :before-close-function :initform nil))
   (:metaclass ns:+ns-object))
 =

 =

@@ -36,6 +37,7 @@
          (contentframe (#/frame contentview))
          (scrollview (make-instance 'ns:ns-scroll-view :with-frame content=
frame)))
     (#/setWindow: self w)
+    (#/release w)
     (#/setDelegate: w self)
     (#/setWindowController: w self)
     (#/setHasVerticalScroller: scrollview t)
@@ -72,12 +74,16 @@
       self)))
 =

 (objc:defmethod (#/dealloc :void) ((self sequence-window-controller))
+  (objc:remove-lisp-slots self)
   (call-next-method))
 =

 (objc:defmethod (#/windowWillClose: :void) ((self sequence-window-controll=
er)
 					    notification)
   (declare (ignore notification))
   (#/setDataSource: (slot-value self 'table-view) +null-ptr+)
+  (with-slots (before-close-function) self
+    (when (functionp before-close-function)
+      (funcall before-close-function self)))
   (#/autorelease self))
 =

 (objc:defmethod (#/sequenceDoubleClick: :void)