[elpa] externals/org-real f3b5fc7 099/160: More edge cases

[ELPA Syncer]

branch: externals/org-real
commit f3b5fc7d03401c64bad5415a577796c72d5fadd3
Author: Tyler Grinn <tylergrinn@gmail.com>
Commit: Tyler Grinn <tylergrinn@gmail.com>

    More edge cases
---
 demo/garage.org      |  2 +-
 org-real.el          | 76 +++++++++++++++++++++++++++++++---------------------
 tests/edge-cases.org | 30 ++++++++++++---------
 3 files changed, 65 insertions(+), 43 deletions(-)

diff --git a/demo/garage.org b/demo/garage.org
index 2ad5cca..ae95ec8 100644
--- a/demo/garage.org
+++ b/demo/garage.org
@@ -14,4 +14,4 @@
   - [[real://garage/east wall?rel=in/rake?rel=on/hoe?rel=to the left 
of/snowblower?rel=above][snowblower]]
   - [[real://garage/workbench?rel=in/hammer?rel=on/screws?rel=to the right 
of][screws]]
   - [[real://garage/saw?rel=on][saw]]
-  - [[real://garage/workbench?rel=in/hammer?rel=on/screws?rel=to the right 
of/pliers?rel=above][pliers]]
+  - [[real://garage/workbench?rel=in/paintbrush?rel=in front of/wrench?rel=to 
the left of/pliers?rel=below][pliers]]
diff --git a/org-real.el b/org-real.el
index bbb0bf0..b8368a3 100644
--- a/org-real.el
+++ b/org-real.el
@@ -1090,8 +1090,8 @@ PREV must already exist in PARENT."
                      (if (>= x-order cur-x)
                          (setq x-order (+ 1 x-order)))))
                  row-siblings))))
-            (oset box :rel-box prev)
             (oset box :rel rel)
+            (oset box :rel-box prev)
             (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")))
@@ -1161,22 +1161,53 @@ If EXCLUDE-CHILDREN, only retrieve sibling boxes."
     (with-slots (children) box
       (apply 'append (mapcar 'org-real--expand (org-real--get-all 
children))))))
 
+(cl-defmethod org-real--primary-boxes ((box org-real-box))
+  "Get a list of boxes from BOX which have no further relatives."
+  (if (slot-boundp box :name)
+      (if-let ((next-boxes (org-real--next box)))
+          (apply 'append (mapcar 'org-real--primary-boxes next-boxes))
+        (list box))
+    (with-slots (children) box
+      (apply 'append (mapcar 'org-real--primary-boxes (org-real--get-all 
children))))))
+
+(cl-defmethod org-real--find-matching ((search-box org-real-box) (world 
org-real-box))
+  "Find and add box to WORLD with a matching name as SEARCH-BOX."
+  (when (slot-boundp search-box :name)
+    (with-slots ((search-name name)) search-box
+      (seq-find
+       (lambda (box)
+         (and (slot-boundp box :name)
+              (string= search-name
+                       (with-slots (name) box name))))
+       (org-real--expand world)))))
+
+(cl-defmethod org-real--add-matching ((box org-real-box) (match org-real-box))
+  "Add relatives of BOX to MATCH."
+  (oset match :primary (or (with-slots (primary) match primary)
+                           (with-slots (primary) box primary)))
+  (oset match :locations (append (with-slots (locations) match locations)
+                                 (with-slots (locations) box locations)))
+  (let ((world (org-real--get-world match)))
+    (mapc
+     (lambda (next)
+       (if (not (org-real--find-matching next world))
+           (org-real--add-next next match)))
+     (org-real--next box))))
+
 (cl-defmethod org-real--merge-into ((from org-real-box) (to org-real-box))
   "Merge FROM box into TO box."
-  (let ((from-boxes (reverse (org-real--expand from)))
-        (to-boxes (org-real--expand to)))
-    (unless (seq-some
-             (lambda (from-box)
-               (seq-some
-                (lambda (to-box)
-                  (when (and (slot-boundp from-box :name)
-                             (slot-boundp to-box :name)
-                             (string= (with-slots (name) from-box name)
-                                      (with-slots (name) to-box name)))
-                    (org-real--add-matching from-box to-box)
-                    t))
-                  to-boxes))
-             from-boxes)
+  (let (match-found)
+    (mapc
+     (lambda (from-box)
+       (let ((match (org-real--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 match (org-real--find-matching from-box to)))
+         (when match
+           (setq match-found t)
+           (org-real--add-matching from-box match))))
+     (org-real--primary-boxes from))
+    (unless match-found
       (let ((all-from-children (with-slots (children hidden-children) from
                                  (append (org-real--get-all children)
                                          (org-real--get-all 
hidden-children)))))
@@ -1185,21 +1216,6 @@ If EXCLUDE-CHILDREN, only retrieve sibling boxes."
               (org-real--flex-add (car all-from-children) to)
             (org-real--flex-add from to)))))))
 
-(cl-defmethod org-real--add-matching ((box org-real-box)
-                                      (match org-real-box))
-  "Add relatives to BOX to MATCH.
-
-MATCH is used to set the :rel-box and :parent slots on relatives
-of BOX."
-  (oset match :primary (or (with-slots (primary) match primary)
-                           (with-slots (primary) box primary)))
-  (oset match :locations (append (with-slots (locations) match locations)
-                                 (with-slots (locations) box locations)))
-  (mapc
-   (lambda (next)
-     (org-real--add-next next match))
-   (org-real--next box)))
-
 (cl-defmethod org-real--add-next ((next org-real-box)
                                   (prev org-real-box)
                                   &optional force-visible)
diff --git a/tests/edge-cases.org b/tests/edge-cases.org
index 3c8a2ba..0d41305 100644
--- a/tests/edge-cases.org
+++ b/tests/edge-cases.org
@@ -193,22 +193,28 @@
    #+end_example
 * Merging links
 
-** PASS Merges two boxes
+** PASS Merges a box on top of a box
    #+begin_src org
-     - [[real://thing3/thing2?rel=on top of/thing1?rel=to the right of]]
-     - [[real://thing3/thing2?rel=on top of]]
+     - [[real://thing2/thing1?rel=on top of]]
+     - [[real://thing2/thing1?rel=on top of/above?rel=above]]
    #+end_src
    #+begin_example
 
-      ┌──────────┐  ┌──────────┐
-      │          │  │          │
-      │  thing2  │  │  thing1  │
-      │          │  │          │
-   ┌──┴──────────┴──┴──────────┴──┐
-   │                              │
-   │  thing3                      │
-   │                              │
-   └──────────────────────────────┘
+   ┌─────────┐
+   │         │
+   │  above  │
+   │         │
+   └─────────┘
+
+      ┌──────────┐
+      │          │
+      │  thing1  │
+      │          │
+   ┌──┴──────────┴──┐
+   │                │
+   │  thing2        │
+   │                │
+   └────────────────┘
    #+end_example