Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 167 lines (138 sloc) 5.289 kb
324fe7c6 »
2003-11-16 (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 ;;;
c4fc6d02 »
2004-09-19 (stream-read-char): Treat empty strings as end-of-file.
5 ;;; Created 2003
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
6 ;;;
7 ;;; This code has been placed in the Public Domain. All warranties
8 ;;; are disclaimed.
9 ;;;
10
4db92f66 »
2004-03-09 (in-package): We are in-package :swank-backend. Thanks to Raymond
11 (in-package :swank-backend)
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
12
13 (defclass slime-output-stream (fundamental-character-output-stream)
7fb074b2 »
2004-01-12 (slime-input-stream, slime-output-buffer): Added slots to support the
14 ((output-fn :initarg :output-fn)
05f3e0d3 »
2005-09-21 Improve stream efficiency by buffering more
15 (buffer :initform (make-string 8000))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
16 (fill-pointer :initform 0)
05f3e0d3 »
2005-09-21 Improve stream efficiency by buffering more
17 (column :initform 0)
9c6913aa »
2008-08-05 Drop distinction between "recursive" and non-recursive locks.
18 (lock :initform (make-lock :name "buffer write lock"))))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
19
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
20 (defmacro with-slime-output-stream (stream &body body)
21 `(with-slots (lock output-fn buffer fill-pointer column) ,stream
9c6913aa »
2008-08-05 Drop distinction between "recursive" and non-recursive locks.
22 (call-with-lock-held lock (lambda () ,@body))))
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
23
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
24 (defmethod stream-write-char ((stream slime-output-stream) char)
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
25 (with-slime-output-stream stream
26 (setf (schar buffer fill-pointer) char)
27 (incf fill-pointer)
28 (incf column)
29 (when (char= #\newline char)
30 (setf column 0))
31 (when (= fill-pointer (length buffer))
32 (finish-output stream)))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
33 char)
34
5b6392ad »
2008-08-05 * swank-gray.lisp (stream-write-string): New method.
35 (defmethod stream-write-string ((stream slime-output-stream) string
36 &optional start end)
37 (with-slime-output-stream stream
38 (let* ((start (or start 0))
39 (end (or end (length string)))
40 (len (length buffer))
41 (count (- end start))
42 (free (- len fill-pointer)))
43 (when (>= count free)
44 (stream-finish-output stream))
45 (cond ((< count len)
46 (replace buffer string :start1 fill-pointer
47 :start2 start :end2 end)
48 (incf fill-pointer count))
49 (t
50 (funcall output-fn (subseq string start end))))
51 (let ((last-newline (position #\newline string :from-end t
52 :start start :end end)))
53 (setf column (if last-newline
54 (- end last-newline 1)
55 (+ column count))))))
56 string)
57
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
58 (defmethod stream-line-column ((stream slime-output-stream))
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
59 (with-slime-output-stream stream column))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
60
61 (defmethod stream-line-length ((stream slime-output-stream))
62 75)
63
05f3e0d3 »
2005-09-21 Improve stream efficiency by buffering more
64 (defmethod stream-finish-output ((stream slime-output-stream))
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
65 (with-slime-output-stream stream
66 (unless (zerop fill-pointer)
67 (funcall output-fn (subseq buffer 0 fill-pointer))
68 (setf fill-pointer 0)))
05f3e0d3 »
2005-09-21 Improve stream efficiency by buffering more
69 nil)
70
71 (defmethod stream-force-output ((stream slime-output-stream))
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
72 (stream-finish-output stream))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
73
1fc8d7f9 »
2005-09-22 (stream-fresh-line): Define a method, so that Allegro passes our tests.
74 (defmethod stream-fresh-line ((stream slime-output-stream))
72d481c3 »
2008-08-04 * swank-gray.lisp (slime-output-stream): Undo last change.
75 (with-slime-output-stream stream
76 (cond ((zerop column) nil)
77 (t (terpri stream) t))))
1fc8d7f9 »
2005-09-22 (stream-fresh-line): Define a method, so that Allegro passes our tests.
78
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
79 (defclass slime-input-stream (fundamental-character-input-stream)
47ff7de5 »
2008-08-30 * swank-gray.lisp (slime-input-stream): Remove the output stream
80 ((input-fn :initarg :input-fn)
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
81 (buffer :initform "") (index :initform 0)
82 (lock :initform (make-lock :name "buffer read lock"))))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
83
84 (defmethod stream-read-char ((s slime-input-stream))
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
85 (call-with-lock-held
86 (slot-value s 'lock)
87 (lambda ()
47ff7de5 »
2008-08-30 * swank-gray.lisp (slime-input-stream): Remove the output stream
88 (with-slots (buffer index input-fn) s
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
89 (when (= index (length buffer))
90 (let ((string (funcall input-fn)))
91 (cond ((zerop (length string))
92 (return-from stream-read-char :eof))
93 (t
94 (setf buffer string)
95 (setf index 0)))))
96 (assert (plusp (length buffer)))
97 (prog1 (aref buffer index) (incf index))))))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
98
99 (defmethod stream-listen ((s slime-input-stream))
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
100 (call-with-lock-held
101 (slot-value s 'lock)
102 (lambda ()
103 (with-slots (buffer index) s
104 (< index (length buffer))))))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
105
106 (defmethod stream-unread-char ((s slime-input-stream) char)
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
107 (call-with-lock-held
108 (slot-value s 'lock)
109 (lambda ()
110 (with-slots (buffer index) s
111 (decf index)
112 (cond ((eql (aref buffer index) char)
113 (setf (aref buffer index) char))
114 (t
115 (warn "stream-unread-char: ignoring ~S (expected ~S)"
116 char (aref buffer index)))))))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
117 nil)
118
119 (defmethod stream-clear-input ((s slime-input-stream))
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
120 (call-with-lock-held
121 (slot-value s 'lock)
122 (lambda ()
123 (with-slots (buffer index) s
124 (setf buffer ""
125 index 0))))
324fe7c6 »
2003-11-16 (stream-write-char): Don't flush the buffer on newlines.
126 nil)
127
128 (defmethod stream-line-column ((s slime-input-stream))
129 nil)
130
131 (defmethod stream-line-length ((s slime-input-stream))
132 75)
133
05005464 »
2004-01-13 (make-fn-streams): New function.
134
135 ;;; CLISP extensions
136
137 ;; We have to define an additional method for the sake of the C
138 ;; function listen_char (see src/stream.d), on which SYS::READ-FORM
139 ;; depends.
140
141 ;; We could make do with either of the two methods below.
142
143 (defmethod stream-read-char-no-hang ((s slime-input-stream))
8a91fe75 »
2006-04-12 Stream locking patch from Robert Macomber
144 (call-with-lock-held
145 (slot-value s 'lock)
146 (lambda ()
147 (with-slots (buffer index) s
148 (when (< index (length buffer))
149 (prog1 (aref buffer index) (incf index)))))))
05005464 »
2004-01-13 (make-fn-streams): New function.
150
151 ;; This CLISP extension is what listen_char actually calls. The
152 ;; default method would call STREAM-READ-CHAR-NO-HANG, so it is a bit
153 ;; more efficient to define it directly.
154
155 (defmethod stream-read-char-will-hang-p ((s slime-input-stream))
156 (with-slots (buffer index) s
157 (= index (length buffer))))
158
159
160 ;;;
2eb9f831 »
2008-08-22 Implement streams with a length limit.
161
162 (defimplementation make-output-stream (write-string)
bd96d039 »
2008-08-22 Fix typos.
163 (make-instance 'slime-output-stream :output-fn write-string))
2eb9f831 »
2008-08-22 Implement streams with a length limit.
164
165 (defimplementation make-input-stream (read-string)
47ff7de5 »
2008-08-30 * swank-gray.lisp (slime-input-stream): Remove the output stream
166 (make-instance 'slime-input-stream :input-fn read-string))
Something went wrong with that request. Please try again.