[slime-cvs] CVS slime

[mbaringer]

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

Modified Files:
	swank-openmcl.lisp 
Log Message:
(accept-connection, find-external-format):
UNICODE support.


--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2007/04/08 13:29:13	1.117
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2007/04/16 14:47:34	1.118
@@ -167,11 +167,29 @@
 (defimplementation close-socket (socket)
   (close socket))
 
-(defimplementation accept-connection (socket
-                                      &key external-format buffering timeout)
-  (declare (ignore buffering timeout external-format))
+(defimplementation accept-connection (socket &key external-format
+                                             buffering timeout)
+  (declare (ignore buffering timeout
+                   #-openmcl-unicode-strings external-format))
+  #+openmcl-unicode-strings
+  (when external-format
+    (let ((keys (ccl::socket-keys socket)))
+      (setf (getf keys :external-format) external-format
+            (slot-value socket 'ccl::keys) keys)))
   (ccl:accept-connection socket :wait t))
 
+#+openmcl-unicode-strings
+(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")
+    (:utf-8 "utf-8" "utf-8-unix")))
+
+#+openmcl-unicode-strings
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
+
 (defimplementation emacs-connected ()
   (setq ccl::*interactive-abort-process* ccl::*current-process*))