bug#55900: [PATCH] Hierarchy – Defer the Computation of Children

[Jaft <jaft.r@outlook.com>]

[-- Attachment #1: Type: text/plain, Size: 829 bytes --]

> On Thursday, July 28, 2022, 03:51:59 AM CDT, Eli Zaretskii <eliz@gnu.org> wrote: 
>
>
>
>
>
> > Date: Wed, 27 Jul 2022 12:36:55 +0000 (UTC)
> > From: Jaft <jaft.r@outlook.com>
> > Cc: "55900@debbugs.gnu.org" <55900@debbugs.gnu.org>
> > 
> > Just checking if there was anything else I needed to provide for this or if my new additions are satisfactory.
>
> Sorry for the delay.  I've just sent a few minor comments to the
> patch.

No worries; I think I've addressed your comments.

> And I don't see a copyright assignment from you on file.  Did you do
> the legal paperwork for that, and if so, when was that?

I have not yet; this is my first code contribution to Emacs so I'm not entirely familiar with the process, I'm afraid. What steps should I take to accomplish this?

> Thanks.

No problem.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Allow-Hierarchy-to-delay-computing-children.patch --]
[-- Type: text/x-patch, Size: 15033 bytes --]

From 47881e04dc55952b8216a7591736d6172d9e5db1 Mon Sep 17 00:00:00 2001
From: "Wamm K. D" <jaft.r@outlook.com>
Date: Wed, 3 Aug 2022 19:05:08 -0500
Subject: [PATCH] Allow Hierarchy to delay computing children

Add an option to allow users to specify that computing the children of
the hierarchy should be delayed to when the user calls for them, by
utilizing the tree-widget :expander property.

* lisp/emacs-lisp/hierarchy.el (hierarchy-add-tree)
(hierarchy-add-trees):
Add parameter 'delay-children-p'.

* lisp/emacs-lisp/hierarchy.el (hierarchy--create-delayed-tree-widget): Add
function.

* lisp/emacs-lisp/hierarchy.el (hierarchy-convert-to-tree-widget):
Utilize ':expander' if delaying children.

* test/lisp/emacs-lisp/hierarchy-tests.el: Add tests for
delayed-children functionality.
---
 etc/NEWS                                |   8 ++
 lisp/emacs-lisp/hierarchy.el            |  85 +++++++++++---
 test/lisp/emacs-lisp/hierarchy-tests.el | 143 ++++++++++++++++++++++++
 3 files changed, 218 insertions(+), 18 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7e8ed465eb..41d39cb8c5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2142,6 +2142,14 @@ the shell session terminates.
 *** New user option 'calc-kill-line-numbering'.
 Set it to nil to exclude line numbering from kills and copies.
 
+** Hierarchy
+
++++
+*** Tree Display can delay computation of children.
+'hierarchy-add-tree' and 'hierarchy-add-trees' have an optional
+argument which allows tree-widget display to be activated and computed
+only when the user expands the node.
+
 ** Miscellaneous
 
 ---
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 6c95d86b47..4cb5ba64a8 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -71,7 +71,8 @@
                (:conc-name hierarchy--))
   (roots (list)) ; list of the hierarchy roots (no parent)
   (parents (make-hash-table :test 'equal)) ; map an item to its parent
-  (children (make-hash-table :test 'equal)) ; map an item to its childre
+  (children (make-hash-table :test 'equal)) ; map an item to its children
+  (delaying-parents (make-hash-table :test 'equal)) ; map an item to its childrenfn
   ;; cache containing the set of all items in the hierarchy
   (seen-items (make-hash-table :test 'equal)))  ; map an item to t
 
@@ -133,7 +134,8 @@ keys are :key and :test."
   "Create a hierarchy and return it."
   (hierarchy--make))
 
-(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn)
+(defun hierarchy-add-tree (hierarchy item parentfn
+                                     &optional childrenfn acceptfn delay-children-p)
   "In HIERARCHY, add ITEM.
 
 PARENTFN is either nil or a function defining the child-to-parent
@@ -151,27 +153,39 @@ CHILDRENFN are expected to be coherent with each other.
 
 ACCEPTFN is a function returning non-nil if its parameter (any object)
 should be an item of the hierarchy.  By default, ACCEPTFN returns non-nil
-if its parameter is non-nil."
+if its parameter is non-nil.
+
+DELAY-CHILDREN-P is a predicate determining whether the children that would
+normally be processed by CHILDRENFN should, instead, have their processing be
+delayed and stored to be processed by CHILDRENFN when the child is selected
+during use of the hierarchy."
   (unless (hierarchy-has-item hierarchy item)
     (let ((acceptfn (or acceptfn #'identity)))
       (hierarchy--seen-items-add hierarchy item)
       (let ((parent (and parentfn (funcall parentfn item))))
         (when (funcall acceptfn parent)
           (hierarchy--add-relation hierarchy item parent acceptfn)
-          (hierarchy-add-tree hierarchy parent parentfn childrenfn)))
-      (let ((children (and childrenfn (funcall childrenfn item))))
-        (mapc (lambda (child)
-                (when (funcall acceptfn child)
-                  (hierarchy--add-relation hierarchy child item acceptfn)
-                  (hierarchy-add-tree hierarchy child parentfn childrenfn)))
-              children)))))
-
-(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn)
+          (hierarchy-add-tree hierarchy parent
+                              parentfn (if delay-children-p nil childrenfn))))
+      (if (and childrenfn delay-children-p)
+          (map-put! (hierarchy--delaying-parents hierarchy) item childrenfn)
+        (let ((children (and childrenfn (funcall childrenfn item))))
+          (map-put! (hierarchy--delaying-parents hierarchy) item nil)
+          (mapc (lambda (child)
+                  (when (funcall acceptfn child)
+                    (hierarchy--add-relation hierarchy child item acceptfn)
+                    (hierarchy-add-tree hierarchy child parentfn childrenfn)))
+                children))))))
+
+(defun hierarchy-add-trees (hierarchy items parentfn
+                                      &optional childrenfn acceptfn delay-children-p)
   "Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
 
-PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
+PARENTFN, CHILDRENFN, ACCEPTFN, and DELAY-CHILDREN-P have the same meaning as in
+`hierarchy-add'."
   (seq-map (lambda (item)
-             (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
+             (hierarchy-add-tree hierarchy item parentfn
+                                 childrenfn acceptfn delay-children-p))
            items))
 
 (defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
@@ -541,6 +555,30 @@ nil.  The buffer is returned."
     buffer))
 
 (declare-function widget-convert "wid-edit")
+(defun hierarchy--create-delayed-tree-widget (elem labelfn indent childrenfn)
+  "Return a list of tree-widgets for the children generated.
+
+ELEM is the element of the hierarchy passed from
+`hierarchy-convert-to-tree-widget'; it and the CHILDRENFN are used to generate
+the children of the element dynamically.
+
+LABELFN is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+INDENT is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+CHILDRENFN is the function used to discover the children of ELEM."
+  (lambda (widget)
+    (mapcar
+     (lambda (item)
+       (widget-convert
+        'tree-widget
+        :tag (hierarchy-labelfn-to-string labelfn item indent)
+        :expander (hierarchy--create-delayed-tree-widget
+                   item
+                   labelfn
+                   (1+ indent)
+                   childrenfn)))
+     (funcall childrenfn elem))))
 (defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
   "Return a tree-widget for HIERARCHY.
 
@@ -550,10 +588,21 @@ node label."
   (require 'wid-edit)
   (require 'tree-widget)
   (hierarchy-map-tree (lambda (item indent children)
-                        (widget-convert
-                         'tree-widget
-                         :tag (hierarchy-labelfn-to-string labelfn item indent)
-                         :args children))
+                        (let ((childrenfn (map-elt
+                                           (hierarchy--delaying-parents hierarchy)
+                                           item)))
+                          (apply
+                           #'widget-convert
+                           (list 'tree-widget
+                                 :tag (hierarchy-labelfn-to-string labelfn item indent)
+                                 (if childrenfn :expander :args)
+                                 (if childrenfn
+                                     (hierarchy--create-delayed-tree-widget
+                                      item
+                                      labelfn
+                                      (1+ indent)
+                                      childrenfn)
+                                   children)))))
                       hierarchy))
 
 (defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el
index 41d3f2f3cc..d83460a2ba 100644
--- a/test/lisp/emacs-lisp/hierarchy-tests.el
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -552,5 +552,148 @@
     (hierarchy-sort organisms)
     (should (equal (hierarchy-roots organisms) '(animal plant)))))
 
+(defun hierarchy-examples-delayed--find-number (num)
+  "Find a number, NUM, by adding 1s together until you reach it.
+This is entire contrived and mostly meant to be purposefully inefficient to
+not be possible on a large scale.
+Running the number 200 causes this function to crash; running this function in
+`hierarchy-add-tree' with a root of 80 and no delayed children causes that to
+ crash.
+If generating hierarchy children is not delayed, tests for that functionality
+should fail as this function will crash."
+
+  (funcall (lambda (funct) (funcall funct 1 funct))
+           (lambda (n funct)
+             (if (< n num)
+                 (+ 1 (funcall funct (+ 1 n) funct))
+               1))))
+
+(defun hierarchy-examples-delayed--childrenfn (hier-elem)
+  "Return the children of HIER-ELEM.
+Basially, feed the number, minus 1, to `hierarchy-examples-delayed--find-number'
+and then create a list of the number plus 0.0–0.9."
+
+  (when (> hier-elem 1)
+    (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem))))
+      (mapcar (lambda (dec) (+ next dec)) '(.0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))))
+
+(ert-deftest hierarchy-delayed-add-one-root ()
+  (let ((parentfn (lambda (_) nil))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(190)))))
+
+(ert-deftest hierarchy-delayed-add-one-item-with-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(191)))
+    (should (equal (hierarchy-children hierarchy 191) '(190)))
+    (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-one-item-with-parent-and-grand-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191)
+                      (191 192))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(192)))
+    (should (equal (hierarchy-children hierarchy 192) '(191)))
+    (should (equal (hierarchy-children hierarchy 191) '(190)))
+    (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-same-root-twice ()
+  (let ((parentfn (lambda (_) nil))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(190)))))
+
+(ert-deftest hierarchy-delayed-add-same-child-twice ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(191)))
+    (should (equal (hierarchy-children hierarchy 191) '(190)))
+    (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-item-and-its-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (hierarchy-add-tree hierarchy 191 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(191)))
+    (should (equal (hierarchy-children hierarchy 191) '(190)))
+    (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-item-and-its-child ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 191 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(191)))
+    (should (equal (hierarchy-children hierarchy 191) '(190)))
+    (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-two-items-sharing-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191)
+                      (190.5 191))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (hierarchy-add-tree hierarchy 190.5 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(191)))
+    (should (equal (hierarchy-children hierarchy 191) '(190 190.5)))))
+
+(ert-deftest hierarchy-delayed-add-two-hierarchies ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 191)
+                      (circle 'shape))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 190 parentfn
+                        #'hierarchy-examples-delayed--childrenfn nil t)
+    (hierarchy-add-tree hierarchy 'circle parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(191 shape)))
+    (should (equal (hierarchy-children hierarchy 191) '(190)))
+    (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))
+
+(ert-deftest hierarchy-delayed-add-trees ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (190 '191)
+                      (190.5 '191)
+                      (191 '192))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-trees hierarchy '(191 190.5) parentfn
+                         #'hierarchy-examples-delayed--childrenfn nil t)
+    (should (equal (hierarchy-roots hierarchy) '(192)))
+    (should (equal (hierarchy-children hierarchy '192) '(191)))
+    (should (equal (hierarchy-children hierarchy '191) '(190 190.5)))))
+
 (provide 'hierarchy-tests)
 ;;; hierarchy-tests.el ends here
-- 
2.37.1