Commit | Line | Data |
---|---|---|
91f2ab7b DC |
1 | (in-package :lisp-on-lines) |
2 | ||
3 | ;;;; * Relational Attributes | |
4 | ||
5 | ;;;; ** Has-Many attribute | |
6 | ||
7 | (defattribute has-many () | |
8 | () | |
9 | (:default-properties | |
10 | :add-new-label "Add New" | |
11 | :sort-arguments (list #'< :key #'(lambda (x) (funcall (car (list-keys x)) x))))) | |
12 | ||
13 | ||
87e47dd6 | 14 | (defdisplay object (:description (attribute has-many)) |
91f2ab7b DC |
15 | ; |
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)))) | |
19 | (display component i | |
20 | :type'lol::one-line | |
21 | :layers '(+ wrap-link)))) | |
22 | ||
dee565d0 DC |
23 | |
24 | (defun find-many-to-many-class (slot-name instance) | |
25 | (let* ((imd (getf (meta-model::find-slot-metadata instance slot-name) | |
26 | :db-info)) | |
27 | (jc (make-instance (getf imd :join-class))) | |
28 | (jcmd (getf (meta-model::find-slot-metadata jc (getf imd :target-slot)) | |
29 | :db-info))) | |
30 | (getf jcmd :join-class))) | |
31 | ||
32 | ||
33 | (defattribute many-to-many () | |
34 | ()) | |
35 | ||
14a7e1bc | 36 | |
dee565d0 | 37 | |
87e47dd6 | 38 | (defdisplay object (:description (attribute many-to-many)) |
91f2ab7b DC |
39 | (<:as-html "ASDASD")) |
40 | ||
41 | #+nil(let ((instances (select-instances object t)) | |
dee565d0 DC |
42 | new-instance) |
43 | (<:ul | |
44 | (<:li (<ucw:button :action (add-new-relation component object (getp slot-name)) | |
d2882889 | 45 | (<:as-html "Add New"))) |
dee565d0 DC |
46 | (<:li (<ucw:button :action (add-new-relation component object new-instance) |
47 | (<:as-html "Add:")) | |
48 | (<ucw:select :accessor new-instance | |
49 | (arnesi:dolist* (i instances) | |
50 | (<ucw:option | |
51 | :value i | |
52 | (display component i :type 'one-line))))) | |
53 | (dolist* (i (attribute-value object attribute)) | |
54 | (<:li | |
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))))) | |
6ac956e8 | 60 | ;(display component (mapcar #'car (slot-value object (getp :slot-name)))) |
dee565d0 | 61 |