1 (in-package :lisp-on-lines
)
3 ;;;; * Relational Attributes
5 ;;;; ** Has-Many attribute
7 (defattribute has-many
()
10 :add-new-label
"Add New"
11 :sort-arguments
(list #'< :key
#'(lambda (x) (funcall (car (list-keys x
)) x
)))))
14 (defdisplay (:description
(attribute has-many
))
16 (<ucw
:submit
:action
(add-to-has-many slot instance
) :value
(getp :add-new-label
))
17 (let* ((i (apply #'sort
(slot-value object
(getp :slot-name
))
18 (getp :sort-arguments
))))
21 :layers
'(+ wrap-link
))))
24 (defun find-many-to-many-class (slot-name instance
)
25 (let* ((imd (getf (meta-model::find-slot-metadata instance slot-name
)
27 (jc (make-instance (getf imd
:join-class
)))
28 (jcmd (getf (meta-model::find-slot-metadata jc
(getf imd
:target-slot
))
30 (getf jcmd
:join-class
)))
33 (defattribute many-to-many
()
38 (defdisplay (:description
(attribute many-to-many
))
41 #+nil
(let ((instances (select-instances object t
))
44 (<:li
(<ucw
:button
:action
(add-new-relation component object
(getp slot-name
))
45 (<:as-html
"Add New")))
46 (<:li
(<ucw
:button
:action
(add-new-relation component object new-instance
)
48 (<ucw
:select
:accessor new-instance
49 (arnesi:dolist
* (i instances
)
52 (display component i
:type
'one-line
)))))
53 (dolist* (i (attribute-value object attribute
))
55 (<ucw
:a
:action
(call-view ((car i
) (action-view slot
) (ucw::parent slot
)))
56 (<:as-html
"(view) "))
57 (<ucw
:a
:action
(delete-relationship slot
(second i
) instance
)
58 (<:as-html
"(remove) "))
59 (display component object
)))))
60 ;(display component (mapcar #'car (slot-value object (getp :slot-name))))