[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv10105

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
Unicode support for CMUCL (by Raymond Toy)

* swank-cmucl.lisp (accept-connection, make-socket-io-stream):
Handle external-format argument.
(find-external-format): Implemented.
(*external-format-to-coding-system*): New variable.

--- /project/slime/cvsroot/slime/ChangeLog	2008/05/19 13:12:52	1.1356
+++ /project/slime/cvsroot/slime/ChangeLog	2008/06/02 18:11:15	1.1357
@@ -1,3 +1,12 @@
+2008-06-02  Raymond Toy <toy.raymond at gmail.com>
+
+	Unicode support for CMUCL.
+
+	* swank-cmucl.lisp (accept-connection, make-socket-io-stream):
+	Handle external-format argument.
+	(find-external-format): Implemented.
+	(*external-format-to-coding-system*): New variable.
+
 2008-05-19  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-sbcl.lisp: Don't require asdf.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/04/17 14:56:43	1.179
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/06/02 18:11:16	1.180
@@ -100,9 +100,10 @@
 
 (defimplementation accept-connection (socket &key
                                       external-format buffering timeout)
-  (declare (ignore timeout external-format))
-  (let ((buffering (or buffering :full)))
-    (make-socket-io-stream (ext:accept-tcp-connection socket) buffering)))
+  (declare (ignore timeout))
+  (make-socket-io-stream (ext:accept-tcp-connection socket) 
+                         (or buffering :full)
+                         (or external-format :iso-latin-1-unix)))
 
 ;;;;; Sockets
 
@@ -117,10 +118,24 @@
   (let ((hostent (ext:lookup-host-entry hostname)))
     (car (ext:host-entry-addr-list hostent))))
 
-(defun make-socket-io-stream (fd buffering)
+(defvar *external-format-to-coding-system*
+  '((:iso-8859-1
+     "latin-1" "latin-1-unix" "iso-latin-1-unix"
+     "iso-8859-1" "iso-8859-1-unix")
+    #+unicode
+    (:utf-8 "utf-8" "utf-8-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
+
+(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))
+                      :buffering buffering
+                      #+unicode :external-format 
+                      #+unicode external-format))
 
 ;;;;; Signal-driven I/O