From 0273da43a9b20eb58dea93ff383ee2c10601009f Mon Sep 17 00:00:00 2001
From: Francesco Ceccon <francesco@ceccon.me>
Date: Sat, 6 Sep 2014 14:18:22 +0200
Subject: [PATCH 1/2] Add command to display direct subclasses.

---
 deft-browse/deft-browse.dylan | 43 +++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)

diff --git a/deft-browse/deft-browse.dylan b/deft-browse/deft-browse.dylan
index 0e34a9f..570aed8 100644
--- a/deft-browse/deft-browse.dylan
+++ b/deft-browse/deft-browse.dylan
@@ -208,3 +208,46 @@ define command inspect ($deft-commands)
   implementation
     inspect-dylan-object(dylan-object-name);
 end;
+
+define method print-class-subclasses
+    (project :: <project-object>, object)
+  let id = environment-object-id(project, object);
+  format-out("%s is not a class.\n", id.id-name);
+end method;
+
+define method print-class-subclasses
+    (project :: <project-object>, object == #f)
+  format-out("Object not found.\n");
+end method;
+
+define method print-class-subclasses
+    (project :: <project-object>, object :: <class-object>)
+  let id = environment-object-id(project, object);
+  let subclasses = class-direct-subclasses(project, object);
+  for (sc in subclasses)
+    let sc-id = environment-object-id(project, sc);
+    format-out("\t%s\n", sc-id.id-name);
+  end for;
+end method;
+
+define function subclasses-for-class(name :: <string>)
+  let project = dylan-current-project($deft-context);
+  if (project)
+    let library = project-library(project);
+    let object = find-environment-object(project, name,
+                                          library: library,
+                                          module: first(library-modules(project, library)));
+    print-class-subclasses(project, object);
+  else
+    format-out("No open project found.\n");
+  end if
+end function;
+
+define command subclasses ($deft-commands)
+  help "Display the subclasses of a class.";
+  simple parameter dylan-class-name :: <string>,
+    help: "the dylan class",
+    required?: #t;
+  implementation
+    subclasses-for-class(dylan-class-name);
+end;

From b06212dc1c152ca03f90c698ae0293b447417dd3 Mon Sep 17 00:00:00 2001
From: Francesco Ceccon <francesco@ceccon.me>
Date: Sat, 6 Sep 2014 19:22:15 +0200
Subject: [PATCH 2/2] Change subclasses command to display class hierarchy.

---
 deft-browse/deft-browse.dylan | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/deft-browse/deft-browse.dylan b/deft-browse/deft-browse.dylan
index 570aed8..5dfacb6 100644
--- a/deft-browse/deft-browse.dylan
+++ b/deft-browse/deft-browse.dylan
@@ -210,34 +210,39 @@ define command inspect ($deft-commands)
 end;
 
 define method print-class-subclasses
-    (project :: <project-object>, object)
+    (project :: <project-object>, object, depth :: <integer>, max-depth :: <integer>)
   let id = environment-object-id(project, object);
   format-out("%s is not a class.\n", id.id-name);
 end method;
 
 define method print-class-subclasses
-    (project :: <project-object>, object == #f)
+    (project :: <project-object>, object == #f, depth :: <integer>, max-depth :: <integer>)
   format-out("Object not found.\n");
 end method;
 
 define method print-class-subclasses
-    (project :: <project-object>, object :: <class-object>)
+    (project :: <project-object>, object :: <class-object>, depth :: <integer>, max-depth :: <integer>)
   let id = environment-object-id(project, object);
   let subclasses = class-direct-subclasses(project, object);
   for (sc in subclasses)
     let sc-id = environment-object-id(project, sc);
-    format-out("\t%s\n", sc-id.id-name);
+    // use 2 column indent, starting from column 2
+    let indent = make(<byte-string>, size: (depth + 1) * 2);
+    format-out("%s%s\n", indent, sc-id.id-name);
+    if (depth < max-depth)
+      print-class-subclasses(project, sc, depth + 1, max-depth);
+    end if;
   end for;
 end method;
 
-define function subclasses-for-class(name :: <string>)
+define function subclasses-for-class(name :: <string>, max-depth :: <integer>)
   let project = dylan-current-project($deft-context);
   if (project)
     let library = project-library(project);
     let object = find-environment-object(project, name,
                                           library: library,
                                           module: first(library-modules(project, library)));
-    print-class-subclasses(project, object);
+    print-class-subclasses(project, object, 0, max-depth);
   else
     format-out("No open project found.\n");
   end if
@@ -248,6 +253,9 @@ define command subclasses ($deft-commands)
   simple parameter dylan-class-name :: <string>,
     help: "the dylan class",
     required?: #t;
+  named parameter depth :: <integer>,
+    help: "the hierarchy depth",
+    required?: #f;
   implementation
-    subclasses-for-class(dylan-class-name);
+    subclasses-for-class(dylan-class-name, if (depth) depth else 0 end);
 end;