From bc663521841d63b2cc847310aa58cffef561fed8 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Fri, 3 Aug 2007 18:08:07 +0200
Subject: Use type Class rather than id for classes.

darcs-hash:da715b2f31d65a2ad3fa34d68b2e2445496c8f46
---
 objcl.lisp | 24 +++++++++++++++++++++---
 1 file changed, 21 insertions(+), 3 deletions(-)

(limited to 'objcl.lisp')

diff --git a/objcl.lisp b/objcl.lisp
index c87c6d6..97452dc 100644
--- a/objcl.lisp
+++ b/objcl.lisp
@@ -26,6 +26,7 @@
 
 (defcunion obj-data-union
   (id-val :pointer)
+  (class-val :pointer)
   (sel-val :pointer)
   (char-val :char)
   (short-val :short)
@@ -60,7 +61,8 @@
   (argc :int)
   &rest)
 
-(defcfun "objcl_invoke_class_method" obj-data
+(defcfun ("objcl_invoke_class_method"
+          %objcl-invoke-class-method) obj-data
   (receiver obj-data)
   (method-name :string)
   (argc :int)
@@ -69,6 +71,9 @@
 (defcfun ("objcl_find_class" %objcl-find-class) :pointer
   (class-name :string))
 
+(defcfun ("objcl_class_name" %objcl-class-name) :string
+  (class obj-data))
+
 
 ;;; Copied from objc-api.h
 ;;; Probably ought to be generated by C code at initialisation time.
@@ -107,7 +112,7 @@
 
 (defparameter *objcl-data-map*
   '((id       . id-val)
-    (class    . id-val)
+    (class    . class-val)
     (sel      . sel-val)
     (chr      . char-val)
     (uchr     . char-val)
@@ -215,6 +220,19 @@
       (dealloc-obj-data return-value))))
 
 
+(defun objcl-invoke-class-method (class method-name &rest args)
+  (let* ((arglist (arglist-intersperse-types
+                   (mapcar #'lisp->obj-data args)))
+         (return-value (apply-macro '%objcl-invoke-class-method
+                                    (lisp->obj-data class)
+                                    method-name
+                                    (length args)
+                                    arglist)))
+    (prog1
+        (obj-data->lisp return-value)
+      (dealloc-obj-data return-value))))
+
+
 (defun lisp->obj-data (value)
   (let ((obj-data (foreign-alloc 'obj-data))
         (type-name (lisp-value->type-name value)))
@@ -250,7 +268,7 @@
         (if (null-pointer-p (foreign-slot-value
                              (foreign-slot-value obj-data 'obj-data 'data)
                              'obj-data-union
-                             'id-val))
+                             'class-val))
             nil
             (obj-data->lisp obj-data))
       (dealloc-obj-data obj-data))))
-- 
cgit v1.2.3