From 9794d705ec9b8835213fca1fe811f95aa9792ef2 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Mon, 3 Mar 2008 01:37:34 +0100
Subject: Add Lisp value wrapper classes MLKLispString, MLKLispArray, and
 MLKLispList.

darcs-hash:3dc87ce841df388836310ebc486b20c7214d68e4
---
 Lisp/lisp-value-wrapping.lisp | 58 ++++++++++++++++++++++++++++++++++++++++---
 objective-cl.asd              |  3 ++-
 2 files changed, 56 insertions(+), 5 deletions(-)

diff --git a/Lisp/lisp-value-wrapping.lisp b/Lisp/lisp-value-wrapping.lisp
index cf8e63c..cfe1603 100644
--- a/Lisp/lisp-value-wrapping.lisp
+++ b/Lisp/lisp-value-wrapping.lisp
@@ -19,19 +19,69 @@
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (find-objc-class "NSObject" t))
+  (find-objc-class "NSObject" t)
+  (find-objc-class "NSString" t)
+  (find-objc-class "NSArray" t)
+  (find-objc-class "NSDictionary" t))
 
 
-(defclass ns::mlk-lisp-value (ns::ns-object)
+(defclass lisp-value-wrapper-mixin ()
      ((lisp-value :initarg :value
                   :initform nil
-                  :accessor lisp-value))
+                  :accessor lisp-value)))
+
+
+;; May usefully override, among others:
+;;  - description
+(defclass ns::mlk-lisp-value (ns::ns-object lisp-value-wrapper-mixin)
+     ()
+  #+(or) (:default-constructor new)
   (:metaclass ns::+ns-object))
 
 
 (defun make-lisp-value (value)
   ;; FIXME: The following won't work.  Make MAKE-INSTANCE more useful...
   ;(make-instance 'ns::mlk-lisp-value :value value)
-  (let ((instance (invoke (find-class 'ns::mlk-lisp-value) 'new)))
+  (let ((instance (invoke (typecase value
+                            (string (find-class 'ns::mlk-lisp-string))
+                            (vector (find-class 'ns::mlk-lisp-array))
+                            (list (find-class 'ns::mlk-lisp-list))
+                            (t (find-class 'ns::mlk-lisp-value)))
+                          'new)))
     (setf (lisp-value instance) value)
     instance))
+
+
+;; Must override:
+;;  - characterAtIndex:
+;;  - length
+;;
+;; May usefully override, among others:
+;;  - substringWithRange: (maybe)
+;;  - getCharacters:range: (for performance reasons)
+;;  - description
+(defclass ns::mlk-lisp-string (ns::ns-string lisp-value-wrapper-mixin)
+     ()
+  (:metaclass ns::+ns-object))
+
+
+;; Must override:
+;;  - objectAtIndex:
+;;  - count
+;;
+;; May usefully override, among others:
+;;  - description
+(defclass ns::mlk-lisp-array (ns::ns-array lisp-value-wrapper-mixin)
+     ()
+  (:metaclass ns::+ns-object))
+
+
+;; Must override:
+;;  - objectAtIndex:
+;;  - count
+;;
+;; May usefully override, among others:
+;;  - description
+(defclass ns::mlk-lisp-list (ns::ns-array lisp-value-wrapper-mixin)
+     ()
+  (:metaclass ns::+ns-object))
diff --git a/objective-cl.asd b/objective-cl.asd
index efe3c91..2a0520c 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -96,7 +96,8 @@
                  (:file "lisp-value-wrapping" :depends-on ("defpackage"
                                                            "libobjcl"
                                                            "init"
-                                                           "class-definition"))
+                                                           "class-definition"
+                                                           "method-invocation"))
                  (:file "post-init"          :depends-on ("defpackage"
                                                           "libobjcl"
                                                           "init"
-- 
cgit v1.2.3