[mcclim-cvs] CVS mcclim/Lisp-Dep

[thenriksen]

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