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

View file

@ -18,8 +18,8 @@
:create-type :label :create-type :label
:create-content "label" :create-content "label"
:properties (list :properties (list
(:name "text" (:name "color"
:prop clog:text) :prop clog:color)
(:name "background-color" (:name "background-color"
:prop clog:background-color))) :prop clog:background-color)))
'(:name "button" '(:name "button"
@ -29,8 +29,8 @@
:create-param :button :create-param :button
:create-value "button" :create-value "button"
:properties (list :properties (list
(:name "value" (:name "color"
:prop clog:value) :prop clog:color)
(:name "background-color" (:name "background-color"
:prop clog:background-color))) :prop clog:background-color)))
'(:name "input" '(:name "input"
@ -40,8 +40,8 @@
:create-param :input :create-param :input
:create-value "" :create-value ""
:properties (list :properties (list
(:name "value" (:name "color"
:prop clog:value) :prop clog:color)
(:name "background-color" (:name "background-color"
:prop clog:background-color))))) :prop clog:background-color)))))
@ -234,16 +234,27 @@
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(win (control-properties app)) (win (control-properties app))
(control (current-control app)) (control (current-control app))
(table (properties-list app))
(parent (when control (parent-element control)))) (parent (when control (parent-element control))))
(when (and win control) (when (and win control)
(setf (text (properties-list app)) "") (setf (inner-html table) "")
(add-select-options (properties-list app) (let ((props `(("Name" ,(html-id control) nil)
`(,(format nil "name : ~A" (html-id control)) ("Top" ,(top parent) t ,(lambda (obj)
,(format nil "top : ~A" (top parent)) (setf (top parent) (text obj))))
,(format nil "left : ~A" (left parent)) ("Left" ,(left parent) t ,(lambda (obj)
,(format nil "bottom : ~A" (bottom parent)) (setf (left parent) (text obj))))
,(format nil "right : ~A" (right parent)) ("Value" ,(value control) t ,(lambda (obj)
,(format nil "value : ~A" (value control))))))) (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) (defun on-show-properties (obj)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
@ -253,13 +264,12 @@
:height 300 :width 200 :height 300 :width 200
:has-pinner t)) :has-pinner t))
(content (window-content win)) (content (window-content win))
(control-list (create-select content))) (control-list (create-table content)))
(setf (control-properties app) win) (setf (control-properties app) win)
(setf (properties-list app) control-list) (setf (properties-list app) control-list)
(set-on-window-close win (lambda (obj) (setf (control-properties app) nil))) (set-on-window-close win (lambda (obj) (setf (control-properties app) nil)))
(setf (positioning control-list) :absolute) (setf (positioning control-list) :absolute)
(setf (size control-list) 2) (set-geometry control-list :left 0 :top 0 :bottom 0 :right 0)
(set-geometry control-list :left 0 :top 0 :bottom 0 :width 190)
(on-populate-control-properties obj))))) (on-populate-control-properties obj)))))
(defun on-show-control-pallete (obj) (defun on-show-control-pallete (obj)