branch: externals/boxy
commit f6bc7134863ed20d78927a5f21e59b91de8ef02c
Author: Tyler Grinn <tylergr...@gmail.com>
Commit: Tyler Grinn <tylergr...@gmail.com>
Refactoring
---
boxy.el | 1168 +++++++++++++++++++++++++++++----------------------------------
1 file changed, 546 insertions(+), 622 deletions(-)
diff --git a/boxy.el b/boxy.el
index 4b7d783..1e7ed1c 100644
--- a/boxy.el
+++ b/boxy.el
@@ -651,19 +651,20 @@ flexibly added to its parent. Should not be set
manually."))
(lambda (from-box)
(let ((match (boxy-find-matching from-box to)))
(while (and (not match) (slot-boundp from-box :rel-box))
- (setq from-box (with-slots (rel-box) from-box rel-box))
+ (setq from-box (oref from-box rel-box))
(setq match (boxy-find-matching from-box to)))
(when match
(setq match-found t)
(boxy--add-matching from-box match))))
(boxy--primary-boxes from))
(unless match-found
- (let ((all-from-children (boxy--get-children from 'all)))
+ (let ((all-from-children (append (oref from children)
+ (oref from hidden-children))))
(if (= 1 (length all-from-children))
(progn
- (oset (car all-from-children) :flex t)
+ (oset (car all-from-children) flex t)
(boxy--add-child to (car all-from-children)))
- (oset from :flex t)
+ (oset from flex t)
(boxy--add-child to from))))))
(defun boxy-is-visible (box &optional calculate)
@@ -673,24 +674,20 @@ If CALCULATE, determine if the box has been expanded
manually."
(if calculate
(if (not (slot-boundp box :parent))
t
- (with-slots (parent) box
- (seq-find
- (lambda (sibling) (eq sibling box))
- (boxy--get-children parent))))
- (with-slots (level) box
- (or (= 0 boxy--visibility)
- (<= level boxy--visibility)))))
-
+ (seq-find
+ (lambda (sibling) (eq sibling box))
+ (oref (oref box parent) children)))
+ (or (= 0 boxy--visibility)
+ (<= (oref box level) boxy--visibility))))
(defun boxy-jump-to-box (box)
"Jump cursor to the first character in the label of BOX."
(if (not (boxy-is-visible box t))
- (let ((top (with-slots (parent) box parent)))
+ (let ((top (oref box parent)))
(boxy--cycle-children top)
(while (not (boxy-is-visible top t))
- (setq top (with-slots (parent) top parent))
+ (setq top (oref top parent))
(boxy--cycle-children top))
- (boxy-mode-reset-boxes)
(boxy--flex-adjust top (boxy--get-world top))
(boxy-mode-redraw)
(run-with-timer 0 nil
@@ -705,8 +702,7 @@ If CALCULATE, determine if the box has been expanded
manually."
(forward-line (- (+ (car boxy--offset) top 1 (boxy--padding-y box))
(line-number-at-pos)))
(move-to-column (+ (cdr boxy--offset) left 1 (boxy--padding-x box))))))
-
-
+
(defun boxy-find-matching (search-box world)
"Find a box in WORLD with a matching name as SEARCH-BOX."
(when (slot-boundp search-box :name)
@@ -714,8 +710,7 @@ If CALCULATE, determine if the box has been expanded
manually."
(seq-find
(lambda (box)
(and (slot-boundp box :name)
- (string= search-name
- (with-slots (name) box name))))
+ (string= search-name (oref box name))))
(boxy--expand world)))))
(defun boxy-add-next (next prev &optional force-visible skip-next)
@@ -726,118 +721,97 @@ If FORCE-VISIBLE, show the box regardless of
If SKIP-NEXT, don't add expansion slots for boxes related to
NEXT."
- (if-let ((match (boxy-find-matching next prev)))
- (boxy--add-matching next match)
- (with-slots
- (children
- hidden-children
- (prev-level level)
- (prev-primary primary)
- (prev-behind behind)
- (prev-in-front in-front)
- (prev-on-top on-top))
- prev
- (with-slots
- (rel
- rel-box
- flex
- display-rel
- display-rel-box
- (next-level level)
- (next-behind behind)
- (next-in-front in-front)
- (next-on-top on-top))
- next
- (if (not (slot-boundp prev :parent))
- (progn
- (setq flex t)
- (setq next-level (+ 1 prev-level))
- (boxy--add-child prev next force-visible))
- (let ((parent (with-slots (parent) prev parent)))
- (if (slot-boundp next :display-rel-box)
- (setq display-rel-box
- (boxy-find-matching
- display-rel-box
- (boxy--get-world prev))))
- (if (string= rel "on top of")
- (setq next-on-top t))
- (if (string= rel "in front of")
- (setq next-in-front t))
- (let* ((next-boxes (boxy--next next))
- (partitioned (seq-group-by
- (lambda (next-next)
- (with-slots (rel) next-next
- (if (member rel
boxy-children-relationships)
- 'children
- 'siblings)))
- next-boxes))
- (children-boxes (alist-get 'children partitioned))
- (sibling-boxes (alist-get 'siblings partitioned))
- update-visibility)
- (if-let ((match (boxy-find-matching next prev)))
- (boxy--add-matching next match)
- (cond
- ((member rel '("to the left of" "to the right of"))
- (setq next-level prev-level)
- (setq next-behind prev-behind)
- (setq next-in-front prev-in-front)
- (setq next-on-top prev-on-top))
- ((member rel '("above" "below"))
- (setq next-behind prev-behind)
- (cond
- ((and prev-in-front (string= rel "below"))
- (setq update-visibility t)
- (setq display-rel-box prev)
- (while (with-slots (in-front) prev in-front)
- (setq prev (with-slots (parent) prev parent)))
- (setq parent (with-slots (parent) prev parent))
- (setq next-level (with-slots (level) prev level)))
- ((and prev-on-top (string= rel "above"))
- (setq update-visibility t)
- (setq display-rel-box prev)
- (while (with-slots (on-top) prev on-top)
- (setq prev (with-slots (parent) prev parent)))
- (setq parent (with-slots (parent) prev parent))
- (setq next-level (with-slots (level) prev level)))
- ((and prev-on-top (string= rel "below"))
- (setq update-visibility t)
- (setq display-rel rel)
- (setq display-rel-box prev)
- (setq rel "in")
- (setq prev parent)
- (setq next-level (+ 1 (with-slots (level) prev level))))
- (t
- (setq next-level prev-level))))
- ((or next-on-top next-in-front)
- (setq next-level (+ 1 prev-level))
- (setq next-behind prev-behind))
- ((member rel '("in" "on"))
- (setq flex t)
- (setq next-behind prev-behind)
- (setq next-level (+ 1 prev-level)))
- ((string= rel "behind")
- (setq flex t)
- (setq next-level (+ 1 prev-level))
- (setq next-behind t)))
- (oset next :rel-box prev)
- (if (member rel boxy-children-relationships)
- (boxy--add-child prev next force-visible)
- (boxy--add-child parent next force-visible))
- (unless skip-next
- (if children-boxes
- (object-add-to-list next :expand-children
- `(lambda (box)
- (mapc
- (lambda (child) (boxy-add-next
child box))
- ',children-boxes))))
- (if sibling-boxes
- (object-add-to-list next :expand-siblings
- `(lambda (box)
- (mapc
- (lambda (sibling)
- (boxy-add-next sibling box t))
- ',sibling-boxes))))
- (if update-visibility (boxy--update-visibility
(boxy--get-world prev))))))))))))
+ (with-slots (rel) next
+ (if-let ((match (boxy-find-matching next prev)))
+ (boxy--add-matching next match)
+ (if (not (slot-boundp prev :parent))
+ (progn
+ (oset next flex t)
+ (oset next level (+ 1 (oref prev level)))
+ (boxy--add-child prev next force-visible))
+ (if (slot-boundp next :display-rel-box)
+ (oset next display-rel-box
+ (boxy-find-matching
+ (oref next display-rel-box)
+ (boxy--get-world prev))))
+ (if (string= rel "on top of")
+ (oset next on-top t))
+ (if (string= rel "in front of")
+ (oset next in-front t))
+ (let* ((next-boxes (boxy--next next))
+ (partitioned (seq-group-by
+ (lambda (next-next)
+ (if (member (oref next-next rel)
+ boxy-children-relationships)
+ 'children
+ 'siblings))
+ next-boxes))
+ (children-boxes (alist-get 'children partitioned))
+ (sibling-boxes (alist-get 'siblings partitioned))
+ update-visibility)
+ (if-let ((match (boxy-find-matching next prev)))
+ (boxy--add-matching next match)
+ (cond
+ ((member rel '("to the left of" "to the right of"))
+ (oset next level (oref prev level))
+ (oset next behind (oref prev behind))
+ (oset next in-front (oref prev in-front))
+ (oset next on-top (oref prev on-top)))
+ ((member rel '("above" "below"))
+ (oset next behind (oref prev behind))
+ (cond
+ ((and (oref prev in-front) (string= rel "below"))
+ (setq update-visibility t)
+ (oset next display-rel-box prev)
+ (while (oref prev in-front)
+ (setq prev (oref prev parent)))
+ (oset next level (oref prev level)))
+ ((and (oref prev on-top) (string= rel "above"))
+ (setq update-visibility t)
+ (oset next display-rel-box prev)
+ (while (oref prev on-top)
+ (setq prev (oref prev parent)))
+ (oset next level (oref prev level)))
+ ((and (oref prev on-top) (string= rel "below"))
+ (setq update-visibility t)
+ (oset next display-rel rel)
+ (oset next display-rel-box prev)
+ (setq rel "in")
+ (setq prev (oref prev parent))
+ (oset next level (+ 1 (oref prev level))))
+ (t
+ (oset next level (oref prev level)))))
+ ((or (oref next on-top) (oref next in-front))
+ (oset next level (+ 1 (oref prev level)))
+ (oset next behind (oref prev behind)))
+ ((member rel '("in" "on"))
+ (oset next flex t)
+ (oset next behind (oref prev behind))
+ (oset next level (+ 1 (oref prev level))))
+ ((string= rel "behind")
+ (oset next flex t)
+ (oset next level (+ 1 (oref prev level)))
+ (oset next behind t)))
+ (oset next rel-box prev)
+ (if (member rel boxy-children-relationships)
+ (boxy--add-child prev next force-visible)
+ (boxy--add-child (oref prev parent) next force-visible))
+ (unless skip-next
+ (if children-boxes
+ (object-add-to-list next :expand-children
+ `(lambda (box)
+ (mapc
+ (lambda (child) (boxy-add-next child
box))
+ ',children-boxes))))
+ (if sibling-boxes
+ (object-add-to-list next :expand-siblings
+ `(lambda (box)
+ (mapc
+ (lambda (sibling)
+ (boxy-add-next sibling box t))
+ ',sibling-boxes))))
+ (if update-visibility
+ (boxy--update-visibility (boxy--get-world prev))))))))))
;;;; Drawing
@@ -850,165 +824,153 @@ the `boxy-default' face, otherwise, use BORDER-FACE.
Uses `boxy--offset' to determine row and column offsets."
(let (box-coords)
- (with-slots
- (name
- behind
- in-front
- on-top
- (dashed behind)
- primary
- markers
- hidden-children
- expand-children)
- box
- (when (slot-boundp box :name)
- (let* ((top (+ (car boxy--offset) (boxy--get-top box)))
- (left (+ (cdr boxy--offset) (boxy--get-left box)))
- (width (boxy--get-width box))
- (height (boxy--get-height box))
- (double (or hidden-children expand-children))
- (align-bottom (or in-front on-top)))
- (cl-flet* ((draw (coords str)
- (forward-line (- (car coords) (line-number-at-pos)))
- (when (< (line-number-at-pos) (car coords))
- (insert (make-string (- (car coords)
(line-number-at-pos)) ?\n)))
- (move-to-column (cdr coords) t)
- (if border-face
- (put-text-property (point) (+ (length str)
(point))
- 'face (if (eq border-face t)
- boxy--default-face
- border-face))
- (put-text-property 0 (length str)
- 'face boxy--default-face
- str)
- (insert str)
- (let ((remaining-chars (- (save-excursion
(end-of-line) (current-column))
- (current-column))))
- (delete-char (min (length str)
remaining-chars)))))
- (draw-name (coords str)
- (when (not border-face)
- (forward-line (- (car coords)
(line-number-at-pos)))
- (when (< (line-number-at-pos) (car coords))
- (insert (make-string (- (car coords)
(line-number-at-pos)) ?\n)))
- (move-to-column (cdr coords) t)
- (setq box-coords coords)
- (put-text-property 0 (length str)
- 'face (if primary
-
boxy--primary-face
-
boxy--default-face)
- str)
- (put-text-property 0 (length str)
- 'cursor-sensor-functions
- (list
(boxy-button-cursor-sensor box))
- str)
- (insert-button str
- 'help-echo "Jump to first
occurence"
- 'keymap
(boxy-button-create-keymap box))
- (let ((remaining-chars (- (save-excursion
(end-of-line)
-
(current-column))
- (current-column))))
- (delete-char (min (string-width str)
remaining-chars))))))
- (draw (cons top left)
- (concat (cond ((and double dashed) "┏")
- (double "╔")
- (t "╭"))
+ (when (slot-boundp box :name)
+ (let* ((top (+ (car boxy--offset) (boxy--get-top box)))
+ (left (+ (cdr boxy--offset) (boxy--get-left box)))
+ (width (boxy--get-width box))
+ (height (boxy--get-height box))
+ (double (or (oref box hidden-children) (oref box
expand-children)))
+ (align-bottom (or (oref box in-front) (oref box on-top)))
+ (dashed (oref box behind)))
+ (cl-flet* ((draw (coords str)
+ (forward-line (- (car coords) (line-number-at-pos)))
+ (when (< (line-number-at-pos) (car coords))
+ (insert (make-string (- (car coords)
(line-number-at-pos)) ?\n)))
+ (move-to-column (cdr coords) t)
+ (if border-face
+ (put-text-property (point) (+ (length str)
(point))
+ 'face (if (eq border-face t)
+ boxy--default-face
+ border-face))
+ (put-text-property 0 (length str)
+ 'face boxy--default-face
+ str)
+ (insert str)
+ (let ((remaining-chars (- (save-excursion
(end-of-line) (current-column))
+ (current-column))))
+ (delete-char (min (length str)
remaining-chars)))))
+ (draw-name (coords str)
+ (when (not border-face)
+ (forward-line (- (car coords)
(line-number-at-pos)))
+ (when (< (line-number-at-pos) (car coords))
+ (insert (make-string (- (car coords)
(line-number-at-pos)) ?\n)))
+ (move-to-column (cdr coords) t)
+ (setq box-coords coords)
+ (put-text-property 0 (length str)
+ 'face (if (oref box primary)
+ boxy--primary-face
+ boxy--default-face)
+ str)
+ (put-text-property 0 (length str)
+ 'cursor-sensor-functions
+ (list
(boxy-button-cursor-sensor box))
+ str)
+ (insert-button str
+ 'help-echo "Jump to first
occurence"
+ 'keymap
(boxy-button-create-keymap box))
+ (let ((remaining-chars (- (save-excursion
(end-of-line)
+
(current-column))
+ (current-column))))
+ (delete-char (min (string-width str)
remaining-chars))))))
+ (draw (cons top left)
+ (concat (cond ((and double dashed) "┏")
+ (double "╔")
+ (t "╭"))
+ (make-string (- width 2) (cond ((and double dashed)
#x2505)
+ (dashed #x254c)
+ (double #x2550)
+ (t #x2500)))
+ (cond ((and double dashed) "┓")
+ (double "╗")
+ (t "╮"))))
+ (if align-bottom
+ (draw (cons (+ top height) left)
+ (concat (cond ((and double dashed) "┸")
+ (double "╨")
+ (t "┴"))
+ (make-string (- width 2) (cond (dashed #x254c)
+ (t #x2500)))
+ (cond ((and double dashed) "┸")
+ (double "╨")
+ (t "┴"))))
+ (draw (cons (+ top height -1) left)
+ (concat (cond ((and double dashed) "┗")
+ (double "╚")
+ (t "╰"))
(make-string (- width 2) (cond ((and double dashed)
#x2505)
(dashed #x254c)
(double #x2550)
(t #x2500)))
- (cond ((and double dashed) "┓")
- (double "╗")
- (t "╮"))))
- (if align-bottom
- (draw (cons (+ top height) left)
- (concat (cond ((and double dashed) "┸")
- (double "╨")
- (t "┴"))
- (make-string (- width 2) (cond (dashed #x254c)
- (t #x2500)))
- (cond ((and double dashed) "┸")
- (double "╨")
- (t "┴"))))
- (draw (cons (+ top height -1) left)
- (concat (cond ((and double dashed) "┗")
- (double "╚")
- (t "╰"))
- (make-string (- width 2) (cond ((and double
dashed) #x2505)
- (dashed #x254c)
- (double #x2550)
- (t #x2500)))
- (cond ((and double dashed) "┛")
- (double "╝")
- (t "╯")))))
- (draw-name (cons (+ top 1 (boxy--padding-y box))
- (+ left 1 (boxy--padding-x box)))
- name)
- (let ((r (+ top 1))
- (c1 left)
- (c2 (+ left width -1)))
- (dotimes (_ (- height (if align-bottom 1 2)))
- (draw (cons r c1) (cond ((and double dashed) "┇")
- (dashed "╎")
- (double "║")
- (t "│")))
- (draw (cons r c2) (cond ((and double dashed) "┇")
- (dashed "╎")
- (double "║")
- (t "│")))
- (setq r (+ r 1))))))))
+ (cond ((and double dashed) "┛")
+ (double "╝")
+ (t "╯")))))
+ (draw-name (cons (+ top 1 (boxy--padding-y box))
+ (+ left 1 (boxy--padding-x box)))
+ (oref box name))
+ (let ((r (+ top 1))
+ (c1 left)
+ (c2 (+ left width -1)))
+ (dotimes (_ (- height (if align-bottom 1 2)))
+ (draw (cons r c1) (cond ((and double dashed) "┇")
+ (dashed "╎")
+ (double "║")
+ (t "│")))
+ (draw (cons r c2) (cond ((and double dashed) "┇")
+ (dashed "╎")
+ (double "║")
+ (t "│")))
+ (setq r (+ r 1)))))))
(if border-face
(if box-coords (list box-coords) nil)
(apply #'append
(if box-coords (list box-coords) nil)
(mapcar
#'boxy-draw
- (boxy--get-children box))))))
+ (oref box children))))))
(defun boxy--get-width (box)
"Get the width of BOX."
- (with-slots ((stored-width width)) box
- (if (slot-boundp box :width)
- stored-width
- (let* ((margin (boxy--margin-x box))
- (padding (boxy--padding-x box))
- (base-width (+ 2 ; box walls
- (* 2 padding)))
- (width (+ base-width
- (if (slot-boundp box :name)
- (with-slots (name) box (string-width name))
- 0)))
- (children (boxy--get-children box)))
- (setq stored-width
- (if (not children)
- width
- (let* ((row-indices (cl-delete-duplicates
- (mapcar
- (lambda (child) (with-slots (y-order)
child y-order))
- children)))
- (rows (mapcar
- (lambda (r)
- (cl-delete-duplicates
- (seq-filter
- (lambda (child) (with-slots (y-order) child
(= r y-order)))
- children)
- :test #'(lambda (a b)
- (and (slot-boundp a :name)
- (slot-boundp b :name)
- (string= (with-slots (name) a
name)
- (with-slots (name) b
name))))))
- row-indices))
- (children-width (apply #'max
- (mapcar
- (lambda (row)
- (seq-reduce
- (lambda (sum width)
- (+ sum width margin))
- (mapcar #'boxy--get-width
row)
- (* -1 margin)))
- rows))))
- (if (> width (+ 1 (* 2 padding) children-width))
- width
- (+ base-width children-width)))))))))
+ (if (slot-boundp box :width)
+ (oref box width)
+ (let* ((margin (boxy--margin-x box))
+ (padding (boxy--padding-x box))
+ (base-width (+ 2 ; box walls
+ (* 2 padding)))
+ (width (+ base-width
+ (if (slot-boundp box :name)
+ (string-width (oref box name))
+ 0)))
+ (children (oref box children)))
+ (oset box width
+ (if (not children)
+ width
+ (let* ((row-indices (cl-delete-duplicates
+ (mapcar
+ (lambda (child) (oref child y-order))
+ children)))
+ (rows (mapcar
+ (lambda (r)
+ (cl-delete-duplicates
+ (seq-filter
+ (lambda (child) (= r (oref child y-order)))
+ children)
+ :test #'(lambda (a b)
+ (and (slot-boundp a :name)
+ (slot-boundp b :name)
+ (string= (oref a name) (oref b
name))))))
+ row-indices))
+ (children-width (apply #'max
+ (mapcar
+ (lambda (row)
+ (seq-reduce
+ (lambda (sum width)
+ (+ sum width margin))
+ (mapcar #'boxy--get-width row)
+ (* -1 margin)))
+ rows))))
+ (if (> width (+ 1 (* 2 padding) children-width))
+ width
+ (+ base-width children-width))))))))
(defun boxy--get-on-top-height (box)
"Get the height of any boxes on top of BOX."
@@ -1016,149 +978,140 @@ Uses `boxy--offset' to determine row and column
offsets."
(mapcar
#'boxy--get-on-top-height-helper
(seq-filter
- (lambda (child) (with-slots (rel) child
- (and (slot-boundp child :rel)
- (string= rel "on top of"))))
- (boxy--get-children box)))))
+ (lambda (child)
+ (and (slot-boundp child :rel)
+ (string= (oref child rel) "on top of")))
+ (oref box children)))))
(defun boxy--get-on-top-height-helper (child)
"Get the height of any boxes on top of CHILD, including child."
- (with-slots (rel) child
- (+
- (boxy--get-height child)
+ (+ (boxy--get-height child)
(apply #'max 0
(mapcar
#'boxy--get-on-top-height-helper
(seq-filter
(lambda (grandchild)
- (with-slots ((grandchild-rel rel)) grandchild
- (and (slot-boundp grandchild :rel)
- (string= "on top of" grandchild-rel))))
- (boxy--get-children child)))))))
+ (and (slot-boundp grandchild :rel)
+ (string= "on top of" (oref grandchild rel))))
+ (oref child children))))))
(defun boxy--get-height (box &optional include-on-top)
"Get the height of BOX.
If INCLUDE-ON-TOP is non-nil, also include height on top of box."
(let ((on-top-height (if include-on-top (boxy--get-on-top-height box) 0)))
- (with-slots ((stored-height height) in-front on-top) box
- (if (slot-boundp box :height)
- (+ stored-height on-top-height)
- (let* ((margin (boxy--margin-y box))
- (padding (boxy--padding-y box))
- (height (+ (if (or in-front on-top) -1 0)
- 3 ; box walls + text
- (* 2 padding)))
- (children (seq-filter
- (lambda (child) (with-slots (on-top) child (not
on-top)))
- (boxy--get-children box))))
- (if (not children)
- (progn
- (setq stored-height height)
- (+ height on-top-height))
- (let* ((row-indices (cl-delete-duplicates
- (mapcar
- (lambda (child) (with-slots (y-order) child
y-order))
- children)))
- (children-height (seq-reduce
- (lambda (sum row)
- (+ sum margin row))
- (mapcar
- (lambda (r)
- (apply #'max 0
- (mapcar
- (lambda (child)
(boxy--get-height child t))
- (seq-filter
- (lambda (child)
- (with-slots (y-order) child
(= r y-order)))
- children))))
- row-indices)
- (* -1 margin))))
-
- (setq stored-height (+ height children-height))
- (+ stored-height on-top-height))))))))
+ (if (slot-boundp box :height)
+ (+ (oref box height) on-top-height)
+ (let* ((margin (boxy--margin-y box))
+ (padding (boxy--padding-y box))
+ (align-bottom (or (oref box in-front) (oref box on-top)))
+ (height (+ (if align-bottom -1 0)
+ 3 ; box walls + text
+ (* 2 padding)))
+ (children (seq-filter
+ (lambda (child) (not (oref child on-top)))
+ (oref box children))))
+ (if (not children)
+ (+ on-top-height
+ (oset box height height))
+ (let* ((row-indices (cl-delete-duplicates
+ (mapcar
+ (lambda (child) (oref child y-order))
+ children)))
+ (children-height (seq-reduce
+ (lambda (sum row)
+ (+ sum margin row))
+ (mapcar
+ (lambda (r)
+ (apply #'max 0
+ (mapcar
+ (lambda (child)
(boxy--get-height child t))
+ (seq-filter
+ (lambda (child) (= r (oref
child y-order)))
+ children))))
+ row-indices)
+ (* -1 margin))))
+ (+ on-top-height
+ (oset box height (+ height children-height)))))))))
(defun boxy--get-top (box)
"Get the top row index of BOX."
- (with-slots ((stored-top top) on-top parent x-order y-order rel rel-box) box
- (cond ((slot-boundp box :top) stored-top)
- (on-top (- (boxy--get-top parent) (boxy--get-height box)))
- (t
- (let ((on-top-height (boxy--get-on-top-height box))
- (margin (boxy--margin-y box))
- (padding (boxy--padding-y box)))
- (if (not (slot-boundp box :parent))
- (setq stored-top (+ on-top-height margin))
- (let* ((siblings (seq-filter
- (lambda (sibling)
- (with-slots (on-top in-front) sibling
- (not (or on-top in-front))))
- (boxy--get-children parent)))
- (offset (+ 2 (* 2 padding)))
- (top (+ on-top-height offset (boxy--get-top parent))))
- (if-let* ((directly-above (seq-reduce
- (lambda (above sibling)
- (with-slots ((sibling-y
y-order)) sibling
- (if (< sibling-y y-order)
- (if above
- (with-slots ((max-y
y-order)) (car above)
- (if (> sibling-y
max-y)
- (list sibling)
- (if (= sibling-y
max-y)
- (push sibling
above)
- above)))
- (list sibling))
- above)))
- siblings
- '()))
- (above-bottom (+ margin
- (apply #'max
- (mapcar
- (lambda (sibling)
- (+ (boxy--get-top
sibling)
- (boxy--get-height
sibling)))
- directly-above)))))
- (setq stored-top (+ on-top-height above-bottom))
- (setq stored-top top)))))))))
+ (if (slot-boundp box :top)
+ (oref box top)
+ (cond
+ ((slot-boundp box :top) (oref box top))
+ ((oref box on-top) (- (boxy--get-top (oref box parent)) (boxy--get-height
box)))
+ (t
+ (let ((on-top-height (boxy--get-on-top-height box))
+ (margin (boxy--margin-y box))
+ (padding (boxy--padding-y box)))
+ (if (not (slot-boundp box :parent))
+ (oset box top (+ on-top-height margin))
+ (let* ((siblings (seq-filter
+ (lambda (sibling)
+ (not (or (oref sibling in-front)
+ (oref sibling on-top))))
+ (oref (oref box parent) children)))
+ (offset (+ 2 (* 2 padding)))
+ (top (+ on-top-height offset (boxy--get-top (oref box
parent)))))
+ (if-let* ((directly-above (seq-reduce
+ (lambda (above sibling)
+ (with-slots ((sibling-y y-order))
sibling
+ (if (< sibling-y (oref box y-order))
+ (if above
+ (with-slots ((max-y
y-order)) (car above)
+ (if (> sibling-y max-y)
+ (list sibling)
+ (if (= sibling-y max-y)
+ (push sibling above)
+ above)))
+ (list sibling))
+ above)))
+ siblings
+ '()))
+ (above-bottom (+ margin
+ (apply #'max
+ (mapcar
+ (lambda (sibling)
+ (+ (boxy--get-top sibling)
+ (boxy--get-height
sibling)))
+ directly-above)))))
+ (oset box top (+ on-top-height above-bottom))
+ (oset box top top)))))))))
(defun boxy--get-left (box)
"Get the left column index of BOX."
- (with-slots ((stored-left left) parent x-order y-order) box
- (if (slot-boundp box :left)
- stored-left
- (let ((margin (boxy--margin-x box))
- (padding (boxy--padding-x box)))
- (if (not (slot-boundp box :parent))
- (setq stored-left margin)
- (let* ((left (+ 1
- padding
- (boxy--get-left parent)))
- (to-the-left (seq-filter
- (lambda (child)
- (with-slots ((child-y y-order) (child-x
x-order)) child
- (and (= y-order child-y)
- (< child-x x-order))))
- (boxy--get-children parent)))
- (directly-left (and to-the-left
- (seq-reduce
- (lambda (max child)
- (with-slots ((max-x x-order)) max
- (with-slots ((child-x x-order)) child
- (if (> child-x max-x)
- child
- max))))
- to-the-left
- (boxy-box :x-order -1.0e+INF)))))
- (if directly-left
- (setq stored-left (+ (boxy--get-left directly-left)
- (boxy--get-width directly-left)
- margin))
- (with-slots (rel rel-box) box
- (if (and (slot-boundp box :rel)
- (or (string= "above" rel)
- (string= "below" rel)))
- (setq stored-left (boxy--get-left rel-box))
- (setq stored-left left))))))))))
+ (if (slot-boundp box :left)
+ (oref box left)
+ (let ((margin (boxy--margin-x box))
+ (padding (boxy--padding-x box)))
+ (if (not (slot-boundp box :parent))
+ (oset box left margin)
+ (let* ((left (+ 1
+ padding
+ (boxy--get-left (oref box parent))))
+ (to-the-left (seq-filter
+ (lambda (child)
+ (and (= (oref box y-order) (oref child y-order))
+ (< (oref child x-order) (oref box
x-order))))
+ (oref (oref box parent) children)))
+ (directly-left (and to-the-left
+ (seq-reduce
+ (lambda (max child)
+ (if (> (oref child x-order) (oref max
x-order))
+ child
+ max))
+ to-the-left
+ (boxy-box :x-order -1.0e+INF)))))
+ (if directly-left
+ (oset box left (+ (boxy--get-left directly-left)
+ (boxy--get-width directly-left)
+ margin))
+ (if (and (slot-boundp box :rel)
+ (or (string= "above" (oref box rel))
+ (string= "below" (oref box rel))))
+ (oset box left (boxy--get-left (oref box rel-box)))
+ (oset box left left))))))))
;;;; Boxy mode buttons
@@ -1166,102 +1119,85 @@ If INCLUDE-ON-TOP is non-nil, also include height on
top of box."
"Create cursor functions for entering and leaving BOX."
(let (tooltip-timer)
(lambda (_window _oldpos dir)
- (with-slots
- ((actual-rel rel)
- (actual-rel-box rel-box)
- display-rel-box
- display-rel
- name
- tooltip
- help-echo)
- box
- (let* ((rel-box (and (slot-boundp box :rel-box)
- (if (slot-boundp box :display-rel-box)
- display-rel-box
- actual-rel-box)))
- (visible-rel-box rel-box))
- (while (and visible-rel-box (not (boxy-is-visible visible-rel-box
t)))
- (setq visible-rel-box (with-slots (parent) visible-rel-box
parent)))
- (when (eq dir 'entered)
- (save-excursion
- (let ((inhibit-read-only t))
- (if visible-rel-box (boxy-draw visible-rel-box
boxy--rel-face))
- (boxy-draw box boxy--selected-face)))
- (if (slot-boundp box :help-echo) (message help-echo))
- (if (slot-boundp box :tooltip)
- (setq tooltip-timer (boxy--tooltip tooltip))))
- (when (eq dir 'left)
- (save-excursion
- (let ((inhibit-read-only t))
- (if visible-rel-box (boxy-draw visible-rel-box t))
- (boxy-draw box t)))
- (when tooltip-timer
- (cancel-timer tooltip-timer))))))))
+ (let* ((rel-box (and (slot-boundp box :rel-box)
+ (if (slot-boundp box :display-rel-box)
+ (oref box display-rel-box)
+ (oref box rel-box))))
+ (visible-rel-box rel-box))
+ (while (and visible-rel-box (not (boxy-is-visible visible-rel-box t)))
+ (setq visible-rel-box (oref visible-rel-box parent)))
+ (when (eq dir 'entered)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (if visible-rel-box (boxy-draw visible-rel-box boxy--rel-face))
+ (boxy-draw box boxy--selected-face)))
+ (if (slot-boundp box :help-echo) (message (oref box help-echo)))
+ (if (slot-boundp box :tooltip)
+ (setq tooltip-timer (boxy--tooltip (oref box tooltip)))))
+ (when (eq dir 'left)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (if visible-rel-box (boxy-draw visible-rel-box t))
+ (boxy-draw box t)))
+ (when tooltip-timer
+ (cancel-timer tooltip-timer)))))))
(defun boxy-button-jump-other-window (box)
"Jump to location of link for BOX in other window."
- (with-slots (markers) box
- (lambda ()
- (interactive)
- (let* ((marker (car markers))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (save-selected-window
- (switch-to-buffer-other-window buffer)
- (goto-char pos)))
- (let ((first (car markers)))
- (object-remove-from-list box :markers first)
- (object-add-to-list box :markers first t)))))
+ (lambda ()
+ (interactive)
+ (let ((marker (car (oref box markers))))
+ (save-selected-window
+ (switch-to-buffer-other-window (marker-buffer marker))
+ (goto-char (marker-position marker)))
+ (object-remove-from-list box :markers marker)
+ (object-add-to-list box :markers marker t))))
(defun boxy-button-jump-to (box)
"Jump to the first occurrence of a link for BOX in the same window."
- (with-slots (markers) box
- (lambda ()
- (interactive)
- (let* ((marker (car markers))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (if-let ((window (get-buffer-window buffer)))
+ (lambda ()
+ (interactive)
+ (let* ((marker (car (oref box markers)))
+ (buffer (marker-buffer marker)))
+ (if-let ((window (get-buffer-window buffer)))
(select-window window)
(switch-to-buffer buffer))
- (goto-char pos)))))
+ (goto-char (marker-position marker)))))
(defun boxy-button-jump-all (box)
"View all occurrences of links from BOX in the same window."
- (with-slots (markers) box
- (lambda ()
- (interactive)
- (let* ((size (/ (window-height) (length markers)))
- (marker (car markers)))
- (or (<= window-min-height size)
- (error "To many buffers to visit simultaneously"))
+ (lambda ()
+ (interactive)
+ (let* ((markers (oref box markers))
+ (size (/ (window-height) (length markers)))
+ (marker (car markers)))
+ (or (<= window-min-height size)
+ (error "To many buffers to visit simultaneously"))
+ (switch-to-buffer (marker-buffer marker))
+ (goto-char (marker-position marker))
+ (dolist (marker (cdr markers))
+ (select-window (split-window nil size))
(switch-to-buffer (marker-buffer marker))
- (goto-char (marker-position marker))
- (dolist (marker (cdr markers))
- (select-window (split-window nil size))
- (switch-to-buffer (marker-buffer marker))
- (goto-char (marker-position marker)))))))
+ (goto-char (marker-position marker))))))
(defun boxy-button-jump-rel (box)
"Jump to the box directly related to BOX."
- (with-slots (rel-box display-rel-box) box
- (if (not (slot-boundp box :rel-box))
- (lambda () (interactive))
- (if (slot-boundp box :display-rel-box)
- (lambda ()
- (interactive)
- (boxy-jump-to-box display-rel-box))
+ (if (not (slot-boundp box :rel-box))
+ (lambda () (interactive))
+ (if (slot-boundp box :display-rel-box)
(lambda ()
(interactive)
- (boxy-jump-to-box rel-box))))))
+ (boxy-jump-to-box (oref box display-rel-box)))
+ (lambda ()
+ (interactive)
+ (boxy-jump-to-box (oref box rel-box))))))
(defun boxy-button-cycle-children (box)
"Cycle visibility of children of BOX."
(lambda ()
(interactive)
(boxy--cycle-children box)
- (boxy-mode-reset-boxes)
(let ((world (boxy--get-world box)))
(boxy--flex-adjust world world))
(boxy-mode-redraw)
@@ -1290,6 +1226,7 @@ BOX is the box the button is being made for."
;;;; Private class methods
(defun boxy--make-dirty (box)
+ "Clear all coordinates from BOX and its children."
(if (slot-boundp box :top) (slot-makeunbound box :top))
(if (slot-boundp box :left) (slot-makeunbound box :left))
(if (slot-boundp box :width) (slot-makeunbound box :width))
@@ -1316,7 +1253,7 @@ BOX is the box the button is being made for."
(defun boxy--cycle-children (box)
"Cycle visibility of children of BOX."
- (with-slots (children hidden-children expand-children expanded parent) box
+ (with-slots (children hidden-children) box
(if (or children hidden-children)
(cl-rotatef children hidden-children)
(boxy--expand-box box))))
@@ -1325,7 +1262,7 @@ BOX is the box the button is being made for."
"Update visibility of BOX based on `boxy--visibility'.
Also applies to children."
- (with-slots (level children hidden-children expand-children) box
+ (with-slots (children hidden-children) box
(if (not (boxy-is-visible box))
(if children (cl-rotatef children hidden-children))
(boxy--expand-box box))
@@ -1340,55 +1277,40 @@ Also applies to children."
(defun boxy--margin-x (box)
"Get the inherited property :margin-x from BOX."
(if (slot-boundp box :margin-x)
- (with-slots (margin-x) box margin-x)
+ (oref box margin-x)
(if (slot-boundp box :parent)
- (boxy--margin-x (with-slots (parent) box parent))
+ (boxy--margin-x (oref box parent))
boxy--default-margin-x)))
(defun boxy--margin-y (box)
"Get the inherited property :margin-y from BOX."
(if (slot-boundp box :margin-y)
- (with-slots (margin-y) box margin-y)
+ (oref box margin-y)
(if (slot-boundp box :parent)
- (boxy--margin-y (with-slots (parent) box parent))
+ (boxy--margin-y (oref box parent))
boxy--default-margin-y)))
(defun boxy--padding-x (box)
"Get the inherited property :padding-x from BOX."
(if (slot-boundp box :padding-x)
- (with-slots (padding-x) box padding-x)
+ (oref box padding-x)
(if (slot-boundp box :parent)
- (boxy--padding-x (with-slots (parent) box parent))
+ (boxy--padding-x (oref box parent))
boxy--default-padding-x)))
(defun boxy--padding-y (box)
"Get the inherited property :padding-y from BOX."
(if (slot-boundp box :padding-y)
- (with-slots (padding-y) box padding-y)
+ (oref box padding-y)
(if (slot-boundp box :parent)
- (boxy--padding-y (with-slots (parent) box parent))
+ (boxy--padding-y (oref box parent))
boxy--default-padding-y)))
-(defun boxy--get-children (box &optional arg)
- "Get all visible children of BOX.
-
-If optional ARG is 'all, include hidden children.
-
-If optional ARG is 'hidden, only return hidden children"
- (with-slots (children hidden-children) box
- (cond
- ((eq 'all arg)
- (append children hidden-children))
- ((eq 'hidden arg)
- hidden-children)
- (t
- children))))
-
(defun boxy--add-child (parent child &optional force-visible)
"Add CHILD to PARENT according to its visibility.
If FORCE-VISIBLE, always make CHILD visible in PARENT."
- (oset child :parent parent)
+ (oset child parent parent)
(with-slots (children hidden-children) parent
(if hidden-children
(progn
@@ -1401,10 +1323,9 @@ If FORCE-VISIBLE, always make CHILD visible in PARENT."
(defun boxy--get-world (box)
"Get the top most box related to BOX."
- (with-slots (parent) box
- (if (slot-boundp box :parent)
- (boxy--get-world parent)
- box)))
+ (if (slot-boundp box :parent)
+ (boxy--get-world (oref box parent))
+ box))
(defun boxy--primary-boxes (box)
"Get a list of boxes from BOX which have no further relatives."
@@ -1412,26 +1333,41 @@ If FORCE-VISIBLE, always make CHILD visible in PARENT."
(if-let ((next-boxes (boxy--next box)))
(apply #'append (mapcar #'boxy--primary-boxes next-boxes))
(list box))
- (apply #'append (mapcar #'boxy--primary-boxes (boxy--get-children box
'all)))))
+ (apply #'append
+ (mapcar
+ #'boxy--primary-boxes
+ (append (oref box children)
+ (oref box hidden-children))))))
(defun boxy--expand (box)
"Get a list of all boxes, including BOX, that are related to BOX."
(if (slot-boundp box :parent)
(apply #'append (list box) (mapcar #'boxy--expand (boxy--next box)))
- (apply #'append (mapcar #'boxy--expand (boxy--get-children box 'all)))))
+ (apply #'append
+ (mapcar
+ #'boxy--expand
+ (append (oref box children)
+ (oref box hidden-children))))))
(defun boxy--get-all (box)
"Get all boxes, including BOX, that are children of BOX."
- (apply #'append (list box) (mapcar #'boxy--get-all (boxy--get-children box
'all))))
+ (apply #'append
+ (list box)
+ (mapcar
+ #'boxy--get-all
+ (append (oref box children)
+ (oref box hidden-children)))))
(defun boxy--next (box &optional exclude-children)
"Retrieve any boxes for which the :rel-box slot is BOX.
If EXCLUDE-CHILDREN, only retrieve sibling boxes."
- (let ((relatives (append (if exclude-children '() (boxy--get-children box
'all))
+ (let ((relatives (append (if exclude-children '() (append (oref box children)
+ (oref box
hidden-children)))
(if (slot-boundp box :parent)
(with-slots (parent) box
- (boxy--get-children parent 'all))
+ (append (oref parent children)
+ (oref parent hidden-children)))
'()))))
(seq-filter
(lambda (relative)
@@ -1442,80 +1378,77 @@ If EXCLUDE-CHILDREN, only retrieve sibling boxes."
(defun boxy--apply-level (box level)
"Apply LEVEL to BOX and update all of its children."
- (oset box :level level)
+ (oset box level level)
(mapc
(lambda (child) (boxy--apply-level child (+ 1 level)))
- (boxy--get-children box 'all)))
+ (append (oref box children)
+ (oref box hidden-children))))
(defun boxy--add-matching (box match)
"Add relatives of BOX to MATCH."
- (oset match :primary (or (with-slots (primary) match primary)
- (with-slots (primary) box primary)))
+ (oset match primary (or (oref match primary)
+ (oref box primary)))
(if (or (slot-boundp match :markers)
(slot-boundp box :markers))
- (oset match :markers (append (and (slot-boundp match :markers)
- (with-slots (markers) match markers))
- (and (slot-boundp box :markers)
- (with-slots (markers) box markers)))))
+ (oset match markers (append (and (slot-boundp match :markers) (oref
match markers))
+ (and (slot-boundp box :markers) (oref box
markers)))))
(if (and (not (slot-boundp match :action)) (slot-boundp box :action))
- (oset match :action (with-slots (action) box action)))
+ (oset match action (oref box action)))
(mapc
(lambda (next) (boxy-add-next next match))
(boxy--next box))
- (oset match :expand-siblings (append (with-slots (expand-siblings) match
expand-siblings)
- (with-slots (expand-siblings) box
expand-siblings)))
- (oset match :expand-children (append (with-slots (expand-children) match
expand-children)
- (with-slots (expand-children) box
expand-children))))
+ (oset match expand-siblings (append (oref match expand-siblings)
+ (oref box expand-siblings)))
+ (oset match expand-children (append (oref match expand-children)
+ (oref box expand-children))))
(defun boxy--position-box (box)
"Adjust BOX's position."
- (with-slots (rel-box rel parent x-order y-order on-top in-front parent) box
- (with-slots ((rel-y y-order) (rel-x x-order)) rel-box
- (unless (boxy-find-matching box rel-box)
- (if on-top
- (setq y-order -1.0e+INF))
- (if in-front
- (setq y-order 1.0e+INF))
- (cond
- ((member rel '("to the left of" "to the right of"))
- (setq y-order rel-y)
- (if (string= rel "to the left of")
- (setq x-order rel-x)
- (setq x-order (+ 1 rel-x)))
- (let ((row-siblings (seq-filter
- (lambda (sibling)
- (with-slots ((sibling-y y-order)) sibling
- (= sibling-y rel-y)))
- (boxy--get-children parent))))
- (mapc
- (lambda (sibling)
- (with-slots ((sibling-x x-order)) sibling
- (if (>= sibling-x x-order)
- (setq sibling-x (+ 1 sibling-x)))))
- row-siblings)))
- ((member rel '("above" "below"))
- (setq x-order rel-x)
- (let ((sibling-y-orders (mapcar
- (lambda (sibling) (with-slots (y-order)
sibling y-order))
- (seq-filter
- (lambda (sibling)
- (with-slots (in-front on-top) sibling
- (not (or in-front on-top))))
- (boxy--get-children parent)))))
- (if (string= rel "above")
- (setq y-order (- (apply #'min 0 sibling-y-orders) 1))
- (setq y-order (+ 1 (apply #'max 0 sibling-y-orders))))))
- ((or on-top in-front)
- (setq x-order (+ 1 (apply #'max 0
- (mapcar
- (lambda (child) (with-slots (x-order)
child x-order))
- (seq-filter
- (lambda (child)
- (with-slots ((child-in-front in-front)
(child-on-top on-top)) child
- (and (eq in-front child-in-front)
- (eq on-top child-on-top))))
- (boxy--get-children rel-box))))))))
- (boxy--add-child parent box t)))))
+ (with-slots (rel-box rel parent) box
+ (unless (boxy-find-matching box rel-box)
+ (if (oref box on-top)
+ (oset box y-order -1.0e+INF))
+ (if (oref box in-front)
+ (oset box y-order 1.0e+INF))
+ (cond
+ ((member rel '("to the left of" "to the right of"))
+ (oset box y-order (oref rel-box y-order))
+ (if (string= rel "to the left of")
+ (oset box x-order (oref rel-box x-order))
+ (oset box x-order (+ 1 (oref rel-box x-order))))
+ (let ((row-siblings (seq-filter
+ (lambda (sibling)
+ (= (oref sibling y-order) (oref rel-box
y-order)))
+ (oref parent children))))
+ (mapc
+ (lambda (sibling)
+ (with-slots ((sibling-x x-order)) sibling
+ (if (>= sibling-x (oref box x-order))
+ (setq sibling-x (+ 1 sibling-x)))))
+ row-siblings)))
+ ((member rel '("above" "below"))
+ (oset box x-order (oref rel-box x-order))
+ (let ((sibling-y-orders (mapcar
+ (lambda (sibling) (oref sibling y-order))
+ (seq-filter
+ (lambda (sibling)
+ (not (or (oref sibling in-front)
+ (oref sibling on-top))))
+ (oref parent children)))))
+ (if (string= rel "above")
+ (oset box y-order (- (apply #'min 0 sibling-y-orders) 1))
+ (oset box y-order (+ 1 (apply #'max 0 sibling-y-orders))))))
+ ((or (oref box on-top) (oref box in-front))
+ (oset box x-order
+ (+ 1 (apply #'max 0
+ (mapcar
+ (lambda (child) (oref child x-order))
+ (seq-filter
+ (lambda (child)
+ (and (eq (oref box in-front) (oref child
in-front))
+ (eq (oref box on-top) (oref child on-top))))
+ (oref rel-box children))))))))
+ (boxy--add-child parent box t))))
(defun boxy--flex-add (box parent world)
@@ -1525,67 +1458,58 @@ This function ignores the :rel slot and adds BOX in
such a way
that the width of the WORLD is kept below `boxy--flex-width'
characters if possible."
(let ((cur-width (boxy--get-width world)))
- (boxy-mode-make-dirty)
- (with-slots ((parent-level level) (parent-behind behind)) parent
- (let* ((level (+ 1 parent-level))
- (all-siblings (seq-filter
- (lambda (sibling)
- (with-slots (in-front on-top) sibling
- (not (or in-front on-top))))
- (boxy--get-children parent)))
- (last-sibling (and all-siblings
- (seq-reduce
- (lambda (max sibling)
- (with-slots ((max-x x-order) (max-y
y-order)) max
- (with-slots ((sibling-x x-order)
(sibling-y y-order)) sibling
- (if (> sibling-y max-y)
- sibling
- (if (and (= max-y sibling-y) (>
sibling-x max-x))
- sibling
- max)))))
- all-siblings
- (boxy-box :y-order -1.0e+INF)))))
- (boxy--apply-level box level)
- (boxy--add-child parent box t)
- (boxy--flex-adjust box world)
- (when last-sibling
- (with-slots
- ((last-sibling-y y-order)
- (last-sibling-x x-order))
- last-sibling
- (oset box :y-order last-sibling-y)
- (oset box :x-order (+ 1 last-sibling-x))
- (let ((new-width (boxy--get-width world)))
- (boxy-mode-make-dirty)
- (when (and (> new-width cur-width) (> new-width
boxy--flex-width))
- (oset box :y-order (+ 1 last-sibling-y))
- (oset box :x-order 0)
- (boxy--flex-adjust box world)))))))))
+ (boxy--make-dirty world)
+ (let* ((level (+ 1 (oref parent level)))
+ (all-siblings (seq-filter
+ (lambda (sibling)
+ (not (or (oref sibling in-front) (oref sibling
on-top))))
+ (oref parent children)))
+ (last-sibling (and all-siblings
+ (seq-reduce
+ (lambda (max sibling)
+ (if (> (oref sibling y-order) (oref max
y-order))
+ sibling
+ (if (and (= (oref sibling y-order) (oref
max y-order))
+ (> (oref sibling x-order) (oref
max x-order)))
+ sibling
+ max)))
+ all-siblings
+ (boxy-box :y-order -1.0e+INF)))))
+ (boxy--apply-level box level)
+ (boxy--add-child parent box t)
+ (boxy--flex-adjust box world)
+ (when last-sibling
+ (oset box y-order (oref last-sibling y-order))
+ (oset box x-order (+ 1 (oref last-sibling x-order)))
+ (let ((new-width (boxy--get-width world)))
+ (boxy--make-dirty world)
+ (when (and (> new-width cur-width) (> new-width boxy--flex-width))
+ (oset box y-order (+ 1 (oref last-sibling y-order)))
+ (oset box x-order 0)
+ (boxy--flex-adjust box world)))))))
(defun boxy--flex-adjust (box world)
"Adjust BOX x and y orders to try to fit WORLD within `boxy--flex-width'."
(with-slots (children) box
(let* ((partitioned (seq-group-by
(lambda (child)
- (if (with-slots (flex) child flex)
- 'flex
- 'absolute))
- children))
+ (if (oref child flex) 'flex 'absolute))
+ (oref box children)))
(flex-children (alist-get 'flex partitioned))
- (other-children (alist-get 'absolute partitioned)))
- (setq children '())
- (boxy-mode-make-dirty)
+ (absolute-children (alist-get 'absolute partitioned)))
+ (boxy--make-dirty world)
+ (oset box children '())
(mapc
(lambda (flex-child)
(boxy--flex-add flex-child box world))
flex-children)
(mapc
- (lambda (other-child)
- (if (not (slot-boundp other-child :rel-box))
- (boxy--flex-add other-child box world)
- (boxy--position-box other-child)
- (boxy--flex-adjust other-child world)))
- other-children))))
+ (lambda (absolute-child)
+ (if (not (slot-boundp absolute-child :rel-box))
+ (boxy--flex-add absolute-child box world)
+ (boxy--position-box absolute-child)
+ (boxy--flex-adjust absolute-child world)))
+ absolute-children))))
;;;; Utility expressions
@@ -1631,7 +1555,7 @@ characters if possible."
overlays)
(dolist (str rows)
(let ((left-margin 0)
- start end overlay cur-column)
+ start end cur-column)
(save-excursion
(let ((inhibit-read-only t))
(forward-line (- top (line-number-at-pos)))
@@ -1649,11 +1573,11 @@ characters if possible."
(setq str (format
(concat " %-" (number-to-string (- width 2)) "s ")
(truncate-string-to-width str boxy--tooltip-max-width nil
nil t)))
- (setq overlay (make-overlay start end))
- (overlay-put overlay 'face boxy--tooltip-face)
- (overlay-put overlay 'display `((margin nil) ,str))
- (overlay-put overlay 'before-string (make-string left-margin ?\s))
- (push overlay overlays)
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'face boxy--tooltip-face)
+ (overlay-put overlay 'display `((margin nil) ,str))
+ (overlay-put overlay 'before-string (make-string left-margin ?\s))
+ (push overlay overlays))
(setq top (+ top 1))))
(save-excursion (boxy-mode-recalculate-box-ring))
(push (read-event nil) unread-command-events)
