From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "Wamm K. D." Newsgroups: gmane.emacs.bugs Subject: bug#55900: [PATCH] Hierarchy =?UTF-8?Q?=E2=80=93?= Defer the Computation of Children Date: Sun, 12 Jun 2022 04:01:25 -0500 Message-ID: References: <83wndny5i7.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="22682"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.1 (gnu/linux) Cc: 55900@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Jun 12 11:02:21 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1o0JUC-0005lG-Or for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 12 Jun 2022 11:02:21 +0200 Original-Received: from localhost ([::1]:43920 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1o0JUB-0008Be-AZ for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 12 Jun 2022 05:02:19 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:48014) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1o0JTu-0008A8-QE for bug-gnu-emacs@gnu.org; Sun, 12 Jun 2022 05:02:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:60828) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1o0JTu-0006OQ-3n for bug-gnu-emacs@gnu.org; Sun, 12 Jun 2022 05:02:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1o0JTu-0007XO-1J for bug-gnu-emacs@gnu.org; Sun, 12 Jun 2022 05:02:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "Wamm K. D." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 12 Jun 2022 09:02:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 55900 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 55900-submit@debbugs.gnu.org id=B55900.165502449828930 (code B ref 55900); Sun, 12 Jun 2022 09:02:01 +0000 Original-Received: (at 55900) by debbugs.gnu.org; 12 Jun 2022 09:01:38 +0000 Original-Received: from localhost ([127.0.0.1]:54725 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1o0JTW-0007WY-0a for submit@debbugs.gnu.org; Sun, 12 Jun 2022 05:01:38 -0400 Original-Received: from mail-bn8nam11olkn2032.outbound.protection.outlook.com ([40.92.20.32]:54496 helo=NAM11-BN8-obe.outbound.protection.outlook.com) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1o0JTT-0007WG-3L for 55900@debbugs.gnu.org; Sun, 12 Jun 2022 05:01:36 -0400 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=HdNxiUl6m88n6zoNa49JW8F07jaUp3SZUtNQWFUtWdjHPpffc/OZTJtm8+8TPAAAHNlh3/G+hCWoMY5I03vrww/X2Xpb4VTCP75RSk8KusMro2jKB2DHea9jWscqemOEOyT2nBu2WJCrGnrNOtSBtuBMdoc7NXerS79N7U3jg8RXZIvqHhjYMSjDnCUh/oOSCEA3fLluSbpa7whzp55r+DtxVFTKJhPG5Gixpt9tgwS7HzAPikGVxEXd//XQp8OGgcz1XOHzWcvR74pUYHcF+C+mdOK/gCE5m2GW6xwERJ52mUg68wOx7eMB+R9EHXNIbXdltonpkdd1LGoRObumYg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-AntiSpam-MessageData-ChunkCount:X-MS-Exchange-AntiSpam-MessageData-0:X-MS-Exchange-AntiSpam-MessageData-1; bh=8CqU187t8Z6IM+yuDes4UrjRn9GJWKayWGwvUu6HrdI=; b=M31pIwEmyM4WsGukbis8JSeYAsayavfAH2XVHNBV/swMBIVBPsbWY5Y2MRSDDJ2PU0DKGm16CDXtvhXpsOWpB1OK3MjsdN90OfVzoxragVaRlKIe08hAPofi4KKBkuAFcSb967UzcPKLm4oD06L3HXDQFLeV0qSZC9+0A5hbOXVlZegWOLGI2pgWK1SmDZuKxYDJMP3bODKhjDiFHbYNqnG5Kr6QGiVsnNOoF1LjgylhVhmCluuHDCZkEv0JlmZ1oFvj3bmNzU+terxhT0xtdHMAiMhhVvgSSsjGQ0T2nx4oGTUcdf2jDWKG6aM8OXaSQAzIz7ZbPq4oDatQrfmssQ== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=none; dmarc=none; dkim=none; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=outlook.com; s=selector1; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=8CqU187t8Z6IM+yuDes4UrjRn9GJWKayWGwvUu6HrdI=; b=pdMOOnGmFtzaCOCr4eKTDc0nV1baLhJxMPtjCL7P5ywRibTtfw1+j4l5GT15G3Wb/ULALVOI/PV12LimRSiXQ4Hrp9azcRvfEKXmqVHTLQeX/Ta6QVv0QXYj9nJ1f/kW3IkWiGUyhv/oto5chTVK1PMEr3bxg8dHvA3hp/NdRvMkwVCU7iHA0ZQXScBAhz8iDnvhgAWwgLevPoU4xUjxQl1B/Wc2B/bvD2U+Z7Lr2MCLh99DABXWi9IaCCH0xVPq7RDahYIyS/iXyaSvssm0C71TDVsqoFfozSCqndAy2DvvpnEMTtkBLjUZ0vU5xIcnODFXFbwNw6JcQck4s5Cutw== Original-Received: from BY5PR07MB7029.namprd07.prod.outlook.com (2603:10b6:a03:1f0::20) by BYAPR07MB6389.namprd07.prod.outlook.com (2603:10b6:a03:123::15) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.5332.13; Sun, 12 Jun 2022 09:01:28 +0000 Original-Received: from BY5PR07MB7029.namprd07.prod.outlook.com ([fe80::8dc1:2aac:41b5:1e74]) by BY5PR07MB7029.namprd07.prod.outlook.com ([fe80::8dc1:2aac:41b5:1e74%3]) with mapi id 15.20.5332.019; Sun, 12 Jun 2022 09:01:28 +0000 In-Reply-To: <83wndny5i7.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 11 Jun 2022 04:21:59 -0400") X-TMN: [BFqwToqb/CQ3pVwes2XFbHN/yJZzmuDo] X-ClientProxiedBy: MN2PR19CA0069.namprd19.prod.outlook.com (2603:10b6:208:19b::46) To BY5PR07MB7029.namprd07.prod.outlook.com (2603:10b6:a03:1f0::20) X-Microsoft-Original-Message-ID: <87mtei1cii.fsf@outlook.com> X-MS-Exchange-MessageSentRepresentingType: 1 X-MS-PublicTrafficType: Email X-MS-Office365-Filtering-Correlation-Id: 4b1e7d1d-4a49-4f3f-e1fe-08da4c522299 X-MS-TrafficTypeDiagnostic: BYAPR07MB6389:EE_ X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: Mev/z/9405+HvlJHHmTuWXFp9cK3e8NklvQh99KG8bRJpFoLeQE8bdPVvtzvRLiWA6+96A09ebXZ+e5nLdMFJwi6mz+WM8tygKa3IxlHRBzFVcs7QR14Bt7LGK8AsH6a3qqgLRdT/JKSR+ICrBPOFcWSe0mR5CbMpIzWt0HCTjfASgCZ9n7vLwU1/VcfwIBZMtbnkEQbi0aBpfNLJ8K8KWST9iA7S4t/cqOq9kJm2xrYsBhXF/eekK44+vSp6ktQdjxd9WF0vfdX6YhgbO9DeSxyqYKuC7FJR7pEb764FNui9YE/I9eQrXvXcPmum1LiSHA6MkAvUBdvcoy1PLwFIrLYekFRxjmhCmk7dIHi/RVKY3S0fwaPnT+FrSTOQC3m9lHcxN3oFnF/TL/+WJ+1TrNi0QTQSdQSZvhKlxWCSo7TiruKNyRgcHJ5D9K0m2uY2iF08MKthBM/2uRmX8vVME+YXzO/EMqRZ7yp2Nk5gW53aYw1AAJyzQNFtTgR/MFg66mg36E3YU7I7mdxMw8xPy98ofEVWQBVnBxgOQGbQ8qyZsVHHZ9nPicSxrbXNqAVIPFOJBZC+8S2kSMrmaY2yA== X-MS-Exchange-AntiSpam-MessageData-ChunkCount: 1 X-MS-Exchange-AntiSpam-MessageData-0: Q8s5y0aFqmrA1fs1Ww12fjd89Dtn7I2V3H/OuD34bVscwbRtsLSuSmMDIWHjA07/jhtWDbqTeyS71d8mk69t77vpajIy0Tnem9eRUiBvBLxNj4DF29mB6EOWCxWuqhgA8pUx0iXFHaOneO+YcIypGw3qUL8Eq0sn7vURLTm5fHaFVEnGas49AP+2ArKvRX0XVUp2YOMRHPVmgu7wt+9v4z5Y6DpaSXlgGy6ULULgdy/WNrFwA4h6L+ja2tS+ewNanm+HH6dS3BNUgQ1kIaVz6XAkG1iCKEOsooKUXj9JwUc5jyoW2xUNdqcOKZdvlbwGoc06vC51Cmor/td/R9KykpvnQqAz47I/b0YtfFBTwLNng/2ZK8hJzYz2Y1Hk6vLaNH3Zvq8Ys9l9UrJfO+uuOZYyXPwf7MzUfB81vX75ARRgpNljvSoPZ0fhVxNcVX55EYdHmYvzlZFQJSJqHoV4w8t6ZHEgtjXiBz7QQanc/a8BGDl0PYXKlD7xSahEszO9Iade6dVyTqg+0ZBoBwD176xl4H+0L/Lee6M1QKkSG+JjXdA7Il+PSC5v4P7ly5COGYW0IzQHa09hsLl2UYLlYJwnR/zIIf9r2KqFhJ/XsV4sFUQY5jC35721ZGxdAM89+G6ojZStIUcrRotaDy9aWRZN1/POTjCwLdAfVH/IiwmynXprrnmxCGuGqQPvswOLSFvttu1Z3Dq8lLY4y/vDLSInoHxsZsKhQ/sSXk+CNBfwysfoyA0L1kJJoG Yeavw1EEcGqjFbILSZgncuND++iKZk2XieQ49ge2tchYe4pSdOmtCVWiazTD2bcTXX75IMrmGoM42w21l0Jc99KlRUnZrfD8Ep X-OriginatorOrg: outlook.com X-MS-Exchange-CrossTenant-Network-Message-Id: 4b1e7d1d-4a49-4f3f-e1fe-08da4c522299 X-MS-Exchange-CrossTenant-AuthSource: BY5PR07MB7029.namprd07.prod.outlook.com X-MS-Exchange-CrossTenant-AuthAs: Internal X-MS-Exchange-CrossTenant-OriginalArrivalTime: 12 Jun 2022 09:01:28.1959 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: 84df9e7f-e9f6-40af-b435-aaaaaaaaaaaa X-MS-Exchange-CrossTenant-RMS-PersistedConsumerOrg: 00000000-0000-0000-0000-000000000000 X-MS-Exchange-Transport-CrossTenantHeadersStamped: BYAPR07MB6389 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:234344 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable On Sat. (Jun 11, 2022) at 04:21:59 AM -04, Eli Zaretskii wro= te: >> From: "Wamm K. D." >> Date: Sat, 11 Jun 2022 01:52:13 -0500 >>=20 >> Pretty much as the subject describes; this should allow for users to >> lazily load hierarchy branches when loading everything at once would >> otherwise be too consuming, up-front (or if dealing with an infinite >> tree). > > Thanks. > >> * lisp/emacs-lisp/hierarchy.el (hierarchy-add-tree) (hierarchy-add-trees= ): >> Add parameter 'delay-children-p'. > > Please use our style of commit log messages. The above should be > > * lisp/emacs-lisp/hierarchy.el (hierarchy-add-tree) > (hierarchy-add-trees): Add parameter 'delay-children-p'. Mmm; gotcha. This hadn't been clear, to me; I thought the example given in the CONTRIBUTE file was that way because the line was long and the main point of its demonstration was what to do with a case of more than one function. I've adjusted the commit message appropriately, now. >> +(defun hierarchy--create-delayed-tree-widget (elem labelfn indent fn) >> + "Return a list of tree-widgets for a hierarchy created from the child= renfn. > > The first line of the doc string should ideally mention the > arguments. This one doesn't, and it also seems to misname one > argument: it's FN, not childrenfn, right? Yeah; I was referencing the fact that this function is called childrenfn in a bunch of other functions but, for whatever reason, I didn't call it that here so that's why it isn't all-capitalized (while the reference to it, at the end, is and says FN). But that's weird; I don't know why I went with that name when I could've just=E2=80=A6used the same name as ever= y other function. I've corrected that, standardized. > Can you add some tests of this new functionality? I've added some; I didn't created tests for children functionality since the delayed computation means there aren't children (until someone activates the tree-widget and the children are computed with the provided function) but I create some tests to check that the root and parent elements were still functioning as expected, when using delayed children. > Also, I think this warrants a NEWS entry to describe the new feature. I've added that, as well. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-Allow-Hierarchy-to-delay-computing-children.patch Content-Transfer-Encoding: quoted-printable Content-Description: Patch to Hierarchy library to delay computation of children nodes >From 1ad834830c5d35b92c9e5ef2161d875218c7c1b6 Mon Sep 17 00:00:00 2001 From: "Wamm K. D" Date: Sun, 12 Jun 2022 03:48:01 -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 | 9 ++ lisp/emacs-lisp/hierarchy.el | 86 ++++++++++++--- test/lisp/emacs-lisp/hierarchy-tests.el | 141 ++++++++++++++++++++++++ 3 files changed, 218 insertions(+), 18 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 424d1250c3..a8c863cd20 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1756,6 +1756,15 @@ Enabling this minor mode turns on hiding header mate= rial, like If non-nil, files untracked by a VCS are considered to be part of the project by a VC project based on that VCS. =20 +** Hierarchy + ++++ +*** Tree Display can delay computation of children +'hierarchy-add-tree' and 'hierarchy-add-trees' have an optional +argument, 'delay-children-p', which allows storing 'childrenfn' to the +nodes of a tree-widget display to be activated and computed only when +the users expands the node. + --- ** The autoarg.el library is now marked obsolete. This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el index 6c95d86b47..316cdcb30b 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 c= hildrenfn ;; cache containing the set of all items in the hierarchy (seen-items (make-hash-table :test 'equal))) ; map an item to t =20 @@ -133,7 +134,8 @@ keys are :key and :test." "Create a hierarchy and return it." (hierarchy--make)) =20 -(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn ac= ceptfn) +(defun hierarchy-add-tree (hierarchy item parentfn + &optional childrenfn acceptfn delay-c= hildren-p) "In HIERARCHY, add ITEM. =20 PARENTFN is either nil or a function defining the child-to-parent @@ -151,27 +153,39 @@ CHILDRENFN are expected to be coherent with each othe= r. =20 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 woul= d +normally be processed by CHILDRENFN should, instead, have their processing= be +delayed and stored to be processed by CHILDRENFN when the child is selecte= d +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 childrenf= n) + (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 childrenf= n))) + 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. =20 -PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-a= dd'." +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 accept= fn)) + (hierarchy-add-tree hierarchy item parentfn + childrenfn acceptfn delay-children-p)) items)) =20 (defun hierarchy-add-list (hierarchy list &optional wrap childrenfn) @@ -541,6 +555,31 @@ nil. The buffer is returned." buffer)) =20 (declare-function widget-convert "wid-edit") +(defun hierarchy--create-delayed-tree-widget (elem labelfn indent children= fn) + "Return a list of tree-widgets for the children generated by calling +CHILDRENFN on ELEM. + +ELEM is the element of the hierarchy passed from +`hierarchy-convert-to-tree-widget'; it and the CHILDRENFN are used to gene= rate +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. =20 @@ -550,10 +589,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 in= dent) - :args children)) + (let ((childrenfn (map-elt + (hierarchy--delaying-parents hi= erarchy) + 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-widge= t + item + labelfn + (1+ indent) + childrenfn) + children))))) hierarchy)) =20 (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..8ba86966ea 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -552,5 +552,146 @@ (hierarchy-sort organisms) (should (equal (hierarchy-roots organisms) '(animal plant))))) =20 +(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 t= o +not be possible on a large scale. +Running the number 200 causes this function to crash; running this functio= n in +`hierarchy-add-tree' with a root of 80 and no delayed children causes that= to + 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-n= umber' +and then create a list of the number plus 0.0=E2=80=930.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 --=20 2.36.1 --=-=-=--