[slime-cvs] CVS update: slime/swank-abcl.lisp

[Andras Simon]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv1273

Modified Files:
	swank-abcl.lisp 
Log Message:
Steal auto-flush stuff from swank-sbcl.lisp
Date: Sun Nov 13 12:22:25 2005
Author: asimon

Index: slime/swank-abcl.lisp
diff -u slime/swank-abcl.lisp:1.28 slime/swank-abcl.lisp:1.29
--- slime/swank-abcl.lisp:1.28	Sun Oct 30 17:57:19 2005
+++ slime/swank-abcl.lisp	Sun Nov 13 12:22:24 2005
@@ -472,6 +472,30 @@
 (defimplementation receive ()
   (ext:mailbox-read (mailbox (ext:current-thread))))
 
+;;; Auto-flush streams
+
+;; XXX race conditions
+(defvar *auto-flush-streams* '())
+  
+(defvar *auto-flush-thread* nil)
+
+(defimplementation make-stream-interactive (stream)
+  (setq *auto-flush-streams* (adjoin stream *auto-flush-streams*))
+  (unless *auto-flush-thread*
+    (setq *auto-flush-thread*
+          (ext:make-thread #'flush-streams 
+                           :name "auto-flush-thread"))))
+
+(defun flush-streams ()
+  (loop
+   (setq *auto-flush-streams* 
+         (remove-if (lambda (x) 
+                      (not (and (open-stream-p x)
+                                (output-stream-p x))))
+                    *auto-flush-streams*))
+   (mapc #'finish-output *auto-flush-streams*)
+   (sleep 0.15)))
+
 (defimplementation quit-lisp ()
   (ext:exit))