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

Diff of /slime/swank-clisp.lisp

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

revision 1.98 by heller, Sun Nov 27 21:47:15 2011 UTC revision 1.99 by heller, Sat Dec 3 12:03:26 2011 UTC
# Line 187  Line 187 
187                                 if x collect s)))                                 if x collect s)))
188                (when ready (return ready))))))))                (when ready (return ready))))))))
189    
190    #+win32
191    (defimplementation wait-for-input (streams &optional timeout)
192      (assert (member timeout '(nil t)))
193      (loop
194       (cond ((check-slime-interrupts) (return :interrupt))
195             (t
196              (let ((ready (remove-if-not #'input-available-p streams)))
197                (when ready (return ready)))
198              (when timeout (return nil))
199              (sleep 0.1)))))
200    
201    #+win32
202    ;; Some facts to remember (for the next time we need to debug this):
203    ;;  - interactive-sream-p returns t for socket-streams
204    ;;  - listen returns nil for socket-streams
205    ;;  - (type-of <socket-stream>) is 'stream
206    ;;  - (type-of *terminal-io*) is 'two-way-stream
207    ;;  - stream-element-type on our sockets is usually (UNSIGNED-BYTE 8)
208    ;;  - calling socket:socket-status on non sockets signals an error,
209    ;;    but seems to mess up something internally.
210    ;;  - calling read-char-no-hang on sockets does not signal an error,
211    ;;    but seems to mess up something internally.
212    (defun input-available-p (stream)
213      (case (stream-element-type stream)
214        (character
215         (let ((c (read-char-no-hang stream nil nil)))
216           (cond ((not c)
217                  nil)
218                 (t
219                  (unread-char c stream)
220                  t))))
221        (t
222         (eq (socket:socket-status (cons stream :input) 0 0)
223             :input))))
224    
225  ;;;; Coding systems  ;;;; Coding systems
226    
227  (defvar *external-format-to-coding-system*  (defvar *external-format-to-coding-system*

Legend:
Removed from v.1.98  
changed lines
  Added in v.1.99

  ViewVC Help
Powered by ViewVC 1.1.5