Handle more types of controls

This commit is contained in:
David Botton 2022-01-19 23:35:58 -05:00
parent ac61be0dfb
commit de508237b2
2 changed files with 87 additions and 68 deletions

View file

@ -10,6 +10,56 @@
'(:tag "div"
:control "div")))
(defparameter *props-location*
`((:name "top"
:get ,(lambda (control)
(if (equal (positioning control) "static")
"n/a"
(top control)))
:set ,(lambda (control obj)
(setf (top control) (text obj))))
(:name "left"
:get ,(lambda (control)
(if (equal (positioning control) "static")
"n/a"
(left control)))
:set ,(lambda (control obj)
(setf (top control) (text obj))))
(:name "positioning"
:style "position")))
(defparameter *props-wh*
'((:name "width"
:setf clog:width)
(:name "height"
:setf clog:height)))
(defparameter *props-text*
'((:name "text"
:setf clog:text)))
(defparameter *props-value*
'((:name "value"
:setf clog:value)))
(defparameter *props-colors*
'((:name "color"
:style "color")
(:name "background-color"
:style "background-color")))
(defparameter *props-element*
`(,@*props-location*
,@*props-wh*
,@*props-text*
,@*props-colors*))
(defparameter *props-form-element*
`(,@*props-location*
,@*props-wh*
,@*props-value*
,@*props-colors*))
(defparameter *supported-controls*
(list
'(:name "select"
@ -18,78 +68,40 @@
:create-type nil
:properties nil
:positioning nil)
'(:name "label"
`(:name "label"
:description "Label"
:clog-type clog:clog-label
:create clog:create-label
:create-type :element
:create-content "label"
:properties ((:name "text"
:prop clog:text)
(:name "positioning"
:prop clog:positioning)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))
'(:name "button"
:properties (,@*props-element*))
`(:name "button"
:description "Button"
:clog-type clog:clog-button
:create clog:create-button
:create-type :element
:create-param :button
:create-content "button"
:properties ((:name "text"
:prop clog:text)
(:name "positioning"
:prop clog:positioning)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))
'(:name "input"
:properties (,@*props-element*))
`(:name "input"
:description "Form Text Input"
:clog-type clog:clog-form-element
:create clog:create-form-element
:create-type :form
:create-param :input
:create-value ""
:properties ((:name "value"
:prop clog:value)
(:name "name"
:prop clog:name)
(:name "positioning"
:prop clog:positioning)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))
'(:name "span"
:properties (,@*props-form-element*))
`(:name "span"
:description "Span Control"
:clog-type clog:clog-span
:create clog:create-span
:create-type :element
:create-content "text here"
:properties ((:name "text"
:prop clog:text)
(:name "positioning"
:prop clog:positioning)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))
'(:name "div"
:properties (,@*props-element*))
`(:name "div"
:description "Div Control"
:clog-type clog:clog-div
:create clog:create-div
:create-type :element
:create-content ""
:properties ((:name "text"
:prop clog:text)
(:name "positioning"
:prop clog:positioning)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))))
:properties (,@*props-element*))))

View file

@ -258,7 +258,7 @@ not a temporary attached one when using select-control."
(let ((info (control-info (attribute control "data-clog-type")))
(props `(("name" ,(attribute control "data-clog-name") t
,(lambda (obj)
(setf (attribute control "data-clog-name") (text obj))))
(setf (attribute control "data-clog-name") (text obj))))
("parent" ,(attribute (parent-element control) "data-clog-name")
t ,(lambda (obj)
(place-inside-bottom-of
@ -266,29 +266,36 @@ not a temporary attached one when using select-control."
(clog::js-query control (format nil "$(\"[data-clog-name='~A']\").attr('id')"
(text obj))))
control)
(place-after control placer)))
("top" ,(if (equal (positioning control) "static")
"n/a"
(top control))
t ,(lambda (obj)
(setf (top control) (text obj))))
("left" ,(if (equal (positioning control) "static")
"n/a"
(left control))
t ,(lambda (obj)
(setf (left control) (text obj))))
("width" ,(width control) t ,(lambda (obj)
(setf (width control) (text obj))))
("height" ,(height control) t ,(lambda (obj)
(setf (height control) (text obj)))))))
(place-after control placer))))))
(when info
(let (col)
(dolist (prop (reverse (getf info :properties)))
(cond ((eq (third prop) :prop)
(push `(,(getf prop :name) ,(funcall (getf prop :prop) control) t
(cond ((eq (third prop) :style)
(push `(,(getf prop :name) ,(style control (getf prop :style)) t
,(lambda (obj)
(funcall (find-symbol (format nil "SET-~A" (getf prop :prop)) :clog) control (text obj))))
col))))
(setf (style control (getf prop :style)) (text obj))))
col))
((eq (third prop) :get)
(push `(,(getf prop :name) ,(funcall (getf prop :get) control) t
,(lambda (obj)
(funcall (getf prop :set) control obj)))
col))
((eq (third prop) :setf)
(push `(,(getf prop :name) ,(funcall (getf prop :setf) control) t
,(lambda (obj)
(funcall (find-symbol (format nil "SET-~A" (getf prop :setf)) :clog) control (text obj))))
col))
((eq (third prop) :prop)
(push `(,(getf prop :name) ,(property control (getf prop :prop)) t
,(lambda (obj)
(setf (property control (getf prop :prop)) (text obj))))
col))
((eq (third prop) :attr)
(push `(,(getf prop :name) ,(attribute control (getf prop :attr)) t
,(lambda (obj)
(setf (attribute control (getf prop :attr)) (text obj))))
col))
(t (print "Configuration error."))))
(alexandria:appendf props col)))
(dolist (item props)
(let* ((tr (create-table-row table))