Support for on-setup even set in the control record

This commit is contained in:
David Botton 2022-02-22 15:57:15 -05:00
parent d632d10042
commit 518972d36f
4 changed files with 51 additions and 12 deletions

View file

@ -34,6 +34,7 @@
(:file "clog-panel")
(:file "clog-presentations")
(:file "clog-data")
(:file "clog-dbi")
(:file "clog-gui")
(:file "clog-web")
(:file "clog-helpers")))

View file

@ -39,6 +39,7 @@ embedded in a native template application.)"
(@clog-element-common section)
(@clog-presentations section)
(@clog-data section)
(@clog-dbi section)
(@clog-panels section)
(@clog-style-block section)
(@clog-form section)
@ -537,6 +538,12 @@ embedded in a native template application.)"
(sql-insert* function)
(sql-update function))
(defsection @clog-dbi (:title "CLOG DBI")
"CLOG-Database - CLOG Database Connection"
(clog-database class)
(database-connection generic-function)
(create-database generic-function))
(defsection @clog-panels (:title "CLOG Panels")
"CLOG-Panel - CLOG Panels"
(clog-panel class)

View file

@ -1326,7 +1326,30 @@
:create clog:create-canvas
:create-type :base
:events (,@*events-element*)
:properties (,@*props-base*))))
:properties (,@*props-base*))
'(:name "group"
:description "database"
:create nil
:create-type nil
:events nil
:properties nil)
`(:name "database"
:description "Database"
:clog-type clog:clog-database
:create clog:create-database
:create-type :base
:on-setup ,(lambda (control control-record)
(declare (ignore control-record))
(format nil "(setf (database-connection target) ~
(dbi:connect ~A :database-name \"~A\"))"
(attribute control "data-clog-dbi-dbtype")
(attribute control "data-clog-dbi-dbname")))
:events (,@*events-element*)
:properties ((:name "database type"
:attr "data-clog-dbi-dbtype")
(:name "database name"
:attr "data-clog-dbi-dbname")
,@*props-element*))))
(defparameter *supported-templates*
(list

View file

@ -548,8 +548,8 @@ not a temporary attached one when using select-control."
html-id
(format nil "CLOG:~A" (type-of control)))
vars)
(let ((info (control-info (attribute control "data-clog-type"))))
(dolist (event (getf info :events))
(let ((control-record (control-info (attribute control "data-clog-type"))))
(dolist (event (getf control-record :events))
(let ((handler (attribute control (format nil "data-~A" (getf event :name)))))
(unless (or (equalp handler "undefined")
(equal handler ""))
@ -561,15 +561,23 @@ not a temporary attached one when using select-control."
(getf event :parameters)
(getf event :parameters)
handler)
events))))))
events)))))
(let ((handler (attribute control "data-on-create")))
(unless (or (equalp handler "undefined")
(equal handler ""))
(when (equalp handler "undefined")
(setf handler ""))
(when (getf control-record :on-setup)
(setf handler (format nil "~A~A"
(funcall (getf control-record :on-setup)
control control-record)
handler)))
(unless (equal handler "")
(push (format nil
" \(let \(\(target \(~A panel\)\)\) \(declare \(ignorable target\)\) ~A\)~%"
" \(let \(\(target \(~A panel\)\)\) ~
\(declare \(ignorable target\)\) ~
~A\)~%"
vname
handler)
events))))))
events)))))))
(get-control-list app panel-id))
(let ((result (format nil
"\(in-package \"~A\"\)