Changeset 12140


Ignore:
Timestamp:
May 27, 2009, 8:51:33 PM (10 years ago)
Author:
gb
Message:

Add a HAVE-INTERACTIVE-TERMINAL-IO slot to APPKIT-PROCESS. (This
basically means that we're running in the hybrid (require "COCOA")
environment, running the bundled executable directly in the shell,
or have been able to connect to AltConsole?. Might later mean that
we have a swank connection or similar.)

Experiment with other ways to do PROCESS-INTERRUPT on the AppKit? thread;
code is not ready and may turn out to be a bad idea (conditionalized out.)

In EVENT-LOOP, wrap a restart (not a handler) around the #/run method call
if the event process has (some form of) interactive terminal i/o.

In the PROCESS-DEBUG-CONDITION method, enter a break loop if we have
interactive terminal i/o.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-window.lisp

    r10614 r12140  
    5050                 :void))
    5151
    52 (defclass appkit-process (process) ())
     52(defclass appkit-process (process)
     53    ((have-interactive-terminal-io :initform t)))
    5354
    5455;;; Interrupt the AppKit event process, by enqueing an event (if the
     
    6364    (if (and *NSApp* (#/isRunning *NSApp*))
    6465      (queue-for-gui #'(lambda () (apply function args)) :at-start t)
     66      #+not-yet
     67      (let* ((invoked nil)
     68             (f (lambda ()
     69                  (unless invoked
     70                    (setq invoked t)
     71                    (apply function args)))))
     72        (queue-for-gui f :at-start t)
     73        (call-next-method process f))
    6574      (call-next-method))))
    6675
     
    7786      (unless (or (not (typep c 'error)) (member c *event-process-reported-conditions*))
    7887        (push c *event-process-reported-conditions*)
    79         (catch 'need-a-catch-frame-for-backtrace
    80           (let* ((*debug-in-event-process* nil)
    81                  (context (ccl::new-backtrace-info nil
    82                                                    frame-pointer
    83                                                    (if ccl::*backtrace-contexts*
     88        (if (slot-value process 'have-interactive-terminal-io)
     89          (ccl::application-error ccl::*application* c frame-pointer)
     90          (catch 'need-a-catch-frame-for-backtrace
     91            (let* ((*debug-in-event-process* nil)
     92                   (context (ccl::new-backtrace-info nil
     93                                                     frame-pointer
     94                                                     (if ccl::*backtrace-contexts*
    8495                                                       (or (ccl::child-frame
    8596                                                            (ccl::bt.youngest (car ccl::*backtrace-contexts*))
     
    8798                                                           (ccl::last-frame-ptr))
    8899                                                       (ccl::last-frame-ptr))
    89                                                    (ccl::%current-tcr)
    90                                                    condition
    91                                                    (ccl::%current-frame-ptr)
    92                                                    #+ppc-target ccl::*fake-stack-frames*
    93                                                    #+x86-target (ccl::%current-frame-ptr)
    94                                                    (ccl::db-link)
    95                                                    (1+ ccl::*break-level*)))
    96                  (ccl::*backtrace-contexts* (cons context ccl::*backtrace-contexts*))) 
    97             (format t "~%~%*** Error in event process: ~a~%~%" condition)
    98             (print-call-history :context context :detailed-p t :count 20 :origin frame-pointer)
    99             (format t "~%~%~%")
    100             (force-output t)
    101             ))))))
     100                                                     (ccl::%current-tcr)
     101                                                     condition
     102                                                     (ccl::%current-frame-ptr)
     103                                                     #+ppc-target ccl::*fake-stack-frames*
     104                                                     #+x86-target (ccl::%current-frame-ptr)
     105                                                     (ccl::db-link)
     106                                                     (1+ ccl::*break-level*)))
     107                   (ccl::*backtrace-contexts* (cons context ccl::*backtrace-contexts*))) 
     108              (format t "~%~%*** Error in event process: ~a~%~%" condition)
     109              (print-call-history :context context :detailed-p t :count 20 :origin frame-pointer)
     110              (format t "~%~%~%")
     111              (force-output t)
     112              )))))))
    102113
    103114
     
    153164(defun event-loop (&optional end-test)
    154165  (let* ((app *NSApp*)
    155          (ccl::*break-on-errors* nil))
     166         (thread ccl::*current-process*))
    156167    (loop
    157       (handler-case (let* ((*event-process-reported-conditions* nil))
    158                       (if end-test
    159                         (#/run app)
    160                         #|(#/runMode:beforeDate: (#/currentRunLoop ns:ns-run-loop)
    161                                                #&NSDefaultRunLoopMode
    162                                                (#/distantFuture ns:ns-date))|#
    163                         (#/run app)))
    164         (error (c) (nslog-condition c)))
     168      (if (not (slot-value thread 'have-interactive-terminal-io))
     169        (let* ((ccl::*break-on-errors* nil))
     170          (handler-case (let* ((*event-process-reported-conditions* nil))
     171                          (if end-test
     172                            (#/run app)
     173                          #|(#/runMode:beforeDate: (#/currentRunLoop ns:ns-run-loop)
     174                          #&NSDefaultRunLoopMode
     175                          (#/distantFuture ns:ns-date))|#
     176                          (#/run app))))
     177          (error (c) (nslog-condition c)))
     178        (with-simple-restart (abort "Process the next event")
     179          (#/run app)))
    165180      #+debug (log-debug "~&runMode exited, end-test: ~s isRunning ~s quitting: ~s" end-test (#/isRunning app) ccl::*quitting*)
    166181      (when (or (and end-test (funcall end-test))
Note: See TracChangeset for help on using the changeset viewer.