[Openmcl-devel] Objective-C constant strings with unicode

[Pascal J. Bourguignon]

    (lisp-string (ccl:@ "été")) --> "√©t√©" ; fails.

with the "obvious":

    (defun lisp-string (a-nsstring)
      (ccl::%get-utf-8-cstring (objc:send a-nsstring 'utf8-string)))


The problem is that make-cstring doesn't deal with encodings.

So here is a replacement, which encodes the lisp string into utf-8, and
which uses the NSString public API to build a string from the utf-8
bytes.  (If you have any information about the internals of
NSConstantString, you may want to "optimize" it).


But as it is, I get what I expect:


    (lisp-string @"été") --> "été"




;;;
;;; Constants strings in objc-runtime don't support unicode characters.
;;; so we need to redo it here.
;;;

(defun make-utf8-cstring (lstring)
  (let* ((llen  (length lstring))
         (clen  (ccl::utf-8-octets-in-string lstring 0 llen)))
    (declare (fixnum llen clen))
    (let* ((cstring (ccl::malloc (the fixnum (1+ clen)))))
      (ccl::utf-8-memory-encode lstring cstring 0 0 llen)
      (setf (ccl::%get-byte cstring clen) 0)
      #+testing
      (print (loop
                for str = cstring
                for i from 0 
                for ch = (CCL:%GET-UNSIGNED-BYTE str i)
                while (plusp ch)
                collect ch))
      (values cstring clen))))

(defun %make-constant-nsstring (string-literal)
  (multiple-value-bind (bytes bytelen) (make-utf8-cstring string-literal)
    (objc:send (objc:send ns:ns-string 'alloc)
               :init-with-bytes-no-copy bytes
               :length bytelen
               :encoding #$|NSUTF8StringEncoding|
               :free-when-done t)))


(defvar *objc-constant-strings* (make-hash-table :test #'equal))

(defstruct objc-constant-string
  string
  nsstringptr)

(defun ns-constant-string (string)
  (or (gethash string *objc-constant-strings*)
      (setf (gethash string *objc-constant-strings*)
            (make-objc-constant-string :string string
                                       :nsstringptr (%make-constant-nsstring string)))))

(defmethod make-load-form ((s objc-constant-string) &optional env)
  (declare (ignore env))
  `(ns-constant-string ,(objc-constant-string-string s)))


(defmacro @ (string)
  `(objc-constant-string-nsstringptr ,(ns-constant-string string)))


(defun lisp-string (a-nsstring)
  #+testing
  (print (loop
            for str = (objc:send a-nsstring 'utf8-string)
            for i from 0
            for ch = (CCL:%GET-UNSIGNED-BYTE str i)
            while (plusp ch)
            collect ch))
  (ccl::%get-utf-8-cstring (objc:send a-nsstring 'utf8-string)))


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
A bad day in () is better than a good day in {}.