From d4b607fba1a7481f7bef23b38495c591c2ba6e3e Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Thu, 6 Mar 2008 12:09:25 +0100
Subject: Implement #/description (NS::MLK-LISP-VALUE).

darcs-hash:40fcce373c4bbecb159aa9e51e52729864fa75d2
---
 Lisp/lisp-value-wrapping.lisp | 20 ++++++++++++++++++++
 objective-cl.asd              |  3 ++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/Lisp/lisp-value-wrapping.lisp b/Lisp/lisp-value-wrapping.lisp
index 85cf84a..67c72e6 100644
--- a/Lisp/lisp-value-wrapping.lisp
+++ b/Lisp/lisp-value-wrapping.lisp
@@ -16,6 +16,7 @@
 ;;;; <http://www.gnu.org/licenses/>.
 
 (in-package #:mulk.objective-cl)
+#.(enable-method-syntax)
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -39,6 +40,22 @@
   (:metaclass ns::+ns-object))
 
 
+(define-objective-c-generic-function #/description (self))
+
+(define-objective-c-method #/description :id ((self ns::mlk-lisp-value ))
+  (#/stringWithUTF8String: (find-objc-class 'ns-string)
+                           (format nil "<MLKLispValue: ~A>"
+                                   (write-to-string (lisp-value self)
+                                                    :readably nil
+                                                    :escape t
+                                                    :circle t
+                                                    :length 50
+                                                    :level 5
+                                                    :pretty nil
+                                                    :radix nil
+                                                    :base 10))))
+
+
 (defcoercion id ((x list))
   (intern-lisp-value x))
 
@@ -113,3 +130,6 @@
 (defclass ns::mlk-lisp-list (ns::ns-array lisp-value-wrapper-mixin)
      ()
   (:metaclass ns::+ns-object))
+
+
+#.(disable-method-syntax)
diff --git a/objective-cl.asd b/objective-cl.asd
index 983721b..aebcad6 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -104,7 +104,8 @@
                                                            "init"
                                                            "class-definition"
                                                            "method-invocation"
-                                                           "method-definition"))
+                                                           "method-definition"
+                                                           "reader-syntax"))
                  (:file "post-init"          :depends-on ("defpackage"
                                                           "libobjcl"
                                                           "init"
-- 
cgit v1.2.3