summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/class-definition.lisp142
1 files changed, 142 insertions, 0 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
new file mode 100644
index 0000000..3da1ec2
--- /dev/null
+++ b/Lisp/class-definition.lisp
@@ -0,0 +1,142 @@
+;;;; Objective-CL, an Objective-C bridge for Common Lisp.
+;;;; Copyright (C) 2007 Matthias Andreas Benkard.
+;;;;
+;;;; This program is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public License
+;;;; as published by the Free Software Foundation, either version 3 of
+;;;; the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful, but
+;;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this program. If not, see
+;;;; <http://www.gnu.org/licenses/>.
+
+(in-package #:mulk.objective-cl)
+
+
+(defclass foreign-slot-definition-mixin ()
+ ((foreign-name :initarg :foreign-name
+ :initform nil
+ :accessor slot-definition-foreign-name
+ :type (or null string))
+ (foreign-type :initarg :foreign-type
+ :initform nil
+ :accessor slot-definition-foreign-type)
+ #+(#:unused)
+ (property :initarg :property
+ :accessor slot-definition-property-p
+ :type boolean)))
+
+(defclass foreign-direct-slot-definition
+ (foreign-slot-definition-mixin c2mop:standard-direct-slot-definition)
+ ())
+
+(defclass foreign-effectve-slot-definition
+ (foreign-slot-definition-mixin c2mop:standard-effective-slot-definition)
+ ())
+
+(defclass objective-c-class (standard-class)
+ ((class-ptr :initarg :class-ptr
+ :type c-pointer
+ :accessor pointer-to)))
+
+
+(defmethod c2mop:direct-slot-definition-class ((class objective-c-class)
+ &rest initargs)
+ (if (some #'(lambda (symbol) (let ((nada '#:nada))
+ (not (eq nada (getf initargs symbol nada)))))
+ '(:foreign-type :foreign-name))
+ (find-class 'foreign-direct-slot-definition)
+ (find-class 'c2mop:standard-direct-slot-definition)))
+
+
+(defmethod c2mop:effective-slot-definition-class ((class objective-c-class)
+ &rest initargs)
+ (if (some #'(lambda (symbol) (let ((nada '#:nada))
+ (not (eq nada (getf initargs symbol nada)))))
+ '(:foreign-type :foreign-name))
+ (find-class 'foreign-direct-slot-definition)
+ (find-class 'c2mop:standard-direct-slot-definition)))
+
+
+(defmethod c2mop:slot-value-using-class ((class objective-c-class)
+ instance
+ effective-slot-definition)
+ (etypecase effective-slot-definition
+ (standard-effective-slot-definition (call-next-method))
+ (foreign-effective-slot-definition
+ (cerror "FIXME" '()))))
+
+
+(defmethod (setf c2mop:slot-value-using-class) (value
+ (class objective-c-class)
+ instance
+ effective-slot-definition)
+ (etypecase effective-slot-definition
+ (standard-effective-slot-definition (call-next-method))
+ (foreign-effective-slot-definition
+ (cerror "FIXME" '()))))
+
+
+(defmethod c2mop:compute-slots ((class objective-c-class))
+ ;; FIXME: Maybe add lots of foreign slots here whose presence the
+ ;; Objective-C runtime tells us.
+ (call-next-method))
+
+
+#+(or)
+(defmethod make-instance ((class-name (eql 'objective-c-class)) &rest initargs)
+ (let ((class (call-next-method)))
+ class))
+
+#+(or)
+(defmethod initialize-instance ((class objective-c-class)
+ &key documentation
+ name
+ plist
+ direct-superclasses
+ direct-slots
+ direct-default-initargs
+ class-ptr
+ wrapped-foreign-class)
+ (call-next-method))
+
+#+(or)
+(defmethod reinitialize-instance ((class objective-c-class)
+ &key documentation
+ name
+ plist
+ direct-superclasses
+ direct-slots
+ direct-default-initargs
+ class-ptr
+ wrapped-foreign-class)
+ (call-next-method))
+
+#+(or)
+(defmethod c2mop:compute-effective-slot-definition ((class objective-c-class)
+ slot-name
+ direct-slots)
+ (call-next-method))
+
+
+#+(or)
+(make-instance 'objective-c-class :wrapped-foreign-class "NSString")
+#+(or)
+(c2mop:ensure-class 'ns-string
+ :metaclass 'objective-c-class
+ :wrapped-foreign-class "NSString")
+#+(or)
+(defclass ns-string ()
+ ((bla :foreign-type 'string
+ :foreign-name "_bla"
+ :accessor ns-string-bla)
+ (nothing :accessor ns-string-nothing
+ :initarg :ns-string
+ :initform 100))
+ (:metaclass objective-c-class)
+ (:wrapped-foreign-class "NSString"))