mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2026-01-04 00:02:57 -08:00
Code Issues Projects Releases Wiki Activity

Add some locks to complete control creation

Browse source
This commit is contained in:
David Botton 2022-01-31 13:42:45 -05:00
parent 60b230ab0c
commit 5f7867ec66
1 changed files with 69 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

16
tools/clog-builder.lisp
View file

@ -58,6 +58,10 @@
:accessor control-pallete-win
:initform nil
:documentation "Current control pallete window")
(new-control-lock
:accessor new-control-lock
:initform (bordeaux-threads:make-lock)
:documentation "Sync creating new controls")
(control-lists
:accessor control-lists
:initform (make-hash-table :test #'equalp)
@ -243,6 +247,7 @@
(defun do-drop-new-control (app content data &key win custom-query)
"Create new control droppend at event DATA on CONTENT of WIN)"
;; create control
(bordeaux-threads:with-lock-held ((new-control-lock app))
(let* ((control-record (control-info (value (select-tool app))))
(control-type-name (getf control-record :name))
(positioning (if (getf data :ctrl-key)
@ -280,7 +285,7 @@
(deselect-current-control app)
(on-populate-control-properties-win content :win win)
(on-populate-control-list-win content)
nil))))
nil)))))
(defun setup-control (content control &key win)
"Setup CONTROL by creating pacer and setting up events for manipulation"
@ -345,11 +350,12 @@ access to it and allows manipulation of location, size etc of the control."
(setf (current-control app) nil)))
(defun delete-current-control (app panel-id html-id)
(bordeaux-threads:with-lock-held ((new-control-lock app))
(remove-from-control-list app panel-id html-id)
(destroy (get-placer (current-control app)))
(destroy (current-control app))
(setf (current-control app) nil)
(remove-deleted-from-control-list app panel-id))
(remove-deleted-from-control-list app panel-id)))
(defun select-control (control)
"Select CONTROL as the current control and highlight its placer.
@ -924,6 +930,7 @@ of controls and double click to select control."
(get-control-list app panel-id)))))
(set-on-click btn-paste (lambda (obj)
(declare (ignore obj))
(bordeaux-threads:with-lock-held ((new-control-lock app))
(when (copy-buf app)
(let ((control (create-control content content
`(:name "custom"
@ -938,7 +945,7 @@ of controls and double click to select control."
(setup-control content control :win win)
(select-control control)
(add-sub-controls control content :win win :paste t)
(on-populate-control-list-win content)))))
(on-populate-control-list-win content))))))
(set-on-click btn-del (lambda (obj)
(declare (ignore obj))
(when (current-control app)
@ -1119,6 +1126,7 @@ of controls and double click to select control."
(get-control-list app panel-id)))))
(set-on-click btn-paste (lambda (obj)
(declare (ignore obj))
(bordeaux-threads:with-lock-held ((new-control-lock app))
(when (copy-buf app)
(let ((control (create-control content content
`(:name "custom"
@ -1133,7 +1141,7 @@ of controls and double click to select control."
(setup-control content control :win win)
(select-control control)
(add-sub-controls control content :win win :paste t)
(on-populate-control-list-win content)))))
(on-populate-control-list-win content))))))
(set-on-click btn-del (lambda (obj)
(declare (ignore obj))
(when (current-control app)