Object subclass:#HTMLDocGenerator
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'System-Documentation'
!
!HTMLDocGenerator class methodsFor:'documentation'!
documentation
"
helper class to generate HTML docuemntation
for classes - see DocViewers Class Documentation.
[author:]
Claus Gittinger
"
! !
!HTMLDocGenerator class methodsFor:'document generation'!
htmlClassCategoryList
|categories s prefixList prefix prefixStack prev|
categories := Set new.
Smalltalk allClasses do:[:cls |
cls isPrivate ifFalse:[
(cls isNamespace not or:[cls == Smalltalk]) ifTrue:[
categories add:cls category
]
]
].
categories := categories asOrderedCollection sort.
s := '' writeStream.
s nextPutAll:'
<html>
<head>
<title>
Class categories:
</title>
</head>
<body>
<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>
<hr>
<h1>Class categories:</h1>
<ul>
'.
prefixList := Set new.
categories keysAndValuesDo:[:index :element |
|prev common|
index ~~ 1 ifTrue:[
prev := categories at:(index - 1).
common := (Array with:prev with:element) longestCommonPrefix.
(common endsWith:'-') ifTrue:[
prefixList add:(common copyWithoutLast:1)
] ifFalse:[
common = prev ifTrue:[
prefixList add:common
]
]
]
].
prefix := ''. prefixStack := OrderedCollection new.
prev := ''.
categories := categories select:[:nm | nm ~= 'obsolete'].
categories do:[:nm |
|longest|
"/ longest prefix ....
longest := prefixList inject:'' into:[:maxPrefix :prefix |
nm = prefix ifTrue:[
maxPrefix
] ifFalse:[
(nm startsWith:prefix)
ifTrue:[
prefix size > maxPrefix size
ifTrue:[
prefix
] ifFalse:[
maxPrefix
]
] ifFalse:[
maxPrefix
]
]
].
longest size > 0 ifTrue:[
longest = prefix ifTrue:[
"/ no change
] ifFalse:[
(longest startsWith:prefix) ifTrue:[
prefixStack addLast:longest.
longest ~= prev ifTrue:[
prefixStack size == 1 ifTrue:[
s nextPutLine:'<p>'.
].
s nextPutLine:'<li>' , longest.
].
s nextPutLine:'<ul>'.
prefix := longest.
] ifFalse:[
s nextPutLine:'</ul>'.
prefixStack notEmpty ifTrue:[
prefixStack removeLast.
].
[prefixStack notEmpty
and:[(longest startsWith:prefixStack last) not]] whileTrue:[
s nextPutLine:'</ul>'.
prefixStack removeLast.
].
prefixStack notEmpty ifTrue:[
prefix := prefixStack last.
] ifFalse:[
prefixStack addLast:longest.
prefix := longest.
longest ~= prev ifTrue:[
prefixStack size == 1 ifTrue:[
s nextPutLine:'<p>'.
].
s nextPutLine:'<li>' , longest.
].
s nextPutLine:'<ul>'.
]
].
]
] ifFalse:[
[prefixStack size > 0] whileTrue:[
s nextPutLine:'</ul>'.
prefixStack removeLast.
].
prefixStack size == 0 ifTrue:[
s nextPutLine:'<p>'.
].
prefix := ''.
].
s nextPutAll:'<li><a href="../misc/onlyInSTX2.html" action="html:'
, self name
, ' htmlClassesListOfCategory:''' , nm
, ''' backTo:''htmlClassCategoryList''">'
"/ full name:
"/ , nm ,'</a>';cr.
"/ cut off prefix:
, (nm copyFrom:prefix size + 1) ,'</a>';cr.
prev := nm.
].
s nextPutAll:'
</ul>
</body>
</html>
'.
^ s contents
"
HTMLDocGenerator htmlClassCategoryList
"
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 2.3.1997 / 00:26:10 / cg"
!
htmlClassListPrefix:prefix
|classes|
classes := Smalltalk allClasses
select:[:cls |
cls isPrivate not
and:[(cls isNamespace not or:[cls == Smalltalk])
and:[cls name startsWith:prefix]]
].
^ self
htmlClasses:classes
title:('Classes starting with ''' , prefix asString , ''':').
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 5.1.1997 / 20:10:23 / cg"
!
htmlClasses:classes title:title
^ self
htmlClasses:classes
title:title
backTo:nil
"Modified: 23.4.1996 / 15:32:10 / cg"
!
htmlClasses:classes title:title backTo:backRef
|classNames s|
classNames := (classes collect:[:cls | cls name]) asOrderedCollection sort.
s := '' writeStream.
s nextPutAll:'
<html>
<head>
<title>
'.
s nextPutAll:title.
s nextPutAll:'
</title>
</head>
<body>
'.
backRef notNil ifTrue:[
backRef == #none ifFalse:[
s nextPutAll:'<a NOPRINT HREF="TOP.html" action="html:' , self name , ' ' , backRef , '"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>'.
]
] ifFalse:[
s nextPutAll:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>'.
].
backRef ~~ #none ifTrue:[
s nextPutAll:'<hr>
'.
].
s nextPutAll:'
<h1>
'.
s nextPutLine:title.
s nextPutAll:'
</h1>
<ul>
'.
classNames do:[:nm |
s nextPutLine:'<li><a href="../misc/onlyInSTX2.html" action="html:' , self name ,' htmlDocOf:' , nm , '">' , nm , '</A>'
].
s nextPutAll:'
</ul>
</body>
</html>
'.
^ s contents
"Created: 23.4.1996 / 15:31:55 / cg"
"Modified: 9.11.1996 / 00:16:48 / cg"
!
htmlClassesListOfCategory:category
^ self
htmlClassesListOfCategory:category
backTo:nil
"Modified: 5.1.1997 / 20:09:36 / cg"
!
htmlClassesListOfCategory:category backTo:backRef
|classes|
classes := Smalltalk allClasses
select:[:cls | cls isPrivate not
and:[(cls isNamespace not or:[cls == Smalltalk])
and:[cls category = category]]
].
^ self
htmlClasses:classes title:('Classes in: ' , category)
backTo:backRef
"Created: 23.4.1996 / 15:39:39 / cg"
"Modified: 5.1.1997 / 20:09:15 / cg"
!
htmlClassesMatching:aMatchPattern backTo:backRef
|classes cls|
classes := Smalltalk allClasses
select:[:cls | cls isPrivate not
and:[(cls isNamespace not or:[cls == Smalltalk])
and:[aMatchPattern match:cls name]]
].
^ self
htmlClasses:classes title:('Classes matching: ' , aMatchPattern)
backTo:backRef
"
self htmlClassesMatching:'Tgen::*' backTo:nil
"
"Modified: 11.1.1997 / 19:40:17 / cg"
!
htmlDocOf:aClass
^ self htmlDocOf:aClass back:nil backRef:nil
"
self htmlDocOf:PostscriptPrinterStream
"
"Modified: 24.4.1996 / 15:03:06 / cg"
!
htmlDocOf:aClass back:backCmd
^ self htmlDocOf:aClass back:backCmd backRef:nil
"Modified: 24.4.1996 / 15:03:30 / cg"
!
htmlDocOf:aClass back:backCmd backRef:backRef
"generate a nice HTML page from a class, with a back-reference
to a command or document.
Extract sections from the classes documentation method,
where the following lines start a special subsection:
[see also:] - references to other classes and/or documents
[start with:] - one-liners to start a demonstration
[author:] - author(s) of this class
[warning:] - usage warnings if any
[hints:] - usage hints if any
Each section ends with an empty line - however, for formatting,
a line consisting of a single backslash character will be converted
to an empty line.
Extract examples from the classes example method,
where executable examples are made from sections enclosed in:
[exBegin]
...
[exEnd]
these parts are displayed in courier and will be made executable.
everything else is plain documentation text.
"
|supers s indent m docu examples firstIndent firstNonEmpty
collectionOfCategories collectionOfClassCategories
revInfo pckgInfo subs refLines demoLines warnLines hintLines
backHRef authorLines first wasLoaded didLoadBin
privateClasses owner className metaClass shortName shortMetaName
text path|
(wasLoaded := aClass isLoaded) ifFalse:[
"/ load it - but not a binary
didLoadBin := Smalltalk loadBinaries.
Smalltalk loadBinaries:false.
[
aClass autoload.
] valueNowOrOnUnwindDo:[
didLoadBin ifTrue:[Smalltalk loadBinaries:true].
]
].
owner := aClass owningClass.
privateClasses := aClass privateClasses.
className := aClass name.
shortName := aClass nameWithoutPrefix.
metaClass := aClass class.
shortMetaName := metaClass nameWithoutPrefix.
"/
"/ extract documentation or comment, if there is any
"/
m := metaClass compiledMethodAt:#documentation.
m notNil ifTrue:[
docu := m comment.
] ifFalse:[
"try comment"
docu := aClass comment.
].
(docu notNil and:[docu isEmpty]) ifTrue:[
docu := nil
].
docu notNil ifTrue:[
docu := (docu copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
docu := docu asStringCollection.
"/
"/ search for a [see also:] section
"/
refLines := self extractSpecial:'[see also:]' from:docu.
"/
"/ search for a [start with:] section
"/
demoLines := self extractSpecial:'[start with:]' from:docu.
"/
"/ search for a [author:] section
"/
authorLines := self extractSpecial:'[author:]' from:docu.
authorLines isNil ifTrue:[
authorLines := self extractSpecial:'[authors:]' from:docu.
].
"/
"/ search for a [warning:] section
"/
warnLines := self extractSpecial:'[warning:]' from:docu.
"/
"/ search for a [hints:] section
"/
hintLines := self extractSpecial:'[hints:]' from:docu.
hintLines isNil ifTrue:[
hintLines := self extractSpecial:'[hint:]' from:docu.
].
"/
"/ strip off empty lines
"/
[(docu at:1) size == 0] whileTrue:[
docu removeIndex:1
].
[(docu at:docu size) size == 0] whileTrue:[
docu removeIndex:(docu size)
].
docu notEmpty ifTrue:[
firstIndent := docu first leftIndent.
firstIndent > 0 ifTrue:[
docu := docu collect:[:line |
line leftIndent >= firstIndent ifTrue:[
line copyFrom:firstIndent + 1.
] ifFalse:[
line
]
].
].
firstNonEmpty := docu findFirst:[:line | line notEmpty].
firstNonEmpty > 1 ifTrue:[
docu := docu copyFrom:firstNonEmpty
]
].
docu := docu asString.
].
refLines notNil ifTrue:[
refLines := refLines collect:[:l |
|t|
((t := l withoutSeparators) startsWith:'(') ifTrue:[
t
] ifFalse:[
l asCollectionOfWords
]
].
].
"/
"/ extract examples if there are any
"/
m := metaClass compiledMethodAt:#examples.
m notNil ifTrue:[
examples := m comment.
examples notNil ifTrue:[
examples isEmpty ifTrue:[
examples := nil
].
].
examples notNil ifTrue:[
examples := (examples copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
examples := examples asStringCollection.
"/
"/ strip off empty lines
"/
[examples first size == 0] whileTrue:[
examples removeIndex:1
].
[examples last size == 0] whileTrue:[
examples removeIndex:(examples size)
].
examples notEmpty ifTrue:[
firstIndent := examples first withTabsExpanded leftIndent.
firstIndent > 0 ifTrue:[
examples := examples collect:[:line |
|l|
l := line withTabsExpanded.
l leftIndent >= firstIndent ifTrue:[
l copyFrom:firstIndent.
] ifFalse:[
l
]
].
].
firstNonEmpty := examples findFirst:[:line | line notEmpty].
firstNonEmpty > 1 ifTrue:[
examples := examples copyFrom:firstNonEmpty
]
].
]
].
collectionOfClassCategories := metaClass categories.
collectionOfClassCategories size > 0 ifTrue:[
collectionOfClassCategories := collectionOfClassCategories asOrderedCollection.
collectionOfClassCategories remove:'documentation' ifAbsent:nil.
].
collectionOfCategories := aClass categories.
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection.
].
(aClass == Autoload or:[aClass == Object]) ifTrue:[
subs := #()
] ifFalse:[
subs := aClass subclasses
asOrderedCollection sort:[:a :b | a name < b name].
].
s := '' writeStream.
s nextPutLine:'<html><head><title>'.
s nextPutAll:'Class: '; nextPutLine:(className).
s nextPutLine:'</title></head><body>'.
backRef isNil ifTrue:[
backHRef := 'TOP.html'
] ifFalse:[
backHRef := backRef
].
backCmd notNil ifTrue:[
s nextPutAll:'<a NOPRINT HREF="' , backHRef , '" action="html:' , self name , ' ' , backCmd , '"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>'.
s nextPutLine:'<hr>'.
] ifFalse:[
backHRef ~~ #none ifTrue:[
s nextPutAll:'<a NOPRINT HREF="' , backHRef , '"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>';cr.
s nextPutLine:'<hr>'.
]
].
s nextPutLine:'<h1>'.
s nextPutAll:'Class: ';
nextPutAll:'<a INFO="open a browser on ' , shortName , '" type="example" action="SystemBrowser openInClass:' , className , '">';
nextPutAll:(shortName); nextPutLine:'</a>'.
owner notNil ifTrue:[
s nextPutAll:' (private in ';
nextPutAll:'<a INFO="open a browser on ' , owner nameWithoutPrefix , '" type="example" action="SystemBrowser openInClass:' , owner name , '">';
nextPutAll:(owner nameWithoutPrefix); nextPutLine:'</a>)'.
] ifFalse:[
aClass nameSpace ~~ Smalltalk ifTrue:[
s nextPutAll:' (in ' , aClass nameSpace name , ')'
]
].
s nextPutLine:'</h1>'.
owner notNil ifTrue:[
s nextPutLine:'This class is only visible from within'.
s nextPutLine:owner nameWithoutPrefix.
owner owningClass notNil ifTrue:[
s nextPutAll:'(which is itself a private class of '.
s nextPutAll:owner owningClass nameWithoutPrefix.
s nextPutLine:')'
].
s nextPutLine:'.'
].
"/
"/ index
"/
"/ s nextPutAll:'Index:'; cr.
s nextPutLine:'<ul>'.
s nextPutLine:'<li><a href="#INHERITANCE" name="I_INHERITANCE">Inheritance</a>'.
docu notNil ifTrue:[
s nextPutLine:'<li><a href="#DESCRIPTION" name="I_DESCRIPTION">Description</a>'.
].
warnLines notNil ifTrue:[
warnLines := warnLines asStringCollection.
s nextPutLine:'<li><a href="#WARNING" name="I_WARNING">Warning</a>'.
].
hintLines notNil ifTrue:[
hintLines := hintLines asStringCollection.
s nextPutLine:'<li><a href="#HINTS" name="I_HINTS">Hints</a>'.
].
refLines notNil ifTrue:[
s nextPutLine:'<li><a href="#SEEALSO" name="I_SEEALSO">Related information</a>'.
].
"/ s nextPutLine:'<li><a href="#INSTANCEVARIABLES" name="I_INSTANCEVARIABLES">Instance variables</a>'.
"/ s nextPutLine:'<li><a href="#CLASSVARIABLES" name="I_CLASSVARIABLES">Class variables</a>'.
collectionOfClassCategories size > 0 ifTrue:[
s nextPutLine:'<li><a href="#CLASSPROTOCOL" name="I_CLASSPROTOCOL">Class protocol</a>'.
s nextPutLine:'<ul>'.
collectionOfClassCategories sort do:[:cat |
s nextPutLine:'<li><a name="I_' , shortMetaName , '_category_' , cat , '"' ,
' href="#' , shortMetaName , '_category_' , cat ,
'">' , cat , '</a> '.
].
s nextPutLine:'</ul>'.
].
collectionOfCategories size > 0 ifTrue:[
s nextPutLine:'<li><a href="#INSTANCEPROTOCOL" name="I_INSTANCEPROTOCOL">Instance protocol</a>'.
s nextPutLine:'<ul>'.
collectionOfCategories sort do:[:cat |
s nextPutLine:'<li><a name="I_' , shortName , '_category_' , cat , '"' ,
' href="#' , shortName , '_category_' , cat ,
'">' , cat , '</a> '.
].
s nextPutLine:'</ul>'.
].
privateClasses size > 0 ifTrue:[
privateClasses := privateClasses asOrderedCollection sort:[:a :b | a nameWithoutPrefix < b nameWithoutPrefix].
s nextPutLine:'<li><a href="#PRIVATECLASSES" name="I_PRIVATECLASSES">Private classes</a>'.
].
(aClass == Object or:[aClass == Autoload]) ifTrue:[
s nextPutLine:'<li><a href="#SUBCLASSES" name="I_SUBCLASSES">Subclasses</a>'.
].
demoLines notNil ifTrue:[
s nextPutLine:'<li><a href="#DEMOSTARTUP" name="I_DEMOSTARTUP">Demonstration</a>'.
].
examples notNil ifTrue:[
s nextPutLine:'<li><a href="#EXAMPLES" name="I_EXAMPLES">Examples</a>'.
].
s nextPutLine:'</ul>'; nextPutLine:'<hr>'.
"/
"/ hierarchy
"/
s nextPutLine:'<h2><a name="INHERITANCE" href="#I_INHERITANCE">Inheritance:</A></h2>'.
s nextPutLine:'<pre>'.
indent := 3.
first := true.
supers := aClass allSuperclasses.
(supers notNil) ifTrue:[
supers reverse do:[:cls |
|nm|
nm := cls name.
first ifFalse:[
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutAll:'+--'.
indent := indent + 3.
] ifTrue:[
s spaces:indent
].
first := false.
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , nm , '">' , nm , '</A>'.
].
s spaces:indent; nextPutLine:'|'.
s spaces:indent.
s nextPutAll:'+--<B>'; nextPutAll:className; nextPutLine:'</B>'.
indent := indent + 3.
] ifFalse:[
s spaces:indent; nextPutLine:'nil'.
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutAll:'+--<B>'; nextPutAll:className; nextPutLine:'</B>'.
aClass ~~ Object ifTrue:[
s cr.
s nextPutLine:' <B>This class inherits NOTHING - most messages will lead into doesNotUnderstand:</B>'
].
indent := indent + 3.
].
subs notEmpty ifTrue:[
subs do:[:aSubclass |
|nm|
nm := aSubclass name.
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutAll:'+--'.
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , nm , '">' , nm , '</A>'.
]
] ifFalse:[
aClass == Object ifTrue:[
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutLine:'+-- ... almost every other class ...'
]
].
s nextPutLine:'</pre>'; nextPutLine:'<hr>'.
"/
"/ category, version & package
"/
s nextPutLine:'<dl>'.
s nextPutLine:'<dt><a name="CATEGORY"><b>Category:</b></A>'.
s nextPutLine:'<dd><b>', aClass category , '</b>'.
s nextPutLine:'</dl>'.
owner notNil ifTrue:[
s nextPutLine:'<dl>'.
s nextPutLine:'<dt><a name="OWNER"><b>Owner:</b></A>'.
s nextPutAll:'<dd><b>';
nextPutAll:'<a INFO="show documentation of ' , owner nameWithoutPrefix , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , owner name , '">' , owner nameWithoutPrefix , '</A>';
nextPutLine:'</b>'.
] ifFalse:[
self htmlRevisionDocOf:aClass to:s.
].
s nextPutLine:'</dl>'.
authorLines notNil ifTrue:[
s nextPutLine:'<dl><dt><a name="AUTHOR"><b>Author:</b></A>'.
authorLines do:[:l|
s nextPutLine:'<dd><b>', l , '</b>'.
].
s nextPutLine:'</dl>'.
].
s nextPutLine:'<hr>'.
docu notNil ifTrue:[
s nextPutLine:'<h2><a name="DESCRIPTION" href="#I_DESCRIPTION">Description:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<pre>'.
s nextPutLine:docu.
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
warnLines notNil ifTrue:[
s nextPutLine:'<h2><a name="WARNING" href="#I_WARNING">Warning:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<pre>'.
firstIndent := warnLines first leftIndent.
warnLines do:[:aLine |
aLine leftIndent >= firstIndent ifTrue:[
s nextPutLine:(aLine copyFrom:firstIndent+1)
] ifFalse:[
s nextPutLine:aLine
].
].
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
hintLines notNil ifTrue:[
s nextPutLine:'<h2><a name="HINTS" href="#I_HINTS">Hints:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<pre>'.
firstIndent := hintLines first leftIndent.
hintLines do:[:aLine |
aLine leftIndent >= firstIndent ifTrue:[
s nextPutLine:(aLine copyFrom:firstIndent+1)
] ifFalse:[
s nextPutLine:aLine
].
].
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
"/
"/ see also
"/
refLines notNil ifTrue:[
s nextPutLine:'<h2><a name="SEEALSO" href="#I_SEEALSO">Related information:</A></h2>'.
s nextPutLine:'<pre>'.
refLines do:[:l |
|nm href|
s nextPutAll:' '.
l isString ifTrue:[
nm := (l copyFrom:2 to:(l indexOf:$:)-1) withoutSpaces.
href := (l copyFrom:(l indexOf:$:)+1 to:(l size - 1)) withoutSpaces.
(href startsWith:'man:') ifTrue:[
href := (href copyFrom:5) withoutSpaces.
s nextPutAll:'<a INFO="show man page" href="../misc/onlyInSTX2.html" action="html:' , self name , ' manPageFor:''' , href , '''">[<I>' , nm , '</I>]</A>'.
] ifFalse:[
(href startsWith:'html:') ifTrue:[
href := (href copyFrom:6) withoutSpaces.
].
s nextPutAll:'<a href="../' , href , '">[<I>' , nm , '</I>]</a>'.
]
] ifFalse:[
l do:[:ref |
|realRef ns|
(ref includesMatchCharacters) ifTrue:[
s nextPutAll:'<a INFO="show documentation of ' , ref , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlClassesMatching:''' , ref , ''' backTo:nil">' , ref , '</A>'.
] ifFalse:[
realRef := ref.
(ns := aClass nameSpace) notNil ifTrue:[
(ns at:realRef asSymbol) notNil ifTrue:[
realRef := ns name , '::' , realRef
]
].
s nextPutAll:'<a INFO="show documentation of ' , realRef , '" href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , realRef , '">' , ref , '</A>'.
s nextPutAll:' '.
]
].
].
s cr.
].
s nextPutLine:'</pre>'.
s nextPutLine:'<hr>'.
].
"/
"/ inst & classVars
"/ to be added
"/
"/ protocol
"/
self printOutHTMLProtocolOf:aClass on:s.
"/
"/ subclasses (only for Object and Autoload)
"/
(aClass == Object or:[aClass == Autoload]) ifTrue:[
subs := aClass subclasses
asOrderedCollection sort:[:a :b | a name < b name].
s nextPutLine:'<h2><a name="SUBCLASSES" href="#I_SUBCLASSES">Subclasses (direct subclasses only):</A></h2>'.
s nextPutLine:'<pre>'.
subs do:[:cls |
|nm|
nm := cls name.
s nextPutAll:' '.
cls isLoaded ifFalse:[
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:' , nm , ' autoload. ',self name,' htmlDocOf:' , nm, '">' , nm , '</A>'
] ifTrue:[
s nextPutLine:'<a INFO="show documentation of ' , nm , '" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , nm , '">' , nm , '</A>'
].
].
s nextPutLine:'</pre>'; nextPutLine:'<hr>'.
].
"/
"/ private classes
"/
privateClasses size > 0 ifTrue:[
s nextPutLine:'<h2><a name="PRIVATECLASSES" href="#I_PRIVATECLASSES">Private classes:</A></h2>'.
s nextPutLine:'<pre>'.
privateClasses do:[:cls |
|nm fullName|
nm := cls nameWithoutPrefix.
fullName := cls owningClass name , '::' , nm.
s nextPutAll:' '.
s nextPutLine:'<a INFO="show documentation of ' , fullName , '" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , fullName , '">' , nm , '</A>'
].
s nextPutLine:'</pre>'; nextPutLine:'<hr>'.
].
"/
"/ demonstration
"/
demoLines notNil ifTrue:[
s nextPutLine:'<h2><a name="DEMOSTARTUP" href="#I_DEMOSTARTUP">Demonstration:</A></h2>'.
demoLines do:[:l |
s nextPutLine:'<a INFO="demonstration" type="example">'.
s nextPutLine:'<code><pre>'.
s nextPutLine:' ' , l withoutSeparators.
s nextPutLine:'</pre></code>'.
s nextPutLine:'</a>'.
s nextPutLine:'<br>'.
].
s nextPutLine:'<hr>'.
].
"/
"/ add examples if there are any
"/
examples notNil ifTrue:[
s nextPutLine:'<h2><a name="EXAMPLES" href="#I_EXAMPLES">Examples:</A></h2>'.
s nextPutLine:'<BR>'.
s nextPutLine:'<code><pre>'.
examples do:[:line |
line withoutSeparators = '[exBegin]' ifTrue:[
s nextPutLine:'<a INFO="execute the example" type="example">'.
] ifFalse:[
line withoutSeparators = '[exEnd]' ifTrue:[
s nextPutLine:'</a>'.
] ifFalse:[
s nextPutLine:line
]
].
].
s nextPutLine:'</pre></code>'; nextPutLine:'<hr>'.
].
s nextPutLine:'</body>'; nextPutLine:'</html>'.
wasLoaded ifFalse:[
aClass unload
].
^ s contents
"
self htmlDocOf:Object
self htmlDocOf:Array
self htmlDocOf:Filename
self htmlDocOf:Block
"
"Created: 24.4.1996 / 15:01:59 / cg"
"Modified: 11.1.1997 / 19:43:23 / cg"
!
htmlDocOf:aClass backRef:backRef
^ self htmlDocOf:aClass back:nil backRef:backRef
"Modified: 24.4.1996 / 15:02:52 / cg"
"Created: 24.4.1996 / 15:03:25 / cg"
!
htmlDocOfImplementorsOf:selector
|sel s|
sel := (selector copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
s := '' writeStream.
s nextPutLine:'<html><head><title>'.
s nextPutLine:sel.
s nextPutLine:'</title></head>'.
s nextPutLine:'<body>'.
s nextPutLine:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>'.
s nextPutLine:'<hr>'.
s nextPutAll:'<h1>'; nextPutAll:sel; nextPutAll:'</h1>'.
s nextPutLine:'<dl>'.
sel := selector asSymbol.
Smalltalk allClassesDo:[:cls |
cls isPrivate ifFalse:[
(cls implements:sel) ifTrue:[
self printOutHTMLMethodProtocol:(cls compiledMethodAt:sel)
on:s showClassName:true classRef:true.
s nextPutLine:'<p>'.
]
]
].
s nextPutLine:'</dl>'.
s nextPutLine:'</body></html>'.
^ s contents
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 9.11.1996 / 00:34:30 / cg"
!
htmlRevisionDocOf:aClass to:s
|revInfo pckgInfo text path|
revInfo := aClass revisionInfo.
pckgInfo := aClass packageSourceCodeInfo.
s nextPutLine:'<dl><dt><a name="VERSION"><b>Version:</b></A>'.
(revInfo isNil and:[pckgInfo isNil]) ifTrue:[
s nextPutLine:'<dd>no revision info'.
] ifFalse:[
revInfo isNil ifTrue:[revInfo := IdentityDictionary new].
pckgInfo isNil ifTrue:[pckgInfo := IdentityDictionary new].
s nextPutLine:'<dd>rev: <b>'.
"/ fetch the revision-info; prefer revisionInfo
text := revInfo at:#revision ifAbsent:(pckgInfo at:#revision ifAbsent:'?').
s nextPutLine:text.
"/ fetch the date & time; prefer revisionInfo
text := revInfo at:#date ifAbsent:(pckgInfo at:#date ifAbsent:'?').
s nextPutAll:'</b> date: <b>' , text.
text := revInfo at:#time ifAbsent:(pckgInfo at:#time ifAbsent:'?').
s nextPutLine:' ', text , '</b>'.
text := revInfo at:#user ifAbsent:(pckgInfo at:#user ifAbsent:'?').
s nextPutLine:'<dd>user: <b>' , text , '</b>'.
text := revInfo at:#fileName ifAbsent:(pckgInfo at:#fileNamer ifAbsent:'?').
s nextPutAll:'<dd>file: <b>' , text.
text := revInfo at:#directory ifAbsent:(pckgInfo at:#directory ifAbsent:nil).
text isNil ifTrue:[
path := revInfo at:#repositoryPathName ifAbsent:(pckgInfo at:#repositoryPathName ifAbsent:nil).
path notNil ifTrue:[
SourceCodeManager notNil ifTrue:[
text := SourceCodeManager directoryFromContainerPath:path.
].
text isNil ifTrue:[text := '?'].
] ifFalse:[
text := '?'
]
].
s nextPutLine:'</b> directory: <b>' , text , '</b>'.
text := revInfo at:#module ifAbsent:(pckgInfo at:#module ifAbsent:nil).
text isNil ifTrue:[
path := revInfo at:#repositoryPathName ifAbsent:(pckgInfo at:#repositoryPathName ifAbsent:nil).
path notNil ifTrue:[
SourceCodeManager notNil ifTrue:[
text := SourceCodeManager moduleFromContainerPath:path.
].
text isNil ifTrue:[text := '?'].
] ifFalse:[
text := '?'
]
].
s nextPutAll:'<dd>module: <b>' , text.
text := revInfo at:#library ifAbsent:(pckgInfo at:#library ifAbsent:'*none*').
s nextPutLine:'</b> stc-classLibrary: <b>' , text , '</b>'.
].
"Created: 8.1.1997 / 13:43:28 / cg"
"Modified: 23.1.1997 / 14:08:24 / cg"
!
htmlSelectorList
|selectors|
selectors := IdentitySet new.
Smalltalk allClassesDo:[:cls |
selectors addAll:cls methodDictionary keys.
].
selectors := selectors asOrderedCollection sort.
^ self htmlSelectors:selectors title:('All selectors:').
"
self htmlSelectorList
"
"Modified: 22.4.1996 / 12:48:45 / cg"
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 5.6.1996 / 12:27:09 / stefan"
!
htmlSelectorListMatching:pattern
|selectors|
selectors := IdentitySet new.
Smalltalk allClassesDo:[:cls |
cls methodDictionary keysDo:[:sel |
(pattern match:sel) ifTrue:[
selectors add:sel.
]
]
].
selectors := selectors asOrderedCollection sort.
^ self htmlSelectors:selectors title:('Selectors matching ''' , pattern , ''':').
"
self htmlSelectorListMatching:'*do*'
"
"Modified: 22.4.1996 / 17:11:56 / cg"
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 5.6.1996 / 12:29:27 / stefan"
!
htmlSelectorListPrefix:prefix
|selectors|
selectors := IdentitySet new.
Smalltalk allClassesDo:[:cls |
cls methodDictionary keysDo:[:sel |
(sel startsWith:prefix) ifTrue:[
selectors add:sel.
]
]
].
selectors := selectors asOrderedCollection sort.
^ self htmlSelectors:selectors title:('Selectors starting with ''' , prefix asString , ''':').
"
self htmlSelectorListPrefix:'a'
"
"Modified: 22.4.1996 / 19:57:50 / cg"
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 5.6.1996 / 12:31:13 / stefan"
!
htmlSelectors:selectors title:title
|s|
s := '' writeStream.
s nextPutLine:'<html><head><title>'.
s nextPutLine:title.
s nextPutLine:'</title></head>'.
s nextPutLine:'<body>'.
s nextPutLine:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>'.
s nextPutLine:'<hr>'.
s nextPutAll:'<h1>'; nextPutAll:title; nextPutAll:'</h1>'.
s nextPutLine:'<ul>'.
selectors do:[:sel |
|nm|
nm := (sel copy replChar:$< withString:'<')
replChar:$> withString:'>'.
s nextPutLine:'<li><a href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOfImplementorsOf:''' , nm , '''">' , nm , '</A>'
].
s nextPutLine:'</ul>'.
s nextPutLine:'</body></html>'.
^ s contents
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 9.11.1996 / 00:34:38 / cg"
!
manPageFor:aCommand
"q&d hack to convert man output to html"
^ self
manPageFor:aCommand
inSection:nil
"Modified: 9.9.1996 / 17:45:29 / cg"
!
manPageFor:aCommand inSection:sectionOrNil
"q&d hack to convert man output to html"
|manCmd|
sectionOrNil isNil ifTrue:[
manCmd := 'man ' , aCommand
] ifFalse:[
manCmd := 'man ' , sectionOrNil printString , ' ' , aCommand
].
^ self
manPageFor:aCommand
manCommand:manCmd.
"Created: 9.9.1996 / 17:45:08 / cg"
"Modified: 9.9.1996 / 17:48:29 / cg"
!
manPageFor:aCommand manCommand:manCommand
"q&d hack to convert man output to html"
|s t outStream state ch keep|
s := PipeStream readingFrom:manCommand.
s notNil ifTrue:[
outStream := '' writeStream.
state := nil.
keep := nil.
[s atEnd] whileFalse:[
ch := s next.
ch notNil ifTrue:[
state == nil ifTrue:[
ch == Character backspace ifTrue:[
state := #back
] ifFalse:[
keep notNil ifTrue:[
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep.
].
].
keep := ch
]
] ifFalse:[
state == #back ifTrue:[
ch == keep ifTrue:[
outStream nextPutAll:'<b>'.
ch == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:ch.
].
outStream nextPutAll:'</b>'.
state := nil.
keep := nil.
] ifFalse:[
ch == $_ ifTrue:[
keep notNil ifTrue:[
outStream nextPutAll:'<i>'.
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep.
].
outStream nextPutAll:'</i>'.
].
state := nil.
keep := nil.
] ifFalse:[
keep == $_ ifTrue:[
outStream nextPutAll:'<i>'.
ch == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:ch.
].
outStream nextPutAll:'</i>'.
state := nil.
keep := nil.
] ifFalse:[
keep notNil ifTrue:[
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep.
].
ch == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:ch.
]
].
state := nil.
keep := nil.
]
]
]
]
]
]
].
keep notNil ifTrue:[
keep == $< ifTrue:[
outStream nextPutAll:'<'.
] ifFalse:[
outStream nextPut:keep
]
].
t := outStream contents.
s shutDown.
].
(t isNil or:[t isEmpty]) ifTrue:[
^ '
No manual page for "<CODE><B>' , aCommand , '</B></CODE>" available.
<BR>
(the failed command was: "<CODE>' , manCommand , '"</CODE>.)
'.
].
^ '
<pre>
' , t , '
</pre>
'
"
self manPageFor:'cvs'
"
"Modified: 28.6.1996 / 21:28:47 / stefan"
"Created: 9.9.1996 / 17:43:16 / cg"
"Modified: 9.9.1996 / 17:58:00 / cg"
!
printOutHTMLCategoryProtocol:aCategory of:aClass on:aStream
|any dict selectors methods shortName|
shortName := aClass nameWithoutPrefix.
dict := aClass methodDictionary.
dict notNil ifTrue:[
any := false.
dict do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
any := true
]
].
any ifTrue:[
aStream nextPutLine:'<a name="' , shortName , '_category_' , aCategory ,
'" href="#I_' , shortName , '_category_' , aCategory ,
'"><b>' , aCategory , '</b></A>'.
aStream nextPutLine:'<dl>'.
selectors := dict keys asArray.
methods := dict values.
selectors sortWith:methods.
methods do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
ErrorSignal catch:[
self printOutHTMLMethodProtocol:aMethod on:aStream.
].
aStream nextPutLine:'<p>'.
]
].
aStream nextPutLine:'</dl>'.
]
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 5.6.1996 / 13:41:27 / stefan"
"Modified: 30.12.1996 / 18:47:23 / cg"
!
printOutHTMLMethodProtocol:aMethod on:aStream
"given the source in aString, print the methods message specification
and any method comments - without source; used to generate documentation
pages"
^ self printOutHTMLMethodProtocol:aMethod on:aStream showClassName:false classRef:false
"Modified: 22.4.1996 / 18:01:56 / cg"
"Created: 22.4.1996 / 20:03:30 / cg"
!
printOutHTMLMethodProtocol:aMethod on:aStream showClassName:showClassName classRef:withClassRef
"given the source in aString, print the methods message specification
and any method comments - without source; used to generate documentation
pages"
|comment cls sel partStream args argStream who methodSpecLine first
firstIndent firstNonEmpty isSubres isObsolete smallOrEmpty
ballColor|
who := aMethod who.
cls := who methodClass.
sel := who methodSelector.
partStream := sel keywords readStream.
(args := aMethod methodArgNames) notNil ifTrue:[
argStream := aMethod methodArgNames readStream.
methodSpecLine := ''. first := true.
1 to:sel numArgs do:[:index |
first ifTrue:[
first := false.
] ifFalse:[
methodSpecLine := methodSpecLine , ' '
].
methodSpecLine := methodSpecLine , '<B>' , partStream next , '</B>'.
methodSpecLine := methodSpecLine , ' <I>' , argStream next , '</I>'.
].
] ifFalse:[
methodSpecLine := '<B>' , partStream next , '</B>'
].
isSubres := (aMethod sends:#subclassResponsibility).
isObsolete := false.
((aMethod sends:#obsoleteMethodWarning)
or:[(aMethod sends:#obsoleteMethodWarning:)
or:[(aMethod sends:#obsoleteMethodWarning:from:)]]) ifTrue:[
cls ~~ Object ifTrue:[
isObsolete := true
]
].
smallOrEmpty := ''.
aMethod isPrivate ifTrue:[
methodSpecLine := '<i>private</I> ' , methodSpecLine.
"/ smallOrEmpty := '-small'.
] ifFalse:[
aMethod isProtected ifTrue:[
methodSpecLine := '<i>protected</I> ' , methodSpecLine.
"/ smallOrEmpty := '-small'.
] ifFalse:[
aMethod isIgnored ifTrue:[
methodSpecLine := '[ ' , methodSpecLine , ' ] (<i>invisible</I>)'.
"/ smallOrEmpty := '-small'.
]
]
].
aStream nextPutLine:'<dt>'.
cls isMeta ifTrue:[
ballColor := 'yellow'
] ifFalse:[
ballColor := 'red'
].
aStream nextPutLine:'<img src="pictures/' , ballColor , '-ball' , smallOrEmpty , '.gif" width=6 height=6>'.
sel := (sel copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
withClassRef ifTrue:[
aStream nextPutLine:'<a name="' , cls name , '_' , sel ,
'" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , cls name ,
'">' , cls name , '</a> ' , methodSpecLine.
] ifFalse:[
showClassName ifTrue:[
methodSpecLine := cls name , ' ' , methodSpecLine
].
aStream nextPutLine:'<a name="' , cls name , '_' , sel ,
"/ '" href="' , cls name , '_' , sel , '"' ,
'>' , methodSpecLine , '</a>'.
].
aStream nextPutLine:'<dd>'.
(comment := aMethod comment) notNil ifTrue:[
comment := (comment copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
comment notEmpty ifTrue:[
comment := comment asStringCollection.
firstIndent := comment first leftIndent.
firstIndent > 0 ifTrue:[
comment := comment collect:[:line |
line leftIndent >= firstIndent ifTrue:[
line copyFrom:firstIndent.
] ifFalse:[
line
]
].
].
firstNonEmpty := comment findFirst:[:line | line notEmpty].
firstNonEmpty > 1 ifTrue:[
comment := comment copyFrom:firstNonEmpty
].
comment := comment asString.
].
comment asStringCollection do:[:line |
aStream nextPutAll:line; nextPutLine:'<br>'.
].
].
isSubres ifTrue:[
aStream nextPutLine:'<BR>'.
aStream nextPutLine:'<I>** This method raises an error - it must be redefined in concrete classes **</I>'.
].
isObsolete ifTrue:[
aStream nextPutLine:'<BR>'.
aStream nextPutLine:'<I>** This is an obsolete interface - do not use it (it may vanish in future versions) **</I>'.
].
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 9.11.1996 / 00:36:04 / cg"
!
printOutHTMLProtocolOf:aClass on:aStream
|collectionOfCategories any|
"/ self printOutDefinitionOn:aPrintStream.
collectionOfCategories := aClass class categories.
any := false.
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection.
collectionOfCategories remove:'documentation' ifAbsent:[].
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories sort.
aStream nextPutLine:'<h2><a name="CLASSPROTOCOL" href="#I_CLASSPROTOCOL">Class protocol:</A></h2>'.
collectionOfCategories do:[:aCategory |
self printOutHTMLCategoryProtocol:aCategory of:aClass class on:aStream.
any := true.
].
"/ any ifFalse:[
"/ aStream nextPutAll:'no new protocol'
"/ ].
aStream nextPutLine:'<hr>'.
]
].
collectionOfCategories := aClass categories.
any := false.
collectionOfCategories size > 0 ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection sort.
aStream nextPutLine:'<h2><a name="INSTANCEPROTOCOL" href="#I_INSTANCEPROTOCOL">Instance protocol:</A></h2>'.
collectionOfCategories do:[:aCategory |
self printOutHTMLCategoryProtocol:aCategory of:aClass on:aStream
].
"/ any ifFalse:[
"/ aStream nextPutAll:'no new protocol'
"/ ].
aStream nextPutLine:'<hr>'.
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 30.12.1996 / 19:06:50 / cg"
! !
!HTMLDocGenerator class methodsFor:'helpers'!
extractSpecial:pattern from:docu
"given a collection of docu lines (from documentation methods comment),
extract things like [see also:], [author:] etc.
If found, remove the lines from the string collection,
and return the extracted ones. Otherwise return nil."
|srchIdx idx lines l|
srchIdx := docu findFirst:[:l | l asLowercase withoutSeparators = pattern].
srchIdx ~~ 0 ifTrue:[
lines := OrderedCollection new.
idx := srchIdx+1.
[idx <= docu size] whileTrue:[
l := docu at:idx.
(l isNil or:[l withoutSeparators size == 0]) ifTrue:[
idx := docu size + 1.
] ifFalse:[
l withoutSeparators = '\' ifTrue:[
l := ''
].
lines add:l
].
idx := idx + 1.
].
docu removeFromIndex:srchIdx toIndex:srchIdx+lines size
].
^ lines
"Created: 25.4.1996 / 14:16:01 / cg"
"Modified: 11.1.1997 / 13:03:38 / cg"
! !
!HTMLDocGenerator class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.15 1997-03-01 23:26:31 cg Exp $'
! !