mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
bulk traverse dom trees
This commit is contained in:
David Botton
parent
0287d16884
commit
dbfe0723ce
3 changed files with 123 additions and 106 deletions
|
|
@ -765,7 +765,7 @@ first menu-window-select will receive change window notices only."))
|
|||
(set-on-mouse-enter window-select (lambda (obj)
|
||||
(refill obj))))))
|
||||
(set-on-change window-select (lambda (obj)
|
||||
(let ((win (gethash (value obj) (windows app))))
|
||||
(let ((win (gethash (text-value obj) (windows app))))
|
||||
(when win
|
||||
(unless (keep-on-top win)
|
||||
(setf (hiddenp win) nil)
|
||||
|
|
@ -1967,7 +1967,9 @@ result of on-input."
|
|||
:client-movement client-movement
|
||||
:html-id html-id))
|
||||
(input (attach-as-child win (format nil "~A-input" html-id)
|
||||
:clog-type 'clog:clog-form-element))
|
||||
:clog-type (if (eql rows 1)
|
||||
`clog:clog-form-element
|
||||
'clog:clog-text-area)))
|
||||
(ok (attach-as-child win (format nil "~A-ok" html-id)))
|
||||
(cancel (attach-as-child win (format nil "~A-cancel" html-id))))
|
||||
(unless top
|
||||
|
|
@ -1986,13 +1988,14 @@ result of on-input."
|
|||
:one-time t)
|
||||
(set-on-click ok (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(set-on-window-close win nil)
|
||||
(when modal
|
||||
(window-end-modal win))
|
||||
(window-close win)
|
||||
(setf result (funcall on-input (value input)))
|
||||
(when sem
|
||||
(bordeaux-threads:signal-semaphore sem)))
|
||||
(let ((r (text-value input)))
|
||||
(set-on-window-close win nil)
|
||||
(when modal
|
||||
(window-end-modal win))
|
||||
(window-close win)
|
||||
(setf result (funcall on-input r))
|
||||
(when sem
|
||||
(bordeaux-threads:signal-semaphore sem))))
|
||||
:one-time t)
|
||||
(set-on-window-close win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
|
|
@ -2261,7 +2264,7 @@ on-input returned after either ok or cancel or time elapses."
|
|||
(declare (ignore obj))
|
||||
(server-file-dialog body (first l) (fourth l)
|
||||
(lambda (fname)
|
||||
(setf (value fld) fname))))))))
|
||||
(setf (text-value fld) fname))))))))
|
||||
fields)
|
||||
(js-execute obj (format nil "$('[name=~A-~A]').focus()"
|
||||
html-id
|
||||
|
|
@ -2372,9 +2375,9 @@ If time-out return result of on-file-name, cancels dialog if time runs out."
|
|||
(let ((dir (directory-namestring d)))
|
||||
(setf (inner-html dirs) "")
|
||||
(add-select-option dirs (format nil "~A" dir) ".")
|
||||
(setf (value input) (if (equal fname "")
|
||||
(truename dir)
|
||||
(format nil "~A~A" (truename dir) fname)))
|
||||
(setf (text-value input) (if (equal fname "")
|
||||
(truename dir)
|
||||
(format nil "~A~A" (truename dir) fname)))
|
||||
(unless (or (equalp dir "/") (equalp dir #P"/"))
|
||||
(add-select-option dirs (format nil "~A../" dir) ".."))
|
||||
(dolist (item (uiop:subdirectories dir))
|
||||
|
|
@ -2393,21 +2396,21 @@ If time-out return result of on-file-name, cancels dialog if time runs out."
|
|||
(populate-files initial-dir)
|
||||
(when initial-filename
|
||||
(ignore-errors
|
||||
(setf (value input) (truename initial-filename)))
|
||||
(setf (text-value input) (truename initial-filename)))
|
||||
(caret-at-end))
|
||||
(set-on-change files (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (value input) (truename (value files)))
|
||||
(setf (text-value input) (truename (text-value files)))
|
||||
(caret-at-end)))
|
||||
(set-on-change dirs (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (value input) (value dirs))
|
||||
(setf (text-value input) (text-value dirs))
|
||||
(caret-at-end)
|
||||
(populate-files (value dirs))))
|
||||
(populate-files (text-value dirs))))
|
||||
(set-on-double-click dirs
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(populate-dirs (truename (value dirs)))))
|
||||
(populate-dirs (truename (text-value dirs)))))
|
||||
(set-on-double-click files (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(click ok))))
|
||||
|
|
@ -2428,7 +2431,7 @@ If time-out return result of on-file-name, cancels dialog if time runs out."
|
|||
(when modal
|
||||
(window-end-modal win))
|
||||
(window-close win)
|
||||
(setf result (funcall on-file-name (value input)))
|
||||
(setf result (funcall on-file-name (text-value input)))
|
||||
(when sem
|
||||
(bordeaux-threads:signal-semaphore sem)))
|
||||
:one-time t)
|
||||
|
|
|
|||
|
|
@ -134,81 +134,90 @@ of controls and double click to select control."
|
|||
(deselect-current-control app)
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win)))
|
||||
(labels ((add-siblings (control sim)
|
||||
(let (dln dcc)
|
||||
(loop
|
||||
(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
|
||||
(setf (color list-item) :darkred)
|
||||
(setf (css-class-name list-item) *builder-pallete-class*))
|
||||
(setf (draggablep list-item) t)
|
||||
(setf (attribute list-item "data-clog-control") (html-id control))
|
||||
;; click to select item
|
||||
(set-on-mouse-down list-item
|
||||
(lambda (obj data)
|
||||
(let ((dom (list-of-children content :no-attach t))
|
||||
dln)
|
||||
(labels ((tr (control sim)
|
||||
(if (equal (html-id control) "undefined")
|
||||
(setf dln nil)
|
||||
(setf dln (attribute control "data-clog-name")))
|
||||
(when (and dln
|
||||
(not (equal dln "undefined")))
|
||||
(let ((list-item (create-div lwin :content (format nil "↕ ~A~A"
|
||||
(format nil "~v@{~A~:*~}" sim "→")
|
||||
dln)))
|
||||
(status (hiddenp (get-placer control))))
|
||||
(if status
|
||||
(setf (color list-item) :darkred)
|
||||
(setf (css-class-name list-item) *builder-pallete-class*))
|
||||
(setf (draggablep list-item) t)
|
||||
(setf (attribute list-item "data-clog-control") (html-id control))
|
||||
;; click to select item
|
||||
(set-on-mouse-down list-item
|
||||
(lambda (obj data)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id)))
|
||||
(cond ((or (getf data :shift-key)
|
||||
(getf data :ctrl-key)
|
||||
(getf data :meta-key))
|
||||
(when (drop-new-control app content data)
|
||||
(incf-next-id content)))
|
||||
(t
|
||||
(when last-ctl
|
||||
(set-border last-ctl "0px" :dotted :blue))
|
||||
(set-border list-item "2px" :dotted :blue)
|
||||
(setf last-ctl list-item)
|
||||
(select-control control))))))
|
||||
(set-on-double-click list-item
|
||||
(lambda (obj)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id)))
|
||||
(cond ((or (getf data :shift-key)
|
||||
(getf data :ctrl-key)
|
||||
(getf data :meta-key))
|
||||
(when (drop-new-control app content data)
|
||||
(incf-next-id content)))
|
||||
(t
|
||||
(when last-ctl
|
||||
(set-border last-ctl "0px" :dotted :blue))
|
||||
(set-border list-item "2px" :dotted :blue)
|
||||
(setf last-ctl list-item)
|
||||
(select-control control))))))
|
||||
(set-on-double-click list-item
|
||||
(lambda (obj)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id))
|
||||
(placer (get-placer control))
|
||||
(state (hiddenp placer)))
|
||||
(setf (hiddenp placer) (not state))
|
||||
(select-control control)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
;; drag and drop to change
|
||||
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
|
||||
(set-on-drop list-item
|
||||
(lambda (obj data)
|
||||
(let* ((id (attribute obj "data-clog-control"))
|
||||
(control1 (get-from-control-list app
|
||||
panel-id
|
||||
id))
|
||||
(control2 (get-from-control-list app
|
||||
panel-id
|
||||
(getf data :drag-data)))
|
||||
(placer1 (get-placer control1))
|
||||
(placer2 (get-placer control2)))
|
||||
(if (getf data :shift-key)
|
||||
(place-inside-bottom-of control1 control2)
|
||||
(place-before control1 control2))
|
||||
(place-after control2 placer2)
|
||||
(set-geometry placer1 :top (position-top control1)
|
||||
:left (position-left control1)
|
||||
:width (client-width control1)
|
||||
:height (client-height control1))
|
||||
(set-geometry placer2 :top (position-top control2)
|
||||
:left (position-left control2)
|
||||
:width (client-width control2)
|
||||
:height (client-height control2))
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
(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 :no-attach t) (format nil "~A→" sim)))))
|
||||
(setf control (next-sibling control :no-attach t))))))
|
||||
(add-siblings (first-child content :no-attach t) ""))))))))))
|
||||
html-id))
|
||||
(placer (get-placer control))
|
||||
(state (hiddenp placer)))
|
||||
(setf (hiddenp placer) (not state))
|
||||
(select-control control)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
;; drag and drop to change
|
||||
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
|
||||
(set-on-drop list-item
|
||||
(lambda (obj data)
|
||||
(let* ((id (attribute obj "data-clog-control"))
|
||||
(control1 (get-from-control-list app
|
||||
panel-id
|
||||
id))
|
||||
(control2 (get-from-control-list app
|
||||
panel-id
|
||||
(getf data :drag-data)))
|
||||
(placer1 (get-placer control1))
|
||||
(placer2 (get-placer control2)))
|
||||
(if (getf data :shift-key)
|
||||
(place-inside-bottom-of control1 control2)
|
||||
(place-before control1 control2))
|
||||
(place-after control2 placer2)
|
||||
(set-geometry placer1 :top (position-top control1)
|
||||
:left (position-left control1)
|
||||
:width (client-width control1)
|
||||
:height (client-height control1))
|
||||
(set-geometry placer2 :top (position-top control2)
|
||||
:left (position-left control2)
|
||||
:width (client-width control2)
|
||||
:height (client-height control2))
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
|
||||
:drag-data (html-id control)))))
|
||||
(ll (lst sim)
|
||||
(mapcar (lambda (l)
|
||||
(if (listp l)
|
||||
(if (and (not (listp (first l)))
|
||||
(not (equal (attribute (first l) "data-clog-composite-control")
|
||||
"undefined")))
|
||||
(tr (first l) sim)
|
||||
(ll l (1+ sim)))
|
||||
(tr l sim)))
|
||||
lst)))
|
||||
(ll dom -1)))))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -460,20 +460,25 @@ not a temporarily attached one when using select-control."
|
|||
(unless (equalp name "undefined")
|
||||
(setf (attribute content "data-clog-name") name)
|
||||
(destroy data))))
|
||||
(labels ((add-siblings (control)
|
||||
(let (dct)
|
||||
(loop
|
||||
(when (equal (html-id control) "undefined") (return))
|
||||
(let ((dom (list-of-children parent))
|
||||
dct)
|
||||
(labels ((tr (control)
|
||||
(unless (equal (html-id control) "undefined")
|
||||
(setf dct (attribute control "data-clog-type"))
|
||||
(unless (equal dct "undefined")
|
||||
(change-class control (getf (control-info dct) :clog-type))
|
||||
(when (getf (control-info dct) :on-load)
|
||||
(funcall (getf (control-info dct) :on-load) control (control-info dct)))
|
||||
(setup-control content control :win win)
|
||||
(unless (equal dct "block")
|
||||
(add-siblings (first-child control))))
|
||||
(setf control (next-sibling control))))))
|
||||
(add-siblings (first-child parent)))))
|
||||
(change-class control (getf (control-info dct) :clog-type)))
|
||||
(when (getf (control-info dct) :on-load)
|
||||
(funcall (getf (control-info dct) :on-load) control (control-info dct)))
|
||||
(setup-control content control :win win)))
|
||||
(ll (lst)
|
||||
(mapcar (lambda (l)
|
||||
(if (listp l)
|
||||
(if (listp (first l))
|
||||
(tr (first l))
|
||||
(ll l))
|
||||
(tr l)))
|
||||
lst)))
|
||||
(ll dom)))))
|
||||
|
||||
;; Panel Windows
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue