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:
Hermes
2026-05-12 01:00:17 +00:00
parent a294f21c70
commit abf8e5cdeb
6 changed files with 40 additions and 29 deletions

View File

@@ -59,18 +59,27 @@ module adds:
(when handler (funcall handler event)))) (when handler (funcall handler event))))
(defun hit-test (root x y) (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) (labels ((recurse (node)
(when (and (slot-exists-p node 'x) (slot-boundp node 'x) (let ((ln (ignore-errors (component-layout-node node)))
(slot-exists-p node 'y) (slot-boundp node 'y) (best nil))
(slot-exists-p node 'width) (slot-boundp node 'width) (when ln
(slot-exists-p node 'height) (slot-boundp node 'height)) (let ((nx (layout-node-x ln))
(let ((nx (slot-value node 'x)) (ny (layout-node-y ln))
(ny (slot-value node 'y)) (nw (layout-node-width ln))
(nw (slot-value node 'width)) (nh (layout-node-height ln)))
(nh (slot-value node 'height))) ;; 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)) (when (and (>= x nx) (< x (+ nx nw))
(>= y ny) (< y (+ ny nh))) (>= y ny) (< y (+ ny nh)))
node))))) node)))))))
(recurse root))) (recurse root)))
;; Selection ;; Selection

View File

@@ -504,7 +504,8 @@ they are truncated with an ellipsis.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defmethod render ((tb tab-bar) backend) (defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb)) (let* ((ln (tab-bar-layout-node tb))
(x 0) (y 0) (x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80)) (w (if ln (layout-node-width ln) 80))
(active-id (tab-bar-active tb)) (active-id (tab-bar-active tb))
(tabs (tab-bar-tabs tb)) (tabs (tab-bar-tabs tb))
@@ -664,9 +665,11 @@ Children outside the viewport are skipped."
(case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil))) (case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil)))
(defmethod render ((tb tab-bar) backend) (defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb)) (y 0) (let* ((ln (tab-bar-layout-node tb))
(x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80)) (w (if ln (layout-node-width ln) 80))
(active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos 0)) (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x))
(dolist (tab tabs) (dolist (tab tabs)
(let* ((id (getf tab :id)) (title (getf tab :title)) (let* ((id (getf tab :id)) (title (getf tab :title))
(label (format nil " ~A " title)) (label-len (length label)) (label (format nil " ~A " title)) (label-len (length label))

View File

@@ -402,7 +402,8 @@ not selectable (visually distinct).
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(defmethod render ((sel select) backend) (defmethod render ((sel select) backend)
(let* ((ln (select-layout-node sel)) (let* ((ln (select-layout-node sel))
(x 0) (y 0) (x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80)) (w (if ln (layout-node-width ln) 80))
(visible (select-visible-options sel)) (visible (select-visible-options sel))
(sel-idx (select-selected-index sel))) (sel-idx (select-selected-index sel)))
@@ -508,7 +509,9 @@ not selectable (visually distinct).
(subseq filtered start end))) (subseq filtered start end)))
(defmethod render ((sel select) backend) (defmethod render ((sel select) backend)
(let* ((ln (select-layout-node sel)) (x 0) (y 0) (let* ((ln (select-layout-node sel))
(x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80)) (w (if ln (layout-node-width ln) 80))
(visible (select-visible-options sel)) (sel-idx (select-selected-index sel))) (visible (select-visible-options sel)) (sel-idx (select-selected-index sel)))
(dolist (item visible) (dolist (item visible)

View File

@@ -603,9 +603,9 @@ debugging argument mismatches — avoid that trap.
(cursor (text-input-cursor in)) (cursor (text-input-cursor in))
(display (if (plusp (length value)) (display (if (plusp (length value))
value value
(or (text-input-placeholder in) "")))) (or (text-input-placeholder in) "")))
(declare (ignore w cursor)) (truncated (subseq display 0 (min (length display) w))))
(draw-text backend x y display nil nil))) (draw-text backend x y truncated nil nil)))
#+END_SRC #+END_SRC
@@ -861,7 +861,6 @@ debugging argument mismatches — avoid that trap.
(h (if ln (layout-node-height ln) 24)) (h (if ln (layout-node-height ln) 24))
(lines (textarea-lines ta)) (lines (textarea-lines ta))
(max-lines (min (length lines) h))) (max-lines (min (length lines) h)))
(declare (ignore w))
(loop for i from 0 below max-lines (loop for i from 0 below max-lines
for line in lines for line in lines
do (draw-text backend x (+ y i) do (draw-text backend x (+ y i)

View File

@@ -72,21 +72,18 @@ Children outside the viewport are skipped."
(if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0)) (if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0))
(defun draw-scrollbars (sb backend viewport-w viewport-h) (defun draw-scrollbars (sb backend viewport-w viewport-h)
(let* ((ln (scroll-box-layout-node sb)) (let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb))
(vx (if ln (layout-node-x ln) 0))
(vy (if ln (layout-node-y ln) 0))
(content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb))
(sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb))) (sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb)))
(when (> content-h viewport-h) (when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h)))) (thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ vx (1- viewport-w)) vy 1 viewport-h :bg :bright-black) (draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :bright-black)
(draw-text backend (+ vx (1- viewport-w)) (+ vy thumb-pos) "█" nil nil))) (draw-text backend (1- viewport-w) thumb-pos "█" nil nil)))
(when (> content-w viewport-w) (when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w)))) (thumb-pos (round (* thumb viewport-w))))
(draw-rect backend vx (+ vy (1- viewport-h)) viewport-w 1 :bg :bright-black) (draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :bright-black)
(draw-text backend (+ vx thumb-pos) (+ vy (1- viewport-h)) "█" nil nil))))) (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)
(when (sticky-scroll-p sb) (when (sticky-scroll-p sb)

View File

@@ -46,7 +46,7 @@
(is-active (eql id active-id)) (is-active (eql id active-id))
(fg (if is-active :accent :text-muted)) (fg (if is-active :accent :text-muted))
(bg (if is-active :background-element nil))) (bg (if is-active :background-element nil)))
(when (> (+ x-pos label-len 2) w) (when (>= (+ x-pos label-len 2) w)
(draw-text backend x-pos y "..." :text-muted nil) (return)) (draw-text backend x-pos y "..." :text-muted nil) (return))
(draw-text backend x-pos y label fg bg) (draw-text backend x-pos y label fg bg)
(incf x-pos (+ label-len 2))))) (incf x-pos (+ label-len 2)))))