r10917: 2006-04-17 Kevin Rosenberg (kevin@rosenberg.net)

[uffi.git] / src / strings.lisp

diff --git a/src/strings.lisp b/src/strings.lisp
index 1e90118c174e8a10f25dda0f06224d533a7c1ff3..69f1f02836f9fbf0ff37b21af145a076029ed091 100644 (file)
--- a/src/strings.lisp
+++ b/src/strings.lisp
@@ -9,11 +9,7 @@
 ;;;;
 ;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;; *************************************************************************
 
 (in-package #:uffi)
@@ -23,7 +19,7 @@
     #+(or cmu sbcl scl) nil
     #+allegro 0
     #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
-    #+mcl (ccl:%null-ptr)
+    #+(or openmcl digitool) (ccl:%null-ptr)
 )
 
 (defmacro convert-from-cstring (obj)
@@ -36,7 +32,7 @@ that LW/CMU automatically converts strings from c-calls."
        (if (zerop ,stored)
           nil
           (values (excl:native-to-string ,stored)))))
-  #+mcl 
+  #+(or openmcl digitool) 
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (if (ccl:%null-ptr-p ,stored)
@@ -52,7 +48,7 @@ that LW/CMU automatically converts strings from c-calls."
        (if (null ,stored)
           0
           (values (excl:string-to-native ,stored)))))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (if (null ,stored)
@@ -69,7 +65,7 @@ that LW/CMU automatically converts strings from c-calls."
     `(let ((,stored ,obj))
        (unless (zerop ,stored)
         (ff:free-fobject ,stored))))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (unless (ccl:%null-ptr-p ,stored)
@@ -86,7 +82,7 @@ that LW/CMU automatically converts strings from c-calls."
        (excl:with-native-string (,acl-native ,stored-lisp-string)
         (let ((,cstring (if ,stored-lisp-string ,acl-native 0)))
           ,@body))))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((stored-lisp-string (gensym)))
     `(let ((,stored-lisp-string ,lisp-string))
        (if (stringp ,stored-lisp-string)
@@ -109,11 +105,11 @@ that LW/CMU automatically converts strings from c-calls."
   #+lispworks
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
-       `(if (null ,stored)
-           +null-cstring-pointer+
-           (fli:convert-to-foreign-string 
-            ,stored
-            :external-format '(:latin-1 :eol-style :lf)))))
+       (if (null ,stored)
+          +null-cstring-pointer+
+          (fli:convert-to-foreign-string 
+           ,stored
+           :external-format '(:latin-1 :eol-style :lf)))))
   #+allegro
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
@@ -162,7 +158,7 @@ that LW/CMU automatically converts strings from c-calls."
                      (char-code (char ,stored-obj ,i))))
              (setf (sb-alien:deref ,storage ,size) 0))
            ,storage)))))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((stored-obj (gensym)))
     `(let ((,stored-obj ,obj))
        (if (null ,stored-obj)
@@ -218,14 +214,14 @@ that LW/CMU automatically converts strings from c-calls."
            (sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
                                     :length ,length
                                     :null-terminated-p ,null-terminated-p))))
-  #+mcl
+  #+(or openmcl digitool)
   (declare (ignore null-terminated-p))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((stored-obj (gensym)))
     `(let ((,stored-obj ,obj))
        (if (ccl:%null-ptr-p ,stored-obj)
           nil
-          #+(and mcl (not openmcl)) (ccl:%get-cstring
+          #+digitool (ccl:%get-cstring
                                      ,stored-obj 0
                                      ,@(if length (list length) nil))
           #+openmcl ,@(if length
@@ -265,9 +261,9 @@ that LW/CMU automatically converts strings from c-calls."
   (declare (ignore unsigned))
   #+allegro
   `(ff:allocate-fobject :char :c ,size)
-  #+mcl
+  #+(or openmcl digitool)
   (declare (ignore unsigned))
-  #+mcl
+  #+(or openmcl digitool)
   `(new-ptr ,size)
   )
 
@@ -288,6 +284,11 @@ that LW/CMU automatically converts strings from c-calls."
       (free-foreign-object ,foreign-string)
       ,result)))
 
+(defmacro with-foreign-strings (bindings &body body)
+  `(with-foreign-string ,(car bindings)
+    ,@(if (cdr bindings)
+          `((with-foreign-strings ,(cdr bindings) ,@body))
+          body)))
 
 ;; Modified from CMUCL's source to handle non-null terminated strings
 #+cmu