[elpa] externals/org-real 7f89820 094/160: Added expansion slots to speed up initial rendering

[ELPA Syncer]

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

    Added expansion slots to speed up initial rendering
---
 org-real.el | 173 ++++++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 127 insertions(+), 46 deletions(-)

diff --git a/org-real.el b/org-real.el
index 0e99900..9b354a8 100644
--- a/org-real.el
+++ b/org-real.el
@@ -612,6 +612,11 @@ ORIG is `org-insert-link', ARGS are the arguments passed 
to it."
    (hidden-children :initarg :hidden-children
                     :initform (org-real-box-collection)
                     :type org-real-box-collection)
+   (expand-siblings :initarg :expand-siblings
+                    :type function)
+   (expand-children :initarg :expand-children
+                    :type function)
+   (extra-data :initarg :extra-data)
    (level :initarg :level
           :initform 0
           :type number)
@@ -685,12 +690,23 @@ non-nil, skip setting :primary slot on the last box."
 
 (cl-defmethod org-real--update-visibility ((box org-real-box))
   "Update visibility of BOX and all of its children."
-  (with-slots (level children hidden-children) box
-    (let ((hidden (org-real--get-all hidden-children)))
-      (if (or (= 0 org-real--visibility)
-              (<= level org-real--visibility))
-          (if hidden (cl-rotatef children hidden-children))
-        (if (not hidden) (cl-rotatef children hidden-children))))
+  (with-slots (level children hidden-children expand-children) box
+    (if (or (= 0 org-real--visibility)
+            (<= level org-real--visibility))
+        (progn
+          (when (slot-boundp box :expand-children)
+            (funcall expand-children box)
+            (slot-makeunbound box :expand-children))
+          (if (org-real--get-all hidden-children)
+              (cl-rotatef children hidden-children))
+          (mapc
+           (lambda (child)
+             (with-slots (expand-siblings) child
+               (when (slot-boundp child :expand-siblings)
+                 (funcall expand-siblings child)
+                 (slot-makeunbound child :expand-siblings))))
+           (org-real--get-all children)))
+      (if (not (org-real--get-all hidden-children)) (cl-rotatef children 
hidden-children)))
     (mapc 'org-real--update-visibility (append (org-real--get-all children)
                                                (org-real--get-all 
hidden-children)))))
 
@@ -720,7 +736,8 @@ button drawn."
                (left (org-real--get-left box))
                (width (org-real--get-width box))
                (height (org-real--get-height box))
-               (double (org-real--get-all hidden-children))
+               (double (or (org-real--get-all hidden-children)
+                           (slot-boundp box :expand-children)))
                (align-bottom (or in-front on-top)))
           (cl-flet* ((draw (coords str &optional primary)
                            (forward-line (- (car coords) (line-number-at-pos)))
@@ -1184,8 +1201,12 @@ of BOX."
    (org-real--next box)))
 
 (cl-defmethod org-real--add-next ((next org-real-box)
-                                  (prev org-real-box))
-  "Add NEXT to world according to its relationship to PREV."
+                                  (prev org-real-box)
+                                  &optional force-visible)
+  "Add NEXT to world according to its relationship to PREV.
+
+If FORCE-VISIBLE, show the box regardless of
+`org-real--visibility'."
   (with-slots
       (children
        hidden-children
@@ -1202,6 +1223,7 @@ of BOX."
       (with-slots
           (rel
            rel-box
+           extra-data
            (next-level level)
            (next-y y-order)
            (next-x x-order)
@@ -1209,7 +1231,17 @@ of BOX."
            (next-in-front in-front)
            (next-on-top on-top))
           next
-        (let ((next-boxes (org-real--next next)))
+        (let* ((next-boxes (org-real--next next))
+               (partitioned (seq-group-by
+                             (lambda (next-next)
+                               (with-slots (rel) next-next
+                                 (if (member rel '("in" "on" "behind" "in 
front of" "on top of"))
+                                     'children
+                                   'siblings)))
+                             next-boxes))
+               (children-boxes (alist-get 'children partitioned))
+               (sibling-boxes (alist-get 'siblings partitioned)))
+          (setq extra-data partitioned)
           (cond
            ((member rel '("to the left of" "to the right of"))
             (setq next-level prev-level)
@@ -1265,24 +1297,33 @@ of BOX."
             (setq next-behind prev-behind)))
           (if (not (slot-boundp next :name)) (setq next-level 0))
           (oset next :rel-box prev)
-          (let ((visible (or (= 0 org-real--visibility) (<= next-level 
org-real--visibility))))
+          (let* ((visible (or force-visible (= 0 org-real--visibility) (<= 
next-level org-real--visibility))))
             (cond
              ((member rel '("in front of" "on top of"))
               (oset next :parent prev)
               (if visible
                   (setq children (org-real--push children next))
                 (setq hidden-children (org-real--push hidden-children next))))
-              ((member rel '("in" "on" "behind"))
-               (org-real--flex-add next prev))
-              (t
-               (oset next :parent parent)
-               (if visible
-                   (setq siblings (org-real--push siblings next))
-                 (setq hidden-siblings (org-real--push hidden-siblings 
next))))))
-          (mapc
-           (lambda (next-next)
-             (org-real--add-next next-next next))
-           next-boxes))))))
+             ((member rel '("in" "on" "behind"))
+              
+              (org-real--flex-add next prev))
+             (t
+              (oset next :parent parent)
+              (if visible
+                  (setq siblings (org-real--push siblings next))
+                (setq hidden-siblings (org-real--push hidden-siblings 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--flex-add ((box org-real-box)
                                   (parent org-real-box))
@@ -1414,34 +1455,73 @@ characters if possible."
 (cl-defmethod org-real--add-headline (headline
                                       (parent org-real-box))
   "Add HEADLINE to world as a child of PARENT."
-  (let* ((pos (org-element-property :begin headline))
-         (rel (or (org-entry-get pos "REL") "in"))
-         (box (org-real-box :name (org-element-property :title headline)
-                            :rel rel
-                            :rel-box parent
-                            :parent parent
-                            :locations (list (set-marker (point-marker) pos))
-                            :in-front (string= rel "in front of")
-                            :on-top (string= rel "on top of")
-                            :y-order (cond
-                                      ((string= rel "in front of") 1.0e+INF)
-                                      ((string= rel "on top of") -1.0e+INF)
-                                      (t 0))
-                            :primary t)))
-    (if (= 1 (with-slots (level) parent level))
-        (org-real--flex-add box parent)
-      (org-real--add-next box parent))
-    (mapc
-     (lambda (h)
-       (org-real--add-headline h box))
-     (cddr headline))))
+  (with-slots (locations (parent-level level)) parent
+    (with-current-buffer (marker-buffer (car locations))
+      (let* ((partitioned (seq-group-by
+                           (lambda (h)
+                             (let ((child-rel (or (org-entry-get 
(org-element-property :begin h) "REL") "in")))
+                               (if (member child-rel '("in" "on" "behind" "in 
front of" "on top of"))
+                                   'children
+                                 'siblings)))
+                           (cddr headline)))
+             (children (alist-get 'children partitioned))
+             (siblings (alist-get 'siblings partitioned))
+             (pos (org-element-property :begin headline))
+             (rel (or (org-entry-get pos "REL") "in"))
+             (level (if (member rel '("in" "on" "behind" "in front of" "on top 
of"))
+                        (+ 1 parent-level)
+                      parent-level))
+             (box (org-real-box :name (org-element-property :title headline)
+                                :rel rel
+                                :level level
+                                :rel-box parent
+                                :parent parent
+                                :locations (list (set-marker (point-marker) 
pos))
+                                :in-front (string= rel "in front of")
+                                :on-top (string= rel "on top of")
+                                :y-order (cond
+                                          ((string= rel "in front of") 
1.0e+INF)
+                                          ((string= rel "on top of") -1.0e+INF)
+                                          (t 0))
+                                :primary t)))
+        (org-real--add-next box parent)
+        (oset box :extra-data partitioned)
+        (if children
+            (oset box :expand-children
+                  '(lambda (box)
+                     (mapc
+                      (lambda (h) (org-real--add-headline h box))
+                      (alist-get 'children (oref box :extra-data))))))
+        (if siblings
+            (oset box :expand-siblings
+                  '(lambda (box)
+                     (mapc
+                      (lambda (h) (org-real--add-headline h box))
+                      (alist-get 'siblings (oref box :extra-data))))))))))
 
 (cl-defmethod org-real--cycle-children ((box org-real-box))
   "Cycle visibility of children of BOX."
   (lambda ()
     (interactive)
-    (with-slots (children hidden-children) box
-      (cl-rotatef children hidden-children))
+    (with-slots (children hidden-children expand-children expanded) box
+      (if (slot-boundp box :expand-children)
+          (progn
+            (funcall expand-children box)
+            (slot-makeunbound box :expand-children)
+            (if (org-real--get-all hidden-children)
+                (cl-rotatef children hidden-children)))
+        (cl-rotatef children hidden-children))
+      (let (fully-expanded)
+        (while (not fully-expanded)
+          (setq fully-expanded t)
+          (mapc
+           (lambda (child)
+             (with-slots (expand-siblings) child
+               (when (slot-boundp child :expand-siblings)
+                 (setq fully-expanded nil)
+                 (funcall expand-siblings child)
+                 (slot-makeunbound child :expand-siblings))))
+           (org-real--get-all children)))))
     (org-real-mode-redraw)
     (let ((top (org-real--get-top box))
           (left (org-real--get-left box)))
@@ -1588,7 +1668,8 @@ set to the :loc slot of each box."
          (title (or (concat (file-name-base filename) "." (file-name-extension 
filename))
                     "Document"))
          (world (org-real-box))
-         (document (org-real-box :name title)))
+         (document (org-real-box :name title
+                                 :locations (list (point-min-marker)))))
     (org-real--flex-add document world)
     (mapc
      (lambda (headline)