/[slime]/slime/swank-allegro.lisp
ViewVC logotype

Diff of /slime/swank-allegro.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.42 by heller, Mon Jun 28 16:03:52 2004 UTC revision 1.43 by lgorrie, Sun Jul 4 00:21:09 2004 UTC
# Line 49  Line 49 
49  ;; no-applicable-method function in Allegro 5.  We have to provide an  ;; no-applicable-method function in Allegro 5.  We have to provide an
50  ;; implementation.  ;; implementation.
51  (defimplementation emacs-connected (stream)  (defimplementation emacs-connected (stream)
52    (declare (ignore stream)))    (declare (ignore stream))
53      (install-advice))
54    
55  (defimplementation format-sldb-condition (c)  (defimplementation format-sldb-condition (c)
56    (princ-to-string c))    (princ-to-string c))
# Line 116  Line 117 
117      (:class      (:class
118       (describe (find-class symbol)))))       (describe (find-class symbol)))))
119    
120    (defimplementation make-stream-interactive (stream)
121      (setf (interactive-stream-p stream) t))
122    
123  ;;;; Debugger  ;;;; Debugger
124    
125  (defvar *sldb-topframe*)  (defvar *sldb-topframe*)
# Line 297  Line 301 
301    
302  ;;;; Multithreading  ;;;; Multithreading
303    
304    (defvar *swank-thread* nil
305      "Bound to true in any thread with an ancestor created by SPAWN.
306    Such threads always use Emacs for debugging and user interaction.")
307    
308    (defvar *inherited-bindings*
309      '(*debugger-hook*
310        *standard-output* *error-output* *trace-output*
311        *standard-input*
312        *debug-io* *query-io* *terminal-io*)
313      "Variables whose values are inherited by children of Swank threads.")
314    
315  (defimplementation startup-multiprocessing ()  (defimplementation startup-multiprocessing ()
316    (mp:start-scheduler))    (mp:start-scheduler))
317    
318  (defimplementation spawn (fn &key name)  (defimplementation spawn (fn &key name)
319    (mp:process-run-function name fn))    (mp:process-run-function name
320                               (lambda ()
321                                 (let ((*swank-thread* t))
322                                   (funcall fn)))))
323    
324    #+allegro-v6.2
325    (excl:def-fwrapper make-process/inherit (&key &allow-other-keys)
326      "Advice for MP:MAKE-PROCESS.
327    New threads that have a Swank thread for an ancestor will inherit
328    debugging and I/O bindings from their parent."
329      (let ((process (excl:call-next-fwrapper)))
330        (when *swank-thread*
331          (push (cons '*swank-thread* t)
332                (mp:process-initial-bindings process))
333          (dolist (variable *inherited-bindings*)
334            (push (cons variable (symbol-value variable))
335                  (mp:process-initial-bindings process))))
336        process))
337    
338    (defun install-advice ()
339      #+allegro-v6.2
340      (excl:fwrap 'mp:make-process 'make-process/inherit 'make-process/inherit))
341    
342  (defvar *id-lock* (mp:make-process-lock :name "id lock"))  (defvar *id-lock* (mp:make-process-lock :name "id lock"))
343  (defvar *thread-id-counter* 0)  (defvar *thread-id-counter* 0)

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

  ViewVC Help
Powered by ViewVC 1.1.5