/[slime]/slime/swank-gray.lisp
ViewVC logotype

Contents of /slime/swank-gray.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sun Nov 16 17:46:59 2003 UTC (10 years, 5 months ago) by heller
Branch: MAIN
CVS Tags: SLIME-0-9, SLIME-0-8, SLIME-0-10
(stream-write-char): Don't flush the buffer on newlines.
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; swank-gray.lisp --- Gray stream based IO redirection.
4 ;;;
5 ;;; Created 2003, Helmut Eller
6 ;;;
7 ;;; This code has been placed in the Public Domain. All warranties
8 ;;; are disclaimed.
9 ;;;
10 ;;; $Id: swank-gray.lisp,v 1.1 2003/11/16 17:46:59 heller Exp $
11 ;;;
12
13 (in-package :swank)
14
15 (defclass slime-output-stream (fundamental-character-output-stream)
16 ((buffer :initform (make-string 512))
17 (fill-pointer :initform 0)
18 (column :initform 0)))
19
20 (defmethod stream-write-char ((stream slime-output-stream) char)
21 (with-slots (buffer fill-pointer column) stream
22 (setf (schar buffer fill-pointer) char)
23 (incf fill-pointer)
24 (incf column)
25 (when (char= #\newline char)
26 (setf column 0))
27 (when (= fill-pointer (length buffer))
28 (force-output stream)))
29 char)
30
31 (defmethod stream-line-column ((stream slime-output-stream))
32 (slot-value stream 'column))
33
34 (defmethod stream-line-length ((stream slime-output-stream))
35 75)
36
37 (defmethod stream-force-output ((stream slime-output-stream))
38 (with-slots (buffer fill-pointer) stream
39 (let ((end fill-pointer))
40 (unless (zerop end)
41 (send-to-emacs `(:read-output ,(subseq buffer 0 end)))
42 (setf fill-pointer 0))))
43 nil)
44
45 (defclass slime-input-stream (fundamental-character-input-stream)
46 ((buffer :initform "") (index :initform 0)))
47
48 (defmethod stream-read-char ((s slime-input-stream))
49 (with-slots (buffer index) s
50 (when (= index (length buffer))
51 (setf buffer (slime-read-string))
52 (setf index 0))
53 (assert (plusp (length buffer)))
54 (prog1 (aref buffer index) (incf index))))
55
56 (defmethod stream-listen ((s slime-input-stream))
57 (with-slots (buffer index) s
58 (< index (length buffer))))
59
60 (defmethod stream-unread-char ((s slime-input-stream) char)
61 (with-slots (buffer index) s
62 (setf (aref buffer (decf index)) char))
63 nil)
64
65 (defmethod stream-clear-input ((s slime-input-stream))
66 (with-slots (buffer index) s
67 (setf buffer ""
68 index 0))
69 nil)
70
71 (defmethod stream-line-column ((s slime-input-stream))
72 nil)
73
74 (defmethod stream-line-length ((s slime-input-stream))
75 75)
76

  ViewVC Help
Powered by ViewVC 1.1.5