mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

Support for on-setup even set in the control record

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

1
clog.asd
View file

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

7
source/clog.lisp
View file

@ -39,6 +39,7 @@ embedded in a native template application.)"
(@clog-element-common section) (@clog-element-common section)
(@clog-presentations section) (@clog-presentations section)
(@clog-data section) (@clog-data section)
(@clog-dbi section)
(@clog-panels section) (@clog-panels section)
(@clog-style-block section) (@clog-style-block section)
(@clog-form section) (@clog-form section)
@ -537,6 +538,12 @@ embedded in a native template application.)"
(sql-insert* function) (sql-insert* function)
(sql-update 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") (defsection @clog-panels (:title "CLOG Panels")
"CLOG-Panel - CLOG Panels" "CLOG-Panel - CLOG Panels"
(clog-panel class) (clog-panel class)

25
tools/clog-builder-settings.lisp
View file

@ -1326,7 +1326,30 @@
:create clog:create-canvas :create clog:create-canvas
:create-type :base :create-type :base
:events (,@*events-element*) :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* (defparameter *supported-templates*
(list (list

30
tools/clog-builder.lisp
View file

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