[slime-cvs] CVS slime

[heller]

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (eval-for-emacs): Don't flush streams here as that
may now block.

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/04 09:13:06	1.1383
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/04 20:25:23	1.1384
@@ -1,5 +1,8 @@
 2008-08-04  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (eval-for-emacs): Don't flush streams here as that
+	may now block.
+
 	* swank-lispworks.lisp (receive-if): Handle interrupts.
 
 	* slime.el (slime-repl-clear-buffer): Delete stuff after the
--- /project/slime/cvsroot/slime/swank.lisp	2008/08/03 19:20:51	1.550
+++ /project/slime/cvsroot/slime/swank.lisp	2008/08/04 20:25:24	1.551
@@ -731,16 +731,18 @@
 ;; FIXME: if wait-for-event aborts the event will stay in the queue forever.
 (defun make-output-function (connection)
   "Create function to send user output to Emacs."
-  (let ((max 100) (i 0) (tag 0))
+  (let ((max 100) (i 0) (tag 0) (l 0))
     (lambda (string)
       (with-connection (connection)
         (with-simple-restart (abort "Abort sending output to Emacs.")
-          (when (= i max)
+          (when (or (= i max) (> l (* 80 20 5)))
             (setf tag (mod (1+ tag) 1000))
             (send-to-emacs `(:ping ,(thread-id (current-thread)) ,tag))
             (wait-for-event `(:emacs-pong ,tag))
-            (setf i 0))
+            (setf i 0) 
+            (setf l 0))
           (incf i)
+          (incf l (length string))
           (send-to-emacs `(:write-string ,string)))))))
 
 (defun make-output-function-for-target (connection target)
@@ -1443,8 +1445,7 @@
       (prin1-to-string object))))
 
 (defun force-user-output ()
-  (force-output (connection.user-io *emacs-connection*))
-  (finish-output (connection.user-output *emacs-connection*)))
+  (force-output (connection.user-io *emacs-connection*)))
 
 (defun clear-user-input  ()
   (clear-input (connection.user-input *emacs-connection*)))
@@ -1544,14 +1545,14 @@
               :prompt ,(package-string-for-prompt *package*))
     :version ,*swank-wire-protocol-version*))
 
-(defslimefun io-speed-test (&optional (n 5000) (m 1))
+(defslimefun io-speed-test (&optional (n 1000) (m 1))
   (let* ((s *standard-output*)
          (*trace-output* (make-broadcast-stream s *log-output*)))
     (time (progn
             (dotimes (i n)
               (format s "~D abcdefghijklm~%" i)
               (when (zerop (mod n m))
-                (force-output s)))
+                (finish-output s)))
             (finish-output s)
             (when *emacs-connection*
               (eval-in-emacs '(message "done.")))))
@@ -1760,9 +1761,7 @@
               ;;(setq result (apply (car form) (cdr form)))
               (setq result (eval form))
               (run-hook *pre-reply-hook*)
-              (finish-output)
               (setq ok t))
-         (force-user-output)
          (send-to-emacs `(:return ,(current-thread)
                                   ,(if ok
                                        `(:ok ,result)