Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep In directory clnet:/tmp/cvs-serv11208/Lisp-Dep
Modified Files: mp-sbcl.lisp Log Message: Improved CLIM-SYS:CURRENT-PROCESS on SBCL.
Should now always return the correct process, even within processes not started by McCLIM.
--- /project/mcclim/cvsroot/mcclim/Lisp-Dep/mp-sbcl.lisp 2007/12/16 23:20:11 1.11 +++ /project/mcclim/cvsroot/mcclim/Lisp-Dep/mp-sbcl.lisp 2008/05/29 19:11:28 1.12 @@ -44,12 +44,9 @@
(defvar *current-process* (%make-process - :name "initial process" :function nil - :thread - #+#.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or)) - sb-thread:*current-thread* - #-#.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or)) - (sb-thread:current-thread-id))) + :name (sb-thread:thread-name sb-thread:*current-thread*) + :function nil + :thread sb-thread:*current-thread*))
(defvar *all-processes* (list *current-process*))
@@ -85,7 +82,15 @@ (sb-thread:terminate-thread (process-thread process)))
(defun current-process () - *current-process*) + (if (eq (process-thread *current-process*) sb-thread:*current-thread*) + *current-process* + (setf *current-process* + (or (find sb-thread:*current-thread* *all-processes* + :key #'process-thread) + (%make-process + :name (sb-thread:thread-name sb-thread:*current-thread*) + :function nil + :thread sb-thread:*current-thread*)))))
(defun all-processes () ;; we're calling DELETE on *ALL-PROCESSES*. If we look up the value