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))
|
||||
(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 (value input)))
|
||||
(setf result (funcall on-input r))
|
||||
(when sem
|
||||
(bordeaux-threads:signal-semaphore 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,7 +2375,7 @@ 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 "")
|
||||
(setf (text-value input) (if (equal fname "")
|
||||
(truename dir)
|
||||
(format nil "~A~A" (truename dir) fname)))
|
||||
(unless (or (equalp dir "/") (equalp dir #P"/"))
|
||||
|
|
@ -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,16 +134,17 @@ 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)))
|
||||
(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)
|
||||
|
|
@ -207,8 +208,16 @@ of controls and double click to select control."
|
|||
(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) ""))))))))))
|
||||
: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))
|
||||
(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)))))
|
||||
(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