[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Sun Nov 6 17:05:41 UTC 2011
Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv11179
Modified Files:
ChangeLog swank-abcl.lisp swank-backend.lisp swank-clisp.lisp
swank-cmucl.lisp swank-lispworks.lisp swank-sbcl.lisp
swank-scl.lisp
Log Message:
* swank-abcl.lisp (accept-connection): Make it so.
* swank-clisp.lisp (accept-connection): Make it so.
* swank-cmucl.lisp (accept-connection): Make it so.
* swank-lispworks.lisp (accept-connection): Make it so.
* swank-sbcl.lisp (accept-connection): Make it so.
* swank-scl.lisp (accept-connection): Make it so.
--- /project/slime/cvsroot/slime/ChangeLog 2011/11/06 17:05:27 1.2231
+++ /project/slime/cvsroot/slime/ChangeLog 2011/11/06 17:05:41 1.2232
@@ -4,39 +4,26 @@
particular say that we want a binary stream if the EXTERNAL-FORMAT
argument is nil.
-2011-11-06 Helmut Eller <heller at common-lisp.net>
-
- * swank-sbcl.lisp (string-to-utf8, string-to-utf8): Implemented.
+ * swank-abcl.lisp (accept-connection): Make it so.
+ * swank-clisp.lisp (accept-connection): Make it so.
+ * swank-cmucl.lisp (accept-connection): Make it so.
+ * swank-lispworks.lisp (accept-connection): Make it so.
+ * swank-sbcl.lisp (accept-connection): Make it so.
+ * swank-scl.lisp (accept-connection): Make it so.
2011-11-06 Helmut Eller <heller at common-lisp.net>
- * swank-lispworks.lisp (string-to-utf8, string-to-utf8): Implemented.
-
-2011-11-06 Helmut Eller <heller at common-lisp.net>
+ * swank-backend.lisp (utf8-to-string, string-to-utf8): New.
+ * swank-sbcl.lisp (string-to-utf8, string-to-utf8): Implemented .
+ * swank-lispworks.lisp (string-to-utf8, string-to-utf8): Implemented.
* swank-cmucl.lisp (string-to-utf8, string-to-utf8): Implemented.
-
-2011-11-06 Helmut Eller <heller at common-lisp.net>
-
* swank-clisp.lisp (string-to-utf8, string-to-utf8): Implemented.
-
-2011-11-06 Helmut Eller <heller at common-lisp.net>
-
* swank-ccl.lisp (string-to-utf8, string-to-utf8): Implemented.
-
-2011-11-06 Helmut Eller <heller at common-lisp.net>
-
* swank-allegro.lisp (string-to-utf8, string-to-utf8): Implemented.
-
-2011-11-06 Helmut Eller <heller at common-lisp.net>
-
* swank-abcl.lisp (string-to-utf8, string-to-utf8): Implemented.
(octets-to-jbytes, jbytes-to-octets): New helpers.
-2011-11-06 Helmut Eller <heller at common-lisp.net>
-
- * swank-backend.lisp (utf8-to-string, string-to-utf8): New.
-
2011-11-03 Helmut Eller <heller at common-lisp.net>
* swank.lisp (close-connection): Be more careful with non-ascii.
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2011/11/06 17:04:10 1.88
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2011/11/06 17:05:41 1.89
@@ -144,7 +144,10 @@
&key external-format buffering timeout)
(declare (ignore buffering timeout))
(ext:get-socket-stream (ext:socket-accept socket)
- :external-format external-format))
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format (or external-format :default)))
;;;; UTF8
--- /project/slime/cvsroot/slime/swank-backend.lisp 2011/11/06 17:05:27 1.208
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2011/11/06 17:05:41 1.209
@@ -292,10 +292,10 @@
Return a stream for the new connection.
If EXTERNAL-FORMAT is nil return a binary stream
otherwise create a character stream.
-BUFFERING can be one of:
- nil or :none ... no buffering
- t or :full ... enable buffering
- :line ... some buffering with autmatic flushing on eol.")
+BUFFERING can be one of:
+ nil ... no buffering
+ t ... enable buffering
+ :line ... enable buffering with automatic flushing on eol.")
(definterface add-sigio-handler (socket fn)
"Call FN whenever SOCKET is readable.")
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2011/11/06 17:04:43 1.96
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2011/11/06 17:05:41 1.97
@@ -165,9 +165,11 @@
&key external-format buffering timeout)
(declare (ignore buffering timeout))
(socket:socket-accept socket
- :buffered nil ;; XXX should be t
- :element-type 'character
- :external-format external-format))
+ :buffered buffering ;; XXX may not work if t
+ :element-type (if external-format
+ 'character
+ '(unsigned-byte 8))
+ :external-format (or external-format :default)))
#-win32
(defimplementation wait-for-input (streams &optional timeout)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2011/11/06 17:04:54 1.233
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2011/11/06 17:05:41 1.234
@@ -112,8 +112,11 @@
external-format buffering timeout)
(declare (ignore timeout))
(make-socket-io-stream (ext:accept-tcp-connection socket)
- (or buffering :full)
- (or external-format :iso-8859-1)))
+ (ecase buffering
+ (:full :full)
+ (:line :line)
+ ((:none nil) :none))
+ external-format))
;;;;; Sockets
@@ -141,11 +144,15 @@
(defun make-socket-io-stream (fd buffering external-format)
"Create a new input/output fd-stream for FD."
- #-unicode(declare (ignore external-format))
- (sys:make-fd-stream fd :input t :output t :element-type 'base-char
- :buffering buffering
- #+unicode :external-format
- #+unicode external-format))
+ (cond ((and external-format (ext:featurep :unicode))
+ (sys:make-fd-stream fd :input t :output t
+ :element-type '(unsigned-byte 8)
+ :buffering buffering
+ :external-format external-format))
+ (t
+ (sys:make-fd-stream fd :input t :output t
+ :element-type '(unsigned-byte 8)
+ :buffering buffering))))
(defimplementation make-fd-stream (fd external-format)
(make-socket-io-stream fd :full external-format))
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2011/11/06 17:05:05 1.143
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2011/11/06 17:05:41 1.144
@@ -104,22 +104,29 @@
(declare (ignore buffering))
(let* ((fd (comm::get-fd-from-socket socket)))
(assert (/= fd -1))
- (assert (valid-external-format-p external-format))
- (cond ((member (first external-format) '(:latin-1 :ascii))
+ (cond ((not external-format)
(make-instance 'comm:socket-stream
:socket fd
:direction :io
:read-timeout timeout
- :element-type 'base-char))
+ :element-type '(unsigned-byte 8)))
(t
- (assert (member (first external-format) '(:utf-8)))
- (make-instance 'utf8-stream
- :byte-stream
- (make-instance 'comm:socket-stream
- :socket fd
- :direction :io
- :read-timeout timeout
- :element-type '(unsigned-byte 8)))))))
+ (assert (valid-external-format-p external-format))
+ (ecase (first external-format)
+ ((:latin-1 :ascii)
+ (make-instance 'comm:socket-stream
+ :socket fd
+ :direction :io
+ :read-timeout timeout
+ :element-type 'base-char))
+ (:utf-8
+ (make-instance 'utf8-stream :byte-stream
+ (make-instance
+ 'comm:socket-stream
+ :socket fd
+ :direction :io
+ :read-timeout timeout
+ :element-type '(unsigned-byte 8)))))))))
(defclass utf8-stream (stream:fundamental-character-input-stream
stream:fundamental-character-output-stream)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2011/11/06 17:05:16 1.290
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2011/11/06 17:05:41 1.291
@@ -103,9 +103,11 @@
external-format
buffering timeout)
(declare (ignore timeout))
- (make-socket-io-stream (accept socket)
- (or external-format :iso-latin-1-unix)
- (or buffering :full)))
+ (make-socket-io-stream (accept socket) external-format
+ (ecase buffering
+ ((t :full) :full)
+ ((nil :none) :none)
+ ((:line) :line))))
#-win32
(defimplementation install-sigint-handler (function)
@@ -281,22 +283,25 @@
*external-format-to-coding-system*)))
(defun make-socket-io-stream (socket external-format buffering)
- (sb-bsd-sockets:socket-make-stream socket
- :output t
- :input t
- :element-type 'character
- :buffering buffering
- #+sb-unicode :external-format
- #+sb-unicode external-format
- :serve-events
- (eq :fd-handler
- ;; KLUDGE: SWANK package isn't
- ;; available when backend is loaded.
- (symbol-value
- (intern "*COMMUNICATION-STYLE*" :swank)))
- ;; SBCL < 1.0.42.43 doesn't support :SERVE-EVENTS
- ;; argument.
- :allow-other-keys t))
+ (let ((args `(,@()
+ :output t
+ :input t
+ :element-type ,(if external-format
+ 'character
+ '(unsigned-byte 8))
+ :buffering ,buffering
+ ,@(cond ((and external-format (sb-int:featurep :sb-unicode))
+ `(:external-format ,external-format))
+ (t '()))
+ :serve-events ,(eq :fd-handler
+ ;; KLUDGE: SWANK package isn't
+ ;; available when backend is loaded.
+ (symbol-value
+ (intern "*COMMUNICATION-STYLE*" :swank)))
+ ;; SBCL < 1.0.42.43 doesn't support :SERVE-EVENTS
+ ;; argument.
+ :allow-other-keys t)))
+ (apply #'sb-bsd-sockets:socket-make-stream socket args)))
(defun accept (socket)
"Like socket-accept, but retry on EAGAIN."
--- /project/slime/cvsroot/slime/swank-scl.lisp 2010/05/06 06:18:32 1.37
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2011/11/06 17:05:41 1.38
@@ -38,8 +38,7 @@
(defimplementation accept-connection (socket
&key external-format buffering timeout)
- (let ((external-format (or external-format :default))
- (buffering (or buffering :full))
+ (let ((buffering (or buffering :full))
(fd (socket-fd socket)))
(loop
(let ((ready (sys:wait-until-fd-usable fd :input timeout)))
@@ -47,7 +46,11 @@
(error "Timeout accepting connection on socket: ~S~%" socket)))
(let ((new-fd (ignore-errors (ext:accept-tcp-connection fd))))
(when new-fd
- (return (make-socket-io-stream new-fd external-format buffering)))))))
+ (return (make-socket-io-stream new-fd external-format
+ (ecase buffering
+ ((t) :full)
+ ((nil) :none)
+ (:line :line)))))))))
(defimplementation set-stream-timeout (stream timeout)
(check-type timeout (or null real))
@@ -82,15 +85,22 @@
(defun make-socket-io-stream (fd external-format buffering)
"Create a new input/output fd-stream for 'fd."
- (let* ((stream (sys:make-fd-stream fd :input t :output t
- :element-type 'base-char
- :buffering buffering
- :external-format external-format)))
- ;; Ignore character conversion errors. Without this the communication
- ;; channel is prone to lockup if a character conversion error occurs.
- (setf (lisp::character-conversion-stream-input-error-value stream) #\?)
- (setf (lisp::character-conversion-stream-output-error-value stream) #\?)
- stream))
+ (cond ((not external-format)
+ (sys:make-fd-stream fd :input t :output t :buffering buffering
+ :element-type '(unsigned-byte 8)))
+ (t
+ (let* ((stream (sys:make-fd-stream fd :input t :output t
+ :element-type 'base-char
+ :buffering buffering
+ :external-format external-format)))
+ ;; Ignore character conversion errors. Without this the
+ ;; communication channel is prone to lockup if a character
+ ;; conversion error occurs.
+ (setf (lisp::character-conversion-stream-input-error-value stream)
+ #\?)
+ (setf (lisp::character-conversion-stream-output-error-value stream)
+ #\?)
+ stream))))
;;;; Stream handling
More information about the slime-cvs
mailing list