r3472: *** empty log message ***

[hyperobject.git] / hyperobject.lisp

diff --git a/hyperobject.lisp b/hyperobject.lisp
index 2479712a0dd855e57cf1ca52067186f5c58f4bfe..60d34831d14e5165d62de1f5c6868f02a0a97681 100644 (file)
--- a/hyperobject.lisp
+++ b/hyperobject.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: hyperobject.lisp,v 1.13 2002/11/25 02:10:38 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.14 2002/11/25 04:47:23 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -136,7 +136,7 @@
                                                   iargs)
   (find-class 'hyperobject-dsd))
 
-(defmacro define-class-slot (slot-name &optional required)
+(defmacro define-class-option (slot-name &optional required)
   #+lispworks
   `(defmethod clos:process-a-class-option ((class hyperobject-class)
                                           (name (eql ,slot-name))
@@ -150,9 +150,30 @@
   (declare (ignore slot-name required))
   )
 
-(define-class-slot :title)
-(define-class-slot :print-slots)
-(define-class-slot :description)
+(defmacro define-slot-option (slot-name)
+  #+lispworks
+  `(defmethod clos:process-a-slot-option ((class hyperobject-class)
+                                         (option (eql ,slot-name))
+                                         value
+                                         already-processed-other-options
+                                         slot)
+    (if (null (cdr value))
+       (list option (car value))
+       (list option `',value)))
+  #-lispworks
+  (declare (ignore slot-name))
+  )
+
+(define-class-option :title)
+(define-class-option :print-slots)
+(define-class-option :description)
+
+(define-slot-option :ho-type)
+(define-slot-option :print-formatter)
+(define-slot-option :subobject)
+(define-slot-option :reference)
+(define-slot-option :description)
+
 
 
 (defmethod compute-effective-slot-definition :around