1 (in-package :lisp-on-lines
)
3 ;;;; * Relational Attributes
13 (define-layered-method attribute-value
(object (attribute has-a
))
14 (meta-model:explode-foreign-key object
(slot-name attribute
) :nilp t
))
16 (defdisplay ((attribute has-a
) object
)
17 (let ((args (plist-union (description.properties attribute
) (has-a attribute
)))
18 (val (attribute-value object attribute
)))
20 (setf (getf args
:type
)
26 ;;;; ** Has-Many attribute
28 (defattribute has-many
()
31 :add-new-label
"Add New"
32 :sort-arguments
(list #'< :key
#'(lambda (x) (funcall (car (list-keys x
)) x
))))
34 :type
'lol
::one-line
))
37 (define-layered-method
38 attribute-value
(object (has-many has-many
))
39 (slot-value object
(slot-name has-many
)))
41 (defdisplay ((attribute has-many
) object
)
43 ;(<ucw:submit :action (add-to-has-many slot instance) :value (add-new-label attribute))
45 (<:div
:style
"clear:both;"
46 (let* ((i (apply #'sort
(slot-value object
(slot-name attribute
))
47 (sort-arguments attribute
))))
52 :layers
'(+ wrap-link - label-attributes
))))))))
55 (defun find-many-to-many-class (slot-name instance
)
56 (let* ((imd (getf (meta-model::find-slot-metadata instance slot-name
)
58 (jc (make-instance (getf imd
:join-class
)))
59 (jcmd (getf (meta-model::find-slot-metadata jc
(getf imd
:target-slot
))
61 (getf jcmd
:join-class
)))
64 (defattribute many-to-many
()
69 (defdisplay ((attribute many-to-many
) object
)
72 #+nil
(let ((instances (select-instances object t
))
75 (<:li
(<ucw
:button
:action
(add-new-relation component object
(.get slot-name
))
76 (<:as-html
"Add New")))
77 (<:li
(<ucw
:button
:action
(add-new-relation component object new-instance
)
79 (<ucw
:select
:accessor new-instance
80 (arnesi:dolist
* (i instances
)
83 (display component i
:type
'one-line
)))))
84 (dolist* (i (attribute-value object attribute
))
86 (<ucw
:a
:action
(call-view ((car i
) (action-view slot
) (ucw::parent slot
)))
87 (<:as-html
"(view) "))
88 (<ucw
:a
:action
(delete-relationship slot
(second i
) instance
)
89 (<:as-html
"(remove) "))
90 (display component object
)))))
91 ;(display component (mapcar #'car (slot-value object (.get :slot-name))))