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

handle editting html properly for custom html block

Browse source
This commit is contained in:
David Botton 2022-07-21 02:55:30 -04:00
parent 616a623c48
commit 2028bb2d7a
2 changed files with 57 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -335,11 +335,11 @@
`((:name "html contents" `((:name "html contents"
:setup ,(lambda (control td1 td2) :setup ,(lambda (control td1 td2)
(declare (ignore td1)) (declare (ignore td1))
(let ((d1 (create-text-area td2 :value (attribute control "data-original-html")))) (let ((d1 (create-text-area td2 :value (escape-string (attribute control "data-original-html") :html t))))
(set-on-change d1 (lambda (obj) (set-on-change d1 (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(setf (attribute control "data-original-html") (escape-string (value d1) :html t)) (setf (attribute control "data-original-html") (value d1))
(setf (inner-html control) (escape-string (value d1) :html t))))) (setf (inner-html control) (value d1)))))
nil)))) nil))))
(defparameter *props-text* (defparameter *props-text*

105
tools/clog-builder.lisp
View file

@ -701,64 +701,67 @@ not a temporary attached one when using select-control."
(labels ((add-siblings (control) (labels ((add-siblings (control)
(let (dct) (let (dct)
(loop (loop
(unless control (return))
(when (equal (html-id control) "undefined") (return)) (when (equal (html-id control) "undefined") (return))
(setf dct (attribute control "data-clog-name")) (setf dct (attribute control "data-clog-name"))
(unless (equal dct "undefined") (unless (equal dct "undefined")
(setf control (get-from-control-list app panel-id (html-id control))) (setf control (get-from-control-list app panel-id (html-id control)))
(let ((vname (attribute control "data-clog-name")) (when control
(control-record (control-info (attribute control "data-clog-type")))) (let ((vname (attribute control "data-clog-name"))
(unless (and (>= (length vname) 5) (control-record (control-info (attribute control "data-clog-type"))))
(equalp (subseq vname 0 5) "none-")) (unless (and (>= (length vname) 5)
;; Add to members of the panel's class for each control (equalp (subseq vname 0 5) "none-"))
(push (format nil ;; Add to members of the panel's class for each control
" \(~A :reader ~A\)~%" (push (format nil
vname " \(~A :reader ~A\)~%"
vname) vname
cmembers) vname)
;; On instance of class, set member value for each control cmembers)
(push (format nil ;; On instance of class, set member value for each control
" \(setf (slot-value panel '~A\) ~ (push (format nil
" \(setf (slot-value panel '~A\) ~
\(attach-as-child clog-obj \"~A\" :clog-type \'~A\ :new-id t)\)~%" \(attach-as-child clog-obj \"~A\" :clog-type \'~A\ :new-id t)\)~%"
vname vname
(html-id control) (html-id control)
(format nil "~S" (getf control-record :clog-type))) (format nil "~S" (getf control-record :clog-type)))
vars) vars)
;; On instance of class, set handers defined for each control ;; On instance of class, set handers defined for each control
(dolist (event (getf control-record :events)) (dolist (event (getf control-record :events))
;; Set regular handlers ;; Set regular handlers
(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 ""))
(unless (equalp (getf event :name) "on-create") (unless (equalp (getf event :name) "on-create")
(let ((event-package (or (getf event :package) "clog"))) (let ((event-package (or (getf event :package) "clog")))
(push (format nil (push (format nil
" \(~A:set-~A \(~A panel\) \(lambda \(~A\) \(declare \(ignorable ~A\)\) ~A\)\)~%" " \(~A:set-~A \(~A panel\) \(lambda \(~A\) \(declare \(ignorable ~A\)\) ~A\)\)~%"
event-package event-package
(getf event :name) (getf event :name)
vname vname
(getf event :parameters) (getf event :parameters)
(getf event :parameters) (getf event :parameters)
handler) handler)
events)))))) events))))))
;; Set on-create (from user in builder) and on-setup (from control-record) ;; Set on-create (from user in builder) and on-setup (from control-record)
(let ((handler (attribute control "data-on-create"))) (let ((handler (attribute control "data-on-create")))
(when (equalp handler "undefined") (when (equalp handler "undefined")
(setf handler "")) (setf handler ""))
(when (getf control-record :on-setup) (when (getf control-record :on-setup)
(setf handler (format nil "~A~A" (setf handler (format nil "~A~A"
(funcall (getf control-record :on-setup) (funcall (getf control-record :on-setup)
control control-record) control control-record)
handler))) handler)))
(unless (equal handler "") (unless (equal handler "")
(push (format nil (push (format nil
" \(let \(\(target \(~A panel\)\)\) ~ " \(let \(\(target \(~A panel\)\)\) ~
\(declare \(ignorable target\)\) ~ \(declare \(ignorable target\)\) ~
~A\)~%" ~A\)~%"
vname vname
handler) handler)
creates))))) creates)))))
(add-siblings (first-child control))) (add-siblings (first-child control))))
(setf control (next-sibling control)))))) (when control
(setf control (next-sibling control)))))))
(add-siblings (first-child content))) (add-siblings (first-child content)))
(let ((result (format nil (let ((result (format nil
"\(in-package \"~A\"\) "\(in-package \"~A\"\)