[elpa] externals/org-real 00b02f8968 118/188: Reworked flexible layout

[ELPA Syncer]

branch: externals/org-real
commit 00b02f8968f0dd11841dcc2ca7ba9f187c1971e3
Author: Amy Grinn <grinn.amy@gmail.com>
Commit: Amy Grinn <grinn.amy@gmail.com>

    Reworked flexible layout
---
 org-real.el | 327 +++++++++++++++++++++++++++---------------------------------
 1 file changed, 149 insertions(+), 178 deletions(-)

diff --git a/org-real.el b/org-real.el
index aceb0191c4..4a306ad299 100644
--- a/org-real.el
+++ b/org-real.el
@@ -437,7 +437,7 @@ MAX-LEVEL is the maximum level to show headlines for."
 (defun org-real-mode-redraw ()
   "Redraw `org-real--current-box' in the current buffer."
   (org-real--make-dirty org-real--current-box)
-  (org-real--flex-adjust org-real--current-box)
+  (org-real--flex-adjust org-real--current-box org-real--current-box)
   (let ((inhibit-read-only t))
     (erase-buffer)
     (if org-real--current-containers
@@ -819,8 +819,11 @@ non-nil, skip setting :primary slot on the last box."
       (let ((all-from-children (org-real--get-children from 'all)))
         (with-slots ((to-children children) (to-behind behind)) to
           (if (= 1 (length all-from-children))
-              (org-real--flex-add (car all-from-children) to)
-            (org-real--flex-add from to)))))))
+              (progn
+                (oset (car all-from-children) :flex t)
+                (org-real--add-child to (car all-from-children)))
+            (oset from :flex t)
+            (org-real--add-child to from)))))))
 
 (cl-defmethod org-real--update-visibility ((box org-real-box))
   "Update visibility of BOX and all of its children."
@@ -1297,9 +1300,14 @@ If optional ARG is 'hidden, only return hidden children"
 If FORCE-VISIBLE, always make CHILD visible in PARENT."
   (oset child :parent parent)
   (with-slots (children hidden-children) parent
-    (if (or force-visible (org-real--is-visible child))
-        (setq children (org-real--push children child))
-      (setq hidden-children (org-real--push hidden-children child)))))
+    (if (org-real--get-all hidden-children)
+        (progn
+          (setq hidden-children (org-real--push hidden-children child))
+          (if (or force-visible (org-real--is-visible child))
+              (cl-rotatef children hidden-children)))
+      (if (or force-visible (org-real--is-visible child))
+          (setq children (org-real--push children child))
+        (setq hidden-children (org-real--push hidden-children child))))))
 
 (cl-defmethod org-real--get-world ((box org-real-box))
   "Get the top most box related to BOX."
@@ -1367,41 +1375,37 @@ PREV must already exist in PARENT."
                :name (plist-get container :name)
                :locations (list (plist-get container :loc)))))
     (with-slots
-        ((cur-x x-order)
-         (cur-y y-order)
-         (cur-level level)
+        ((cur-level level)
          (cur-behind behind)
          (cur-on-top on-top)
-         (cur-in-front in-front))
+         (cur-in-front in-front)
+         flex)
         box
         (with-slots
-            ((prev-x x-order)
-             (prev-y y-order)
-             (prev-level level)
+            ((prev-level level)
              (prev-behind behind)
              (prev-on-top on-top)
              (prev-in-front in-front))
             prev
           (cond
            ((or (string= rel "in") (string= rel "on"))
+            (setq flex t)
             (setq cur-level (+ 1 prev-level))
             (setq cur-behind prev-behind))
            ((string= rel "behind")
+            (setq flex t)
             (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)
@@ -1413,42 +1417,14 @@ PREV must already exist in 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
-                   (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))))
-                     (org-real--get-children parent 'all)))))
-              (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))))))
+              (setq prev parent))))
            ((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)))
-                                 (org-real--get-children parent 'all))))
-              (mapc
-               (lambda (sibling)
-                 (with-slots (x-order) sibling
-                   (if (>= x-order cur-x)
-                       (setq x-order (+ 1 x-order)))))
-               row-siblings))))
+            (setq cur-in-front prev-in-front)))
           (oset box :rel rel)
           (oset box :rel-box prev)
-          (if (not (slot-boundp box :name)) (setq cur-level 0))
           (if (member rel org-real-children-prepositions)
               (progn
                 (org-real--add-child prev box)
@@ -1483,19 +1459,20 @@ PREV must already exist in PARENT."
 
 (cl-defmethod org-real--add-next ((next org-real-box)
                                   (prev org-real-box)
-                                  &optional force-visible)
+                                  &optional force-visible skip-next)
   "Add NEXT to world according to its relationship to PREV.
 
 If FORCE-VISIBLE, show the box regardless of
-`org-real--visibility'."
+`org-real--visibility'
+
+If SKIP-NEXT, don't add expansion slots for boxes related to
+NEXT."
   (with-slots
       (children
        hidden-children
        parent
        (prev-level level)
        (prev-primary primary)
-       (prev-y y-order)
-       (prev-x x-order)
        (prev-behind behind)
        (prev-in-front in-front)
        (prev-on-top on-top))
@@ -1504,9 +1481,8 @@ If FORCE-VISIBLE, show the box regardless of
         (rel
          rel-box
          extra-data
+         flex
          (next-level level)
-         (next-y y-order)
-         (next-x x-order)
          (next-behind behind)
          (next-in-front in-front)
          (next-on-top on-top))
@@ -1530,82 +1506,100 @@ If FORCE-VISIBLE, show the box regardless of
           (cond
            ((member rel '("to the left of" "to the right of"))
             (setq next-level prev-level)
-            (setq next-y prev-y)
             (setq next-behind prev-behind)
             (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)))
-                                 (org-real--get-children parent 'all))))
-              (mapc
-               (lambda (sibling)
-                 (with-slots (x-order) sibling
-                   (if (>= x-order next-x)
-                       (setq x-order (+ 1 x-order)))))
-               row-siblings)))
+            (setq next-on-top prev-on-top))
            ((member rel '("above" "below"))
             (setq next-level prev-level)
-            (setq next-x prev-x)
-            (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))))
-                                      (org-real--get-children parent 'all)))))
-              (if (string= rel "above")
-                  (setq next-y (- (apply 'min 0 sibling-y-orders) 1))
-                (setq next-y (+ 1 (apply 'max 0 sibling-y-orders))))))
+            (setq next-behind prev-behind))
            ((or next-on-top next-in-front)
             (setq next-level (+ 1 prev-level))
-            (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 on-top) child
-                                           (and (eq next-in-front in-front)
-                                                (eq next-on-top on-top))))
-                                       (org-real--get-children prev 'all))))))
             (setq next-behind prev-behind))
            ((member rel '("in" "on" "behind"))
+            (setq flex t)
+            (setq next-level (+ 1 prev-level)))
+           ((string= rel "behind")
+            (setq flex t)
             (setq next-level (+ 1 prev-level))
-            (setq next-behind prev-behind)))
-          (if (not (slot-boundp next :name)) (setq next-level 0))
+            (setq next-behind t)))
           (oset next :rel-box prev)
           (if (member rel org-real-children-prepositions)
-              (if (member rel org-real-flex-prepositions)
-                  (org-real--flex-add next prev)
-                (org-real--add-child prev next force-visible))
+              (org-real--add-child prev next force-visible)
             (org-real--add-child parent next force-visible))
-          (if children-boxes
-              (oset next :expand-children
-                    '(lambda (box)
-                       (mapc
-                        (lambda (child) (org-real--add-next child box))
-                        (alist-get 'children (oref box :extra-data))))))
-          (if sibling-boxes
-              (oset next :expand-siblings
-                    '(lambda (box)
-                       (mapc
-                        (lambda (sibling) (org-real--add-next sibling box t))
-                        (alist-get 'siblings (oref box :extra-data)))))))))))
+          (unless skip-next
+            (if children-boxes
+                (oset next :expand-children
+                      '(lambda (box)
+                         (mapc
+                          (lambda (child) (org-real--add-next child box))
+                          (alist-get 'children (oref box :extra-data))))))
+            (if sibling-boxes
+                (oset next :expand-siblings
+                      '(lambda (box)
+                         (mapc
+                          (lambda (sibling) (org-real--add-next sibling box t))
+                          (alist-get 'siblings (oref box 
:extra-data))))))))))))
+
+(cl-defmethod org-real--position-box ((box org-real-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 (org-real--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 next-y 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)))
+                               (org-real--get-children parent 'all))))
+            (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 next-x 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))))
+                                    (org-real--get-children parent 'all)))))
+            (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))))
+                                      (org-real--get-children rel-box 
'all))))))))
+        (org-real--add-child parent box t)))))
+          
 
 (cl-defmethod org-real--flex-add ((box org-real-box)
-                                  (parent org-real-box))
+                                  (parent org-real-box)
+                                  (world org-real-box))
   "Add BOX to a PARENT box flexibly.
 
 This function ignores the :rel slot and adds BOX in such a way
 that the width of the world is kept below `org-real-flex-width'
 characters if possible."
-  (let* ((world (org-real--get-world parent))
-         (cur-width (org-real--get-width world)))
+  (let ((cur-width (org-real--get-width world)))
     (org-real--make-dirty world)
     (with-slots ((parent-level level) (parent-behind behind)) parent
       (let* ((level (+ 1 parent-level))
@@ -1613,7 +1607,7 @@ characters if possible."
                             (lambda (sibling)
                               (with-slots (in-front on-top) sibling
                                 (not (or in-front on-top))))
-                            (org-real--get-children parent 'all)))
+                            (org-real--get-children parent)))
              (last-sibling (and all-siblings
                                 (seq-reduce
                                  (lambda (max sibling)
@@ -1629,7 +1623,8 @@ characters if possible."
         (oset box :flex t)
         (oset box :behind parent-behind)
         (org-real--apply-level box level)
-        (org-real--add-child parent box)
+        (org-real--add-child parent box t)
+        (org-real--flex-adjust box world)
         (when last-sibling
           (with-slots
               ((last-sibling-y y-order)
@@ -1641,70 +1636,46 @@ characters if possible."
               (org-real--make-dirty world)
               (when (and (> new-width cur-width) (> new-width 
org-real-flex-width))
                 (oset box :y-order (+ 1 last-sibling-y))
-                (oset box :x-order 0)))))))))
-
-(cl-defmethod org-real--flex-adjust ((box org-real-box))
+                (oset box :x-order 0)
+                (org-real--flex-adjust box world)))))))))
+
+(cl-defmethod org-real--partition (fn (collection org-real-box-collection))
+  "Partition COLLECTION into two collections using predicate FN."
+  (if (not (slot-boundp collection :box))
+      (list (org-real-box-collection) (org-real-box-collection))
+    (let ((pass (org-real-box-collection))
+          (fail (org-real-box-collection)))
+      (while (slot-boundp collection :box)
+        (with-slots (box next) collection
+          (if (funcall fn box)
+              (setq pass (org-real--push pass box))
+            (setq fail (org-real--push fail box)))
+          (if (slot-boundp collection :next)
+              (setq collection next)
+            (setq collection (org-real-box-collection)))))
+      (list pass fail))))
+
+(cl-defmethod org-real--flex-adjust ((box org-real-box) (world org-real-box))
   "Adjust BOX x and y orders to try to fit BOX within `org-real-flex-width'."
-  (let ((cur-width (org-real--get-width box))
-        new-width)
-    (org-real--flex-adjust-helper box box)
-    (setq new-width (org-real--get-width box))
-    (while (and (< new-width cur-width)
-                (> new-width org-real-flex-width))
-      (setq cur-width new-width)
-      (org-real--flex-adjust-helper box box)
-      (setq new-width (org-real--get-width box)))))
-
-(cl-defmethod org-real--flex-adjust-helper ((box org-real-box) (world 
org-real-box))
-  "Adjust BOX x and y orders to try to fit WORLD within `org-real-flex-width'."
-  (with-slots (flex parent) box
-    (when flex
-      (let ((cur-width (org-real--get-width world)))
-        (when (> cur-width org-real-flex-width)
-          (let ((left (org-real--get-left box))
-                (width (org-real--get-width box)))
-            (when (> (+ left width) org-real-flex-width)
-              (org-real--make-dirty world)
-              (when-let* ((all-siblings (seq-filter
-                                         (lambda (sibling)
-                                           (with-slots (in-front on-top) 
sibling
-                                             (not (or in-front on-top))))
-                                         (org-real--get-children parent)))
-                          (last-sibling (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
-                                         (org-real-box :y-order -1.0e+INF))))
-                (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 ((when-last (org-real--get-width world)))
-                    (when (> when-last org-real-flex-width)
-                      (org-real--make-dirty world)
-                      (oset box :y-order (+ 1 last-sibling-y))
-                      (oset box :x-order 0)
-                      (let ((when-new-row (org-real--get-width world)))
-                        (when (>= when-new-row when-last)
-                          (org-real--make-dirty world)
-                          (oset box :y-order last-sibling-y)
-                          (oset box :x-order (+ 1 last-sibling-x))))))))))))))
-  (mapc
-   (lambda (child)
-     (org-real--flex-adjust-helper child world))
-   (org-real--get-children box)))
-
+  (with-slots (children) box
+    (let* ((partitioned (org-real--partition
+                         (lambda (child) (with-slots (flex) child flex))
+                         children))
+           (flex-children (org-real--get-all (car partitioned)))
+           (other-children (org-real--get-all (cadr partitioned))))
+      (setq children (org-real-box-collection))
+      (org-real--make-dirty world)
+      (mapc
+       (lambda (flex-child)
+         (org-real--flex-add flex-child box world))
+       flex-children)
+      (mapc
+       (lambda (other-child)
+         (if (not (slot-boundp other-child :rel-box))
+             (org-real--flex-add other-child box world)
+           (org-real--position-box other-child)
+           (org-real--flex-adjust other-child world)))
+       other-children))))
 
 (cl-defmethod org-real--add-headline (headline
                                       (parent org-real-box))
@@ -1723,14 +1694,14 @@ characters if possible."
                            (cddr headline)))
              (children (alist-get 'children partitioned))
              (siblings (alist-get 'siblings partitioned))
-             (pos (goto-char (org-element-property :begin headline)))
-             (columns (org-columns--collect-values))
+             (pos (org-element-property :begin headline))
+             (columns (save-excursion (goto-char pos) 
(org-columns--collect-values)))
              (max-column-length (apply 'max 0
                                        (mapcar
                                         (lambda (column)
                                           (length (cadr (car column))))
                                         columns)))
-             (rel (or (org-entry-get nil "REL") "in"))
+             (rel (save-excursion (goto-char pos) (or (org-entry-get nil 
"REL") "in")))
              (level (if (member rel org-real-children-prepositions)
                         (+ 1 parent-level)
                       parent-level))
@@ -1947,7 +1918,7 @@ set to the :loc slot of each box."
          (document (org-real-box :name title
                                  :metadata ""
                                  :locations (list (point-min-marker)))))
-    (org-real--flex-add document world)
+    (org-real--flex-add document world world)
     (mapc
      (lambda (headline)
         (org-real--add-headline headline document))