Index: /branches/ide-1.0/ccl/examples/cocoa-window.lisp
===================================================================
--- /branches/ide-1.0/ccl/examples/cocoa-window.lisp	(revision 6611)
+++ /branches/ide-1.0/ccl/examples/cocoa-window.lisp	(revision 6612)
@@ -108,4 +108,34 @@
         (#/performSelectorOnMainThread:withObject:waitUntilDone:
          *NSApp* (@selector "postEventAtStart:") e  t)))))
+
+
+(defparameter *debug-in-event-process* t)
+
+(defmethod process-debug-condition ((process appkit-process) condition frame-pointer)
+  "Better than nothing.  Not much better."
+  (when *debug-in-event-process*
+    (catch 'need-a-catch-frame-for-backtrace
+      (let* ((*debug-in-event-process* nil)
+             (context (new-backtrace-info nil
+                                          frame-pointer
+                                          (if *backtrace-contexts*
+                                            (or (child-frame
+                                                 (bt.youngest (car *backtrace-contexts*))
+                                                 nil)
+                                                (last-frame-ptr))
+                                            (last-frame-ptr))
+                                          (%current-tcr)
+                                          condition
+                                          (%current-frame-ptr)
+                                          #+ppc-target *fake-stack-frames*
+                                          #+x86-target (%current-frame-ptr)
+                                          (db-link)
+                                          (1+ *break-level*)))
+             (*backtrace-contexts* (cons context *backtrace-contexts*)))  
+        (format t "~%~%*** Error in event process: ~a~%~%" condition)
+        (print-call-history :context context :detailed-p t :count 20 :origin frame-pointer)
+        (format t "~%~%~%")
+        (force-output t)
+        ))))
 
 
@@ -243,4 +273,5 @@
 		      (push attr-name implemented-attributes))))))
 	    (values (#/retain font) implemented-attributes))))))
+
 
 ;;; Create a paragraph style, mostly so that we can set tabs reasonably.
