bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Morgan Willcock]

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

Tags: patch

Attached is a patch which rewrites 'speedbar-expand-line-descendants'.

The previous version could get into an infinite loop by reaching the
maximum recursion depth, although in practice the slow speed meant that
most people would probably abort the operation before reaching that
point.

The majority of the slowdown was because the motion commands being used
were the variants which looked up information for every entry, displayed
the information as a message, and adjusted the cursor position.  The
messages were not readable because of being continually overwritten.

Here is a way to demonstrate that stack depth was increasing for items
at the same level, that the messages were not readable, and how slow the
whole process was:

  rm -rf /tmp/project
  mkdir /tmp/project
  for i in $(seq 1 50); do echo "(defun fun-$i ())" >> /tmp/project/file1.el; done
  for i in $(seq 1 50); do echo "(defun fun-$i ())" >> /tmp/project/file2.el; done
  emacs -Q \
        --eval="(find-file \"/tmp/project/file1.el\")" \
        --eval "(speedbar-get-focus)" \
        --eval "(profiler-start 'cpu)" \
        --eval "(speedbar-expand-line-descendants)" \
        --eval "(profiler-stop)" \
        --eval "(profiler-report)"

...that should expand every entry in file1.el and not touch the entries
in file2.el.

The replacement function is significantly faster.  Messages are only
used to indicate that the function is running and when it is finished -
the result is similar to manually clicking every node open.

Thanks,
Morgan


In GNU Emacs 30.0.91 (build 2, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.16.0, Xaw3d scroll bars) of 2024-09-12 built on inspiron
Windowing system distributor 'The X.Org Foundation', version 11.0.12101007
System Description: Debian GNU/Linux 12 (bookworm)

Configured using:
 'configure --with-native-compilation=aot --with-xml2
 --with-x-toolkit=lucid'


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Rewrite-speedbar-expansion-for-all-descendants.patch --]
[-- Type: text/patch, Size: 2447 bytes --]

From 0e25d28bfbef31c20ec22c2e508933b3824a8172 Mon Sep 17 00:00:00 2001
From: Morgan Willcock <morgan@ice9.digital>
Date: Sat, 28 Sep 2024 19:11:11 +0100
Subject: [PATCH] Rewrite speedbar expansion for all descendants

Rewrite 'speedbar-expand-line-descendants' to avoid getting into
an infinite loop by reaching max-lisp-eval-depth.  The new
method avoids querying and displaying information for every
movement, instead using a single message to indicate that
expansion is in progress, and so is significantly faster.

* lisp/speedbar.el (speedbar-expand-line-descendants): Use
simpler line motion and no recursion.  Output messages
indicating when expansion is in progress and when it is
completed.
---
 lisp/speedbar.el | 31 ++++++++++++++++---------------
 1 file changed, 16 insertions(+), 15 deletions(-)

diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index c13c977938b..11e11e1e56c 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3172,21 +3172,22 @@ speedbar-expand-line-descendants
   "Expand the line under the cursor and all descendants.
 Optional argument ARG indicates that any cache should be flushed."
   (interactive "P")
-  (save-restriction
-    (narrow-to-region (line-beginning-position)
-                      (line-beginning-position 2))
-    (speedbar-expand-line arg)
-    ;; Now, inside the area expanded here, expand all subnodes of
-    ;; the same descendant type.
-    (save-excursion
-      (speedbar-next 1) ;; Move into the list.
-      (let ((err nil))
-        (while (not err)
-	  (condition-case nil
-	      (progn
-	        (speedbar-expand-line-descendants arg)
-	        (speedbar-restricted-next 1))
-	    (error (setq err t))))))))
+  (dframe-message "Expanding all descendants...")
+  (save-excursion
+    (with-restriction
+        ;; Narrow around the top-level item.
+        (line-beginning-position)
+        (condition-case nil
+            (save-excursion
+              (speedbar-restricted-move 1)
+              (line-beginning-position))
+          (error (line-beginning-position 2)))
+      ;; Expand every line until the end of the restriction.
+      (while (zerop (progn
+                      (speedbar-expand-line arg)
+                      (forward-line 1))))))
+  (dframe-message "Expanding all descendants...done")
+  (speedbar-position-cursor-on-line))
 
 (defun speedbar-contract-line-descendants ()
   "Expand the line under the cursor and all descendants."
-- 
2.39.5

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Eli Zaretskii]

> From: Morgan Willcock <morgan@ice9.digital>
> Date: Sat, 28 Sep 2024 20:05:26 +0100
> 
> Attached is a patch which rewrites 'speedbar-expand-line-descendants'.
> 
> The previous version could get into an infinite loop by reaching the
> maximum recursion depth, although in practice the slow speed meant that
> most people would probably abort the operation before reaching that
> point.
> 
> The majority of the slowdown was because the motion commands being used
> were the variants which looked up information for every entry, displayed
> the information as a message, and adjusted the cursor position.  The
> messages were not readable because of being continually overwritten.
> 
> Here is a way to demonstrate that stack depth was increasing for items
> at the same level, that the messages were not readable, and how slow the
> whole process was:
> 
>   rm -rf /tmp/project
>   mkdir /tmp/project
>   for i in $(seq 1 50); do echo "(defun fun-$i ())" >> /tmp/project/file1.el; done
>   for i in $(seq 1 50); do echo "(defun fun-$i ())" >> /tmp/project/file2.el; done
>   emacs -Q \
>         --eval="(find-file \"/tmp/project/file1.el\")" \
>         --eval "(speedbar-get-focus)" \
>         --eval "(profiler-start 'cpu)" \
>         --eval "(speedbar-expand-line-descendants)" \
>         --eval "(profiler-stop)" \
>         --eval "(profiler-report)"
> 
> ...that should expand every entry in file1.el and not touch the entries
> in file2.el.
> 
> The replacement function is significantly faster.  Messages are only
> used to indicate that the function is running and when it is finished -
> the result is similar to manually clicking every node open.

Thanks.  Unfortunately, speedbar doesn't have a test suite, so I would
like to ask how you tested this rewrite, and whether we could have
some tests for this added to the test suite.

Regardless, it would be good to have both old and the new code
annotated with explanations of what each non-trivial line does, to
allow independent verification of the correctness of the rewrite by
people who are not familiar with speedbar code and don't immediately
understand the effects of a call to speedbar-naxt or
speedbar-restricted-move.

Also, this comment in the old code bothers me:

> -    ;; Now, inside the area expanded here, expand all subnodes of
> -    ;; the same descendant type.

What does it mean by "the same descendant type", and how does the old
and the new code make sure they expand only those descendants?

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Morgan Willcock]

Eli Zaretskii <eliz@gnu.org> writes:

> Thanks.  Unfortunately, speedbar doesn't have a test suite, so I would
> like to ask how you tested this rewrite, and whether we could have
> some tests for this added to the test suite.

I've been testing by expanding all descendent items interactively,
either with test files which generate a lot of items or within the Emacs
source tree.

I wouldn't be against adding tests but it doesn't look like there are
many ways to query the speedbar state, which is probably why the
original code is not testing whether nodes are expandable before trying
to expand them.  Both the original and the new code and fundamentally
doing the same thing by assuming that each new line may be expanded and
trying to expand it - moving "into" a sub-list is just moving forward
because if expansion was possible it has occurred.

I could probably craft a test which would demonstrate the old code
hitting a recursion limit, but fundamentally the problem was the speed
and excessive message output.

> Regardless, it would be good to have both old and the new code
> annotated with explanations of what each non-trivial line does, to
> allow independent verification of the correctness of the rewrite by
> people who are not familiar with speedbar code and don't immediately
> understand the effects of a call to speedbar-naxt or
> speedbar-restricted-move.

speedbar-next = forward-line + display message for item + reposition
cursor

speedbar-restricted-move = move to the next item in the list at the
current level or signal an error if the end of the list is reached

speedbar-restricted-next = speedbar-restricted-move + display message
for item

Here is the original code my comments instead of the original comments:

  (defun speedbar-expand-line-descendants (&optional arg)
    "Expand the line under the cursor and all descendants.
  Optional argument ARG indicates that any cache should be flushed."
    (interactive "P")
    (save-restriction
      ;; The recursion of the original code means that sibling items below
      ;; the first item were also being accidentally expanded.  Narrow the
      ;; buffer around the current item to prevent opening all sibling
      ;; items.  bug#35014
      (narrow-to-region (line-beginning-position)
                        (line-beginning-position 2))
      ;; Assume that the current line can be expanded.
      (speedbar-expand-line arg)
      (save-excursion
        ;; Move forward.  Where current line did not expand this
        ;; effectively moves to the next sibling or the end of the buffer
        ;; restriction.  Display a description of the newly moved to item
        ;; as a message.  Readjust the column position of point.
        (speedbar-next 1)
        ;; Loop across all siblings until an error is signalled.
        (let ((err nil))
          (while (not err)
            (condition-case nil
                (progn
                  ;; Assume that the item is expandable and recursively
                  ;; expand it.
                  (speedbar-expand-line-descendants arg)
                  ;; Move to the next item at the current level or signal
                  ;; an error.  Display a description of the newly moved
                  ;; to item as a message.
                  (speedbar-restricted-next 1))
              (error (setq err t))))))))

To stop the continual stream of messages and cursor repositioning of
calling speedbar-next, it can just be replaced with forward-line because
that is all speedbar-next does to move.

To stop the continual stream of messages from speedbar-restricted-next
it can just be replaced with speedbar-restricted-move which is exactly
the same thing but without the message output.

So the majority of the speedup is just done by those two replacements,
and all that should have changed is that now no messages are being
produced.  To make it non-recursive and add the status message to
indicate that something is happening, what I've actually done is change
the fix which was applied for bug#35014.  Instead of narrowing
recursively to avoid accidentally running into siblings, the narrowing
is setup once by using speedbar-restricted-move to find the next
sibling.  The logic for expansion is effectively still the same as a
depth first traversal but without the messages being generated:

  (defun speedbar-expand-line-descendants (&optional arg)
    "Expand the line under the cursor and all descendants.
  Optional argument ARG indicates that any cache should be flushed."
    (interactive "P")
    (dframe-message "Expanding all descendants...")
    (save-excursion
      (with-restriction
          ;; Narrow around the top-level item to ensure that later sibling
          ;; items will not be entered.
          (line-beginning-position)
          (condition-case nil
              (save-excursion
                (speedbar-restricted-move 1)
                ;; The line beginning position of the next sibling item.
                (line-beginning-position))
            ;; This was the last sibling item so just apply the
            ;; restriction around the current item, in the same way that
            ;; the previous fix for bug#35014 did.
            (error (line-beginning-position 2)))
        ;; Expand every line until the end of the restriction.
        (while (zerop (progn
                        ;; Assume that the line will expand and try to
                        ;; expand it.
                        (speedbar-expand-line arg)
                        ;; Moving forwards will be moving into the
                        ;; expanded lists if one opened, or moving to a
                        ;; sibling or end of restriction if there was no
                        ;; expansion.
                        (forward-line 1))))))
    (dframe-message "Expanding all descendants...done")
    ;; Reposition point to match the previous behavior.
    (speedbar-position-cursor-on-line))

> Also, this comment in the old code bothers me:
>
>> -    ;; Now, inside the area expanded here, expand all subnodes of
>> -    ;; the same descendant type.
>
> What does it mean by "the same descendant type", and how does the old
> and the new code make sure they expand only those descendants?

I don't know what it means by "type" because the code only deals with
siblings and children.  I think it means depth-first expansion of all
siblings.

The old code pre-bug#35014 did not ensure that it only expanded
descendants and just ran until the end of the buffer.

The old code with the fix for bug#35014 narrowed each item recursively
with the narrowing around the top level preventing a top-level sibling
being reached.

The new code just sets up the narrowing once around the top-level item
and then effectively runs the same expansion logic but without the item
look and message output.  The messages were being generated by calling
speedbar-item-info, and I cannot see how calling that repeatedly during
expansion is required when someone can just click the nodes open with
the mouse and also skip those calls.

I can re-send the patch with additional comments (more similar to the
above) if that helps.

Thanks,
Morgan

-- 
Morgan Willcock

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Morgan Willcock]

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

Morgan Willcock <morgan@ice9.digital> writes:

> The old code with the fix for bug#35014 narrowed each item recursively
> with the narrowing around the top level preventing a top-level sibling
> being reached.

The change that was made in bug#35014 looks like it broke the expansion
when the item was already partially expanded, so attached is a modified
version of the patch that completely removes the narrowing-per-item
approach and also includes more comments.

Thanks,
Morgan

-- 
Morgan Willcock

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Rewrite-speedbar-expansion-for-all-descendants.patch --]
[-- Type: text/x-diff, Size: 3563 bytes --]

From aa17e562b9844a50b8b01777c83830d3c4ead963 Mon Sep 17 00:00:00 2001
From: Morgan Willcock <morgan@ice9.digital>
Date: Sat, 28 Sep 2024 19:11:11 +0100
Subject: [PATCH] Rewrite speedbar expansion for all descendants

Rewrite 'speedbar-expand-line-descendants' to avoid getting into
an infinite loop by reaching max-lisp-eval-depth.  The new
method avoids querying and displaying information for every
movement, instead using a single message to indicate that
expansion is in progress, and so is significantly faster.  The
narrowing per item introduced by the fix for bug#35014 is
removed because it prevented expanded descendant items when the
top-level item was already expanded.

* lisp/speedbar.el (speedbar-expand-line-descendants): Use
simpler line motion and no recursion.  Output messages
indicating when expansion is in progress and when it is
completed.  Fix expansion of descendants where the top-level
item was already expanded.
---
 lisp/speedbar.el | 45 ++++++++++++++++++++++++++++++---------------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index c13c977938b..723a5595854 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3172,21 +3172,36 @@ speedbar-expand-line-descendants
   "Expand the line under the cursor and all descendants.
 Optional argument ARG indicates that any cache should be flushed."
   (interactive "P")
-  (save-restriction
-    (narrow-to-region (line-beginning-position)
-                      (line-beginning-position 2))
-    (speedbar-expand-line arg)
-    ;; Now, inside the area expanded here, expand all subnodes of
-    ;; the same descendant type.
-    (save-excursion
-      (speedbar-next 1) ;; Move into the list.
-      (let ((err nil))
-        (while (not err)
-	  (condition-case nil
-	      (progn
-	        (speedbar-expand-line-descendants arg)
-	        (speedbar-restricted-next 1))
-	    (error (setq err t))))))))
+  (dframe-message "Expanding all descendants...")
+  (save-excursion
+    (with-restriction
+        ;; Narrow around the top-level item to ensure that later sibling
+        ;; items will not be entered.
+        (line-beginning-position)
+        (condition-case nil
+            (save-excursion
+              (speedbar-restricted-move 1)
+              ;; Use the line beginning position of the next sibling
+              ;; item to apply the restriction.
+              (line-beginning-position))
+          ;; This was the last sibling item so just apply the
+          ;; restriction to the end of the buffer.  This fixes the
+          ;; change applied in bug#35014 which prevented the top-level
+          ;; item from having its descendants expanded if it was already
+          ;; expanded.
+          (error (point-max)))
+      ;; Expand every line until the end of the restriction is reached.
+      (while (zerop (progn
+                      ;; Assume that the line will expand and try to
+                      ;; expand it.
+                      (speedbar-expand-line arg)
+                      ;; Moving forwards will be moving into the
+                      ;; expanded lists if one opened, into an already
+                      ;; expanded list if it was already open, to a
+                      ;; sibling, or to the end of restriction.
+                      (forward-line 1))))))
+  (dframe-message "Expanding all descendants...done")
+  (speedbar-position-cursor-on-line))
 
 (defun speedbar-contract-line-descendants ()
   "Expand the line under the cursor and all descendants."
-- 
2.39.5

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Morgan Willcock]

Morgan Willcock <morgan@ice9.digital> writes:

> The change that was made in bug#35014 looks like it broke the expansion
> when the item was already partially expanded, so attached is a modified
> version of the patch that completely removes the narrowing-per-item
> approach and also includes more comments.

Unfortunately the narrowing trick causes problems in some situations,
either the previous way from bug#35014 or using the result of point-max
(either too few entries or expanded to too many).

I'll try to an alternative way to move through the entries.

-- 
Morgan Willcock

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Morgan Willcock]

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

Attached is a patch for a replacement function and an additional patch
which adds tests for expanding all descendants.

I couldn't see a direct way to test a Speedbar without creating a frame,
and because the Speedbar code doesn't implement any type of hierarchy
itself I've used eieio-speedbar to make something minimal to test.

Each test runs by converting a list of strings into objects which
implement a Speedbar display, making state changes for the functions
being tested, and then converting the objects back into strings - this
was the simplest way I could find to create a reusable interface for
tests.  The conversion back to a string is customizable to allow
whatever state change is under test to be represented.

If the tests are problematic or considered too complicated, perhaps they
can just be used to test the current function and the replacement
function and not committed.  The current function fails 3/9 tests.

-- 
Morgan Willcock

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Rewrite-speedbar-expansion-for-all-descendants.patch --]
[-- Type: text/x-diff, Size: 3187 bytes --]

From 50c623de5e4ac3a101a2fa19de97f75132063554 Mon Sep 17 00:00:00 2001
From: Morgan Willcock <morgan@ice9.digital>
Date: Sat, 5 Oct 2024 18:33:51 +0100
Subject: [PATCH 1/2] Rewrite speedbar expansion for all descendants

Rewrite 'speedbar-expand-line-descendants' to avoid getting into
an infinite loop by reaching max-lisp-eval-depth.  The new
method avoids querying and displaying information for every
movement, instead using a single message to indicate that
expansion is in progress, and so is significantly faster.  The
narrowing per item introduced by the fix for bug#35014 is
removed because it prevented expanded descendant items when the
top-level item was already expanded.

* lisp/speedbar.el (speedbar--get-line-indent-level): New
function to return the indentation level of the current line.
(speedbar-expand-line-descendants): Use simpler line motion and
no recursion.  Output messages indicating when expansion is in
progress and when it is completed.  Fix expansion of descendants
where the top-level item was already expanded.
---
 lisp/speedbar.el | 37 ++++++++++++++++++++++---------------
 1 file changed, 22 insertions(+), 15 deletions(-)

diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index c13c977938b..38fb641acf7 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3168,25 +3168,32 @@ speedbar-toggle-line-expansion
 	(speedbar-do-function-pointer))
     (error (speedbar-position-cursor-on-line))))
 
+(defun speedbar--get-line-indent-level ()
+  "Return the indentation level of the current line."
+  (save-excursion
+    (beginning-of-line)
+    (if (looking-at "[0-9]+:")
+        (string-to-number (match-string 0))
+      0)))
+
 (defun speedbar-expand-line-descendants (&optional arg)
   "Expand the line under the cursor and all descendants.
 Optional argument ARG indicates that any cache should be flushed."
   (interactive "P")
-  (save-restriction
-    (narrow-to-region (line-beginning-position)
-                      (line-beginning-position 2))
-    (speedbar-expand-line arg)
-    ;; Now, inside the area expanded here, expand all subnodes of
-    ;; the same descendant type.
-    (save-excursion
-      (speedbar-next 1) ;; Move into the list.
-      (let ((err nil))
-        (while (not err)
-	  (condition-case nil
-	      (progn
-	        (speedbar-expand-line-descendants arg)
-	        (speedbar-restricted-next 1))
-	    (error (setq err t))))))))
+  (dframe-message "Expanding all descendants...")
+  (save-excursion
+    (let ((top-depth (speedbar--get-line-indent-level)))
+      ;; Attempt to expand the top-level item.
+      (speedbar-expand-line arg)
+      ;; Move forwards, either into the newly expanded list, onto an
+      ;; already expanded list, onto a sibling item, or to the end of
+      ;; the buffer.
+      (while (and (zerop (forward-line 1))
+                  (not (eobp))
+                  (> (speedbar--get-line-indent-level) top-depth)
+                  (speedbar-expand-line arg)))))
+  (dframe-message "Expanding all descendants...done")
+  (speedbar-position-cursor-on-line))
 
 (defun speedbar-contract-line-descendants ()
   "Expand the line under the cursor and all descendants."
-- 
2.39.5


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-initial-Speedbar-tests.patch --]
[-- Type: text/x-diff, Size: 14736 bytes --]

From eb4c17fbe64542a9877cd16753cda29188c700a0 Mon Sep 17 00:00:00 2001
From: Morgan Willcock <morgan@ice9.digital>
Date: Tue, 8 Oct 2024 17:34:20 +0100
Subject: [PATCH 2/2] Add initial Speedbar tests

Add initial Speedbar tests which test the operation of
'speedbar-expand-line-descendants'.

* test/lisp/speedbar-tests.el (speedbar-tests-container)
(eieio-speedbar-object-children)
(speedbar-tests-item)
(speedbar-tests--make-object)
(speedbar-tests--setup-strings)
(speedbar-tests--object-hierarchy)
(speedbar-tests--base-items)
(speedbar-tests--clean-up)
(speedbar-tests--initialize)
(speedbar-tests--object-name-expanded)
(speedbar-tests--object-name-function)
(speedbar-tests--objects-as-strings)
(speedbar-tests--state-test)
(speedbar-tests--expand-descendants-single)
(speedbar-tests--expand-descendants-nested)
(speedbar-tests--expand-descendants-nested-wide)
(speedbar-tests--expand-descendants-of-first)
(speedbar-tests--expand-descendants-of-first-expanded)
(speedbar-tests--expand-descendants-of-last)
(speedbar-tests--expand-descendants-of-last-expanded)
(speedbar-tests--expand-descendants-of-middle)
(speedbar-tests--expand-descendants-of-middle-expanded):
Test 'speedbar-expand-line-descendants'.
---
 test/lisp/speedbar-tests.el | 318 ++++++++++++++++++++++++++++++++++++
 1 file changed, 318 insertions(+)
 create mode 100644 test/lisp/speedbar-tests.el

diff --git a/test/lisp/speedbar-tests.el b/test/lisp/speedbar-tests.el
new file mode 100644
index 00000000000..5450d211b1a
--- /dev/null
+++ b/test/lisp/speedbar-tests.el
@@ -0,0 +1,318 @@
+;;; speedbar-tests.el --- Tests for speedbar.el  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'eieio-base)
+(require 'eieio-speedbar)
+
+(defclass speedbar-tests-container (eieio-named eieio-speedbar-file-button)
+  ((child-items :initarg :child-items
+                :type list))
+  "An expandable Speedbar item which can contain other items.")
+
+(cl-defmethod eieio-speedbar-object-children ((item speedbar-tests-container))
+  "Return the list of child items for ITEM."
+  (slot-value item 'child-items))
+
+(defclass speedbar-tests-item (eieio-named eieio-speedbar)
+  nil
+  "A Speedbar item which cannot contain other items.")
+
+(defun speedbar-tests--make-object (item-spec)
+  "Return an object representing a Speedbar item.
+
+The object is constructed based on the specification ITEM-SPEC which
+should be a cons pair of the form (NAME . CHILD-ITEMS).  NAME is a
+string which will be used for display purposes.  CHILD-ITEMS is a list
+of additional ITEM-SPEC values which will be referenced as children."
+  (let ((name (car item-spec))
+        (child-items (cdr item-spec)))
+    (unless (stringp name)
+      (error "Item name must be a string"))
+    (unless (listp child-items)
+      (error "Child-items must be a list"))
+    (if child-items
+        (speedbar-tests-container
+         :object-name name
+         :child-items (mapcar #'speedbar-tests--make-object
+                              child-items))
+      (speedbar-tests-item
+       :object-name name))))
+
+(defvar speedbar-tests--setup-strings nil
+  "An alist of strings which represents a hierarchy of Speedbar items.")
+
+(defvar speedbar-tests--object-hierarchy nil
+  "The current object hierarchy for the Speedbar being tested.")
+
+(defun speedbar-tests--base-items (_directory)
+  "Return the list of top-level objects for the Speedbar."
+  (setq speedbar-tests--object-hierarchy
+        (mapcar #'speedbar-tests--make-object
+                speedbar-tests--setup-strings)))
+
+(eieio-speedbar-create #'eieio-speedbar-make-map
+		       'eieio-speedbar-key-map
+		       'eieio-speedbar-menu
+		       "Test"
+		       #'speedbar-tests--base-items)
+
+(defun speedbar-tests--clean-up ()
+  "Clean-up after Speedbar test."
+  (when (framep speedbar-frame)
+    (delete-frame speedbar-frame)))
+
+(defun speedbar-tests--initialize ()
+  "Initialize a Speedbar for testing."
+  (speedbar-get-focus)
+  (speedbar-change-initial-expansion-list "Test"))
+
+(defun speedbar-tests--object-name-expanded (object)
+  "Return the string name of OBJECT when it is expanded."
+  (let ((name (eieio-speedbar-object-buttonname object)))
+    (if (slot-value object 'expanded)
+        (concat name "+")
+      name)))
+
+(defvar speedbar-tests--object-name-function
+  #'eieio-speedbar-object-buttonname
+  "The function which returns the string representation of an object.")
+
+(defun speedbar-tests--objects-as-strings (object-list)
+  "Return the object hierarchy OBJECT-LIST as an alist of strings.
+
+The string used to represent the object is determined by the function
+bound to `speedbar-tests--object-name-function' is a function, which
+should accept the object as the only argument and return a string to use
+as the name."
+  (mapcar (lambda (object)
+            (let ((name (funcall speedbar-tests--object-name-function
+                                 object))
+                  (child-items (eieio-speedbar-object-children
+                                object)))
+              (cons name (speedbar-tests--objects-as-strings
+                          child-items))))
+          object-list))
+
+(cl-defmacro speedbar-tests--state-test
+    ((&optional &key setup final name-function) &rest body)
+  "Evaluate BODY and verify the Speedbar is in an expected state.
+
+`:setup' specifies an alist of strings which will be used to create an
+object hierarchy used for the Speedbar display.
+
+`:final' specifies an alist of strings which should represent the final
+Speedbar state once BODY has been evaluated and the object hierarchy has
+been converted back to an alist of strings.  `:name-function' specifies
+the function to use to generate a string from an object, which should
+accept the object as an argument and return a string which represents
+the object as well as its state."
+  (declare (indent 1))
+  (let ((let-vars `((speedbar-tests--setup-strings ',setup))))
+    (when name-function
+      (push `(speedbar-tests--object-name-function #',name-function)
+            let-vars))
+    `(unwind-protect
+         (let ,let-vars
+           (speedbar-tests--initialize)
+           (should (equal (speedbar-tests--objects-as-strings
+                           speedbar-tests--object-hierarchy)
+                          ',setup))
+           ,@body
+           (should (equal (speedbar-tests--objects-as-strings
+                           speedbar-tests--object-hierarchy)
+                          ',final)))
+       (speedbar-tests--clean-up))))
+
+(ert-deftest speedbar-tests--expand-descendants-single ()
+  "Expand the first item."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"))))
+        :final (("A+" . (("A1"))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (should (string-equal "A" (speedbar-line-text)))
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-nested ()
+  "Expand the first item and its only child."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A"))))))
+        :final (("A+" . (("A1+" . (("A1A"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (should (string-equal "A" (speedbar-line-text)))
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-nested-wide ()
+  "Expand all descendants of first item which has multiple children."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A"))))))
+        :final (("A+" . (("A1+" . (("A1A")))
+                         ("A2+" . (("A2A"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (should (string-equal "A" (speedbar-line-text)))
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-of-first ()
+  "Expand the first item and all descendants."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B"))))))
+        :final (("A+" . (("A1+" . (("A1A")))
+                         ("A2+" . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (should (string-equal "A" (speedbar-line-text)))
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-of-first-expanded ()
+  "Expand the already expanded first item and all descendants."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B"))))))
+        :final (("A+" . (("A1+" . (("A1A")))
+                         ("A2+" . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (should (string-equal "A" (speedbar-line-text)))
+      (speedbar-expand-line 'nocache)
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-of-last ()
+  "Expand the last item and all descendants."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B"))))))
+        :final (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B+" . (("B1+" . (("B1B")))
+                         ("B2+" . (("B2B"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (forward-line)
+      (should (string-equal "B" (speedbar-line-text)))
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-of-last-expanded ()
+  "Expand the already expanded last item and all descendants."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B"))))))
+        :final (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B+" . (("B1+" . (("B1B")))
+                         ("B2+" . (("B2B"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (save-excursion
+        (forward-line)
+        (should (string-equal "B" (speedbar-line-text)))
+        (speedbar-expand-line 'nocache))
+      (save-excursion
+        (forward-line)
+        (should (string-equal "B" (speedbar-line-text)))
+        (speedbar-expand-line-descendants 'nocache)))))
+
+(ert-deftest speedbar-tests--expand-descendants-of-middle ()
+  "Expand the middle item and all descendants."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B")))))
+                ("C"  . (("C1"  . (("C1C")))
+                         ("C2"  . (("C2C"))))))
+        :final (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B+" . (("B1+" . (("B1B")))
+                         ("B2+" . (("B2B")))))
+                ("C"  . (("C1"  . (("C1C")))
+                         ("C2"  . (("C2C"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (goto-char (point-min))
+      (forward-line)
+      (should (string-equal "B" (speedbar-line-text)))
+      (speedbar-expand-line-descendants 'nocache))))
+
+(ert-deftest speedbar-tests--expand-descendants-of-middle-expanded ()
+  "Expand the already expanded middle item and all descendants."
+  (skip-when noninteractive)
+  (speedbar-tests--state-test
+      ( :setup (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B"  . (("B1"  . (("B1B")))
+                         ("B2"  . (("B2B")))))
+                ("C"  . (("C1"  . (("C1C")))
+                         ("C2"  . (("C2C"))))))
+        :final (("A"  . (("A1"  . (("A1A")))
+                         ("A2"  . (("A2A")))))
+                ("B+" . (("B1+" . (("B1B")))
+                         ("B2+" . (("B2B")))))
+                ("C"  . (("C1"  . (("C1C")))
+                         ("C2"  . (("C2C"))))))
+        :name-function speedbar-tests--object-name-expanded)
+    (with-current-buffer speedbar-buffer
+      (goto-char (point-min))
+      (save-excursion
+        (forward-line)
+        (should (string-equal "B" (speedbar-line-text)))
+        (speedbar-expand-line 'nocache))
+      (save-excursion
+        (forward-line)
+        (should (string-equal "B" (speedbar-line-text)))
+        (speedbar-expand-line-descendants 'nocache)))))
+
+(provide 'speedbar-tests)
+;;; speedbar-tests.el ends here
-- 
2.39.5

bug#73533: [PATCH] Rewrite speedbar expansion for all descendants

[Eli Zaretskii]

> From: Morgan Willcock <morgan@ice9.digital>
> Cc: 73533@debbugs.gnu.org
> Date: Tue, 08 Oct 2024 19:36:06 +0100
> 
> Attached is a patch for a replacement function and an additional patch
> which adds tests for expanding all descendants.
> 
> I couldn't see a direct way to test a Speedbar without creating a frame,
> and because the Speedbar code doesn't implement any type of hierarchy
> itself I've used eieio-speedbar to make something minimal to test.
> 
> Each test runs by converting a list of strings into objects which
> implement a Speedbar display, making state changes for the functions
> being tested, and then converting the objects back into strings - this
> was the simplest way I could find to create a reusable interface for
> tests.  The conversion back to a string is customizable to allow
> whatever state change is under test to be represented.
> 
> If the tests are problematic or considered too complicated, perhaps they
> can just be used to test the current function and the replacement
> function and not committed.  The current function fails 3/9 tests.

Thanks, I installed these patches on master.

There seems to be still a problem with some files, in that
speedbar-expand-line-descendants takes a very long time, and if I
interrupt it with C-g, I see nested DEFUNs, something that shouldn't
happen, because DEFUNs are never nested.  E.g., try this:

 $ cd /path/to/emacs/src
 $ ./emacs -Q
 M-x speedbar RET

At this point you should see all the files in the Emacs src directory.
Go to androidfns.c and type '['.  After about 10 sec type C-g.  You
should see nested DEFUns in the Speedbar frame.

Could you please look into this?