Editable properties

This commit is contained in:
David Botton 2021-12-13 13:41:17 -05:00
parent 91fb3eb34e
commit 69e0e69b20
2 changed files with 37 additions and 27 deletions

View file

@ -1910,7 +1910,7 @@ auto | w h | % = cover of parent | contain"))
:double :groove :ridge :inset :outset))
(defgeneric border (clog-element)
(:documentation "Get border. <line-width> <line-style> <line-color>"))
(:documentation "Get border. <line-width> <border-style> <line-color>"))
(defmethod border ((obj clog-element))
(style obj "border"))
@ -1919,13 +1919,13 @@ auto | w h | % = cover of parent | contain"))
;; set-border ;;
;;;;;;;;;;;;;;;;
(defgeneric set-border (clog-element line-width line-style line-color)
(defgeneric set-border (clog-element line-width border-style line-color)
(:documentation "Set border width style and color.
line-width - size or medium|thin|thick|length|initial|inherit"))
(defmethod set-border ((obj clog-element) line-width line-style line-color)
(defmethod set-border ((obj clog-element) line-width border-style line-color)
(setf (style obj "border") (format nil "~A ~A ~A"
line-width line-style line-color)))
line-width border-style line-color)))
;;;;;;;;;;;;;;;;;;;
;; border-radius ;;
@ -1987,7 +1987,7 @@ line-width - size or medium|thin|thick|length|initial|inherit"))
:groove :ridge :inset :outset))
(defgeneric outline (clog-element)
(:documentation "Get outline. <line-color> <line-style> <line-width>"))
(:documentation "Get outline. <line-color> <outline-style> <line-width>"))
(defmethod outline ((obj clog-element))
(style obj "outline"))
@ -1996,13 +1996,13 @@ line-width - size or medium|thin|thick|length|initial|inherit"))
;; set-outline ;;
;;;;;;;;;;;;;;;;;
(defgeneric set-outline (clog-element line-color line-style line-width)
(:documentation "Set outline <line-color> <line-style> <line-width>
(defgeneric set-outline (clog-element line-color outline-style line-width)
(:documentation "Set outline <line-color> <outline-style> <line-width>
line-width - size or medium|thin|thick|length|initial|inherit"))
(defmethod set-outline ((obj clog-element) line-color line-style line-width)
(defmethod set-outline ((obj clog-element) line-color outline-style line-width)
(setf (style obj "outline") (format nil "~A ~A ~A"
line-color line-style line-width)))
line-color outline-style line-width)))
;;;;;;;;;;;;
;; margin ;;

View file

@ -18,8 +18,8 @@
:create-type :label
:create-content "label"
:properties (list
(:name "text"
:prop clog:text)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))
'(:name "button"
@ -29,8 +29,8 @@
:create-param :button
:create-value "button"
:properties (list
(:name "value"
:prop clog:value)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))
'(:name "input"
@ -40,8 +40,8 @@
:create-param :input
:create-value ""
:properties (list
(:name "value"
:prop clog:value)
(:name "color"
:prop clog:color)
(:name "background-color"
:prop clog:background-color)))))
@ -234,16 +234,27 @@
(let* ((app (connection-data-item obj "builder-app-data"))
(win (control-properties app))
(control (current-control app))
(table (properties-list app))
(parent (when control (parent-element control))))
(when (and win control)
(setf (text (properties-list app)) "")
(add-select-options (properties-list app)
`(,(format nil "name : ~A" (html-id control))
,(format nil "top : ~A" (top parent))
,(format nil "left : ~A" (left parent))
,(format nil "bottom : ~A" (bottom parent))
,(format nil "right : ~A" (right parent))
,(format nil "value : ~A" (value control)))))))
(when (and win control)
(setf (inner-html table) "")
(let ((props `(("Name" ,(html-id control) nil)
("Top" ,(top parent) t ,(lambda (obj)
(setf (top parent) (text obj))))
("Left" ,(left parent) t ,(lambda (obj)
(setf (left parent) (text obj))))
("Value" ,(value control) t ,(lambda (obj)
(setf (value control) (text obj))))
("Text" ,(text control) t ,(lambda (obj)
(setf (text control) (text obj)))))))
(dolist (item props)
(let* ((tr (create-table-row table))
(td1 (create-table-column tr :content (first item)))
(td2 (create-table-column tr :content (second item))))
(set-border td1 "1px" :dotted :black)
(when (third item)
(setf (editablep td2) t)
(set-on-blur td2 (fourth item)))))))))
(defun on-show-properties (obj)
(let ((app (connection-data-item obj "builder-app-data")))
@ -253,13 +264,12 @@
:height 300 :width 200
:has-pinner t))
(content (window-content win))
(control-list (create-select content)))
(control-list (create-table content)))
(setf (control-properties app) win)
(setf (properties-list app) control-list)
(set-on-window-close win (lambda (obj) (setf (control-properties app) nil)))
(setf (positioning control-list) :absolute)
(setf (size control-list) 2)
(set-geometry control-list :left 0 :top 0 :bottom 0 :width 190)
(set-geometry control-list :left 0 :top 0 :bottom 0 :right 0)
(on-populate-control-properties obj)))))
(defun on-show-control-pallete (obj)