diff --git a/code/string.lisp b/code/string.lisp index 84aa6a9dcb57a270d4c4d8faa9d914d15a96aab7..e2782ad9c96f9ccd06d7b9d81569d484b3e2848c 100644 --- a/code/string.lisp +++ b/code/string.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.24 2010/04/20 17:57:45 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.25 2010/09/13 21:27:04 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1684,3 +1684,33 @@ result :start (1+ start) :end next))) (write-string string result :start end :end offset-slen)))))) + +;; Some utilities +(defun codepoints-string (seq) + "Convert a sequence of codepoints to a string. Codepoints outside + the basic multilingual plane (BMP) are converted into the + corresponding surrogate pairs." + (with-output-to-string (s) + (map nil #'(lambda (c) + (multiple-value-bind (hi lo) + (surrogates c) + (write-char hi s) + (when lo (write-char lo s)))) + seq))) + +(defun string-codepoints (s) + "Convert a string to a list of corresponding code points. Surrogate + pairs in the string are converted into the correspoinding + codepoint." + (declare (type simple-string s)) + (let ((len (length s)) + cp) + (do ((idx 0)) + ((>= idx len)) + (multiple-value-bind (c widep) + (codepoint s idx) + (if widep + (incf idx 2) + (incf idx)) + (push c cp))) + (nreverse cp))) \ No newline at end of file