has-many attribute added.. getting ther.
[clinton/lisp-on-lines.git] / src / relational-attributes.lisp
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
14 (defdisplay (:description (attribute has-many))
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
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
36
37
38 (defdisplay (:description (attribute many-to-many))
39 (<:as-html "ASDASD"))
40
41 #+nil(let ((instances (select-instances object t))
42 new-instance)
43 (<:ul
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)
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)))))
60 (display component (mapcar #'car (slot-value object (getp :slot-name)))))
61