[slime-cvs] CVS slime

[CVS User rtoy]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv8210

Modified Files:
	ChangeLog swank-backend.lisp swank-cmucl.lisp swank-rpc.lisp 
Log Message:
Add CODEPOINT-LENGTH function to return the number of codepoints in a
string.  Needed to make sure that Emacs and Lisp agree on the length
of a string.  Emacs wants codepoints and some lisps give code units.


--- /project/slime/cvsroot/slime/ChangeLog	2010/10/08 09:03:24	1.2149
+++ /project/slime/cvsroot/slime/ChangeLog	2010/10/09 23:02:32	1.2150
@@ -1,3 +1,16 @@
+2010-10-09  Raymond Toy  <toy.raymond at gmail.com>
+
+	* swank-cmucl.lisp (codepoint-length): Implement codepoint-length
+	to return the number of codepoints in cmucl's utf-16 strings.
+
+	* swank-backend.lisp (:swank-backend): Export codepoint-length. 
+	(codepoint-length): definterface codepoint-length.  Default is to
+	use LENGTH.
+
+	* swank-rpc.lisp (write-message): Call
+	swank-backend:codepoint-length to get the correct length for
+	emacs. 
+
 2010-10-08  Christophe Rhodes  <csr21 at cantab.net>
 
 	Pass more detailed source location information to
--- /project/slime/cvsroot/slime/swank-backend.lisp	2010/10/08 09:03:24	1.202
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2010/10/09 23:02:33	1.203
@@ -1317,3 +1317,12 @@
   "Request saving a heap image to the file FILENAME.
 RESTART-FUNCTION, if non-nil, should be called when the image is loaded.
 COMPLETION-FUNCTION, if non-nil, should be called after saving the image.")
+
+;;; Codepoint length
+
+(definterface codepoint-length (string)
+  "Return the number of codepoints in STRING.
+With some Lisps, like cmucl, LENGTH returns the number of UTF-16 code
+units, but other Lisps return the number of codepoints. The slime
+protocol wants string lengths in terms of codepoints."
+  (length string))
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/09/20 16:09:13	1.231
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/10/09 23:02:33	1.232
@@ -2576,3 +2576,16 @@
     (loop for n in names
        when (funcall matchp prefix n)
        collect n)))
+
+(defimplementation codepoint-length (string)
+  "Return the number of code points in the string.  The string MUST be
+  a valid UTF-16 string."
+  (do ((len (length string))
+       (index 0 (1+ index))
+       (count 0 (1+ count)))
+      ((>= index len)
+       count)
+    (multiple-value-bind (codepoint wide)
+	(lisp:codepoint string index)
+      (declare (ignore codepoint))
+      (when wide (incf index)))))
--- /project/slime/cvsroot/slime/swank-rpc.lisp	2010/04/14 17:51:30	1.6
+++ /project/slime/cvsroot/slime/swank-rpc.lisp	2010/10/09 23:02:33	1.7
@@ -92,7 +92,7 @@
 
 (defun write-message (message package stream)
   (let* ((string (prin1-to-string-for-emacs message package))
-         (length (length string)))
+         (length (swank-backend:codepoint-length string)))
     (let ((*print-pretty* nil))
       (format stream "~6,'0x" length))
     (write-string string stream)