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
|classes categories s prefixList prefix prefixStack indent prev|
categories := Set new.
Smalltalk allClasses do:[:cls |
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 nextPutAll:'<p>';cr.
].
s nextPutAll:'<li>' , longest ;cr.
].
s nextPutAll:'<ul>'; cr.
prefix := longest.
] ifFalse:[
s nextPutAll:'</ul>';cr.
prefixStack removeLast.
[prefixStack notEmpty
and:[(longest startsWith:prefixStack last) not]] whileTrue:[
s nextPutAll:'</ul>';cr.
prefixStack removeLast.
].
prefixStack notEmpty ifTrue:[
prefix := prefixStack last.
] ifFalse:[
prefixStack addLast:longest.
prefix := longest.
longest ~= prev ifTrue:[
prefixStack size == 1 ifTrue:[
s nextPutAll:'<p>';cr.
].
s nextPutAll:'<li>' , longest ;cr.
].
s nextPutAll:'<ul>'; cr.
]
].
]
] ifFalse:[
[prefixStack size > 0] whileTrue:[
s nextPutAll:'</ul>';cr.
prefixStack removeLast.
].
prefixStack size == 0 ifTrue:[
s nextPutAll:'<p>';cr.
].
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: 7.9.1996 / 19:59:55 / cg"
!
htmlClassListPrefix:prefix
|classes|
classes := Smalltalk allClasses
select:[:cls | cls name startsWith:prefix].
^ self htmlClasses:classes title:('Classes starting with ''' , prefix asString , ''':').
"Modified: 20.4.1996 / 22:42:13 / cg"
"Created: 22.4.1996 / 20:03:31 / 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 nextPutAll:title; cr.
s nextPutAll:'
</h1>
<ul>
'.
classNames do:[:nm |
s nextPutAll:'<li><a href="../misc/onlyInSTX2.html" action="html:' , self name ,' htmlDocOf:' , nm , '">' , nm , '</A>';cr
].
s nextPutAll:'
</ul>
</body>
</html>
'.
^ s contents
"Created: 23.4.1996 / 15:31:55 / cg"
"Modified: 7.9.1996 / 20:00:10 / cg"
!
htmlClassesListOfCategory:category
|classes|
classes := Smalltalk allClasses
select:[:cls | cls category = category].
^ self
htmlClasses:classes
title:('Classes in: ' , category)
backTo:nil
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 23.4.1996 / 15:42:17 / cg"
!
htmlClassesListOfCategory:category backTo:backRef
|classes|
classes := Smalltalk allClasses
select:[:cls | cls category = category].
^ self
htmlClasses:classes title:('Classes in: ' , category)
backTo:backRef
"Modified: 23.4.1996 / 15:31:38 / cg"
"Created: 23.4.1996 / 15:39:39 / 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
|supers s indent m docu examples firstIndent firstNonEmpty
collectionOfCategories collectionOfClassCategories
revInfo pckgInfo subs refLines srchIdx l idx demoLines
backHRef authorLines first wasLoaded didLoadBin|
(wasLoaded := aClass isLoaded) ifFalse:[
"/ load it - but not a binary
didLoadBin := Smalltalk loadBinaries.
Smalltalk loadBinaries:false.
aClass autoload.
didLoadBin ifTrue:[Smalltalk loadBinaries:true].
].
"/
"/ extract documentation or comment, if there is any
"/
m := aClass class compiledMethodAt:#documentation.
m notNil ifTrue:[
docu := m comment.
] ifFalse:[
"try comment"
docu := aClass comment.
].
docu notNil ifTrue:[
docu isEmpty ifTrue:[
docu := nil
].
].
docu notNil ifTrue:[
docu := (docu copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
docu := docu asStringCollection.
"/
"/ search for a [see also:] line
"/
refLines := self extractSpecial:'[see also:]' from:docu.
"/
"/ search for a [start with:] line
"/
demoLines := self extractSpecial:'[start with:]' from:docu.
"/
"/ search for a [author:] line
"/
authorLines := self extractSpecial:'[author:]' 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.
] 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 := aClass class 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 := aClass class 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 nextPutAll:'<html>'; cr.
s nextPutAll:'<head>'; cr.
s nextPutAll:'<title>'; cr.
s nextPutAll:'Class: '; nextPutAll:(aClass name); cr.
s nextPutAll:'</title>'; cr.
s nextPutAll:'</head>'; cr.
s nextPutAll:'<body>'; cr.
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 nextPutAll:'<hr>'; cr.
] ifFalse:[
backHRef ~~ #none ifTrue:[
s nextPutAll:'<a NOPRINT HREF="' , backHRef , '"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>';cr.
s nextPutAll:'<hr>'; cr.
]
].
s nextPutAll:'<h1>'; cr.
s nextPutAll:'Class: ';
nextPutAll:'<a type="example" action="SystemBrowser openInClass:' , aClass name , '">';
nextPutAll:(aClass name); nextPutAll:'</a>'; cr.
s nextPutAll:'</h1>'; cr.
"/
"/ index
"/
"/ s nextPutAll:'Index:'; cr.
s nextPutAll:'<ul>'; cr.
s nextPutAll:'<li><a href="#INHERITANCE" name="I_INHERITANCE">Inheritance</a>'; cr.
docu notNil ifTrue:[
s nextPutAll:'<li><a href="#DESCRIPTION" name="I_DESCRIPTION">Description</a>'; cr.
].
refLines notNil ifTrue:[
s nextPutAll:'<li><a href="#SEEALSO" name="I_SEEALSO">Related information</a>'; cr.
].
"/ s nextPutAll:'<li><a href="#INSTANCEVARIABLES" name="I_INSTANCEVARIABLES">Instance variables</a>'; cr.
"/ s nextPutAll:'<li><a href="#CLASSVARIABLES" name="I_CLASSVARIABLES">Class variables</a>'; cr.
collectionOfClassCategories size > 0 ifTrue:[
s nextPutAll:'<li><a href="#CLASSPROTOCOL" name="I_CLASSPROTOCOL">Class protocol</a>'; cr.
s nextPutAll:'<ul>'; cr.
collectionOfClassCategories sort do:[:cat |
s nextPutAll:'<li><a name="I_' , aClass class name , '_category_' , cat , '"' ,
' href="#' , aClass class name , '_category_' , cat ,
'">' , cat , '</a> '; cr.
].
s nextPutAll:'</ul>'; cr.
].
collectionOfCategories size > 0 ifTrue:[
s nextPutAll:'<li><a href="#INSTANCEPROTOCOL" name="I_INSTANCEPROTOCOL">Instance protocol</a>'; cr.
s nextPutAll:'<ul>'; cr.
collectionOfCategories sort do:[:cat |
s nextPutAll:'<li><a name="I_' , aClass name , '_category_' , cat , '"' ,
' href="#' , aClass name , '_category_' , cat ,
'">' , cat , '</a> '; cr.
].
s nextPutAll:'</ul>'; cr.
].
(aClass == Object or:[aClass == Autoload]) ifTrue:[
s nextPutAll:'<li><a href="#SUBCLASSES" name="I_SUBCLASSES">Subclasses</a>'; cr.
].
demoLines notNil ifTrue:[
s nextPutAll:'<li><a href="#DEMOSTARTUP" name="I_DEMOSTARTUP">Demonstration</a>'; cr.
].
examples notNil ifTrue:[
s nextPutAll:'<li><a href="#EXAMPLES" name="I_EXAMPLES">Examples</a>'; cr.
].
s nextPutAll:'</ul>'; cr.
s nextPutAll:'<hr>'; cr.
"/
"/ hierarchy
"/
s nextPutAll:'<h2><a name="INHERITANCE" href="#I_INHERITANCE">Inheritance:</A></h2>'; cr.
s nextPutAll:'<pre>'; cr.
indent := 3.
first := true.
supers := aClass allSuperclasses.
(supers notNil) ifTrue:[
supers reverse do:[:cls |
|nm|
nm := cls name.
first ifFalse:[
s spaces:indent; nextPutAll:'|'; cr.
s spaces:indent; nextPutAll:'+--'.
indent := indent + 3.
] ifTrue:[
s spaces:indent
].
first := false.
s nextPutAll:'<a href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , nm , '">' , nm , '</A>';cr.
].
s spaces:indent; nextPutAll:'|'; cr.
s spaces:indent.
s nextPutAll:'+--<B>'; nextPutAll:aClass name; nextPutAll:'</B>'; cr.
indent := indent + 3.
] ifFalse:[
s spaces:indent; nextPutAll:'nil'; cr.
s spaces:indent; nextPutAll:'|'; cr.
s spaces:indent; nextPutAll:'+--<B>'; nextPutAll:aClass name; nextPutAll:'</B>'; cr.
aClass ~~ Object ifTrue:[
s cr.
s nextPutAll:' <B>This class inherits NOTHING - most messages will lead into doesNotUnderstand:</B>'; cr
].
indent := indent + 3.
].
subs notEmpty ifTrue:[
subs do:[:aSubclass |
|nm|
nm := aSubclass name.
s spaces:indent; nextPutAll:'|'; cr.
s spaces:indent; nextPutAll:'+--'.
s nextPutAll:'<a href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , nm , '">' , nm , '</A>';cr.
]
] ifFalse:[
aClass == Object ifTrue:[
s spaces:indent; nextPutAll:'|'; cr.
s spaces:indent; nextPutAll:'+-- ... almost every other class ...'; cr
]
].
s nextPutAll:'</pre>'; cr.
s nextPutAll:'<hr>'; cr.
"/
"/ category, version & package
"/
s nextPutAll:'<dl>'; cr.
s nextPutAll:'<dt><a name="CATEGORY"><b>Category:</b></A>'; cr.
s nextPutAll:'<dd><b>', aClass category , '</b>'; cr.
s nextPutAll:'</dl>'; cr.
revInfo := aClass revisionInfo.
pckgInfo := aClass packageSourceCodeInfo.
s nextPutAll:'<dl>'; cr.
s nextPutAll:'<dt><a name="VERSION"><b>Version:</b></A>'; cr.
(revInfo isNil and:[pckgInfo isNil]) ifTrue:[
s nextPutAll:'<dd>no revision info'; cr.
] ifFalse:[
revInfo isNil ifTrue:[revInfo := IdentityDictionary new].
pckgInfo isNil ifTrue:[pckgInfo := IdentityDictionary new].
s nextPutAll:'<dd>rev: <b>'; cr.
s nextPutAll:(revInfo at:#revision ifAbsent:'?'); cr.
s nextPutAll:'</b> date: <b>' , (revInfo at:#date ifAbsent:'')
, ' ', (revInfo at:#time ifAbsent:'') , '</b>'; cr.
s nextPutAll:'<dd>user: <b>' , (revInfo at:#user ifAbsent:'?') , '</b>';cr.
s nextPutAll:'<dd>file: <b>' , (revInfo at:#fileName ifAbsent:'?').
s nextPutAll:'</b> directory: <b>' , (pckgInfo at:#directory ifAbsent:'?') , '</b>'; cr.
s nextPutAll:'<dd>module: <b>' , (pckgInfo at:#module ifAbsent:'?')
, '</b> classLibrary: <b>' , (pckgInfo at:#library ifAbsent:'?') , '</b>';cr.
].
s nextPutAll:'</dl>'; cr.
authorLines notNil ifTrue:[
s nextPutAll:'<dl>'; cr.
s nextPutAll:'<dt><a name="AUTHOR"><b>Author:</b></A>'; cr.
authorLines do:[:l|
s nextPutAll:'<dd><b>', l , '</b>'; cr.
].
s nextPutAll:'</dl>'; cr.
].
s nextPutAll:'<hr>'; cr.
docu notNil ifTrue:[
s nextPutAll:'<h2><a name="DESCRIPTION" href="#I_DESCRIPTION">Description:</A></h2>'; cr.
s nextPutAll:'<BR>'; cr.
s nextPutAll:'<pre>'; cr.
s nextPutAll:docu;cr.
s nextPutAll:'</pre>'; cr.
s nextPutAll:'<hr>'; cr.
].
"/
"/ see also
"/
refLines notNil ifTrue:[
s nextPutAll:'<h2><a name="SEEALSO" href="#I_SEEALSO">Related information:</A></h2>'; cr.
s nextPutAll:'<pre>'; cr.
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 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 |
s nextPutAll:'<a href="../misc/onlyInSTX2.html" action="html:' , self name , ' htmlDocOf:' , ref , '">' , ref , '</A>'.
s nextPutAll:' '.
].
].
s cr.
].
s nextPutAll:'</pre>'; cr.
s nextPutAll:'<hr>'; cr.
].
"/
"/ 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 nextPutAll:'<h2><a name="SUBCLASSES" href="#I_SUBCLASSES">Subclasses (direct subclasses only):</A></h2>'; cr.
s nextPutAll:'<pre>'; cr.
subs do:[:cls |
|nm|
nm := cls name.
s nextPutAll:' '.
cls isLoaded ifFalse:[
s nextPutAll:'<a href="../misc/onlyInSTX2.html" action="html:' , nm , ' autoload. ',self name,' htmlDocOf:' , nm, '">' , nm , '</A>';cr
] ifTrue:[
s nextPutAll:'<a href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , nm , '">' , nm , '</A>';cr
].
].
s nextPutAll:'</pre>'; cr.
s nextPutAll:'<hr>'; cr.
].
"/
"/ demonstration
"/
demoLines notNil ifTrue:[
s nextPutAll:'<h2><a name="DEMOSTARTUP" href="#I_DEMOSTARTUP">Demonstration:</A></h2>'; cr.
demoLines do:[:l |
s nextPutAll:'<a type="example">'; cr.
s nextPutAll:'<code><pre>'; cr.
s nextPutAll:' ' , l withoutSeparators; cr.
s nextPutAll:'</pre></code>'; cr.
s nextPutAll:'</a>'; cr.
s nextPutAll:'<br>'; cr.
].
s nextPutAll:'<hr>'; cr.
].
"/
"/ add examples if there are any
"/
examples notNil ifTrue:[
s nextPutAll:'<h2><a name="EXAMPLES" href="#I_EXAMPLES">Examples:</A></h2>'; cr.
s nextPutAll:'<BR>'; cr.
s nextPutAll:'<code><pre>'; cr.
examples do:[:line |
line withoutSeparators = '[exBegin]' ifTrue:[
s nextPutAll:'<a type="example">'; cr.
] ifFalse:[
line withoutSeparators = '[exEnd]' ifTrue:[
s nextPutAll:'</a>'; cr.
] ifFalse:[
s nextPutAll:line; cr
]
].
].
s nextPutAll:'</pre></code>'; cr.
s nextPutAll:'<hr>'; cr.
].
s nextPutAll:'</body>'; cr.
s nextPutAll:'</html>'; cr.
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: 12.9.1996 / 08:05:38 / 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
|classNames sel s|
sel := (selector copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
s := '' writeStream.
s nextPutAll:'<html>'; cr.
s nextPutAll:'<head>'; cr.
s nextPutAll:'<title>'; cr.
s nextPutAll:sel; cr.
s nextPutAll:'</title>'; cr.
s nextPutAll:'</head>'; cr.
s nextPutAll:'<body>'; cr.
s nextPutAll:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>';cr.
s nextPutAll:'<hr>'; cr.
s nextPutAll:'<h1>'; cr.
s nextPutAll:sel ; cr.
s nextPutAll:'</h1>'; cr.
s nextPutAll:'<dl>'; cr.
sel := selector asSymbol.
Smalltalk allClassesDo:[:cls |
(cls implements:sel) ifTrue:[
self printOutHTMLMethodProtocol:(cls compiledMethodAt:sel)
on:s showClassName:true classRef:true.
s nextPutAll:'<p>'; cr.
]
].
s nextPutAll:'</dl>'; cr.
s nextPutAll:'</body>'; cr.
s nextPutAll:'</html>'; cr.
^ s contents
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 7.9.1996 / 20:00:31 / 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
|classNames s|
s := '' writeStream.
s nextPutAll:'<html>'; cr.
s nextPutAll:'<head>'; cr.
s nextPutAll:'<title>'; cr.
s nextPutAll:title; cr.
s nextPutAll:'</title>'; cr.
s nextPutAll:'</head>'; cr.
s nextPutAll:'<body>'; cr.
s nextPutAll:'<a NOPRINT HREF="TOP.html"> <IMG SRC="../icons/DocsUpArrow.gif" ALT="back"></A>';cr.
s nextPutAll:'<hr>'; cr.
s nextPutAll:'<h1>'; cr.
s nextPutAll:title; cr.
s nextPutAll:'</h1>'; cr.
s nextPutAll:'<ul>'; cr.
selectors do:[:sel |
|nm|
nm := (sel copy replChar:$< withString:'<')
replChar:$> withString:'>'.
s nextPutAll:'<li><a href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOfImplementorsOf:''' , nm , '''">' , nm , '</A>';cr
].
s nextPutAll:'</ul>'; cr.
s nextPutAll:'</body>'; cr.
s nextPutAll:'</html>'; cr.
^ s contents
"Created: 22.4.1996 / 20:03:31 / cg"
"Modified: 7.9.1996 / 20:00:34 / 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|
dict := aClass methodDictionary.
dict notNil ifTrue:[
any := false.
dict do:[:aMethod |
(aCategory = aMethod category) ifTrue:[
any := true
]
].
any ifTrue:[
aStream nextPutAll:'<a name="' , aClass name , '_category_' , aCategory ,
'" href="#I_' , aClass name , '_category_' , aCategory ,
'"><b>' , aCategory , '</b></A>'; cr.
aStream nextPutAll:'<dl>'; cr.
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 nextPutAll:'<p>'; cr.
]
].
aStream nextPutAll:'</dl>'; cr.
]
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 30.4.1996 / 15:14:20 / cg"
"Modified: 5.6.1996 / 13:41:27 / stefan"
!
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"
|text comment cls sel partStream args argStream who methodSpecLine first
firstIndent firstNonEmpty isSubres isObsolete smallOrEmpty
ballColor|
who := aMethod who.
cls := who at:1.
sel := who at:2.
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 nextPutAll:'<dt>'; cr.
cls isMeta ifTrue:[
ballColor := 'yellow'
] ifFalse:[
ballColor := 'red'
].
aStream nextPutAll:'<img src="pictures/' , ballColor , '-ball' , smallOrEmpty , '.gif" width=6 height=6>'; cr.
sel := (sel copy
replChar:$< withString:'<')
replChar:$> withString:'>'.
withClassRef ifTrue:[
aStream nextPutAll:'<a name="' , cls name , '_' , sel ,
'" href="../misc/onlyInSTX2.html" action="html:',self name,' htmlDocOf:' , cls name ,
'">' , cls name , '</a> ' , methodSpecLine; cr.
] ifFalse:[
showClassName ifTrue:[
methodSpecLine := cls name , ' ' , methodSpecLine
].
aStream nextPutAll:'<a name="' , cls name , '_' , sel ,
"/ '" href="' , cls name , '_' , sel , '"' ,
'>' , methodSpecLine , '</a>'; cr.
].
aStream nextPutAll:'<dd>';cr.
(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.
].
"/ aStream nextPutAll:'<pre>'; cr.
"/ aStream spaces:((text at:2) indexOfNonSeparatorStartingAt:1).
comment asStringCollection do:[:line |
aStream nextPutAll:line; nextPutAll:'<br>'; cr.
].
"/ aStream nextPutAll:'</pre>';cr.
].
isSubres ifTrue:[
aStream nextPutAll:'<BR>'; cr.
aStream nextPutAll:'<I>** This method raises an error - it must be redefined in concrete classes **</I>'; cr.
].
isObsolete ifTrue:[
aStream nextPutAll:'<BR>'; cr.
aStream nextPutAll:'<I>** This is an obsolete interface - do not use it (it may vanish in future versions) **</I>'; cr.
].
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 26.4.1996 / 18:27:13 / cg"
!
printOutHTMLProtocolOf:aClass on:aStream
|collectionOfCategories any|
"/ self printOutDefinitionOn:aPrintStream.
collectionOfCategories := aClass class categories.
any := false.
collectionOfCategories notNil ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection sort.
aStream nextPutAll:'<h2><a name="CLASSPROTOCOL" href="#I_CLASSPROTOCOL">Class protocol:</A></h2>'; cr.
collectionOfCategories do:[:aCategory |
aCategory ~= 'documentation' ifTrue:[
self printOutHTMLCategoryProtocol:aCategory of:aClass class on:aStream.
any := true.
]
].
"/ any ifFalse:[
"/ aStream nextPutAll:'no new protocol'
"/ ].
aStream nextPutAll:'<hr>'; cr.
].
collectionOfCategories := aClass categories.
any := false.
collectionOfCategories notNil ifTrue:[
collectionOfCategories := collectionOfCategories asOrderedCollection sort.
aStream nextPutAll:'<h2><a name="INSTANCEPROTOCOL" href="#I_INSTANCEPROTOCOL">Instance protocol:</A></h2>'; cr.
collectionOfCategories do:[:aCategory |
self printOutHTMLCategoryProtocol:aCategory of:aClass on:aStream
].
"/ any ifFalse:[
"/ aStream nextPutAll:'no new protocol'
"/ ].
aStream nextPutAll:'<hr>'; cr.
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: 22.4.1996 / 20:03:30 / cg"
"Modified: 27.4.1996 / 15:05:19 / 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:[
lines add:l
].
idx := idx + 1.
].
docu removeFromIndex:srchIdx toIndex:srchIdx+lines size
].
^ lines
"Created: 25.4.1996 / 14:16:01 / cg"
"Modified: 27.4.1996 / 19:01:07 / cg"
! !
!HTMLDocGenerator class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.1 1996-09-13 09:18:17 cg Exp $'
! !