[slime-cvs] CVS slime

[heller]

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

Modified Files:
	swank-backend.lisp swank-gray.lisp 
Log Message:
* swank-gray.lisp (stream-write-string): New method.
* swank-backend.lisp (*gray-stream-symbols*): Include write-string.

--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/08/03 18:23:10	1.136
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/08/05 17:38:39	1.137
@@ -194,6 +194,7 @@
 (defvar *gray-stream-symbols*
   '(:fundamental-character-output-stream
     :stream-write-char
+    :stream-write-string
     :stream-fresh-line
     :stream-force-output
     :stream-finish-output
--- /project/slime/cvsroot/slime/swank-gray.lisp	2008/08/04 21:38:07	1.12
+++ /project/slime/cvsroot/slime/swank-gray.lisp	2008/08/05 17:38:40	1.13
@@ -32,6 +32,29 @@
       (finish-output stream)))
   char)
 
+(defmethod stream-write-string ((stream slime-output-stream) string
+                                &optional start end)
+  (with-slime-output-stream stream
+    (let* ((start (or start 0))
+           (end (or end (length string)))
+           (len (length buffer))
+           (count (- end start))
+           (free (- len fill-pointer)))
+      (when (>= count free)
+        (stream-finish-output stream))
+      (cond ((< count len)
+             (replace buffer string :start1 fill-pointer
+                      :start2 start :end2 end)
+             (incf fill-pointer count))
+            (t
+             (funcall output-fn (subseq string start end))))
+      (let ((last-newline (position #\newline string :from-end t
+                                    :start start :end end)))
+        (setf column (if last-newline 
+                         (- end last-newline 1)
+                         (+ column count))))))
+  string)
+              
 (defmethod stream-line-column ((stream slime-output-stream))
   (with-slime-output-stream stream column))