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 | ||
15 | (define-layered-method attribute-value (object (attribute many-to-many)) | |
16 | (call-next-method)) | |
17 | ||
18 | (defdisplay (:description (attribute many-to-many)) | |
19 | (let ((instances (select-instances object)) | |
20 | new-instance) | |
21 | (<:ul | |
22 | (<:li (<ucw:button :action (add-new-relation component object (getp slot-name)) | |
23 | (<:as-html "Add New"))) | |
24 | (<:li (<ucw:button :action (add-new-relation component object new-instance) | |
25 | (<:as-html "Add:")) | |
26 | (<ucw:select :accessor new-instance | |
27 | (arnesi:dolist* (i instances) | |
28 | (<ucw:option | |
29 | :value i | |
30 | (display component i :type 'one-line))))) | |
31 | (dolist* (i (attribute-value object attribute)) | |
32 | (<:li | |
33 | (<ucw:a :action (call-view ((car i) (action-view slot) (ucw::parent slot))) | |
34 | (<:as-html "(view) ")) | |
35 | (<ucw:a :action (delete-relationship slot (second i) instance) | |
36 | (<:as-html "(remove) ")) | |
37 | (display component object))))) | |
38 | (display component (mapcar #'car (slot-value object (getp :slot-name))))) | |
39 |