Changeset 15281

Timestamp:

Mar 28, 2012, 11:28:58 AM (13 years ago)

Author:

R. Matthew Emerson

Message:

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.

Location:

trunk/source/cocoa-ide

Files:

• cocoa-listener.lisp (modified) (1 diff)
• cocoa-utils.lisp (modified) (4 diffs)

trunk/source/cocoa-ide/cocoa-listener.lisp

@@ -603 +603 @@
     (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)) nil))
       :result-callback #'(lambda (r)
+                           (execute-in-gui #'(lambda ()
+                                               (#/close (car (ccl::bt.restarts context)))))
                            (process-interrupt
                             process

trunk/source/cocoa-ide/cocoa-utils.lisp

@@ -26 +26 @@
      (result-callback :initarg :result-callback)
      (display :initform #'(lambda (item stream) (prin1 item stream)) :initarg :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))
 
@@ -37 +38 @@
          (scrollview (make-instance 'ns:ns-scroll-view :with-frame contentframe)))
     (#/setWindow: self w)
+    (#/release w)
     (#/setDelegate: w self)
     (#/setWindowController: w self)
@@ -73 +75 @@
 
 (objc:defmethod (#/dealloc :void) ((self sequence-window-controller))
+  (objc:remove-lisp-slots self)
   (call-next-method))
 
@@ -79 +82 @@
   (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))