mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
performace enhacements
This commit is contained in:
David Botton
parent
519cadddd4
commit
452ee0b1b8
5 changed files with 437 additions and 422 deletions
|
|
@ -2384,34 +2384,43 @@ used for DOM tree walking or other throw away purposes."))
|
|||
;; first-child ;;
|
||||
;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric first-child (clog-element)
|
||||
(defgeneric first-child (clog-element &key no-attach)
|
||||
(:documentation "Traverse to first child element. If Child does not have an
|
||||
html id than Element_Type will have an ID of undefined and therefore attached
|
||||
to no actual HTML element."))
|
||||
|
||||
(defmethod first-child ((obj clog-element))
|
||||
(attach-as-child obj (jquery-query obj "children().first().prop('id')")))
|
||||
(defmethod first-child ((obj clog-element) &key no-attach)
|
||||
(let ((id (jquery-query obj "children().first().prop('id')")))
|
||||
(if (or no-attach (equalp id "undefined"))
|
||||
(make-clog-element (connection-id obj) id :clog-type 'clog-element))
|
||||
(attach-as-child obj id)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; next-sibling ;;
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric next-sibling (clog-element)
|
||||
(defgeneric next-sibling (clog-element &key no-attach)
|
||||
(:documentation "Traverse to next sibling element. If Child does not have an
|
||||
html id than Element_Type will have an ID of undefined and therefore attached
|
||||
to no actual HTML element."))
|
||||
|
||||
(defmethod next-sibling ((obj clog-element))
|
||||
(attach-as-child obj (jquery-query obj "next().prop('id')")))
|
||||
(defmethod next-sibling ((obj clog-element) &key no-attach)
|
||||
(let ((id (jquery-query obj "next().prop('id')")))
|
||||
(if (or no-attach (equalp id "undefined"))
|
||||
(make-clog-element (connection-id obj) id :clog-type 'clog-element))
|
||||
(attach-as-child obj id)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; previous-sibling ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric previous-sibling (clog-element)
|
||||
(defgeneric previous-sibling (clog-element &key no-attach)
|
||||
(:documentation "Traverse to previous sibling element.
|
||||
If Child does not have an html id than Element_Type will have an ID of
|
||||
undefined and therefore attached to no actual HTML elemen."))
|
||||
|
||||
(defmethod previous-sibling ((obj clog-element))
|
||||
(attach-as-child obj (jquery-query obj "previous().prop('id')")))
|
||||
(defmethod previous-sibling ((obj clog-element) &key no-attach)
|
||||
(let ((id (jquery-query obj "previous().prop('id')")))
|
||||
(if (or no-attach (equalp id "undefined"))
|
||||
(make-clog-element (connection-id obj) id :clog-type 'clog-element))
|
||||
(attach-as-child obj id)))
|
||||
|
|
|
|||
|
|
@ -990,6 +990,7 @@ The on-window-change clog-obj received is the new window"))
|
|||
"Handle mouse down on drag items"
|
||||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(setf (in-drag app) (attribute obj "data-drag-type"))
|
||||
(handler-case
|
||||
(let* ((target (gethash (attribute obj "data-drag-obj") (windows app)))
|
||||
(pointer-x (getf data ':screen-x))
|
||||
(pointer-y (getf data ':screen-y))
|
||||
|
|
@ -1020,8 +1021,8 @@ The on-window-change clog-obj received is the new window"))
|
|||
(set-on-pointer-cancel obj 'on-gui-drag-stop)
|
||||
(set-on-pointer-up obj 'on-gui-drag-stop))
|
||||
(t
|
||||
(setf (in-drag app) nil))))))
|
||||
|
||||
(setf (in-drag app) nil))))
|
||||
(error () nil))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; on-gui-drag-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -119,13 +119,15 @@ of controls and double click to select control."
|
|||
(let ((app (connection-data-item content "builder-app-data")))
|
||||
(if clear
|
||||
(when (control-list-win app)
|
||||
(setf (inner-html (control-list-win app)) ""))
|
||||
(setf (inner-html (control-list-win app)) "")
|
||||
(browser-gc content))
|
||||
(with-sync-event (content)
|
||||
(let ((panel-id (html-id content))
|
||||
(last-ctl nil))
|
||||
(when (control-list-win app)
|
||||
(let ((lwin (control-list-win app)))
|
||||
(setf (inner-html lwin) "")
|
||||
(browser-gc content)
|
||||
(set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
|
|
@ -135,11 +137,12 @@ of controls and double click to select control."
|
|||
(labels ((add-siblings (control sim)
|
||||
(let (dln dcc)
|
||||
(loop
|
||||
(when (equal (html-id control) "undefined") (return))
|
||||
(setf dcc (attribute control "data-clog-composite-control"))
|
||||
(when (equalp (html-id control) "undefined")
|
||||
(return))
|
||||
(setf dln (attribute control "data-clog-name"))
|
||||
(unless (or (equal dln "undefined")
|
||||
(eq dln nil))
|
||||
(setf dcc (attribute control "data-clog-composite-control"))
|
||||
(let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
|
||||
(status (hiddenp (get-placer control))))
|
||||
(if status
|
||||
|
|
@ -206,6 +209,6 @@ of controls and double click to select control."
|
|||
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
|
||||
:drag-data (html-id control))
|
||||
(when (equal dcc "undefined") ; when t is not a composite control
|
||||
(add-siblings (first-child control) (format nil "~A→" sim)))))
|
||||
(setf control (next-sibling control))))))
|
||||
(add-siblings (first-child content) ""))))))))))
|
||||
(add-siblings (first-child control :no-attach t) (format nil "~A→" sim)))))
|
||||
(setf control (next-sibling control :no-attach t))))))
|
||||
(add-siblings (first-child content :no-attach t) ""))))))))))
|
||||
|
|
|
|||
|
|
@ -32,7 +32,9 @@
|
|||
(when obj
|
||||
(let ((app (connection-data-item obj "builder-app-data")))
|
||||
(if clear
|
||||
(progn
|
||||
(setf (inner-html (properties-list app)) "")
|
||||
(browser-gc obj))
|
||||
(with-sync-event (obj)
|
||||
(bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj)))
|
||||
(let* ((prop-win (control-properties-win app))
|
||||
|
|
|
|||
|
|
@ -214,8 +214,9 @@
|
|||
(panel-id (html-id content))
|
||||
(touch-x 0)
|
||||
(touch-y 0)
|
||||
(placer (create-div control :auto-place nil
|
||||
(placer (create-div control
|
||||
:class "placer"
|
||||
:style "position:absolute;box-sizing:content-box;tabindex:0"
|
||||
:html-id (format nil "p-~A" (html-id control)))))
|
||||
(add-to-control-list app panel-id control)
|
||||
(setf (attribute placer "data-panel-id") panel-id)
|
||||
|
|
@ -225,8 +226,6 @@
|
|||
:width (client-width control)
|
||||
:height (client-height control))
|
||||
(place-after control placer)
|
||||
(setf (box-sizing placer) :content-box)
|
||||
(setf (positioning placer) :absolute)
|
||||
(jquery-execute placer (format nil "draggable({snap:'.placer',snapMode:'inner',cursor:'crosshair'})~
|
||||
.resizable({alsoResize:'#~A',autoHide:true})"
|
||||
(html-id control)))
|
||||
|
|
@ -383,7 +382,9 @@
|
|||
prevents access to use or activate the control directy and allows
|
||||
manipulation of the control's location and size."
|
||||
(when control
|
||||
(attach-as-child control (format nil "p-~A" (html-id control)))))
|
||||
(clog::make-clog-element (clog::connection-id control)
|
||||
(format nil "p-~A" (html-id control))
|
||||
:clog-type 'clog-element)))
|
||||
|
||||
(defun deselect-current-control (app)
|
||||
"Remove selection on current control and remove visual ques on its placer."
|
||||
|
|
@ -729,8 +730,7 @@ not a temporarily attached one when using select-control."
|
|||
(system-clipboard-write obj (copy-buf app))
|
||||
(let ((c (create-text-area (window-content (copy-history-win app))
|
||||
:value (copy-buf app)
|
||||
:class "w3-input"
|
||||
:auto-place nil)))
|
||||
:class "w3-input")))
|
||||
(place-inside-top-of (window-content (copy-history-win app)) c))
|
||||
(maphash
|
||||
(lambda (html-id control)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue