r4920: Auto commit for Debian build

[hyperobject.git] / wrapper.lisp

diff --git a/wrapper.lisp b/wrapper.lisp
index 6e67805fc8bf061838da35527e5a0b84403c8a83..e1c497c18894319b544a926abb6d02940857356f 100644 (file)
--- a/wrapper.lisp
+++ b/wrapper.lisp
@@ -7,10 +7,60 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: wrapper.lisp,v 1.2 2002/12/13 05:44:19 kevin Exp $
+;;;; $Id: wrapper.lisp,v 1.3 2002/12/13 07:33:54 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;; *************************************************************************
 
 (in-package :hyperobject)
 
+(eval-when (:compile-toplevel :execute)
+  (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
+
+#||
+(defmacro define-hyperobject (name parents fields &rest meta-fields)
+  (let* ((meta-fields (process-meta-fields fields meta-fields))
+        (cl-fields (process-hyper-fields fields meta-fields)))
+    `(progn
+       (eval-when (:compile-toplevel :load-toplevel :execute)
+        (defclass ,name ,(append parents (list 'hyperobject)) ,cl-fields
+          ,@meta-fields))(and documentation (list (list :documentation documentation)))))
+       (let ((,value-func (compile nil (eval (slot-value ,meta 'value-func))))
+            (,xml-value-func (compile nil (eval (slot-value ,meta 'xml-value-func)))))
+        (defmethod ho-title ((obj ,name))
+          ,title)
+        (defmethod ho-name ((obj ,name))
+          ,(string-downcase (symbol-name name)))
+        (defmethod ho-fields ((obj ,name))
+          ',(slot-value meta 'fields))
+        (defmethod ho-references ((obj ,name))
+          ',(slot-value meta 'references))
+        (defmethod ho-subobjects ((obj ,name))
+          ',(slot-value meta 'subobjects))
+        (defmethod ho-value-func ((obj ,name))
+          ,value-func)
+        (defmethod ho-xml-value-func ((obj ,name))
+          ,xml-value-func)
+        (defmethod ho-fmtstr-text ((obj ,name))
+          ,(slot-value meta 'fmtstr-text))
+        (defmethod ho-fmtstr-html ((obj ,name))
+          ,(slot-value meta 'fmtstr-html))
+        (defmethod ho-fmtstr-xml ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml))
+        (defmethod ho-fmtstr-text-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-text-labels))
+        (defmethod ho-fmtstr-html-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-html-labels))
+        (defmethod ho-fmtstr-xml-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml-labels))
+        (defmethod ho-fmtstr-html-ref ((obj ,name))
+          ,(slot-value meta 'fmtstr-html-ref))
+        (defmethod ho-fmtstr-xml-ref ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml-ref))
+        (defmethod ho-fmtstr-html-ref-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-html-ref-labels))
+        (defmethod ho-fmtstr-xml-ref-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml-ref-labels))
+        ))))
+
+||#