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

Improved cut and paste nested

Browse source
This commit is contained in:
David Botton 2022-01-30 22:07:30 -05:00
parent e96960a2c3
commit 8a77a3d8ee
1 changed files with 124 additions and 100 deletions
Download patch file Download diff file Expand all files Collapse all files

224
tools/clog-builder.lisp
View file

@ -50,6 +50,10 @@
:accessor control-list-win :accessor control-list-win
:initform nil :initform nil
:documentation "Current control list window") :documentation "Current control list window")
(control-list-win-lock
:accessor control-list-win-lock
:initform (bordeaux-threads:make-lock)
:documentation "Sync control-list-win list")
(control-pallete-win (control-pallete-win
:accessor control-pallete-win :accessor control-pallete-win
:initform nil :initform nil
@ -390,14 +394,13 @@ not a temporary attached one when using select-control."
(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"))
(package (attribute data "data-in-package"))) (package (attribute data "data-in-package")))
(when name (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 name "undefined")
(unless (equalp name "undefined") (setf (attribute content "data-clog-name") name)
(setf (attribute content "data-clog-name") name) (destroy data)))
(destroy data))))
(labels ((add-siblings (control) (labels ((add-siblings (control)
(let (dct) (let (dct)
(loop (loop
@ -562,83 +565,84 @@ not a temporary attached one when using select-control."
(defun on-populate-control-list-win (content) (defun on-populate-control-list-win (content)
"Populate the control-list-window to allow drag and drop adjust of order "Populate the control-list-window to allow drag and drop adjust of order
of controls and double click to select control." 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)) (bordeaux-threads:with-lock-held ((control-list-win-lock app))
(last-ctl nil)) (let ((panel-id (html-id content))
(when (control-list-win app) (last-ctl nil))
(let ((win (window-content (control-list-win app)))) (when (control-list-win app)
(setf (inner-html win) "") (let ((win (window-content (control-list-win app))))
(labels ((add-siblings (control sim) (setf (inner-html win) "")
(let (dln) (labels ((add-siblings (control sim)
(loop (let (dln)
(when (equal (html-id control) "undefined") (return)) (loop
(setf dln (attribute control "data-clog-name")) (when (equal (html-id control) "undefined") (return))
(unless (equal dln "undefined") (setf dln (attribute control "data-clog-name"))
(let ((list-item (create-div win :content (format nil "↕ ~A~A" sim dln))) (unless (equal dln "undefined")
(status (hiddenp (get-placer control)))) (let ((list-item (create-div win :content (format nil "↕ ~A~A" sim dln)))
(if status (status (hiddenp (get-placer control))))
(setf (background-color list-item) :gray) (if status
(setf (background-color list-item) :lightgray)) (setf (background-color list-item) :gray)
(setf (draggablep list-item) t) (setf (background-color list-item) :lightgray))
(setf (attribute list-item "data-clog-control") (html-id control)) (setf (draggablep list-item) t)
;; click to select item (setf (attribute list-item "data-clog-control") (html-id control))
(set-on-mouse-down list-item ;; click to select item
(lambda (obj data) (set-on-mouse-down list-item
(let* ((html-id (attribute obj "data-clog-control")) (lambda (obj data)
(control (get-from-control-list app (let* ((html-id (attribute obj "data-clog-control"))
panel-id (control (get-from-control-list app
html-id))) panel-id
(cond ((or (getf data :shift-key) html-id)))
(getf data :ctrl-key)) (cond ((or (getf data :shift-key)
(when (drop-new-control app content data) (getf data :ctrl-key))
(incf-next-id content))) (when (drop-new-control app content data)
(t (incf-next-id content)))
(when last-ctl (t
(set-border last-ctl "0px" :dotted :blue)) (when last-ctl
(set-border list-item "2px" :dotted :blue) (set-border last-ctl "0px" :dotted :blue))
(setf last-ctl list-item) (set-border list-item "2px" :dotted :blue)
(select-control control)))))) (setf last-ctl list-item)
(set-on-double-click list-item (select-control control))))))
(lambda (obj) (set-on-double-click list-item
(let* ((html-id (attribute obj "data-clog-control")) (lambda (obj)
(control (get-from-control-list app (let* ((html-id (attribute obj "data-clog-control"))
panel-id (control (get-from-control-list app
html-id)) panel-id
(placer (get-placer control)) html-id))
(state (hiddenp placer))) (placer (get-placer control))
(setf (hiddenp placer) (not state)) (state (hiddenp placer)))
(select-control control)))) (setf (hiddenp placer) (not state))
;; drag and drop to change (select-control control))))
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))())) ;; drag and drop to change
(set-on-drop list-item (set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
(lambda (obj data) (set-on-drop list-item
(let* ((id (attribute obj "data-clog-control")) (lambda (obj data)
(control1 (get-from-control-list app (let* ((id (attribute obj "data-clog-control"))
panel-id (control1 (get-from-control-list app
id)) panel-id
(control2 (get-from-control-list app id))
panel-id (control2 (get-from-control-list app
(getf data :drag-data))) panel-id
(placer1 (get-placer control1)) (getf data :drag-data)))
(placer2 (get-placer control2))) (placer1 (get-placer control1))
(if (getf data :shift-key) (placer2 (get-placer control2)))
(place-inside-bottom-of control1 control2) (if (getf data :shift-key)
(place-before control1 control2)) (place-inside-bottom-of control1 control2)
(place-after control2 placer2) (place-before control1 control2))
(set-geometry placer1 :top (position-top control1) (place-after control2 placer2)
:left (position-left control1) (set-geometry placer1 :top (position-top control1)
:width (client-width control1) :left (position-left control1)
:height (client-height control1)) :width (client-width control1)
(set-geometry placer2 :top (position-top control2) :height (client-height control1))
:left (position-left control2) (set-geometry placer2 :top (position-top control2)
:width (client-width control2) :left (position-left control2)
:height (client-height control2)) :width (client-width control2)
(on-populate-control-list-win content)))) :height (client-height control2))
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))()) (on-populate-control-list-win content))))
:drag-data (html-id control)) (set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
(add-siblings (first-child control) (format nil "~A→" sim)))) :drag-data (html-id control))
(setf control (next-sibling control)))))) (add-siblings (first-child control) (format nil "~A→" sim))))
(add-siblings (first-child content) "")))))) (setf control (next-sibling control))))))
(add-siblings (first-child content) ""))))))))
;; Menu handlers ;; Menu handlers
@ -827,7 +831,7 @@ of controls and double click to select control."
(format nil (format nil
"var z=~a.clone();~ "var z=~a.clone();~
z.find('*').each(function(){if($(this).attr('id') !== undefined && ~ z.find('*').each(function(){if($(this).attr('id') !== undefined && ~
if($(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~ $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
z.html()" z.html()"
(clog::jquery content))) (clog::jquery content)))
fname) fname)
@ -892,6 +896,12 @@ of controls and double click to select control."
(set-on-click btn-copy (lambda (obj) (set-on-click btn-copy (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
(maphash
(lambda (html-id control)
(declare (ignore html-id))
(place-inside-bottom-of (bottom-panel box)
(get-placer control)))
(get-control-list app panel-id))
(setf (copy-buf app) (setf (copy-buf app)
(js-query content (js-query content
(format nil (format nil
@ -899,9 +909,14 @@ of controls and double click to select control."
z.find('*').each(function(){if($(this).attr('id') !== undefined && ~ z.find('*').each(function(){if($(this).attr('id') !== undefined && ~
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~ $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
z.html()" z.html()"
(clog::jquery (current-control app)))))))) (clog::jquery (current-control app)))))
(set-on-click btn-paste (lambda (obj) (maphash
(declare (ignore obj)) (lambda (html-id control)
(declare (ignore html-id))
(place-after control (get-placer control)))
(get-control-list app panel-id)))))
(set-on-click btn-paste (lambda (obj)
(declare (ignore obj))
(when (copy-buf app) (when (copy-buf app)
(let ((control (create-control content content (let ((control (create-control content content
`(:name "custom" `(:name "custom"
@ -912,8 +927,7 @@ of controls and double click to select control."
:custom-query (copy-buf app)))) :custom-query (copy-buf app))))
(setup-control content control :win win) (setup-control content control :win win)
(select-control control) (select-control control)
(add-sub-controls control content :win win) (add-sub-controls control content :win win)))))
(on-populate-control-list-win content)))))
(set-on-click btn-del (lambda (obj) (set-on-click btn-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
@ -1048,8 +1062,8 @@ of controls and double click to select control."
(cond (custom-boot (cond (custom-boot
(load-css (html-document body) "/css/jquery-ui.css") (load-css (html-document body) "/css/jquery-ui.css")
(load-script (html-document body) "/js/jquery-ui.js")) (load-script (html-document body) "/js/jquery-ui.js"))
(t (t
(clog-gui-initialize body) (clog-gui-initialize body)
(clog-web-initialize body :w3-css-url nil))) (clog-web-initialize body :w3-css-url nil)))
;; init builder ;; init builder
(init-control-list app panel-id) (init-control-list app panel-id)
@ -1073,14 +1087,25 @@ of controls and double click to select control."
(set-on-click btn-copy (lambda (obj) (set-on-click btn-copy (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
(maphash
(lambda (html-id control)
(declare (ignore html-id))
(place-inside-bottom-of (bottom-panel box)
(get-placer control)))
(get-control-list app panel-id))
(setf (copy-buf app) (setf (copy-buf app)
(js-query content (js-query content
(format nil (format nil
"var z=~a.clone(); z=$('<div />').append(z);~ "var z=~a.clone(); z=$('<div />').append(z);~
z.find('*').each(function(){if($(this).attr('id') !== undefined && ~ z.find('*').each(function(){if($(this).attr('id') !== undefined && ~
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~ $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
z.html()" z.html()"
(clog::jquery (current-control app)))))))) (clog::jquery (current-control app)))))
(maphash
(lambda (html-id control)
(declare (ignore html-id))
(place-after control (get-placer control)))
(get-control-list app panel-id)))))
(set-on-click btn-paste (lambda (obj) (set-on-click btn-paste (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (copy-buf app) (when (copy-buf app)
@ -1093,8 +1118,7 @@ of controls and double click to select control."
:custom-query (copy-buf app)))) :custom-query (copy-buf app))))
(setup-control content control :win win) (setup-control content control :win win)
(select-control control) (select-control control)
(add-sub-controls control content :win win) (add-sub-controls control content :win win)))))
(on-populate-control-list-win content)))))
(set-on-click btn-del (lambda (obj) (set-on-click btn-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)