Changeset 14917 for release/1.7

Timestamp:

Jul 28, 2011, 5:03:56 PM (10 years ago)

Author:

rme

Message:

Merge updated fix for ticket:845

Location:

release/1.7/source

Files:

• . (modified) (1 prop)
• cocoa-ide/app-delegate.lisp (modified) (1 diff)
• cocoa-ide/cocoa-listener.lisp (modified) (2 diffs)
• cocoa-ide/hemlock/src/listener.lisp (modified) (2 diffs)

release/1.7/source/cocoa-ide/app-delegate.lisp

@@ -135 +135 @@
    (#/sharedDocumentController ns:ns-document-controller) #@"Listener" t))
 
+(defun active-listener-windows ()
+  (let* ((listener-windows ())
+         (all-windows (#/orderedWindows *NSApp*)))
+    (dotimes (i (#/count all-windows) (nreverse listener-windows))
+      (let* ((w (#/objectAtIndex: all-windows i))
+             (wc (#/windowController w)))
+        (when (and (typep wc 'hemlock-listener-window-controller)
+                   (#/isVisible w))
+          (let* ((doc (#/document wc)))
+            (unless (%null-ptr-p doc)
+              (when (hemlock-document-process doc)
+                (push w listener-windows)))))))))
+        
+                
 (objc:defmethod (#/showListener: :void) ((self lisp-application-delegate)
                                         sender)
   (declare (ignore sender))
-  (let* ((all-windows (#/orderedWindows *NSApp*))
-         (key-window (#/keyWindow *NSApp*))
-         (listener-windows ())
+  (let* ((key-window (#/keyWindow *NSApp*))
+         (listener-windows (active-listener-windows))
          (top-listener nil))
-    (dotimes (i (#/count all-windows))
-      (let* ((w (#/objectAtIndex: all-windows i))
-             (wc (#/windowController w)))
-        (when (eql (#/class wc) hemlock-listener-window-controller)
-          (push w listener-windows))))
-    (setq listener-windows (nreverse listener-windows))
     (setq top-listener (car listener-windows))
     (cond 

release/1.7/source/cocoa-ide/cocoa-listener.lisp

@@ -306 +306 @@
 (objc:defmethod (#/windowShouldClose: #>BOOL) ((w hemlock-listener-frame)
                                                sender)
+  (declare (ignorable sender))
   (let* ((doc (#/document (#/windowController w))))
     (if (or (%null-ptr-p doc)
-            (and (hemlock-document-process doc)
-                 (perform-close-kills-process-p doc)))
+            (null (hemlock-document-process doc)) 
+            (perform-close-kills-process-p doc))
       t
       (progn
-        ;(#/orderOut: w sender)
-        (#/close w)
+        (#/orderOut: w sender)
+        ;(#/close w)
         nil))))
 
@@ -384 +385 @@
 
 (objc:defmethod #/topListener ((self +hemlock-listener-document))
-  (let* ((all-windows (#/orderedWindows *NSApp*)))
-    (dotimes (i (#/count all-windows) +null-ptr+)
-      (let* ((w (#/objectAtIndex: all-windows i)))
-        (when (#/isVisible w)
-          (let* ((wc (#/windowController w))
-                 (doc (#/document wc)))
-            (unless (%null-ptr-p doc)
-              (when (#/isKindOfClass: doc self)
-                (return doc)))))))))
+  (let* ((w (car (active-listener-windows))))
+    (if w
+      (#/document (#/windowController w))
+      +null-ptr+)))
+
+(defun top-listener-document ()
+  (let* ((doc (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p doc) doc)))
+
 
 (defun symbol-value-in-top-listener-process (symbol)

release/1.7/source/cocoa-ide/hemlock/src/listener.lisp

@@ -608 +608 @@
                     (defun-region (current-point)))))
          (form (when *echo-expression-to-listener* (region-to-string region)))
-         (buf (gui::hemlock-buffer (#/topListener gui::hemlock-listener-document))))
+         (doc (gui::top-listener-document))
+         (buf (when doc (gui::hemlock-buffer doc))))
     (when buf
       (let ((HI::*CURRENT-BUFFER* buf))
@@ -620 +621 @@
   (let* ((region (copy-region (current-form-region)))
          (form (when *echo-expression-to-listener* (region-to-string region)))
-         (buf (gui::hemlock-buffer (#/topListener gui::hemlock-listener-document))))
+         (doc (gui::top-listener-document))
+         (buf (when doc (gui::hemlock-buffer doc))))
     (when buf
       (let ((HI::*CURRENT-BUFFER* buf))