[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv21364

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (make-stream-interactive): Run our own
thread to periodically flush streams instead of relying on
soft-force-output.

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/05 17:38:53	1.1394
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/05 17:38:59	1.1395
@@ -1,5 +1,9 @@
 2008-08-05  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-lispworks.lisp (make-stream-interactive): Run our own
+	thread to periodically flush streams instead of relying on
+	soft-force-output.
+
 	* swank.lisp (encode-message): Inhibit interrupts
 	while writing the length and the body.
 
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/08/04 21:38:07	1.104
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/08/05 17:38:59	1.105
@@ -795,12 +795,29 @@
     (defmethod env-internals:environment-display-debugger (env)
       *debug-io*)))
 
+(defvar *auto-flush-interval* 0.15)
+(defvar *auto-flush-lock* (mp:make-lock :name "auto-flush-lock"))
+(defvar *auto-flush-thread* nil)
+(defvar *auto-flush-streams* '())
+  
 (defimplementation make-stream-interactive (stream)
-  (unless (find-method #'stream:stream-soft-force-output nil `((eql ,stream))
-                       nil)
-    (let ((lw:*handle-warn-on-redefinition* :warn))
-      (defmethod stream:stream-soft-force-output  ((o (eql stream)))
-        (force-output o)))))
+  (mp:with-lock (*auto-flush-lock*)
+    (pushnew stream *auto-flush-streams*)
+    (unless *auto-flush-thread*
+      (setq *auto-flush-thread*
+            (mp:process-run-function "auto-flush-thread [SWANK]" () 
+                                     #'flush-streams)))))
+
+(defun flush-streams ()
+  (loop
+   (mp:with-lock (*auto-flush-lock*)
+     (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 *auto-flush-interval*)))
 
 (defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
   (apply (swank-sym :y-or-n-p-in-emacs) msg args))