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

Diff of /slime/swank-gray.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by heller, Wed Jan 19 18:28:37 2005 UTC revision 1.8 by heller, Wed Sep 21 11:39:10 2005 UTC
# Line 12  Line 12 
12    
13  (defclass slime-output-stream (fundamental-character-output-stream)  (defclass slime-output-stream (fundamental-character-output-stream)
14    ((output-fn :initarg :output-fn)    ((output-fn :initarg :output-fn)
15     (buffer :initform (make-string 512))     (buffer :initform (make-string 8000))
16     (fill-pointer :initform 0)     (fill-pointer :initform 0)
17     (column :initform 0)))     (column :initform 0)
18       (last-flush-time :initform (get-internal-real-time))))
19    
20  (defmethod stream-write-char ((stream slime-output-stream) char)  (defmethod stream-write-char ((stream slime-output-stream) char)
21    (with-slots (buffer fill-pointer column) stream    (with-slots (buffer fill-pointer column) stream
# Line 22  Line 23 
23      (incf fill-pointer)      (incf fill-pointer)
24      (incf column)      (incf column)
25      (when (char= #\newline char)      (when (char= #\newline char)
26        (setf column 0))        (setf column 0)
27          (force-output stream))
28      (when (= fill-pointer (length buffer))      (when (= fill-pointer (length buffer))
29        (force-output stream)))        (finish-output stream)))
30    char)    char)
31    
32  (defmethod stream-line-column ((stream slime-output-stream))  (defmethod stream-line-column ((stream slime-output-stream))
# Line 33  Line 35 
35  (defmethod stream-line-length ((stream slime-output-stream))  (defmethod stream-line-length ((stream slime-output-stream))
36    75)    75)
37    
38  (defmethod stream-force-output ((stream slime-output-stream))  (defmethod stream-finish-output ((stream slime-output-stream))
39    (with-slots (buffer fill-pointer output-fn) stream    (with-slots (buffer fill-pointer output-fn last-flush-time) stream
40      (let ((end fill-pointer))      (let ((end fill-pointer))
41        (unless (zerop end)        (unless (zerop end)
42          (funcall output-fn (subseq buffer 0 end))          (funcall output-fn (subseq buffer 0 end))
43          (setf fill-pointer 0))))          (setf fill-pointer 0)))
44        (setf last-flush-time (get-internal-real-time)))
45      nil)
46    
47    (defmethod stream-force-output ((stream slime-output-stream))
48      (with-slots (last-flush-time) stream
49        (let ((now (get-internal-real-time)))
50          (when (> (/ (- now last-flush-time)
51                      (coerce internal-time-units-per-second 'double-float))
52                   0.2)
53            (finish-output stream))))
54    nil)    nil)
55    
56  (defclass slime-input-stream (fundamental-character-input-stream)  (defclass slime-input-stream (fundamental-character-input-stream)
# Line 50  Line 62 
62    (with-slots (buffer index output-stream input-fn) s    (with-slots (buffer index output-stream input-fn) s
63      (when (= index (length buffer))      (when (= index (length buffer))
64        (when output-stream        (when output-stream
65          (force-output output-stream))          (finish-output output-stream))
66        (let ((string (funcall input-fn)))        (let ((string (funcall input-fn)))
67          (cond ((zerop (length string))          (cond ((zerop (length string))
68                 (return-from stream-read-char :eof))                 (return-from stream-read-char :eof))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5