mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
custom slots on panels
This commit is contained in:
parent
17b34bbffb
commit
783707efaa
3 changed files with 30 additions and 2 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -17,3 +17,4 @@
|
||||||
*.wx64fsl
|
*.wx64fsl
|
||||||
*.wx32fsl
|
*.wx32fsl
|
||||||
*~
|
*~
|
||||||
|
*.bak
|
||||||
|
|
|
||||||
|
|
@ -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")))
|
||||||
|
|
|
||||||
|
|
@ -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")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue