[Openmcl-cvs-notifications] r12232 - /trunk/source/cocoa-ide/app-delegate.lisp

[gb at clozure.com]

Author: gb
Date: Mon Jun  8 04:13:14 2009
New Revision: 12232

Log:
app delegate validates/implements listener break loop commands, forwards
to top listener. (ticket:151).

Modified:
    trunk/source/cocoa-ide/app-delegate.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 Jun  8 04:13:14 2009
@@ -201,3 +201,34 @@
 				       (compile-file filename)
 				       (fresh-line)))))))
 =

+(objc:defmethod (#/exitBreak: :void) ((self lisp-application-delegate) sen=
der)
+  (let* ((top-listener (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p top-listener)
+      (#/exitBreak: top-listener sender))))
+
+(objc:defmethod (#/continue: :void) ((self lisp-application-delegate) send=
er)
+  (let* ((top-listener (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p top-listener)
+      (#/continue: top-listener sender))))
+
+(objc:defmethod (#/restarts: :void) ((self lisp-application-delegate) send=
er)
+  (let* ((top-listener (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p top-listener)
+      (#/restarts: top-listener sender))))
+
+(objc:defmethod (#/backtrace: :void) ((self lisp-application-delegate) sen=
der)
+  (let* ((top-listener (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p top-listener)
+      (#/backtrace: top-listener sender))))
+
+(objc:defmethod (#/validateMenuItem: #>BOOL) ((self lisp-application-deleg=
ate) item)
+  (let* ((action (#/action item))
+         (top-listener (#/topListener hemlock-listener-document)))
+    (unless (%null-ptr-p top-listener)      =

+      (cond ((or (eql action (@selector "exitBreak:"))
+                 (eql action (@selector "continue:"))
+                 (eql action (@selector "restarts:"))
+                 (eql action (@selector "backtrace:")))
+             (#/validateMenuItem: top-listener item))))))
+
+