X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=old%2Fwrapper.lisp;fp=old%2Fwrapper.lisp;h=5c550afcf3f91bf69a7d8172003960be4903b131;hb=0bb5498ce669d7f3c6d619bea10056b24db30b0a;hp=0000000000000000000000000000000000000000;hpb=1255fdac4de4b06cf5e2c8fe5825a9d157dc1916;p=hyperobject.git

diff --git a/old/wrapper.lisp b/old/wrapper.lisp
new file mode 100644
index 0000000..5c550af
--- /dev/null
+++ b/old/wrapper.lisp
@@ -0,0 +1,66 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          wrapper.lisp
+;;;; Purpose:       Macro wrapper for Hyperobject
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: wrapper.lisp,v 1.1 2003/05/22 20:40:03 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2003 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))
+	 ))))
+
+||#