branch: externals/org-real
commit 378806be287bc328d2c9432399a69f190629b91b
Author: Tyler Grinn <[email protected]>
Commit: Tyler Grinn <[email protected]>
Improved efficiency
---
org-real.el | 235 +++++++++++++++++++++++++++++-------------------------------
1 file changed, 112 insertions(+), 123 deletions(-)
diff --git a/org-real.el b/org-real.el
index 58df93d..0e99900 100644
--- a/org-real.el
+++ b/org-real.el
@@ -1006,98 +1006,97 @@ PREV must already exist in PARENT."
(prev-in-front in-front))
prev
(with-slots ((siblings children) (hidden-siblings hidden-children))
parent
- (let (sibling-y-orders row-siblings)
+ (cond
+ ((or (string= rel "in") (string= rel "on"))
+ (setq cur-level (+ 1 prev-level))
+ (setq cur-behind prev-behind))
+ ((string= rel "behind")
+ (setq cur-level (+ 1 prev-level))
+ (setq cur-behind t))
+ ((string= rel "in front of")
+ (setq cur-level (+ 1 prev-level))
+ (setq cur-y 1.0e+INF)
+ (setq cur-behind prev-behind)
+ (setq cur-in-front t))
+ ((string= rel "on top of")
+ (setq cur-level (+ 1 prev-level))
+ (setq cur-y -1.0e+INF)
+ (setq cur-behind prev-behind)
+ (setq cur-on-top t))
+ ((member rel '("above" "below"))
+ (setq cur-behind prev-behind)
+ (setq cur-x prev-x)
(cond
- ((or (string= rel "in") (string= rel "on"))
- (setq cur-level (+ 1 prev-level))
- (setq cur-behind prev-behind))
- ((string= rel "behind")
- (setq cur-level (+ 1 prev-level))
- (setq cur-behind t))
- ((string= rel "in front of")
- (setq cur-level (+ 1 prev-level))
- (setq cur-y 1.0e+INF)
- (setq cur-behind prev-behind)
- (setq cur-in-front t))
- ((string= rel "on top of")
- (setq cur-level (+ 1 prev-level))
- (setq cur-y -1.0e+INF)
- (setq cur-behind prev-behind)
- (setq cur-on-top t))
- ((member rel '("above" "below"))
- (setq cur-behind prev-behind)
- (setq cur-x prev-x)
- (cond
- ((and prev-in-front (string= rel "below"))
- (while (with-slots (in-front) prev in-front)
- (setq prev (with-slots (parent) prev parent)))
- (setq parent (with-slots (parent) prev parent)))
- ((and prev-on-top (string= rel "above"))
- (while (with-slots (on-top) prev on-top)
- (setq prev (with-slots (parent) prev parent)))
- (setq parent (with-slots (parent) prev parent)))
- ((and prev-on-top (string= rel "below"))
- (setq rel "in")
- (setq prev parent)))
- (setq cur-level (+ 1 (with-slots (level) parent level)))
- (setq sibling-y-orders
- (with-slots ((siblings children) (hidden-siblings
hidden-children)) parent
- (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))))
- (append (org-real--get-all siblings)
- (org-real--get-all hidden-siblings))))))
+ ((and prev-in-front (string= rel "below"))
+ (while (with-slots (in-front) prev in-front)
+ (setq prev (with-slots (parent) prev parent)))
+ (setq parent (with-slots (parent) prev parent)))
+ ((and prev-on-top (string= rel "above"))
+ (while (with-slots (on-top) prev on-top)
+ (setq prev (with-slots (parent) prev parent)))
+ (setq parent (with-slots (parent) prev parent)))
+ ((and prev-on-top (string= rel "below"))
+ (setq rel "in")
+ (setq prev parent)))
+ (setq cur-level (+ 1 (with-slots (level) parent level)))
+ (let ((sibling-y-orders
+ (with-slots ((siblings children) (hidden-siblings
hidden-children)) parent
+ (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))))
+ (append (org-real--get-all siblings)
+ (org-real--get-all hidden-siblings)))))))
(if (or prev-on-top (string= rel "above"))
(setq cur-y (- (apply 'min 0 sibling-y-orders) 1))
- (setq cur-y (+ 1 (apply 'max 0 sibling-y-orders)))))
- ((member rel '("to the left of" "to the right of"))
- (setq row-siblings (seq-filter
- (lambda (sibling)
- (with-slots (y-order) sibling
- (= prev-y y-order)))
- (append (org-real--get-all siblings)
- (org-real--get-all
hidden-siblings))))
- (setq cur-level prev-level)
- (setq cur-y prev-y)
- (setq cur-behind prev-behind)
- (setq cur-on-top prev-on-top)
- (setq cur-in-front prev-in-front)
- (if (string= rel "to the left of")
- (setq cur-x prev-x)
- (setq cur-x (+ 1 prev-x)))
+ (setq cur-y (+ 1 (apply 'max 0 sibling-y-orders))))))
+ ((member rel '("to the left of" "to the right of"))
+ (setq cur-level prev-level)
+ (setq cur-y prev-y)
+ (setq cur-behind prev-behind)
+ (setq cur-on-top prev-on-top)
+ (setq cur-in-front prev-in-front)
+ (if (string= rel "to the left of")
+ (setq cur-x prev-x)
+ (setq cur-x (+ 1 prev-x)))
+ (let ((row-siblings (seq-filter
+ (lambda (sibling)
+ (with-slots (y-order) sibling
+ (= prev-y y-order)))
+ (append (org-real--get-all siblings)
+ (org-real--get-all
hidden-siblings)))))
(mapc
(lambda (sibling)
(with-slots (x-order) sibling
(if (>= x-order cur-x)
(setq x-order (+ 1 x-order)))))
- row-siblings)))
- (oset box :rel-box prev)
- (oset box :rel rel)
- (if (not (slot-boundp box :name)) (setq cur-level 0))
- (let ((visible (or (= 0 org-real--visibility) (<= cur-level
org-real--visibility))))
- (if (and prev (member rel '("in" "on" "behind" "in front of"
"on top of")))
- (progn
- (oset box :parent prev)
- (if visible
- (with-slots (children) prev
- (setq children (org-real--push children box)))
- (with-slots (hidden-children) prev
- (setq hidden-children (org-real--push
hidden-children box))))
+ row-siblings))))
+ (oset box :rel-box prev)
+ (oset box :rel rel)
+ (if (not (slot-boundp box :name)) (setq cur-level 0))
+ (let ((visible (or (= 0 org-real--visibility) (<= cur-level
org-real--visibility))))
+ (if (and prev (member rel '("in" "on" "behind" "in front of" "on
top of")))
+ (progn
+ (oset box :parent prev)
+ (if visible
+ (with-slots (children) prev
+ (setq children (org-real--push children box)))
+ (with-slots (hidden-children) prev
+ (setq hidden-children (org-real--push hidden-children
box))))
(if containers
(org-real--make-instance-helper containers prev box
skip-primary)
(unless skip-primary (oset box :primary t))))
- (oset box :parent parent)
- (if visible
- (with-slots (children) parent
- (setq children (org-real--push children box)))
- (with-slots (hidden-children) parent
- (setq hidden-children (org-real--push hidden-children
box))))
- (if containers
- (org-real--make-instance-helper containers parent box
skip-primary)
- (unless skip-primary (oset box :primary t)))))))))))
+ (oset box :parent parent)
+ (if visible
+ (with-slots (children) parent
+ (setq children (org-real--push children box)))
+ (with-slots (hidden-children) parent
+ (setq hidden-children (org-real--push hidden-children
box))))
+ (if containers
+ (org-real--make-instance-helper containers parent box
skip-primary)
+ (unless skip-primary (oset box :primary t))))))))))
(cl-defmethod org-real--get-world ((box org-real-box))
"Get the top most box related to BOX."
@@ -1210,54 +1209,44 @@ of BOX."
(next-in-front in-front)
(next-on-top on-top))
next
- (let* ((next-boxes (org-real--next next))
- (all-siblings (append (org-real--get-all siblings)
- (org-real--get-all hidden-siblings)))
- (row-siblings (seq-filter
- (lambda (sibling)
- (with-slots (y-order) sibling
- (= y-order prev-y)))
- all-siblings))
- (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))))
- all-siblings))))
+ (let ((next-boxes (org-real--next next)))
(cond
- ((string= rel "to the left of")
+ ((member rel '("to the left of" "to the right of"))
(setq next-level prev-level)
- (setq next-x prev-x)
(setq next-y prev-y)
(setq next-behind prev-behind)
- (mapc
- (lambda (sibling)
- (with-slots (x-order) sibling
- (if (>= x-order next-x)
- (setq x-order (+ 1 x-order)))))
- row-siblings))
- ((string= rel "to the right of")
+ (setq next-in-front prev-in-front)
+ (setq next-on-top prev-on-top)
+ (if (string= rel "to the left of")
+ (setq next-x prev-x)
+ (setq next-x (+ 1 prev-x)))
+ (let ((row-siblings (seq-filter
+ (lambda (sibling)
+ (with-slots (y-order) sibling
+ (= y-order prev-y)))
+ (append (org-real--get-all siblings)
+ (org-real--get-all
hidden-siblings)))))
+ (mapc
+ (lambda (sibling)
+ (with-slots (x-order) sibling
+ (if (>= x-order next-x)
+ (setq x-order (+ 1 x-order)))))
+ row-siblings)))
+ ((member rel '("above" "below"))
(setq next-level prev-level)
- (setq next-x (+ 1 prev-x))
- (setq next-y prev-y)
- (setq next-behind prev-behind)
- (mapc
- (lambda (sibling)
- (with-slots (x-order) sibling
- (if (>= x-order next-x)
- (setq x-order (+ 1 x-order)))))
- row-siblings))
- ((string= rel "above")
- (setq next-level prev-level)
- (setq next-y (- (apply 'min 0 sibling-y-orders) 1))
- (setq next-x prev-x)
- (setq next-behind prev-behind))
- ((string= rel "below")
- (setq next-level prev-level)
- (setq next-y (+ 1 (apply 'max 0 sibling-y-orders)))
(setq next-x prev-x)
- (setq next-behind prev-behind))
+ (setq next-behind prev-behind)
+ (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))))
+ (append (org-real--get-all siblings)
+ (org-real--get-all
hidden-siblings))))))
+ (if (string= rel "above")
+ (setq next-y (- (apply 'min 0 sibling-y-orders) 1))
+ (setq next-y (+ 1 (apply 'max 0 sibling-y-orders))))))
((or next-on-top next-in-front)
(setq next-level (+ 1 prev-level))
(setq next-x (+ 1 (apply 'max 0
