- slot)
- (list option `',value))
- #-lispworks
- (declare (ignore slot-name))
- )
-
-(define-class-option :title)
-(define-class-option :print-slots)
-(define-class-option :description)
-
-(define-slot-option :print-formatter)
-(define-slot-option :subobject)
-(define-slot-option :reference)
-(define-slot-option :description)
-
-;; Slot definitions
-
-(defclass hyperobject-dsd (standard-direct-slot-definition)
- ((ho-type :initarg :ho-type :initform nil)
- (print-formatter :initarg :print-formatter :initform nil)
- (subobject :initarg :subobject :initform nil)
- (reference :initarg :reference :initform nil)
- (description :initarg :description :initform nil)
- ))
-
-(defclass hyperobject-esd (standard-effective-slot-definition)
- ((ho-type :initarg :ho-type :accessor esd-ho-type :initform nil)
- (print-formatter :initarg :print-formatter :accessor esd-print-formatter
- :initform nil)
- (subobject :initarg :subobject :accessor esd-subobject :initform nil)
- (reference :initarg :reference :accessor esd-reference :initform nil)
- (description :initarg :description :accessor esd-description :initform nil)
- ))
-
-
+ slot)
+ (list option `',value))
+ #-lispworks
+ (declare (ignore slot-name))
+ )
+
+ (defparameter *class-options*
+ '(:title :print-slots :description :version :sql-name)
+ "List of class options for hyperobjects.")
+ (defparameter *slot-options*
+ '(:print-formatter :subobject :reference :description :unique :sql-name)
+ "List of slot options that can appear as an initarg")
+ (defparameter *slot-options-no-initarg*
+ '(:ho-type)
+ "List of slot options that do not have an initarg")
+
+ (dolist (option *class-options*)
+ (eval `(process-class-option ,option)))
+ (dolist (option *slot-options*)
+ (eval `(process-slot-option ,option)))
+
+ (eval
+ `(defclass hyperobject-dsd (standard-direct-slot-definition)
+ (,@(mapcar #'(lambda (x)
+ `(,(intern (symbol-name x))
+ :initform nil))
+ *slot-options-no-initarg*)
+ ,@(mapcar #'(lambda (x)
+ `(,(intern (symbol-name x))
+ :initarg
+ ,(intern (symbol-name x) (symbol-name :keyword))
+ :initform nil))
+ *slot-options*))))
+ (eval
+ `(defclass hyperobject-esd (standard-effective-slot-definition)
+ (,@(mapcar #'(lambda (x)
+ `(,(intern (symbol-name x))
+ :initarg
+ ,(intern (symbol-name x) (symbol-name :keyword))
+ :initform nil))
+ (append *slot-options* *slot-options-no-initarg*)))))
+ ) ;; eval-when
+