mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-07 03:00:49 -08:00
Control list open on start and better updating
This commit is contained in:
David Botton
parent
820949e28c
commit
32a5798566
1 changed files with 202 additions and 191 deletions
|
|
@ -291,7 +291,10 @@
|
||||||
(let ((app (connection-data-item obj "builder-app-data")))
|
(let ((app (connection-data-item obj "builder-app-data")))
|
||||||
(if (control-list-win app)
|
(if (control-list-win app)
|
||||||
(window-focus (control-list-win app))
|
(window-focus (control-list-win app))
|
||||||
(let* ((win (create-gui-window obj :title "Control List")))
|
(let* ((win (create-gui-window obj :title "Control List"
|
||||||
|
:top 350
|
||||||
|
:left 0
|
||||||
|
:width 200)))
|
||||||
(setf (control-list-win app) win)
|
(setf (control-list-win app) win)
|
||||||
(set-on-window-close win (lambda (obj) (setf (control-list-win app) nil)))))))
|
(set-on-window-close win (lambda (obj) (setf (control-list-win app) nil)))))))
|
||||||
|
|
||||||
|
|
@ -326,197 +329,204 @@
|
||||||
(file-name ".")
|
(file-name ".")
|
||||||
control-list
|
control-list
|
||||||
placer-list)
|
placer-list)
|
||||||
(setf (background-color tool-bar) :silver)
|
(labels ((populate-control-list-win ()
|
||||||
(setf (attribute content "data-lisp-name") panel-name)
|
(when (control-list-win app)
|
||||||
(setf (window-title win) panel-name)
|
(let* ((c (control-list-win app))
|
||||||
(set-on-click btn-del (lambda (obj)
|
(w (window-content c))
|
||||||
(declare (ignore obj))
|
(p (first-child content))
|
||||||
(when (current-control app)
|
dln)
|
||||||
(alexandria:removef control-list (current-control app))
|
(setf (inner-html w) "")
|
||||||
(alexandria:removef placer-list (current-placer app))
|
(loop
|
||||||
(destroy (current-placer app))
|
(when (equal (html-id p) "undefined") (return))
|
||||||
(destroy (current-control app))
|
(setf dln (attribute p "data-lisp-name"))
|
||||||
(setf (current-control app) nil)
|
(unless (equal dln "undefined")
|
||||||
(setf (current-placer app) nil)
|
(let ((n (create-div w :content dln)))
|
||||||
(on-populate-control-properties win))))
|
(setf (color n) :blue)
|
||||||
(set-on-click btn-sim (lambda (obj)
|
(setf (draggablep n) t)
|
||||||
(declare (ignore obj))
|
(setf (attribute n "data-clog-control") (html-id p))
|
||||||
(cond (in-simulation
|
(set-on-drag-over n (lambda (obj)(declare (ignore obj))()))
|
||||||
(setf (text btn-sim) "Simulate")
|
(set-on-drop n (lambda (obj data)
|
||||||
(setf in-simulation nil)
|
(declare (ignore obj))
|
||||||
(dolist (placer placer-list)
|
(let ((id (attribute n "data-clog-control")))
|
||||||
(setf (hiddenp placer) nil)))
|
(place-before
|
||||||
(t
|
(attach-as-child n id)
|
||||||
(setf (text btn-sim) "Develop")
|
(attach-as-child n
|
||||||
(when (current-control app)
|
(getf data :drag-data)))
|
||||||
(set-border (current-placer app) (unit "px" 0) :none :blue)
|
(populate-control-list-win))))
|
||||||
(setf (current-control app) nil)
|
(set-on-drag-start n (lambda (obj)
|
||||||
(setf (current-placer app) nil)
|
(declare (ignore obj))())
|
||||||
(on-populate-control-properties win))
|
:drag-data (html-id p))))
|
||||||
(setf in-simulation t)
|
(setf p (next-sibling p)))))))
|
||||||
(dolist (placer placer-list)
|
(setf (background-color tool-bar) :silver)
|
||||||
(setf (hiddenp placer) t))
|
(setf (attribute content "data-lisp-name") panel-name)
|
||||||
(focus (first-child content))))))
|
(setf (window-title win) panel-name)
|
||||||
(set-on-click btn-save (lambda (obj)
|
(set-on-click btn-del (lambda (obj)
|
||||||
(server-file-dialog obj "Save Panel As.." file-name
|
(declare (ignore obj))
|
||||||
(lambda (fname)
|
(when (current-control app)
|
||||||
(window-focus win)
|
(alexandria:removef control-list (current-control app))
|
||||||
(when fname
|
(alexandria:removef placer-list (current-placer app))
|
||||||
(setf file-name fname)
|
(destroy (current-placer app))
|
||||||
|
(destroy (current-control app))
|
||||||
|
(setf (current-control app) nil)
|
||||||
|
(setf (current-placer app) nil)
|
||||||
|
(on-populate-control-properties win)
|
||||||
|
(populate-control-list-win))))
|
||||||
|
(set-on-click btn-sim (lambda (obj)
|
||||||
|
(declare (ignore obj))
|
||||||
|
(cond (in-simulation
|
||||||
|
(setf (text btn-sim) "Simulate")
|
||||||
|
(setf in-simulation nil)
|
||||||
|
(dolist (placer placer-list)
|
||||||
|
(setf (hiddenp placer) nil)))
|
||||||
|
(t
|
||||||
|
(setf (text btn-sim) "Develop")
|
||||||
|
(when (current-control app)
|
||||||
|
(set-border (current-placer app) (unit "px" 0) :none :blue)
|
||||||
|
(setf (current-control app) nil)
|
||||||
|
(setf (current-placer app) nil)
|
||||||
|
(on-populate-control-properties win))
|
||||||
|
(setf in-simulation t)
|
||||||
|
(dolist (placer placer-list)
|
||||||
|
(setf (hiddenp placer) t))
|
||||||
|
(focus (first-child content))))))
|
||||||
|
(set-on-click btn-save (lambda (obj)
|
||||||
|
(server-file-dialog obj "Save Panel As.." file-name
|
||||||
|
(lambda (fname)
|
||||||
|
(window-focus win)
|
||||||
|
(when fname
|
||||||
|
(setf file-name fname)
|
||||||
|
(dolist (placer placer-list)
|
||||||
|
(place-inside-bottom-of (bottom-panel box) placer))
|
||||||
|
(write-file (inner-html content) fname))
|
||||||
(dolist (placer placer-list)
|
(dolist (placer placer-list)
|
||||||
(place-inside-bottom-of (bottom-panel box) placer))
|
(place-inside-bottom-of content placer)))
|
||||||
(write-file (inner-html content) fname))
|
:initial-filename file-name)))
|
||||||
(dolist (placer placer-list)
|
(set-on-click btn-rndr (lambda (obj)
|
||||||
(place-inside-bottom-of content placer)))
|
(dolist (placer placer-list)
|
||||||
:initial-filename file-name)))
|
(place-inside-bottom-of (bottom-panel box) placer))
|
||||||
(set-on-click btn-rndr (lambda (obj)
|
(let* ((cw (on-show-layout-code obj))
|
||||||
(dolist (placer placer-list)
|
(result (format nil
|
||||||
(place-inside-bottom-of (bottom-panel box) placer))
|
*builder-template1*
|
||||||
(let* ((cw (on-show-layout-code obj))
|
panel-name
|
||||||
(result (format nil
|
(escape-string
|
||||||
*builder-template1*
|
(ppcre:regex-replace-all "\\x22"
|
||||||
panel-name
|
(inner-html content)
|
||||||
(escape-string
|
"\\\\\\\""))
|
||||||
(ppcre:regex-replace-all "\\x22"
|
panel-name
|
||||||
(inner-html content)
|
(mapcar (lambda (e)
|
||||||
"\\\\\\\""))
|
(let ((vname (attribute e "data-lisp-name")))
|
||||||
panel-name
|
(when vname
|
||||||
(mapcar (lambda (e)
|
(format nil *builder-template2*
|
||||||
(let ((vname (attribute e "data-lisp-name")))
|
vname
|
||||||
(when vname
|
(html-id e)
|
||||||
(format nil *builder-template2*
|
(format nil "CLOG:~A" (type-of e))))))
|
||||||
vname
|
control-list)
|
||||||
(html-id e)
|
(html-id cw)
|
||||||
(format nil "CLOG:~A" (type-of e))))))
|
(html-id cw))))
|
||||||
control-list)
|
(js-execute obj (format nil
|
||||||
(html-id cw)
|
"editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||||
(html-id cw))))
|
(html-id cw)
|
||||||
(js-execute obj (format nil
|
(escape-string result)
|
||||||
"editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
(html-id cw))))
|
||||||
(html-id cw)
|
(dolist (placer placer-list)
|
||||||
(escape-string result)
|
(place-inside-bottom-of content placer))))
|
||||||
(html-id cw))))
|
(set-on-click btn-prop
|
||||||
(dolist (placer placer-list)
|
(lambda (obj)
|
||||||
(place-inside-bottom-of content placer))))
|
(input-dialog obj
|
||||||
(set-on-click btn-prop
|
"Panel Name"
|
||||||
(lambda (obj)
|
(lambda (result)
|
||||||
(input-dialog obj
|
(when result
|
||||||
"Panel Name"
|
(setf panel-name result)
|
||||||
(lambda (result)
|
(setf (attribute content "data-lisp-name") panel-name)
|
||||||
(when result
|
(setf (window-title win) panel-name)))
|
||||||
(setf panel-name result)
|
:default-value panel-name
|
||||||
(setf (attribute content "data-lisp-name") panel-name)
|
:title "Panel Properties")))
|
||||||
(setf (window-title win) panel-name)))
|
(set-on-window-close win
|
||||||
:default-value panel-name
|
(lambda (obj)
|
||||||
:title "Panel Properties")))
|
(declare (ignore obj))
|
||||||
(set-on-window-close win
|
(setf (current-control app) nil)
|
||||||
(lambda (obj)
|
(setf (current-placer app) nil)
|
||||||
(declare (ignore obj))
|
(on-populate-control-properties win)
|
||||||
(setf (current-control app) nil)
|
(populate-control-list-win)))
|
||||||
(setf (current-placer app) nil)
|
(set-on-mouse-down content
|
||||||
(on-populate-control-properties win)))
|
(lambda (obj data)
|
||||||
(set-on-mouse-down content
|
(unless in-simulation
|
||||||
(lambda (obj data)
|
(let* ((control (selected-tool app))
|
||||||
(unless in-simulation
|
(create-type (getf control :create-type))
|
||||||
(let* ((control (selected-tool app))
|
(element (cond ((eq create-type :label)
|
||||||
(create-type (getf control :create-type))
|
(funcall (getf control :create) content
|
||||||
(element (cond ((eq create-type :label)
|
:content (getf control :create-content)))
|
||||||
(funcall (getf control :create) content
|
((eq create-type :form)
|
||||||
:content (getf control :create-content)))
|
(funcall (getf control :create) content
|
||||||
((eq create-type :form)
|
(getf control :create-param)
|
||||||
(funcall (getf control :create) content
|
:value (getf control :create-value)))
|
||||||
(getf control :create-param)
|
(t nil)))
|
||||||
:value (getf control :create-value)))
|
(placer (when element
|
||||||
(t nil)))
|
(create-div obj))))
|
||||||
(placer (when element
|
(unless element
|
||||||
(create-div obj))))
|
(when (current-placer app)
|
||||||
(unless element
|
(set-border (current-placer app) (unit "px" 0) :none :blue))
|
||||||
(when (current-placer app)
|
(setf (current-control app) nil)
|
||||||
(set-border (current-placer app) (unit "px" 0) :none :blue))
|
(setf (current-placer app) nil)
|
||||||
(setf (current-control app) nil)
|
(on-populate-control-properties win))
|
||||||
(setf (current-placer app) nil)
|
(when element
|
||||||
(on-populate-control-properties win)
|
(setf (current-control app) element)
|
||||||
(when (control-list-win app)
|
(push element control-list)
|
||||||
(let* ((c (control-list-win app))
|
(push placer placer-list)
|
||||||
(w (window-content c))
|
(setf (attribute element "data-lisp-name")
|
||||||
(p (first-child content))
|
(format nil "~A-~A" (getf control :name) (html-id element)))
|
||||||
dln)
|
(setf (attribute element "data-clog-type") (getf control :name))
|
||||||
(setf (inner-html w) "")
|
(setf (box-sizing element) :content-box)
|
||||||
(loop
|
(setf (box-sizing placer) :content-box)
|
||||||
(when (equal (html-id p) "undefined") (return))
|
(set-on-mouse-down placer (lambda (obj data)
|
||||||
(setf dln (attribute p "data-lisp-name"))
|
(declare (ignore obj) (ignore data))
|
||||||
(unless (equal dln "undefined")
|
(when (current-placer app)
|
||||||
(let ((n (create-div w :content dln)))
|
(set-border (current-placer app) (unit "px" 0) :none :blue))
|
||||||
(setf (color n) :blue)
|
(setf (current-control app) element)
|
||||||
(setf (draggablep n) t)
|
(setf (current-placer app) placer)
|
||||||
(setf (attribute n "data-clog-control") (html-id p))
|
(set-border placer (unit "px" 2) :solid :blue)
|
||||||
(set-on-drag-over n (lambda (obj)(declare (ignore obj))()))
|
(on-populate-control-properties win))
|
||||||
(set-on-drop n (lambda (obj data)
|
:cancel-event t)
|
||||||
(declare (ignore obj))
|
(setf (selected-tool app) nil)
|
||||||
(let ((id (attribute n "data-clog-control")))
|
(setf (positioning element) :absolute)
|
||||||
(place-before (attach-as-child n id)
|
(set-geometry element
|
||||||
(attach-as-child n (getf data :drag-data))))))
|
:left (getf data :x)
|
||||||
(set-on-drag-start n (lambda (obj)
|
:top (getf data :y))
|
||||||
(declare (ignore obj))())
|
(setf (positioning placer) :absolute)
|
||||||
:drag-data (html-id p))))
|
(when (current-placer app)
|
||||||
(setf p (next-sibling p))))))
|
(set-border (current-placer app) (unit "px" 0) :none :blue))
|
||||||
(when element
|
(set-border placer (unit "px" 2) :solid :blue)
|
||||||
(setf (current-control app) element)
|
(setf (current-placer app) placer)
|
||||||
(push element control-list)
|
(clog::jquery-execute placer "draggable().resizable()")
|
||||||
(push placer placer-list)
|
(set-geometry placer
|
||||||
(setf (attribute element "data-lisp-name")
|
:left (getf data :x)
|
||||||
(format nil "control-~A" (html-id element)))
|
:top (getf data :y))
|
||||||
(setf (attribute element "data-clog-type") (getf control :name))
|
(if (> (client-width element) 0)
|
||||||
(setf (box-sizing element) :content-box)
|
(set-geometry placer :units ""
|
||||||
(setf (box-sizing placer) :content-box)
|
:width (client-width element)
|
||||||
(set-on-mouse-down placer (lambda (obj data)
|
:height (client-height element))
|
||||||
(declare (ignore obj) (ignore data))
|
(set-geometry placer :units ""
|
||||||
(when (current-placer app)
|
:width (width element)
|
||||||
(set-border (current-placer app) (unit "px" 0) :none :blue))
|
:height (height element)))
|
||||||
(setf (current-control app) element)
|
(on-populate-control-properties win)
|
||||||
(setf (current-placer app) placer)
|
(clog::set-on-event placer "resizestop"
|
||||||
(set-border placer (unit "px" 2) :solid :blue)
|
(lambda (obj)
|
||||||
(on-populate-control-properties win))
|
(declare (ignore obj))
|
||||||
:cancel-event t)
|
(set-geometry element :units ""
|
||||||
(setf (selected-tool app) nil)
|
:width (width placer)
|
||||||
(setf (positioning element) :absolute)
|
:height (height placer))
|
||||||
(set-geometry element
|
(set-geometry placer :units ""
|
||||||
:left (getf data :x)
|
:width (client-width element)
|
||||||
:top (getf data :y))
|
:height (client-height element))
|
||||||
(setf (positioning placer) :absolute)
|
(on-populate-control-properties win)))
|
||||||
(when (current-placer app)
|
(clog::set-on-event placer "dragstop"
|
||||||
(set-border (current-placer app) (unit "px" 0) :none :blue))
|
(lambda (obj)
|
||||||
(set-border placer (unit "px" 2) :solid :blue)
|
(declare (ignore obj))
|
||||||
(setf (current-placer app) placer)
|
(set-geometry element :units ""
|
||||||
(clog::jquery-execute placer "draggable().resizable()")
|
:top (top placer)
|
||||||
(set-geometry placer
|
:left (left placer))
|
||||||
:left (getf data :x)
|
(on-populate-control-properties win)))
|
||||||
:top (getf data :y))
|
(populate-control-list-win)))))))))
|
||||||
(if (> (client-width element) 0)
|
|
||||||
(set-geometry placer :units ""
|
|
||||||
:width (client-width element)
|
|
||||||
:height (client-height element))
|
|
||||||
(set-geometry placer :units ""
|
|
||||||
:width (width element)
|
|
||||||
:height (height element)))
|
|
||||||
(on-populate-control-properties win)
|
|
||||||
(clog::set-on-event placer "resizestop"
|
|
||||||
(lambda (obj)
|
|
||||||
(declare (ignore obj))
|
|
||||||
(set-geometry element :units ""
|
|
||||||
:width (width placer)
|
|
||||||
:height (height placer))
|
|
||||||
(set-geometry placer :units ""
|
|
||||||
:width (client-width element)
|
|
||||||
:height (client-height element))
|
|
||||||
(on-populate-control-properties win)))
|
|
||||||
(clog::set-on-event placer "dragstop"
|
|
||||||
(lambda (obj)
|
|
||||||
(declare (ignore obj))
|
|
||||||
(set-geometry element :units ""
|
|
||||||
:top (top placer)
|
|
||||||
:left (left placer))
|
|
||||||
(on-populate-control-properties win))))))))))
|
|
||||||
|
|
||||||
(defun on-help-about-builder (obj)
|
(defun on-help-about-builder (obj)
|
||||||
(let ((about (create-gui-window obj
|
(let ((about (create-gui-window obj
|
||||||
|
|
@ -566,6 +576,7 @@
|
||||||
(create-gui-menu-item help :content "About" :on-click #'on-help-about-builder)
|
(create-gui-menu-item help :content "About" :on-click #'on-help-about-builder)
|
||||||
(create-gui-menu-full-screen menu))
|
(create-gui-menu-full-screen menu))
|
||||||
(on-show-control-pallete body)
|
(on-show-control-pallete body)
|
||||||
|
(on-show-control-list body)
|
||||||
(on-show-control-properties body)
|
(on-show-control-properties body)
|
||||||
(on-new-builder-window body)
|
(on-new-builder-window body)
|
||||||
(set-on-before-unload (window body) (lambda(obj)
|
(set-on-before-unload (window body) (lambda(obj)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue