Backport round-2 fixes to org source files
org/text-input.org: remove (declare (ignore w)) from textarea render; add truncation to text-input render (subseq display 0 w) org/mouse.org: hit-test now uses component-layout-node and recurses into children for deepest-match hit testing org/select.org: render reads layout-node-x/y instead of hardcoded (0,0) org/scrollbox-tabbar.org: tabbar render reads layout-node-x/y instead of hardcoded (0,0); x-pos starts at x offset All 4 org files tangled clean. 392 tests pass.
This commit is contained in:
@@ -59,18 +59,27 @@ module adds:
|
||||
(when handler (funcall handler event))))
|
||||
|
||||
(defun hit-test (root x y)
|
||||
"Find the deepest component at (X, Y) by testing layout-node bounds.
|
||||
Recurses into component-children to find the innermost match.
|
||||
Components without a layout-node or position return nil."
|
||||
(labels ((recurse (node)
|
||||
(when (and (slot-exists-p node 'x) (slot-boundp node 'x)
|
||||
(slot-exists-p node 'y) (slot-boundp node 'y)
|
||||
(slot-exists-p node 'width) (slot-boundp node 'width)
|
||||
(slot-exists-p node 'height) (slot-boundp node 'height))
|
||||
(let ((nx (slot-value node 'x))
|
||||
(ny (slot-value node 'y))
|
||||
(nw (slot-value node 'width))
|
||||
(nh (slot-value node 'height)))
|
||||
(when (and (>= x nx) (< x (+ nx nw))
|
||||
(>= y ny) (< y (+ ny nh)))
|
||||
node)))))
|
||||
(let ((ln (ignore-errors (component-layout-node node)))
|
||||
(best nil))
|
||||
(when ln
|
||||
(let ((nx (layout-node-x ln))
|
||||
(ny (layout-node-y ln))
|
||||
(nw (layout-node-width ln))
|
||||
(nh (layout-node-height ln)))
|
||||
;; Check children first for deeper match
|
||||
(dolist (child (ignore-errors (component-children node)))
|
||||
(let ((child-hit (recurse child)))
|
||||
(when child-hit
|
||||
(setf best child-hit))))
|
||||
;; If no child matched, check self
|
||||
(or best
|
||||
(when (and (>= x nx) (< x (+ nx nw))
|
||||
(>= y ny) (< y (+ ny nh)))
|
||||
node)))))))
|
||||
(recurse root)))
|
||||
|
||||
;; Selection
|
||||
|
||||
Reference in New Issue
Block a user