[Openmcl-cvs-notifications] r15180 - in /trunk/source/cocoa-ide: cf-utils.lisp defsystem.lisp

[rme at clozure.com]

Author: rme
Date: Wed Jan 25 14:11:08 2012
New Revision: 15180

Log:
New file cf-utils.lisp.  Build it along with the rest of the IDE.

Added:
    trunk/source/cocoa-ide/cf-utils.lisp
Modified:
    trunk/source/cocoa-ide/defsystem.lisp

Added: trunk/source/cocoa-ide/cf-utils.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cf-utils.lisp (added)
+++ trunk/source/cocoa-ide/cf-utils.lisp Wed Jan 25 14:11:08 2012
@@ -1,0 +1,50 @@
+(in-package "CCL")
+
+(export '(with-cfstring %get-cfstring with-cfurl))
+
+;;; We could use something like ccl:with-pointer-to-ivector to get a
+;;; pointer to the lisp string's underlying vector of UTF-32 code
+;;; points to pass to #_CFStringCreateWithBytes.  This would avoid
+;;; making an extra copy of the string data, and might be a win when
+;;; the strings are large.
+(defun %make-cfstring (string)
+  (with-encoded-cstrs :utf-8 ((cstr string))
+    (#_CFStringCreateWithCString +null-ptr+ cstr #$kCFStringEncodingUTF8)))
+
+(defmacro with-cfstring ((sym string) &body body)
+  `(let* ((,sym (%make-cfstring ,string)))
+     (unwind-protect
+	  (progn , at body)
+       (unless (%null-ptr-p ,sym)
+	 (#_CFRelease ,sym)))))
+
+(defun %get-cfstring (cfstring)
+  (let* ((len (#_CFStringGetLength cfstring))
+	 (noctets (* len 2))
+	 (p (#_CFStringGetCharactersPtr cfstring)))
+    (if (not (%null-ptr-p p))
+      (get-encoded-string #+little-endian-target :utf-16le
+			  #-little-endian-target :utf-16be
+			  p noctets)
+      (rlet ((range #>CFRange))
+	(setf (pref range #>CFRange.location) 0
+	      (pref range #>CFRange.length) len)
+	(%stack-block ((buf noctets))
+	  (#_CFStringGetCharacters cfstring range buf)
+	  (get-encoded-string #+little-endian-target :utf-16le
+			      #-little-endian-target :utf-16be
+			      buf noctets))))))
+	=

+(defun %make-cfurl (pathname)
+  (let* ((namestring (native-translated-namestring pathname))
+	 (noctets (string-size-in-octets namestring :external-format :utf-8))
+	 (dir-p (if (directoryp pathname) #$true #$false)))
+    (with-encoded-cstrs :utf-8 ((s namestring))
+      (#_CFURLCreateFromFileSystemRepresentation +null-ptr+ s noctets dir-=
p))))
+
+(defmacro with-cfurl ((sym pathname) &body body)
+  `(let ((,sym (%make-cfurl ,pathname)))
+     (unwind-protect
+	  (progn , at body)
+       (unless (%null-ptr-p ,sym)
+	 (#_CFRelease ,sym)))))

Modified: trunk/source/cocoa-ide/defsystem.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/defsystem.lisp (original)
+++ trunk/source/cocoa-ide/defsystem.lisp Wed Jan 25 14:11:08 2012
@@ -65,6 +65,7 @@
   '(;"ide-bundle" - loaded by hand above
     "constants"
     "cocoa-utils"
+    "cf-utils"
     "cocoa-defaults"
     "cocoa-prefs"
     "cocoa-typeout"