Commit | Line | Data |
---|---|---|
dee565d0 DC |
1 | (in-package :lol) |
2 | ||
3 | (defun find-many-to-many-class (slot-name instance) | |
4 | (let* ((imd (getf (meta-model::find-slot-metadata instance slot-name) | |
5 | :db-info)) | |
6 | (jc (make-instance (getf imd :join-class))) | |
7 | (jcmd (getf (meta-model::find-slot-metadata jc (getf imd :target-slot)) | |
8 | :db-info))) | |
9 | (getf jcmd :join-class))) | |
10 | ||
11 | ||
12 | (defattribute many-to-many () | |
13 | ()) | |
14 | ||
14a7e1bc | 15 | |
dee565d0 DC |
16 | |
17 | (defdisplay (:description (attribute many-to-many)) | |
d2882889 | 18 | (let ((instances (select-instances object t)) |
dee565d0 DC |
19 | new-instance) |
20 | (<:ul | |
21 | (<:li (<ucw:button :action (add-new-relation component object (getp slot-name)) | |
d2882889 | 22 | (<:as-html "Add New"))) |
dee565d0 DC |
23 | (<:li (<ucw:button :action (add-new-relation component object new-instance) |
24 | (<:as-html "Add:")) | |
25 | (<ucw:select :accessor new-instance | |
26 | (arnesi:dolist* (i instances) | |
27 | (<ucw:option | |
28 | :value i | |
29 | (display component i :type 'one-line))))) | |
30 | (dolist* (i (attribute-value object attribute)) | |
31 | (<:li | |
32 | (<ucw:a :action (call-view ((car i) (action-view slot) (ucw::parent slot))) | |
33 | (<:as-html "(view) ")) | |
34 | (<ucw:a :action (delete-relationship slot (second i) instance) | |
35 | (<:as-html "(remove) ")) | |
36 | (display component object))))) | |
37 | (display component (mapcar #'car (slot-value object (getp :slot-name))))) | |
38 |