[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv10678

Modified Files:
	ChangeLog swank-clisp.lisp 
Log Message:
* swank-mrepl.lisp (package-prompt): Use <= instead of < to give
package-name priority over nicknames.

--- /project/slime/cvsroot/slime/ChangeLog	2011/12/02 20:24:03	1.2258
+++ /project/slime/cvsroot/slime/ChangeLog	2011/12/03 12:03:26	1.2259
@@ -1,3 +1,7 @@
+2011-12-03  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-clisp.lisp (wait-for-input): Add a version for windows.
+
 2011-12-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (wait-for-input): Define only if
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2011/11/27 21:47:15	1.98
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2011/12/03 12:03:26	1.99
@@ -187,6 +187,41 @@
                                if x collect s)))
               (when ready (return ready))))))))
 
+#+win32
+(defimplementation wait-for-input (streams &optional timeout)
+  (assert (member timeout '(nil t)))
+  (loop
+   (cond ((check-slime-interrupts) (return :interrupt))
+         (t 
+          (let ((ready (remove-if-not #'input-available-p streams)))
+            (when ready (return ready)))
+          (when timeout (return nil))
+          (sleep 0.1)))))
+
+#+win32
+;; Some facts to remember (for the next time we need to debug this):
+;;  - interactive-sream-p returns t for socket-streams
+;;  - listen returns nil for socket-streams
+;;  - (type-of <socket-stream>) is 'stream
+;;  - (type-of *terminal-io*) is 'two-way-stream
+;;  - stream-element-type on our sockets is usually (UNSIGNED-BYTE 8)
+;;  - calling socket:socket-status on non sockets signals an error,
+;;    but seems to mess up something internally.
+;;  - calling read-char-no-hang on sockets does not signal an error,
+;;    but seems to mess up something internally.
+(defun input-available-p (stream)
+  (case (stream-element-type stream)
+    (character
+     (let ((c (read-char-no-hang stream nil nil)))
+       (cond ((not c)
+              nil)
+             (t
+              (unread-char c stream)
+              t))))
+    (t
+     (eq (socket:socket-status (cons stream :input) 0 0)
+         :input))))
+
 ;;;; Coding systems
 
 (defvar *external-format-to-coding-system*