[Openmcl-cvs-notifications] r15064 - /trunk/source/cocoa-ide/cocoa-utils.lisp

gz at clozure.com gz at clozure.com
Tue Nov 8 13:15:07 CST 2011


Author: gz
Date: Tue Nov  8 13:15:06 2011
New Revision: 15064

Log:
Add an inhibit-greeting arg to new-listener, and implement it kludgily

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

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 Tue Nov  8 13:15:06 2011
@@ -158,10 +158,16 @@
   (first-window-satisfying-predicate #'(lambda (w) (typep (#/windowControl=
ler w) controller-type))))
 =

 =

-(defun new-listener ()
+(defun new-listener (&key (inhibit-greeting ccl::*inhibit-greeting*))
   (let ((wptr (execute-in-gui (lambda ()
                                 (declare (special hemlock-listener-documen=
t))
-                                (#/newListener: (#/delegate *NSApp*) (%nul=
l-ptr))
+                                ;; TODO: fix this.
+                                (let ((old ccl::*inhibit-greeting*))
+                                  (unwind-protect
+                                      (progn
+                                        (setq ccl::*inhibit-greeting* inhi=
bit-greeting)
+                                        (#/newListener: (#/delegate *NSApp=
*) (%null-ptr)))
+                                    (setq ccl::*inhibit-greeting* old)))
                                 (let ((doc (#/topListener hemlock-listener=
-document)))
                                   (unless (%null-ptr-p doc)
                                     (#/window (#/lastObject (#/windowContr=
ollers doc)))))))))



More information about the Openmcl-cvs-notifications mailing list