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

[Helmut Eller]

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

Modified Files:
	swank-sbcl.lisp swank-openmcl.lisp 
Log Message:
Implement stream-line-column.

Date: Sat Nov  1 10:48:19 2003
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.16 slime/swank-sbcl.lisp:1.17
--- slime/swank-sbcl.lisp:1.16	Fri Oct 31 11:58:37 2003
+++ slime/swank-sbcl.lisp	Sat Nov  1 10:48:19 2003
@@ -162,19 +162,30 @@
 ;; This buffering is done via a Gray stream instead of the CMU-specific
 ;; stream method business...
 (defclass slime-output-stream (sb-gray:fundamental-character-output-stream)
-  ((buffer :initform (make-string-output-stream :element-type 'character)
-           :accessor slime-output-stream-buffer)))
+  ((buffer :initform (make-array 512 :element-type 'character
+                                 :fill-pointer 0 :adjustable t))
+   (last-charpos :initform 0)))
 
 (defmethod sb-gray:stream-write-char ((stream slime-output-stream) char)
-  (write-char char (slime-output-stream-buffer stream)))
+  (vector-push-extend char (slot-value stream 'buffer))
+  char)
 
 (defmethod sb-gray:stream-line-column ((stream slime-output-stream))
-  0)
+  (with-slots (buffer last-charpos) stream
+    (do ((index (1- (fill-pointer buffer)) (1- index))
+         (count 0 (1+ count)))
+        ((< index 0) (+ count last-charpos))
+      (when (char= (aref buffer index) #\newline)
+        (return count)))))
 
 (defmethod sb-gray:stream-force-output ((stream slime-output-stream))
-  (send-to-emacs `(:read-output ,(get-output-stream-string
-                                  (slime-output-stream-buffer stream))))
-  (setf (slime-output-stream-buffer stream) (make-string-output-stream)))
+  (with-slots (buffer last-charpos) stream
+    (let ((end (fill-pointer buffer)))
+      (unless (zerop end)
+        (send-to-emacs `(:read-output ,(subseq buffer 0 end)))
+        (setf last-charpos (sb-gray:stream-line-column stream))
+        (setf (fill-pointer buffer) 0))))
+  nil)
 
 (defclass slime-input-stream (sb-gray:fundamental-character-input-stream)
   ((buffered-char :initform nil)))
@@ -186,6 +197,15 @@
 
 (defmethod sb-gray:stream-unread-char ((s slime-input-stream) char)
   (setf (slot-value s 'buffered-char) char)
+  nil)
+
+(defmethod sb-gray:stream-listen ((s slime-input-stream))
+  nil)
+
+(defmethod sb-gray:stream-line-column ((s slime-input-stream))
+  nil)
+
+(defmethod sb-gray:stream-line-length ((s slime-input-stream))
   nil)
 
 ;;; Utilities


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.15 slime/swank-openmcl.lisp:1.16
--- slime/swank-openmcl.lisp:1.15	Fri Oct 31 11:58:37 2003
+++ slime/swank-openmcl.lisp	Sat Nov  1 10:48:19 2003
@@ -13,7 +13,7 @@
 ;;; The LLGPL is also available online at
 ;;; http://opensource.franz.com/preamble.html
 ;;;
-;;;   $Id: swank-openmcl.lisp,v 1.15 2003/10/31 16:58:37 heller Exp $
+;;;   $Id: swank-openmcl.lisp,v 1.16 2003/11/01 15:48:19 heller Exp $
 ;;;
 
 ;;;
@@ -103,22 +103,33 @@
 
 ;; This buffering is done via a Gray stream instead of the CMU-specific
 ;; stream method business...
-(defclass slime-output-stream (ccl::fundamental-character-output-stream)
-  ((buffer :initform (make-string-output-stream :element-type 'character)
-           :accessor slime-output-stream-buffer)))
+(defclass slime-output-stream (ccl:fundamental-character-output-stream)
+  ((buffer :initform (make-array 512 :element-type 'character
+                                 :fill-pointer 0 :adjustable t))
+   (last-charpos :initform 0)))
 
 (defmethod ccl:stream-write-char ((stream slime-output-stream) char)
-  (write-char char (slime-output-stream-buffer stream)))
+  (vector-push-extend char (slot-value stream 'buffer))
+  char)
 
 (defmethod ccl:stream-line-column ((stream slime-output-stream))
-  nil)
+  (with-slots (buffer last-charpos) stream
+    (do ((index (1- (fill-pointer buffer)) (1- index))
+         (count 0 (1+ count)))
+        ((< index 0) (+ count last-charpos))
+      (when (char= (aref buffer index) #\newline)
+        (return count)))))
 
 (defmethod ccl:stream-force-output ((stream slime-output-stream))
-  (send-to-emacs `(:read-output ,(get-output-stream-string
-                                  (slime-output-stream-buffer stream))))
-  (setf (slime-output-stream-buffer stream) (make-string-output-stream)))
+  (with-slots (buffer last-charpos) stream
+    (let ((end (fill-pointer buffer)))
+      (unless (zerop end)
+        (send-to-emacs `(:read-output ,(subseq buffer 0 end)))
+        (setf last-charpos (ccl:stream-line-column stream))
+        (setf (fill-pointer buffer) 0))))
+  nil)
 
-(defclass slime-input-stream (ccl::fundamental-character-input-stream)
+(defclass slime-input-stream (ccl:fundamental-character-input-stream)
   ((buffered-char :initform nil)))
 
 (defmethod ccl:stream-read-char ((s slime-input-stream))
@@ -128,6 +139,15 @@
 
 (defmethod ccl:stream-unread-char ((s slime-input-stream) char)
   (setf (slot-value s 'buffered-char) char)
+  nil)
+
+(defmethod ccl:stream-listen ((s slime-input-stream))
+  nil)
+
+(defmethod ccl:stream-line-column ((s slime-input-stream))
+  nil)
+
+(defmethod ccl:stream-line-length ((s slime-input-stream))
   nil)
 
 ;;; Evaluation