branch: externals/org-real
commit 01899e9108d27a3060bbf64196da570a3e77f6ea
Author: Tyler Grinn <tylergr...@gmail.com>
Commit: Tyler Grinn <tylergr...@gmail.com>
More edge cases
---
garage.org | 9 +++---
org-real.el | 98 ++++++++++++++++++++++++++++++-------------------------------
2 files changed, 54 insertions(+), 53 deletions(-)
diff --git a/garage.org b/garage.org
index aa025d5..9715df5 100644
--- a/garage.org
+++ b/garage.org
@@ -1,14 +1,15 @@
* Items in the garage
+ - [[real://house/garage?rel=in/east wall?rel=in][East wall]]
- [[real://house/garage?rel=in/workbench?rel=in/paintbrush?rel=in front
of/wrench?rel=to the right of][wrench]]
- [[real://house/garage?rel=in/workbench?rel=in/paintbrush?rel=in front
of][paintbrush]]
- - [[real://house/garage?rel=in/workbench?rel=in/screwdriver?rel=on top
of][screwdriver]]
- - [[real://house/garage?rel=in/east wall?rel=in/shovel?rel=on][shovel]]
+ - [[real://house/garage?rel=in/workbench?rel=in/nails?rel=on top
of/screwdriver?rel=on top of][screwdriver]]
+ - [[real://house?rel=in front of/garage?rel=in/east
wall?rel=in/shovel?rel=on][shovel]]
- [[real://house/garage?rel=in/east wall?rel=in/rake?rel=on][rake]]
- [[real://house/garage?rel=in/workbench?rel=in/hammer?rel=on][hammer]]
- [[real://house/garage?rel=in/east wall?rel=in/rake?rel=on/hoe?rel=to the
left of][hoe]]
- [[real://house/garage?rel=in/car?rel=in/air freshener?rel=in][air
freshener]]
- - [[real://house/garage?rel=in/east wall?rel=in][East wall]]
- - [[real://house/garage?rel=in/workbench?rel=in/ratchet?rel=on][ratchet]]
+ - [[real://house/garage?rel=in/workbench?rel=in/ratchet?rel=on top
of][ratchet]]
- [[real://house/garage?rel=in/workbench?rel=in/nails?rel=on top of][nails]]
- [[real://house/garage?rel=in/workbench?rel=in/nails?rel=on top of][nails2]]
+ - [[real://house/garage?rel=in/workbench?rel=in][workbench]]
diff --git a/org-real.el b/org-real.el
index 3316a59..c955618 100644
--- a/org-real.el
+++ b/org-real.el
@@ -160,7 +160,6 @@ describing where BOX is."
(defun org-real-follow (url &rest _)
"Open a real link URL in a popup buffer."
- (pp include-children)
(let* ((containers (org-real--parse-url url))
(box (org-real--make-instance 'org-real-box (copy-tree containers))))
(if org-real-include-children
@@ -530,7 +529,7 @@ OFFSET is the starting line to start insertion."
(cl-defmethod org-real--get-height ((box org-real-box) &optional
include-on-top)
"Get the height of BOX.
-If INCLUDE-ON-TOP is non-nil, also include height on top of box"
+If INCLUDE-ON-TOP is non-nil, also include height on top of box."
(let ((on-top-height (if include-on-top (org-real--get-on-top-height box)
0)))
(with-slots ((stored-height height) in-front on-top) box
(if (slot-boundp box :height)
@@ -584,40 +583,31 @@ If INCLUDE-ON-TOP is non-nil, also include height on top
of box"
(not (or on-top in-front))))
(org-real--get-all children))))
(offset (+ 2 org-real-padding-y org-real-margin-y))
- (top (+ on-top-height offset (org-real--get-top parent)))
- (above (seq-filter
- (lambda (sibling)
- (with-slots ((sibling-x x-order) (sibling-y
y-order)) sibling
- (and (= x-order sibling-x)
- (< sibling-y y-order))))
- siblings))
- (directly-above (and above (seq-reduce
- (lambda (max child)
- (with-slots ((max-y
y-order)) max
- (with-slots ((child-y
y-order)) child
- (if (> child-y max-y)
- child
- max))))
- above
- (org-real-box :y-order
-9999))))
- (above-height (and directly-above (+ org-real-margin-y
- (apply 'max
- (mapcar
-
'org-real--get-height
- (seq-filter
- (lambda
(sibling)
- (=
(with-slots (y-order) directly-above y-order)
-
(with-slots (y-order) sibling y-order)))
-
siblings)))))))
- (if directly-above
+ (top (+ on-top-height offset (org-real--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-height (+ org-real-margin-y
+ (apply 'max
+ (mapcar
+ 'org-real--get-height
+ directly-above)))))
(setq stored-top (+ on-top-height
- (org-real--get-top directly-above)
+ (org-real--get-top (car
directly-above))
above-height))
- (if (and (slot-boundp box :rel)
- (or (string= "to the left of" rel)
- (string= "to the right of" rel)))
- (setq stored-top (org-real--get-top rel-box))
- (setq stored-top top))))))))))
+ (setq stored-top top)))))))))
(cl-defmethod org-real--get-left ((box org-real-box))
"Get the left column index of BOX."
@@ -821,12 +811,31 @@ of BOX."
(next-on-top on-top))
next
(cond
+ (next-on-top
+ (setq next-x (+ 1
+ (apply 'max 0
+ (mapcar
+ (lambda (child) (with-slots (x-order)
child x-order))
+ (seq-filter
+ (lambda (child) (with-slots (on-top)
child on-top))
+ (org-real--get-all children))))))
+ (setq next-behind match-behind))
+ (next-in-front
+ (setq next-x (+ 1
+ (apply 'max 0
+ (mapcar
+ (lambda (child) (with-slots (x-order)
child x-order))
+ (seq-filter
+ (lambda (child) (with-slots (in-front)
child in-front))
+ (org-real--get-all children))))))
+ (setq next-behind match-behind))
((string= rel "above")
(setq next-y match-y)
(mapc
(lambda (sibling)
- (with-slots ((sibling-y y-order)) sibling
- (when (>= sibling-y match-y)
+ (with-slots ((sibling-y y-order) on-top in-front) sibling
+ (when (and (not (or on-top in-front))
+ (>= sibling-y match-y))
(setq sibling-y (+ 1 sibling-y)))))
(org-real--get-all siblings))
(setq next-x match-x)
@@ -835,21 +844,13 @@ of BOX."
(setq next-y (+ 1 match-y))
(mapc
(lambda (sibling)
- (with-slots ((sibling-y y-order)) sibling
- (when (> sibling-y match-y)
+ (with-slots ((sibling-y y-order) on-top in-front) sibling
+ (when (and (not (or on-top in-front))
+ (> sibling-y match-y))
(setq sibling-y (+ 1 sibling-y)))))
(org-real--get-all siblings))
(setq next-x match-x)
(setq next-behind match-behind))
- ((string= rel "on top of")
- (setq next-x (+ 1
- (apply 'max 0
- (mapcar
- (lambda (child) (with-slots (x-order)
child x-order))
- (seq-filter
- (lambda (child) (with-slots (on-top)
child on-top))
- (org-real--get-all children))))))
- (setq next-behind match-behind))
((string= rel "to the right of")
(setq next-x (+ 1 match-x))
(mapc
@@ -1000,7 +1001,7 @@ Returns a list of plists with a :name property and
optionally a
(org-real--parse-url
(org-element-property :raw-link link))
t))))
- (seq-sort (lambda (a b) (>= (length a) (length b))) container-matrix)))
+ (seq-sort (lambda (a b) (> (length a) (length b))) container-matrix)))
(defun org-real--to-link (containers)
"Create a link string from CONTAINERS."
@@ -1013,7 +1014,6 @@ Returns a list of plists with a :name property and
optionally a
containers
"/")))
-
(provide 'org-real)
;;; org-real.el ends here
