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

Diff of /slime/swank-sbcl.lisp

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

revision 1.22 by heller, Thu Nov 13 00:36:56 2003 UTC revision 1.23 by heller, Sun Nov 16 18:08:43 2003 UTC
# Line 44  Line 44 
44  (declaim (optimize (debug 3)))  (declaim (optimize (debug 3)))
45  (in-package :swank)  (in-package :swank)
46    
47    (import
48     '(sb-gray:fundamental-character-output-stream
49       sb-gray:stream-write-char
50       sb-gray:stream-line-length
51       sb-gray:stream-force-output
52       sb-gray:fundamental-character-input-stream
53       sb-gray:stream-read-char
54       sb-gray:stream-listen
55       sb-gray:stream-unread-char
56       sb-gray:stream-clear-input
57       sb-gray:stream-line-column
58       sb-gray:stream-line-length))
59    
60    (defun without-interrupts* (body)
61      (sb-sys:without-interrupts (funcall body)))
62    
63  ;;; TCP Server  ;;; TCP Server
64    
65    
# Line 155  until the remote Emacs goes away." Line 171  until the remote Emacs goes away."
171      (close *emacs-io*)))      (close *emacs-io*)))
172  |#  |#
173    
   
   
 ;;; Redirecting Output to Emacs  
   
 ;; 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 512))  
    (fill-pointer :initform 0)  
    (column :initform 0)))  
   
 (defmethod sb-gray:stream-write-char ((stream slime-output-stream) char)  
   (with-slots (buffer fill-pointer column) stream  
     (setf (schar buffer fill-pointer) char)  
     (incf fill-pointer)  
     (incf column)  
     (cond ((char= #\newline char)  
            (force-output stream)  
            (setf column 0))  
           ((= fill-pointer (length buffer))  
            (force-output stream))))  
   char)  
   
 (defmethod sb-gray:stream-line-column ((stream slime-output-stream))  
   (slot-value stream 'column))  
   
 (defmethod sb-gray:stream-line-length ((stream slime-output-stream))  
   75)  
   
 (defmethod sb-gray:stream-force-output ((stream slime-output-stream))  
   (with-slots (buffer fill-pointer) stream  
     (let ((end fill-pointer))  
       (unless (zerop end)  
         (send-to-emacs `(:read-output ,(subseq buffer 0 end)))  
         (setf fill-pointer 0))))  
   nil)  
   
 (defclass slime-input-stream (sb-gray:fundamental-character-input-stream)  
   ((buffer :initform "") (index :initform 0)))  
   
 (defmethod sb-gray:stream-read-char ((s slime-input-stream))  
   (with-slots (buffer index) s  
     (when (= index (length buffer))  
       (setf buffer (slime-read-string))  
       (setf index 0))  
     (assert (plusp (length buffer)))  
     (prog1 (aref buffer index) (incf index))))  
   
 (defmethod sb-gray:stream-listen ((s slime-input-stream))  
   (with-slots (buffer index) s  
     (< index (length buffer))))  
   
 (defmethod sb-gray:stream-unread-char ((s slime-input-stream) char)  
   (with-slots (buffer index) s  
     (setf (aref buffer (decf index)) char))  
   nil)  
   
 (defmethod sb-gray:stream-clear-input ((s slime-input-stream))  
   (with-slots (buffer index) s  
     (setf buffer ""  
           index 0))  
   nil)  
   
 (defmethod sb-gray:stream-line-column ((s slime-input-stream))  
   nil)  
   
 (defmethod sb-gray:stream-line-length ((s slime-input-stream))  
   75)  
   
174  ;;; Utilities  ;;; Utilities
175    
176  (defvar *swank-debugger-stack-frame*)  (defvar *swank-debugger-stack-frame*)

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23

  ViewVC Help
Powered by ViewVC 1.1.5