(in-package :lisp-on-lines) ;;;; * Relational Attributes ;;;; ** has-a (defattribute has-a () () (:default-properties :has-a nil)) (define-layered-method attribute-value (object (attribute has-a)) (meta-model:explode-foreign-key object (slot-name attribute) :nilp t)) (defdisplay ((attribute has-a) object) (let ((args (plist-union (description.properties attribute) (has-a attribute))) (val (attribute-value object attribute))) (when val (setf (getf args :type) 'lol::one-line)) (apply #'display* val args))) ;;;; ** Has-Many attribute (defattribute has-many () () (:default-properties :add-new-label "Add New" :sort-arguments (list #'< :key #'(lambda (x) (funcall (car (list-keys x)) x)))) (:default-initargs :type 'lol::one-line)) (define-layered-method attribute-value (object (has-many has-many)) (slot-value object (slot-name has-many))) (defdisplay ((attribute has-many) object) ; ;(