Changeset 452

Timestamp:

Feb 1, 2004, 7:42:52 AM (21 years ago)

Author:

Gary Byers

Message:

Ivar parsing follows different ruls for STRUCT than for *STRUCT; #\B is
for :<BOOL>. Now seems able to parse all Foundation/AppKit classes in
10.3.2.

File:

• trunk/ccl/examples/bridge.lisp (modified) (6 diffs)

trunk/ccl/examples/bridge.lisp

@@ -388 +388 @@
        (subseq typestring 1 =pos)))))
 
-(defun parse-foreign-struct-or-union-spec (typestring startpos record-class)
+(defun parse-foreign-struct-or-union-spec (typestring
+                                           startpos
+                                           record-class
+                                           from-pointer)
   (flet ((extract-record-name (startpos delimpos)
            (unless (and (= delimpos (1+ startpos))
@@ -429 +432 @@
                      typestring
                      (string-input-stream-index string-stream)
-                     nil)
+                     from-pointer)
                   (fields `(,(if field-name-string (escape-foreign-name field-name-string))
                             ,typespec))
@@ -470 +473 @@
 ;;; Parse the ivar's type string and return a FOREIGN-TYPE object.
 (defun objc-foreign-type-for-ivar
-    (str &optional (startpos 0) (allow-id-name t))
+    (str &optional (startpos 0) (allow-id-name t) from-pointer)
   (let* ((endpos (1+ startpos))
          (startchar (schar str startpos))
@@ -488 +491 @@
             (#\d :double-float)
             (#\v :void)
+            (#\B :<BOOL>)
             (#\@ (when allow-id-name
                    (let* ((nextpos (1+ startpos)))
@@ -501 +505 @@
             (#\* '(:* :char))
             (#\^ (multiple-value-bind (type end)
-                     (objc-foreign-type-for-ivar str (1+ startpos) t)
+                     (objc-foreign-type-for-ivar str (1+ startpos) t t)
                    (setq endpos end)
                    `(:* ,type)))
@@ -521 +525 @@
                   str (1+ startpos) (if (eq startchar #\{)
                                       :struct
-                                      :union))
+                                      :union)
+                  from-pointer)
                (setq endpos end)
                type))