From 022d6fd15bb75eb690680c06cacb9a423c712787 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 13 Sep 2010 21:27:04 +0000 Subject: [PATCH] Add function to convert a sequence of codepoints to a string and a function to convert a string to a list of codepoints. --- code/string.lisp | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/code/string.lisp b/code/string.lisp index 84aa6a9dc..e2782ad9c 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 -- GitLab