custom slots on panels

This commit is contained in:
David Botton 2022-02-03 22:49:41 -05:00
parent 17b34bbffb
commit 783707efaa
3 changed files with 30 additions and 2 deletions

1
.gitignore vendored
View file

@ -17,3 +17,4 @@
*.wx64fsl *.wx64fsl
*.wx32fsl *.wx32fsl
*~ *~
*.bak

View file

@ -1274,3 +1274,16 @@
:create-type :base :create-type :base
:events (,@*events-element*) :events (,@*events-element*)
:properties (,@*props-base*)))) :properties (,@*props-base*))))
(defparameter *supported-templates*
(list
'(:name "New CLOG Project"
:code "ncp"
:type :system
:www t
:loc "./templates/project")
'(:name "New CLOG-GUI Project"
:code "ncgp"
:type :system
:www t
:loc "./templates/project")))

View file

@ -169,6 +169,8 @@
:events nil :events nil
:properties ((:name "in-package" :properties ((:name "in-package"
:attr "data-in-package") :attr "data-in-package")
(:name "custom slots"
:attr "data-custom-slots")
(:name "width" (:name "width"
:get ,(lambda (control) (width control)) :get ,(lambda (control) (width control))
:setup :read-only) :setup :read-only)
@ -412,11 +414,14 @@ not a temporary attached one when using select-control."
(let* ((data (first-child content)) (let* ((data (first-child content))
(name (attribute data "data-clog-title")) (name (attribute data "data-clog-title"))
(next-id (attribute data "data-clog-next-id")) (next-id (attribute data "data-clog-next-id"))
(slots (attribute data "data-custom-slots"))
(package (attribute data "data-in-package"))) (package (attribute data "data-in-package")))
(unless (equalp next-id "undefined") (unless (equalp next-id "undefined")
(setf-next-id content next-id)) (setf-next-id content next-id))
(unless (equalp package "undefined") (unless (equalp package "undefined")
(setf (attribute content "data-in-package") package)) (setf (attribute content "data-in-package") package))
(unless (equalp slots "undefined")
(setf (attribute content "data-custom-slots") slots))
(unless (equalp name "undefined") (unless (equalp name "undefined")
(setf (attribute content "data-clog-name") name) (setf (attribute content "data-clog-name") name)
(destroy data))) (destroy data)))
@ -766,8 +771,12 @@ of controls and double click to select control."
(let* ((app (connection-data-item content "builder-app-data")) (let* ((app (connection-data-item content "builder-app-data"))
(panel-id (html-id content)) (panel-id (html-id content))
(package (attribute content "data-in-package")) (package (attribute content "data-in-package"))
(slots (attribute content "data-custom-slots"))
(cname (attribute content "data-clog-name")) (cname (attribute content "data-clog-name"))
cmembers vars events) cmembers vars events)
(unless (or (equal slots "")
(equal slots "undefined"))
(push slots cmembers))
(maphash (lambda (html-id control) (maphash (lambda (html-id control)
(place-inside-bottom-of hide-loc (place-inside-bottom-of hide-loc
(get-placer control)) (get-placer control))
@ -792,7 +801,7 @@ of controls and double click to select control."
(unless (or (equalp handler "undefined") (unless (or (equalp handler "undefined")
(equal handler "")) (equal handler ""))
(push (format nil (push (format nil
"\(set-~A \(~A panel\) \(lambda \(~A\) \(declare \(ignorable ~A\)\) ~A\)\)~%" " \(set-~A \(~A panel\) \(lambda \(~A\) \(declare \(ignorable ~A\)\) ~A\)\)~%"
(getf event :name) (getf event :name)
vname vname
(getf event :parameters) (getf event :parameters)
@ -844,6 +853,8 @@ of controls and double click to select control."
(place-inside-top-of content data) (place-inside-top-of content data)
(setf (attribute data "data-in-package") (setf (attribute data "data-in-package")
(attribute content "data-in-package")) (attribute content "data-in-package"))
(setf (attribute data "data-custom-slots")
(attribute content "data-custom-slots"))
(setf (attribute data "data-clog-next-id") (setf (attribute data "data-clog-next-id")
(attribute content "data-clog-next-id")) (attribute content "data-clog-next-id"))
(setf (attribute data "data-clog-title") (setf (attribute data "data-clog-title")
@ -895,6 +906,7 @@ of controls and double click to select control."
(setf (attribute content "data-clog-name") panel-name)) (setf (attribute content "data-clog-name") panel-name))
(setf (attribute content "data-clog-type") "clog-data") (setf (attribute content "data-clog-type") "clog-data")
(setf (attribute content "data-in-package") "clog-user") (setf (attribute content "data-in-package") "clog-user")
(setf (attribute content "data-custom-slots") "")
(setf (background-color tool-bar) :silver) (setf (background-color tool-bar) :silver)
;; activate associated windows on open ;; activate associated windows on open
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
@ -1060,6 +1072,7 @@ of controls and double click to select control."
(setf (attribute content "data-clog-name") panel-name)) (setf (attribute content "data-clog-name") panel-name))
(setf (attribute content "data-clog-type") "clog-data") (setf (attribute content "data-clog-type") "clog-data")
(setf (attribute content "data-in-package") "clog-user") (setf (attribute content "data-in-package") "clog-user")
(setf (attribute content "data-custom-slots") "")
(setf (overflow content) :auto) (setf (overflow content) :auto)
(set-on-focus (window body) (set-on-focus (window body)
(lambda (obj) (lambda (obj)
@ -1293,7 +1306,7 @@ of controls and double click to select control."
<center>CLOG</center> <center>CLOG</center>
<center>The Common Lisp Omnificent GUI</center></div> <center>The Common Lisp Omnificent GUI</center></div>
<div><p><center>CLOG Builder</center> <div><p><center>CLOG Builder</center>
<center>(c) 2021 - David Botton</center></p></div>" <center>(c) 2022 - David Botton</center></p></div>"
:width 200 :width 200
:height 215 :height 215
:hidden t))) :hidden t)))
@ -1301,6 +1314,7 @@ of controls and double click to select control."
(setf (visiblep about) t) (setf (visiblep about) t)
(set-on-window-can-size about (lambda (obj) (set-on-window-can-size about (lambda (obj)
(declare (ignore obj))())))) (declare (ignore obj))()))))
(defun on-new-builder (body) (defun on-new-builder (body)
"Launch instance of the CLOG Builder" "Launch instance of the CLOG Builder"
(set-html-on-close body "Connection Lost") (set-html-on-close body "Connection Lost")