[Openmcl-cvs-notifications] r14225 - in /trunk/source/cocoa-ide: app-delegate.lisp cocoa-utils.lisp start.lisp

rme at clozure.com rme at clozure.com
Mon Aug 30 10:08:04 CDT 2010


Author: rme
Date: Mon Aug 30 10:08:04 2010
New Revision: 14225

Log:
When launching the IDE, also don't load home:ccl-init if the shift
key is being held down.

See ticket:726.

Modified:
    trunk/source/cocoa-ide/app-delegate.lisp
    trunk/source/cocoa-ide/cocoa-utils.lisp
    trunk/source/cocoa-ide/start.lisp

Modified: trunk/source/cocoa-ide/app-delegate.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/app-delegate.lisp (original)
+++ trunk/source/cocoa-ide/app-delegate.lisp Mon Aug 30 10:08:04 2010
@@ -58,11 +58,8 @@
     ((self lisp-application-delegate) notification)
   (declare (ignore notification))
   (initialize-user-interface)
-  (let* ((event (#_CGEventCreate +null-ptr+))
-	 (flags (#_CGEventGetFlags event)))
-    (unless (logtest flags #$kCGEventFlagMaskShift)
-      (load-ide-init-file))
-    (#_CFRelease event)))
+  (unless (shift-key-p)
+    (load-ide-init-file)))
 =

 (objc:defmethod (#/applicationWillTerminate: :void)
 		((self lisp-application-delegate) notification)

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 Mon Aug 30 10:08:04 2010
@@ -410,4 +410,15 @@
     (#_Gestalt #$gestaltSystemVersion p)
     (>=3D (%get-long p) #x1050)))
 =

-
+;; This works even if an event loop is not running.
+#-cocotron
+(defun shift-key-p ()
+  (let* ((event (#_CGEventCreate +null-ptr+))
+	 (flags (#_CGEventGetFlags event)))
+    (prog1
+	(logtest flags #$kCGEventFlagMaskShift)
+      (#_CFRelease event))))
+
+#+cocotron
+(defun shift-key-p ()
+  nil)

Modified: trunk/source/cocoa-ide/start.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/start.lisp (original)
+++ trunk/source/cocoa-ide/start.lisp Mon Aug 30 10:08:04 2010
@@ -81,7 +81,8 @@
 =

 =

 (defmethod ccl::application-init-file ((a cocoa-application))
-  '("home:ccl-init" "home:\\.ccl-init"))
+  (unless (shift-key-p)
+    '("home:ccl-init" "home:\\.ccl-init")))
 =

 ;;; If we're launched via the Finder, the only argument we'll
 ;;; get is of the form -psnXXXXXX.  That's meaningless to us;



More information about the Openmcl-cvs-notifications mailing list