"real" inheritance graphs

[Matthias Clasen <maclas gmx de>]

I have spent some time finishing my patch to add support for graphical 
inheritance graphs to gtk-doc. It needs dot at least in version 1.8.9
(older versions lack cmap support), which can be obtained from
http://www.graphviz.org.

I'm sure this is not perfect, but I would really like to see something
similar in gtk-doc. Note that I'm not a native Perl speaker, thus the
patch may be less elegant than it could be otherwise. I've noticed
that there are Perl bindings for GraphViz which may make my little
graph-writing language (DotObject(), DotInterface(), DotInherits(),
etc) unnecessary, but I'm not sure if depending on non-standard Perl
modules would be a problem for gtk-doc.

Here is a quick explanation how it works:

When called with the --dot option, gtkdoc-mkdb writes a .dot file
describing the full object hierarchy and .dot files for the "local"
graphs for each class and uses dot to create .png and .map (clientside
imagemap) files from them. gtkdoc-mkdb then reads the .map file back
in to convert it to a Docbook imageobjectco element (with a nested a
areaspec), which gets written to the resulting Docbook document. All
.dot, .map and .png files are created in a directory which can by
specified via --image-dir. The default is $ROOT_DIR/dot. For the
images to be found by the browser, they have to be copied to the html
directory. The easiest way to achive this is to add 
"dot/*.png dot/legend.html" to the variable HTML_IMAGES in the Makefile.

gtk-doc.xsl has been adjusted to convert the areaspec back to an
imagemap. gtkdoc-fixxref has been extended to handle hrefs inside
imagemaps. 

The "local" graphs replace the sections "Object Hierarchy",
"Implemented Interfaces", "Implementations" and "Prerequisites" for
each class, the full object hierarchy is written to the file
xml/tree_map.xml; in order to use it, you have to adjust your driver
document to include it instead of (or in addition to)
xml/tree_index.sgml. Possible reasons to not (solely) use the
graphical object hierarchy are that it can become quite large for
large projects; the GTK+ object hierarchy produced a 1700x6142 png
image for me. 

Matthias

Index: gtk-doc.xsl
===================================================================
RCS file: /cvs/gnome/gtk-doc/gtk-doc.xsl,v
retrieving revision 1.13
diff -u -b -B -p -r1.13 gtk-doc.xsl
--- gtk-doc.xsl	14 Feb 2003 01:24:50 -0000	1.13
+++ gtk-doc.xsl	21 Apr 2003 22:31:02 -0000
@@ -78,6 +78,172 @@
   </xsl:template>
 
   <!-- ========================================================= -->
+  <!-- Override the imageobjectco handling in the docbook stylesheets
+       to handle areaspec to imagemap conversion. -->
+
+<xsl:template match="imageobjectco">
+  <xsl:if test="@id">
+    <a name="{ id}"/>
+  </xsl:if>
+  <xsl:apply-templates select="imageobject"/>
+  <xsl:apply-templates select="areaspec"/>
+  <xsl:apply-templates select="calloutlist"/>
+</xsl:template>
+
+<xsl:template match="imageobject">
+  <xsl:apply-templates select="imagedata"/>
+</xsl:template>
+
+<xsl:template match="imagedata">
+  <xsl:choose>
+    <xsl:when test="@format='linespecific'">
+    </xsl:when>
+    <xsl:otherwise>
+      <xsl:call-template name="process.image">
+        <xsl:with-param name="alt">
+          <xsl:apply-templates select="(../../textobject/phrase)[1]"/>
+        </xsl:with-param>
+        <xsl:with-param name="usemap">
+          <xsl:apply-templates select="../../areaspec/@id"/>
+        </xsl:with-param>
+      </xsl:call-template>
+    </xsl:otherwise>
+  </xsl:choose>
+</xsl:template>
+
+<xsl:template match="areaspec">
+<xsl:element name="map">
+  <xsl:attribute name="name">
+    <xsl:value-of select="@id"/>  
+  </xsl:attribute>
+  <xsl:apply-templates select="area"/> 
+</xsl:element>
+</xsl:template>
+
+<xsl:template match="area">
+  <xsl:variable name="targets" select="id(@linkends)"/>
+  <xsl:variable name="target" select="$targets[1]"/>
+  <xsl:element name="area">
+
+    <xsl:attribute name="href">
+
+    <xsl:choose>
+
+      <xsl:when test="id(@linkends)">
+        <xsl:call-template name="href.target">
+          <xsl:with-param name="object" select="$target"/>
+        </xsl:call-template>
+      </xsl:when>
+
+      <xsl:otherwise>
+	<xsl:text>#GTKDOCURL:</xsl:text>
+        <xsl:value-of select="@linkends"/>
+      </xsl:otherwise>
+
+    </xsl:choose>
+
+    </xsl:attribute>
+
+    <xsl:attribute name="title">
+      <xsl:value-of select="@label"/>
+    </xsl:attribute>
+    <xsl:attribute name="alt">
+      <xsl:value-of select="@label"/>
+    </xsl:attribute>
+    <xsl:attribute name="shape">
+      <xsl:value-of select="@otherunits"/>
+    </xsl:attribute>
+    <xsl:attribute name="coords">
+      <xsl:value-of select="@coords"/>
+    </xsl:attribute>
+  </xsl:element>
+</xsl:template>
+
+<xsl:template name="process.image">
+  <!-- When this template is called, the current node should be  -->
+  <!-- a graphic, inlinegraphic, imagedata, or videodata. All    -->
+  <!-- those elements have the same set of attributes, so we can -->
+  <!-- handle them all in one place.                             -->
+  <xsl:param name="tag" select="'img'"/>
+  <xsl:param name="alt"/>
+  <xsl:param name="usemap"/>
+
+  <xsl:variable name="filename">
+    <xsl:choose>
+      <xsl:when test="local-name(.) = 'graphic'
+                      or local-name(.) = 'inlinegraphic'">
+        <!-- handle legacy graphic and inlinegraphic by new template --> 
+        <xsl:call-template name="mediaobject.filename">
+          <xsl:with-param name="object" select="."/>
+        </xsl:call-template>
+      </xsl:when>
+      <xsl:otherwise>
+        <!-- imagedata, videodata, audiodata -->
+        <xsl:call-template name="mediaobject.filename">
+          <xsl:with-param name="object" select=".."/>
+        </xsl:call-template>
+      </xsl:otherwise>
+    </xsl:choose>
+  </xsl:variable>
+
+  <xsl:variable name="width">
+    <xsl:choose>
+      <xsl:when test="@scale"><xsl:value-of select="@scale"/>%</xsl:when>
+      <xsl:when test="@width"><xsl:value-of select="@width"/></xsl:when>
+      <xsl:otherwise></xsl:otherwise>
+    </xsl:choose>
+  </xsl:variable>
+
+  <xsl:variable name="height">
+    <xsl:choose>
+      <xsl:when test="@scale"></xsl:when>
+      <xsl:when test="@depth"><xsl:value-of select="@depth"/></xsl:when>
+      <xsl:otherwise></xsl:otherwise>
+    </xsl:choose>
+  </xsl:variable>
+
+  <xsl:variable name="align">
+    <xsl:value-of select="@align"/>
+  </xsl:variable>
+
+  <xsl:element name="{$tag}">
+    <xsl:attribute name="src">
+      <xsl:value-of select="$filename"/>
+    </xsl:attribute>
+
+    <xsl:if test="$align != ''">
+      <xsl:attribute name="align">
+        <xsl:value-of select="$align"/>
+      </xsl:attribute>
+    </xsl:if>
+    <xsl:if test="$height != ''">
+      <xsl:attribute name="height">
+        <xsl:value-of select="$height"/>
+      </xsl:attribute>
+    </xsl:if>
+    <xsl:if test="$width != ''">
+      <xsl:attribute name="width">
+        <xsl:value-of select="$width"/>
+      </xsl:attribute>
+    </xsl:if>
+    <xsl:if test="$alt != ''">
+      <xsl:attribute name="alt">
+        <xsl:value-of select="$alt"/>
+      </xsl:attribute>
+    </xsl:if>
+    <xsl:if test="$usemap != ''">
+      <xsl:attribute name="usemap">
+        <xsl:text>#</xsl:text>
+        <xsl:value-of select="$usemap"/>
+      </xsl:attribute>
+      <xsl:attribute name="border">
+        <xsl:text>0</xsl:text>
+      </xsl:attribute>
+    </xsl:if>
+  </xsl:element>
+</xsl:template>
+
+  <!-- ========================================================= -->
   <!-- Below are the visual portions of the stylesheet.  They provide
        the normal gtk-doc output style. -->
 
Index: gtkdoc-fixxref.in
===================================================================
RCS file: /cvs/gnome/gtk-doc/gtkdoc-fixxref.in,v
retrieving revision 1.7
diff -u -b -B -p -r1.7 gtkdoc-fixxref.in
--- gtkdoc-fixxref.in	17 Dec 2002 14:53:33 -0000	1.7
+++ gtkdoc-fixxref.in	21 Apr 2003 22:31:02 -0000
@@ -132,6 +132,8 @@ sub FixHTMLFile {
 
     $entire_file =~ s%<GTKDOCLINK\s+HREF="([^"]*)"\s*>(.*?)</GTKDOCLINK\s*>% &MakeXRef($1, $2); %ge;
 
+    $entire_file =~ s%#GTKDOCURL:([^"]*)% (exists $Links{$1} ? $Links{$1} : "#") %ge;
+
     open (NEWFILE, ">$file.new")
 	|| die "Can't open $file: $!";
     print NEWFILE $entire_file;
Index: gtkdoc-mkdb.in
===================================================================
RCS file: /cvs/gnome/gtk-doc/gtkdoc-mkdb.in,v
retrieving revision 1.74
diff -u -b -B -p -r1.74 gtkdoc-mkdb.in
--- gtkdoc-mkdb.in	14 Mar 2003 22:07:55 -0000	1.74
+++ gtkdoc-mkdb.in	21 Apr 2003 22:31:03 -0000
@@ -41,6 +41,7 @@ require "gtkdoc-common.pl";
 my $MODULE;
 my $TMPL_DIR;
 my $SGML_OUTPUT_DIR;
+my $IMAGE_DIR;
 my @SOURCE_DIRS;
 my $IGNORE_FILES = "";
 my $PRINT_VERSION;
@@ -49,19 +50,22 @@ my $OUTPUT_ALL_SYMBOLS;
 my $MAIN_SGML_FILE;
 my $SGML_MODE;
 my $OUTPUT_FORMAT;
+my $USE_DOT = 0;
 
 my %optctl = (module => \$MODULE,
 	      'source-dir' => \ SOURCE_DIRS,
 	      'ignore-files' => \$IGNORE_FILES,
 	      'output-dir' => \$SGML_OUTPUT_DIR,
 	      'tmpl-dir' => \$TMPL_DIR,
+	      'image-dir' => \$IMAGE_DIR,
+	      'dot' => \$USE_DOT,
 	      'version' => \$PRINT_VERSION,
 	      'help' => \$PRINT_HELP,
 	      'main-sgml-file' => \$MAIN_SGML_FILE,
 	      'outputallsymbols' => \$OUTPUT_ALL_SYMBOLS,
 	      'sgml-mode' => \$SGML_MODE,
 	      'output-format' => \$OUTPUT_FORMAT);
-GetOptions(\%optctl, "module=s", "source-dir:s", "ignore-files:s", "output-dir:s", "tmpl-dir:s", "version", "outputallsymbols", "main-sgml-file:s", "help", "sgml-mode", "output-format:s");
+GetOptions(\%optctl, "module=s", "source-dir:s", "ignore-files:s", "output-dir:s", "tmpl-dir:s", "image-dir:s", "dot!", "version", "outputallsymbols", "main-sgml-file:s", "help", "sgml-mode", "output-format:s");
 
 if ($PRINT_VERSION) {
     print "@VERSION \n";
@@ -79,10 +83,14 @@ if ($PRINT_HELP) {
     print "\n--ignore-files=FILES   Files or directories which should not be scanned";
     print "\n                       May be used more than once for multiple directories";
     print "\n--output-dir=DIRNAME   Directory to put the generated Docbook files in";
-    print "\n--tmpl-dir=DIRNAME     DIRECTORY in which template files may be found";
-    print "\n--main-sgml-file=FILE  File containing the toplevel SGML file.";
-    print "\n--output-format=FORMAT The format to use for the generated docbook, XML or SGML.";
-    print "\n--sgml-mode            Allow Docbook markup in inline documentation.";
+    print "\n--tmpl-dir=DIRNAME     Directory in which template files may be found";
+    print "\n--main-sgml-file=FILE  File containing the toplevel SGML file";
+    print "\n--output-format=FORMAT The format to use for the generated docbook, XML or SGML";
+    print "\n--sgml-mode            Allow Docbook markup in inline documentation";
+    print "\n--output-all-symbols   Write a list of all symbols to a file";
+    print "\n--dot                  Use the 'dot' program to produce inheritance graphs";
+    print "\n--nodot                Don't use 'dot'";
+    print "\n--image-dir=DIRNAME    Directory to put the generated dot files in";
     print "\n--version              Print the version of this program";
     print "\n--help                 Print this help\n";
     exit 0;
@@ -132,6 +140,9 @@ $TMPL_DIR = $TMPL_DIR ? $TMPL_DIR : "$RO
 # This is where we put all the DocBook output.
 $SGML_OUTPUT_DIR = $SGML_OUTPUT_DIR ? $SGML_OUTPUT_DIR : "$ROOT_DIR/$OUTPUT_FORMAT";
 
+# This is where we put generated images.
+$IMAGE_DIR = $IMAGE_DIR ? $IMAGE_DIR : "$ROOT_DIR/dot";
+
 # This file contains the object hierarchy.
 my $OBJECT_TREE_FILE = "$ROOT_DIR/$MODULE.hierarchy";
 
@@ -196,6 +207,33 @@ if (! -e $SGML_OUTPUT_DIR) {
 	|| die "Can't create directory: $SGML_OUTPUT_DIR";
 }
 
+# Create the image directory if it doesn't exist.
+if (! -e $IMAGE_DIR) {
+    mkdir ("$IMAGE_DIR", 0777)
+	|| die "Can't create directory: $IMAGE_DIR";
+}
+
+# Check dot
+if ($USE_DOT) {
+    if (system("dot -V") != 0) {
+	warn "dot not found, disabling graphs\n";
+	$USE_DOT = 0;
+    }
+    else {
+	my $dot_version = `dot -V 2>&1`;
+	if ($dot_version =~ /.*(\d+)\.(\d+)\.(\d+).*/) {
+	    if ($1 < 1 || ($1 == 1 && $2 < 8) || $1 == 1 && $2 == 8 && $3 < 9) {
+		warn "dot is too old, disabling graphs\n";
+		$USE_DOT = 0;
+	    }
+	}
+	else {
+	    warn "can't determine dot version, disabling graphs\n";
+	    $USE_DOT = 0;
+	}
+    }
+}
+
 # Function and other declaration output settings.
 my $RETURN_TYPE_FIELD_WIDTH = 12;
 my $SYMBOL_FIELD_WIDTH = 32;
@@ -206,6 +244,11 @@ my $SIGNAL_FIELD_WIDTH = 12;
 &ReadObjectHierarchy;
 &ReadInterfaces;
 &ReadPrerequisites;
+&OutputObjectList;
+if ($USE_DOT) {
+    &OutputLegend;
+    &OutputObjectTree;
+}
 
 # FIXME: this is the header file output at the top of the Synopsis.
 # We should allow this to be changed in the MODULE-sections.txt file.
@@ -517,9 +560,17 @@ EOF
 		    my ($sig_synop, $sig_desc) = &GetSignals ($symbol);
 		    my ($arg_synop, $child_arg_synop, $style_arg_synop,
 			$arg_desc, $child_arg_desc, $style_arg_desc) = &GetArgs ($symbol);
-		    my $hier = &GetHierarchy ($symbol);
-		    my $ifaces = &GetInterfaces ($symbol);
-		    my $prereqs = &GetPrerequisites ($symbol);
+		    my $hier = "";
+		    my $ifaces = "";
+		    my $prereqs = "";
+		    if ($USE_DOT) {
+			$hier = &GetGraphicalHierarchy ($symbol);
+		    }
+		    else {
+			$hier = &GetHierarchy ($symbol);
+			$ifaces = &GetInterfaces ($symbol);
+			$prereqs = &GetPrerequisites ($symbol);
+		    }
 		    $synopsis .= $synop;
 		    $details .= $desc;
 		    $signals_synop .= $sig_synop;
@@ -1705,6 +1756,333 @@ EOF
 }
 
 
+sub DotStartGraph {
+    my ($name) = @_;
+    print (DOT "digraph " . $name . "{\n");
+    print (DOT "rankdir=LR;\n");
+}
+
+sub DotEndGraph {
+    print (DOT "}\n");
+}
+
+sub DotObject {
+    my ($name, $self) = @_;
+    if ($self) {
+	print (DOT $name . " [shape=box,style=filled,fontsize=10,height=0.2,width=0.4,fontname=\"sans\",fontcolor=white];\n");
+    }
+    else {
+	print (DOT $name . " [URL=\".\",shape=box,fontsize=10,height=0.2,width=0.4,fontname=\"sans\"];\n");
+    }
+}
+
+sub DotInterface {
+    my ($name, $self) = @_;
+    if ($self) {
+	print (DOT $name . " [shape=box,style=filled,fontsize=10,height=0.2,width=0.4,fontname=\"sans\",fillcolor=gray,color=blue,fontcolor=blue];\n");
+    }
+    else {
+	print (DOT $name . " [URL=\".\",shape=box,fontsize=10,height=0.2,width=0.4,fontname=\"sans\",color=blue,fontcolor=blue];\n");
+    }
+}
+
+sub DotInherits {
+    my ($parent, $child) = @_;
+    print (DOT $parent . " -> " . $child . " [dir=back];\n");
+}
+
+sub DotImplements {
+    my ($iface, $impl) = @_;
+    print (DOT $iface . " -> " . $impl . " [dir=back,color=gray];\n");
+}
+
+sub DotRequires {
+    my ($prereq, $iface) = @_;
+    print (DOT $prereq . " -> " . $iface . " [dir=back,color=blue];\n");
+}
+
+sub OutputLegend {
+    my $name;
+    my $command;
+
+    $name = "legend_class";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph ($name);
+    DotObject ("classname");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    $name = "legend_class_self";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph ($name);
+    DotObject ("classname", "classname");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    $name = "legend_iface";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph ($name);
+    DotInterface ("classname");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    $name = "legend_iface_self";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph ($name);
+    DotInterface ("classname", "classname");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    $name = "legend_inherits";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph ($name);
+    print (DOT "a[shape=point];\n");
+    print (DOT "b[shape=point];\n");
+    DotInherits ("a", "b");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    $name = "legend_implements";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph ($name);
+    print (DOT "a[shape=point];\n");
+    print (DOT "b[shape=point];\n");
+    DotImplements ("a", "b");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    $name = "legend_requires";
+    open (DOT, ">$IMAGE_DIR/$name.dot")
+	|| die "Can't create $IMAGE_DIR/$name.dot\n";
+    DotStartGraph($name);
+    print (DOT "a[shape=point];\n");
+    print (DOT "b[shape=point];\n");
+    DotRequires ("a", "b");
+    DotEndGraph;
+    close (DOT);
+    $command = "dot -Tpng $IMAGE_DIR/$name.dot > $IMAGE_DIR/$name.png";
+    system ($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$name.dot\n";
+
+    open (OUTPUT, ">$IMAGE_DIR/legend.html")
+	|| die "Can't create $IMAGE_DIR/legend.html\n";
+    print (OUTPUT <<EOF);
+<html>
+<head>
+<title>Legend</title>
+</head>
+<body>
+<ul>
+<li><img src="legend_class.png" alt="a class" align="middle">
+a class
+<li><img src="legend_class_self.png" alt="the current class" align="middle">
+the current class
+<li><img src="legend_iface.png" alt="an interface" align="middle">
+an interface
+<li><img src="legend_iface_self.png" alt="the current interface" align="middle">
+the current interface
+<li><img src="legend_inherits.png" alt="inheritance" align="middle">
+inheritance
+<li><img src="legend_implements.png" alt="implementation" align="middle">
+implementation
+<li><img src="legend_requires.png" alt="prerequisite" align="middle">
+prerequisite
+</ul>
+</body>
+</html>
+EOF
+      close (OUTPUT);
+}
+
+sub CmapToImageobjectco {
+    my ($mapfile, $id, $imagefile) = @_;
+    my $result = "";
+
+    if (!open (MAP, $mapfile)) {
+	warn "Can't open $mapfile\n";
+	return "";
+    }
+
+    $result = "<imageobjectco>\n";
+    $result .= "<areaspec id=\"$id\">\n";
+
+    while (<MAP>) {
+	my $line = $_;
+
+	$line =~ s/href="."//;
+	$line =~ s/shape=/otherunits=/;
+	$line =~ s/title=/linkends=/;
+	$line =~ s/alt=/label=/;
+	$line =~ s/>$/\/>/;
+
+	$result .= $line;
+    }
+
+    close (MAP);
+
+    $result .= "</areaspec>\n";
+    $result .= "<imageobject>\n";
+    $result .= "<imagedata format=\"PNG\" fileref=\"$imagefile\"/>\n";
+    $result .= "</imageobject>\n";
+    $result .= "</imageobjectco>\n";
+
+    return $result;
+}
+
+sub GetGraphicalHierarchy {
+    my ($object) = @_;
+
+    # Find object in the objects array.
+    my $found = 0;
+    my $i;
+    my $command;
+    my $hierarchy = "";
+
+    my $tree_dot_file = $object . "_tree.dot";
+    my $tree_image_file = $object . "_tree.png";
+    my $tree_map_file = $object . "_tree.map";
+
+    for ($i = 0; $i < @Objects; $i++) {
+	if ($Objects[$i] eq $object) {
+	    $found = 1;
+	    last;
+	}
+    }
+    if (!$found) {
+	return "";
+    }
+
+    open (DOT, ">$IMAGE_DIR/$tree_dot_file")
+	|| die "Can't create $IMAGE_DIR/$tree_dot_file\n";
+    DotStartGraph($object . "_tree");
+
+    # Collect children
+    for (my $j = $i + 1; $j < @Objects; $j++) {
+	if ($ObjectLevels[$j] <= $ObjectLevels[$i]) {
+	    last;
+	}
+	elsif ($ObjectLevels[$j] == $ObjectLevels[$i] + 1) {
+	    DotObject($Objects[$j]);
+	    DotInherits($object, $Objects[$j]);
+	}
+    }
+
+    # Walk up the hierarchy, emitting ancestors
+    my $ancestor = $Objects[$i];
+    my $level = $ObjectLevels[$i];
+    #    print "Level: $level\n";
+    while ($level > 1) {
+	$i--;
+	if ($ObjectLevels[$i] < $level ) {
+	    if (!($Objects[$i] eq "GInterface")) {
+		DotObject($Objects[$i]);
+		DotInherits($Objects[$i], $ancestor);
+	    }
+	    $ancestor = $Objects[$i];
+	    $level = $ObjectLevels[$i];
+	    #	    print "Level: $level\n";
+	}
+    }
+
+    if ($ancestor eq "GInterface") {
+	# emit the interface itself
+	DotInterface($object, 1);
+
+	# emit implementations
+	foreach my $key (keys %Interfaces) {
+	    if ($Interfaces{$key} =~ /\b$object\b/) {
+		DotObject($key);
+		DotImplements($object, $key);
+	    }
+	}
+
+	# emit dependent interfaces
+	foreach my $key (keys %Prerequisites) {
+	    if ($Prerequisites{$key} =~ /\b$object\b/) {
+		DotInterface($key);
+		DotRequires($object, $key);
+	    }
+	}
+
+	# emit prerequisites
+	if (exists($Prerequisites{$object})) {
+	    my @prereqs = split(' ', $Prerequisites{$object});
+	  PREREQ: for (my $k = 0; $k <= $#prereqs; $k++) {
+		DotRequires($prereqs[$k], $object);
+		for (my $j = $i + 1; $j < @Objects; $j++) {
+		    if ($Objects[$j] eq $prereqs[$k]) {
+			# prerequisite is an iterface
+			DotInterface($prereqs[$k]);
+			next PREREQ;
+		    }
+		}
+
+		# prerequisite is an object
+		DotObject($prereqs[$k]);
+	    }
+	}
+    }
+    else {
+	# emit the object itself
+	DotObject($object, 1);
+
+	# emit interfaces and their prerequisites
+	if (exists($Interfaces{$object})) {
+	    my @ifaces = split(' ', $Interfaces{$object});
+	    for (my $j = 0; $j <= $#ifaces; $j++) {
+		DotInterface($ifaces[$j]);
+		DotImplements($ifaces[$j], $object);
+
+		if (exists($Prerequisites{$ifaces[$j]})) {
+		    my @prereqs = split(' ', $Prerequisites{$ifaces[$j]});
+		    for (my $k = 0; $k <= $#prereqs; $k++) {
+			DotRequires($prereqs[$k], $ifaces[$j]);
+		    }
+		}
+	    }
+	}
+
+	# emit dependent interfaces
+	foreach my $key (keys %Prerequisites) {
+	    if ($Prerequisites{$key} =~ /\b$object\b/) {
+		DotInterface($key);
+		DotRequires($object, $key);
+	    }
+	}
+    }
+
+    DotEndGraph;
+    close (DOT);
+
+    $command = "dot -Tpng $IMAGE_DIR/$tree_dot_file > $IMAGE_DIR/$tree_image_file";
+    system($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$tree_dot_file\n";
+
+    $command = "dot -Tcmap $IMAGE_DIR/$tree_dot_file > $IMAGE_DIR/$tree_map_file";
+    system($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$tree_dot_file\n";
+
+    $hierarchy .= CmapToImageobjectco ("$IMAGE_DIR/$tree_map_file", "$object-tree-map", "$tree_image_file");
+    $hierarchy .= "<ulink url=\"legend.html\">legend</ulink>";
+
+    return $hierarchy;
+}
+
 #############################################################################
 # Function    : GetSignals
 # Description : Returns the synopsis and detailed description DocBook output
@@ -2772,8 +3150,74 @@ sub ReadObjectHierarchy {
     close (OUTPUT);
 
     &UpdateFileIfChanged ($old_tree_index, $new_tree_index, 0);
+}
+
+sub OutputObjectTree {
+    my $i;
+    my $j;
+    my $command;
+
+    my $tree_dot_file = "tree.dot";
+    my $tree_image_file = "tree.png";
+    my $tree_map_file = "tree.map";
+    my $tree_file = "tree_map.$OUTPUT_FORMAT";
+
+    open (DOT, ">$IMAGE_DIR/$tree_dot_file")
+	|| die "Can't create $IMAGE_DIR/$tree_dot_file";
+    DotStartGraph("tree");
+
+    for ($i = 0; $i <= $#Objects; $i++) {
+	if ($Objects[$i] eq "GInterface") {
+	    for ($j = $i + 1; $j <= $#Objects; $j++) {
+		if ($ObjectLevels[$j] <= $ObjectLevels[$i]) {
+		    $i = $j;
+		    last;
+		}
+		DotInterface($Objects[$j]);
+
+		if (exists($Prerequisites{$Objects[$j]})) {
+		    my @prereqs = split(' ', $Prerequisites{$Objects[$j]});
+		    for (my $k = 0; $k <= $#prereqs; $k++) {
+			DotRequires($prereqs[$k], $Objects[$j]);
+		    }
+		}
+	    }
+	}
+	else {
+	    DotObject($Objects[$i]);
+	    for ($j = $i + 1; $j <= $#Objects; $j++) {
+		if ($ObjectLevels[$j] <= $ObjectLevels[$i]) {
+		    last;
+		}
+		if ($ObjectLevels[$j] == $ObjectLevels[$i] + 1) {
+		    DotInherits($Objects[$i], $Objects[$j]);
+		}
+	    }
+
+	    if (exists($Interfaces{$Objects[$i]})) {
+		my @ifaces = split(' ', $Interfaces{$Objects[$i]});
+		for ($j = 0; $j <= $#ifaces; $j++) {
+		    DotImplements($ifaces[$j], $Objects[$i]);
+		}
+	    }
+	}
+    }
+
+    DotEndGraph;
+    close (DOT);
+
+    $command = "dot -Tpng $IMAGE_DIR/$tree_dot_file > $IMAGE_DIR/$tree_image_file";
+    system($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$tree_dot_file\n";
+
+    $command = "dot -Tcmap $IMAGE_DIR/$tree_dot_file > $IMAGE_DIR/$tree_map_file";
+    system($command) == 0 or warn "Can't run dot on $IMAGE_DIR/$tree_dot_file\n";
+
+    open (XMAP, ">$SGML_OUTPUT_DIR/$tree_file")
+	|| die "Can't create $SGML_OUTPUT_DIR/$tree_file";
 
-    &OutputObjectList;
+    print (XMAP CmapToImageobjectco ("$IMAGE_DIR/$tree_map_file", "$MODULE-tree-map", "$tree_image_file"));
+    print (XMAP "<ulink url=\"legend.html\">legend</ulink>\n");
+    close (XMAP);
 }
 
 #############################################################################