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