| 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 | |
| 15 | |
| 16 | |
| 17 | (defdisplay (:description (attribute many-to-many)) |
| 18 | (let ((instances (select-instances object t)) |
| 19 | new-instance) |
| 20 | (<:ul |
| 21 | (<:li (<ucw:button :action (add-new-relation component object (getp slot-name)) |
| 22 | (<:as-html "Add New"))) |
| 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 | |