#!/path/to/susie/susie-0.2/susie

"Susie Class Hierarchy html test.]
By Peter William Lount
http://www.smalltalk.org, peter@smalltalk.org.
Copyright 2005, all rights reserved.
This example is licensed under the BSD License. 
See FreeBSD.org for a copy."

Object subclass: #CommonGatewayInterface
   instanceVariableNames: ''
   classVariableNames: ''
   poolDictionaries: ''
   category: ''!

!CommonGatewayInterface class methodsFor: ''!

	cgiContentHeader
		smalltalk 
			print: 'Content-type: text/html';
			print: ''.
	!

!


!Class methodsFor: ''!

	hierarchyHTML
		^ self hierarchyHTML: 0!

	hierarchyHTML: n
		| result |
		result := String new.
		gap := String new.
		(1 to: n) do: [ :i | gap := gap + ' '].
		"result := result + '<div>'."
		result := result + '<div style="padding-left: ' + 
			(20 * n) + 'px;">' + name + '</div>'.
		"result := result + '<span>' + name + '</span></div>'."
		self subClasses do: [ :c|
			result := result + (Char newline asString) + 
				(c hierarchyHTML: n+1) ].
		^ result!

!

Object subclass: #SystemInfo
   instanceVariableNames: ''
   classVariableNames: ''
   poolDictionaries: ''
   category: ''!

!SystemInfo class methods!
	classes
		| aClassNameString |
		aClassNameString := Object hierarchy.
		(File name: 'Object_hierarchy.txt' open: 'w')
			print: aClassNameString;
			close.
	!

	classesHTML
		| aClassNameString |
		aClassNameString := Object hierarchyHTML.
		(File name: 'Object_hierarchy.txt' open: 'w')
			print: aClassNameString;
			close.
	!
!

"This is our 'Do it' that executes some of the above methods."

CommonGatewayInterface cgiContentHeader.
smalltalk print: '<b>Live Susie Smalltalk Class Hierarchy</b><br>' +
	'by Peter William Lount<br><br>' +
	'<b><a href="/versions/SusieSmalltalk.html"
	>Susie Smalltalk</a> ' + 
	'base classes</b> (plus a couple of new ones
	 from the script that generates this pager). ' +
	'Generated with Susie Smalltalk live each page refresh. ' +
	'All of the content within this box was generated 
	from within this script. ' +
	'From a base install of Susie on the ' + 
	'<a href="http://activeinfo.ca/technologies/FreeBSD.html"
	 target=activeinfo>FreeBSD</a> server ' +
	'to this script running was about five hours of work
	 and that included debugging the Susie ' + 
	'virtual machine compiling script.' +
	'<br><br>' +
	(Char newline asString) + 
	Object hierarchyHTML + 
	(Char newline asString) + 
	'</body></html>'.
!