--- a/HTMLDocGenerator.st Wed Oct 15 17:39:41 2008 +0200
+++ b/HTMLDocGenerator.st Sun Oct 19 13:21:33 2008 +0200
@@ -14,7 +14,9 @@
Object subclass:#HTMLDocGenerator
instanceVariableNames:'outStream pathToTopOfDocumentation
pathToLanguageTopOfDocumentation httpRequestOrNil
- generateBodyOnly backRef backCmd imagePath'
+ generateBodyOnly backRef backCmd imagePath refLines demoLines
+ warnLines hintLines authorLines classProtocolCategories
+ instanceProtocolCategories'
classVariableNames:''
poolDictionaries:''
category:'System-Documentation'
@@ -297,6 +299,94 @@
!HTMLDocGenerator methodsFor:'document generation'!
+generateClassInfoForClass:aClass
+ |owner|
+
+ owner := aClass owningClass.
+
+ outStream nextPutLine:'<dl>'.
+ outStream nextPutLine:'<dt><a name="PACKAGE"><b>Package:</b></A>'.
+ outStream nextPutLine:'<dd><b>', aClass package , '</b>'.
+ outStream nextPutLine:'</dl>'.
+
+
+ aClass category notNil ifTrue:[
+ outStream nextPutLine:'<dl>'.
+ outStream nextPutLine:'<dt><a name="CATEGORY"><b>Category:</b></A>'.
+ outStream nextPutLine:'<dd><b>', aClass category , '</b>'.
+ outStream nextPutLine:'</dl>'.
+ ].
+
+ owner notNil ifTrue:[
+ outStream nextPutLine:'<dl>'.
+ outStream nextPutLine:'<dt><a name="OWNER"><b>Owner:</b></A>'.
+ outStream nextPutAll:'<dd><b>'.
+ self generateClassDocReferenceFor:owner name.
+ outStream cr.
+"/ outStream nextPutLine:(self
+"/ anchorForHTMLDocAction:
+"/ ('htmlDocOf:', owner name )
+"/ info:
+"/ ( 'Show documentation of ' , owner nameWithoutPrefix )
+"/ text:
+"/ owner nameWithoutPrefix).
+ outStream nextPutLine:'</b>'.
+ ] ifFalse:[
+ self htmlRevisionDocOf:aClass to:outStream.
+ ].
+ outStream nextPutLine:'</dl>'.
+
+ authorLines notNil ifTrue:[
+ outStream nextPutLine:'<dl><dt><a name="AUTHOR"><b>Author:</b></A>'.
+ authorLines do:[:l|
+ outStream nextPutLine:'<dd><b>', l , '</b>'.
+ ].
+ outStream nextPutLine:'</dl>'.
+ ].
+!
+
+generateClassProtocolDocumentationForClass:aClass
+ |metaClass shortMetaName|
+
+ classProtocolCategories notEmpty ifTrue:[
+ metaClass := aClass class.
+ shortMetaName := metaClass nameWithoutPrefix.
+
+ outStream nextPutLine:'<li><a href="#CLASSPROTOCOL" name="I_CLASSPROTOCOL">Class protocol</a>'.
+ outStream nextPutLine:'<ul>'.
+ classProtocolCategories do:[:cat |
+ outStream nextPutLine:'<li><a name="I_' , shortMetaName , '_category_' , cat , '"' ,
+ ' href="#' , shortMetaName , '_category_' , cat ,
+ '">' , cat , '</a> '.
+ ].
+ outStream nextPutLine:'</ul>'.
+ ].
+!
+
+generateDemo
+ outStream nextPutLine:'<h2><a name="DEMOSTARTUP" href="#I_DEMOSTARTUP">Demonstration:</A></h2>'.
+ demoLines do:[:l |
+ outStream nextPutLine:'<a INFO="demonstration" type="example">'.
+ outStream nextPutLine:'<pre><code>'.
+ outStream nextPutLine:' ' , l withoutSeparators.
+ outStream nextPutLine:'</code></pre>'.
+ outStream nextPutLine:'</a>'.
+ outStream nextPutLine:'<br>'.
+ ].
+!
+
+generateDescription:docu
+ docu notNil ifTrue:[
+ outStream nextPutLine:'<h2><a name="DESCRIPTION" href="#I_DESCRIPTION">Description:</A></h2>'.
+ outStream nextPutLine:'<BR>'.
+
+ outStream nextPutLine:'<pre>'.
+ outStream nextPutLine:docu.
+ outStream nextPutLine:'</pre>'.
+ self generateHorizontalLine.
+ ].
+!
+
generateExampleEnd
outStream nextPutLine:'</code></pre>'.
self generatingForSTXBrowser ifTrue:[
@@ -344,45 +434,123 @@
self generateHorizontalLine.
!
-generatePrivateClassInfoFor:aClass with:privateClasses on:aStream
- |s|
-
- s := aStream.
-
- s nextPutLine:'<pre>'.
- privateClasses do:[:cls |
- |nm fullName|
-
- nm := cls nameWithoutPrefix.
- fullName := cls name.
- s nextPutAll:' '.
- (cls owningClass isLoaded not
- or:[cls owningClass wasAutoloaded]) ifTrue:[
- self
- generateClassDocReferenceFor:fullName
- text:nm
- autoloading:(cls owningClass name)
- ] ifFalse:[
- self
- generateClassDocReferenceFor:fullName
- text:nm.
+generateInheritanceTreeForClass:aClass
+ |indent first supers subs|
+
+ supers := aClass allSuperclasses.
+ (aClass == Autoload or:[aClass == Object]) ifTrue:[
+ subs := #()
+ ] ifFalse:[
+ subs := self shownSubclassesOf:aClass.
+ ].
+
+ outStream nextPutLine:'<h2><a name="INHERITANCE" href="#I_INHERITANCE">Inheritance:</A></h2>'.
+ outStream nextPutLine:'<pre>'.
+ indent := 3.
+ first := true.
+ (supers size > 0) ifTrue:[
+ supers reverseDo:[:cls |
+ |className|
+
+ className := cls name.
+ first ifFalse:[
+ outStream spaces:indent; nextPutLine:'|'.
+ outStream spaces:indent; nextPutAll:'+--'.
+ indent := indent + 3.
+ ] ifTrue:[
+ outStream spaces:indent
].
- s cr.
+ first := false.
+
+ self generateClassDocReferenceFor:className.
+ outStream cr.
+ ].
+ outStream spaces:indent; nextPutLine:'|'.
+ outStream spaces:indent.
+ outStream nextPutAll:'+--<B>'; nextPutAll:aClass name; nextPutLine:'</B>'.
+ indent := indent + 3.
+ ] ifFalse:[
+ outStream spaces:indent; nextPutLine:'nil'.
+ outStream spaces:indent; nextPutLine:'|'.
+ outStream spaces:indent; nextPutAll:'+--<B>'; nextPutAll:aClass name; nextPutLine:'</B>'.
+ aClass ~~ Object ifTrue:[
+ outStream cr.
+ outStream nextPutLine:' <B>This class inherits NOTHING - most messages will lead into doesNotUnderstand:</B>'
].
- s nextPutLine:'</pre>'.
+ indent := indent + 3.
+ ].
+
+ subs notEmpty ifTrue:[
+ subs do:[:aSubclass |
+ |className|
+
+ className := aSubclass name.
+ outStream spaces:indent; nextPutLine:'|'.
+ outStream spaces:indent; nextPutAll:'+--'.
+ self generateClassDocReferenceFor:className.
+ outStream cr.
+ ]
+ ] ifFalse:[
+ aClass == Object ifTrue:[
+ outStream spaces:indent; nextPutLine:'|'.
+ outStream spaces:indent; nextPutLine:'+-- ... almost every other class ...'
+ ]
+ ].
+
+ outStream nextPutLine:'</pre>'.
!
-generateRefLineFor:ref forClass:aClass on:aStream
+generateInstanceProtocolDocumentationForClass:aClass
+ |shortName|
+
+ shortName := aClass nameWithoutPrefix.
+ instanceProtocolCategories notEmpty ifTrue:[
+ outStream nextPutLine:'<li><a href="#INSTANCEPROTOCOL" name="I_INSTANCEPROTOCOL">Instance protocol</a>'.
+ outStream nextPutLine:'<ul>'.
+ instanceProtocolCategories do:[:cat |
+ outStream nextPutLine:'<li><a name="I_' , shortName , '_category_' , cat , '"' ,
+ ' href="#' , shortName , '_category_' , cat ,
+ '">' , cat , '</a> '.
+ ].
+ outStream nextPutLine:'</ul>'.
+ ].
+!
+
+generatePrivateClassInfoForClass:aClass withPrivateClasses:privateClasses
+ outStream nextPutLine:'<pre>'.
+ privateClasses do:[:cls |
+ |nm fullName|
+
+ nm := cls nameWithoutPrefix.
+ fullName := cls name.
+ outStream nextPutAll:' '.
+ (cls owningClass isLoaded not
+ or:[cls owningClass wasAutoloaded]) ifTrue:[
+ self
+ generateClassDocReferenceFor:fullName
+ text:nm
+ autoloading:(cls owningClass name)
+ ] ifFalse:[
+ self
+ generateClassDocReferenceFor:fullName
+ text:nm.
+ ].
+ outStream cr.
+ ].
+ outStream nextPutLine:'</pre>'.
+!
+
+generateRefLineFor:ref forClass:aClass
|idx1 idx2 realRef ns nm href|
- aStream nextPutAll:' '.
+ outStream nextPutAll:' '.
idx1 := ref indexOf:$:.
idx2 := ref indexOf:$: startingAt:idx1+1.
(idx1 == 0 or:[idx2 == (idx1+1)]) ifTrue:[
(ref includesMatchCharacters) ifTrue:[
- aStream nextPutAll:(self
+ outStream nextPutAll:(self
anchorForHTMLDocAction:
('htmlClassesMatching:''' , ref , ''' backTo:nil')
info:
@@ -405,7 +573,7 @@
].
(ref startsWith:'http:') ifTrue:[
- aStream nextPutAll:'<a href="' , ref , '"><I>' , ref , '</I></a>'.
+ outStream nextPutAll:'<a href="' , ref , '"><I>' , ref , '</I></a>'.
^ self.
].
@@ -413,48 +581,46 @@
href := (ref copyFrom:(ref indexOf:$:)+1 to:(ref size - 1)) withoutSpaces.
(href startsWith:'man:') ifTrue:[
href := (href copyFrom:5) withoutSpaces.
- aStream nextPutAll:'<a INFO="Show manual page" href="' , self pathToTopOfDocumentation , '/misc/onlyInSTX2.html" action="html:' , self class name , ' manPageFor:''' , href , '''">[<I>' , nm , '</I>]</A>'.
+ outStream nextPutAll:'<a INFO="Show manual page" href="' , self pathToTopOfDocumentation , '/misc/onlyInSTX2.html" action="html:' , self class name , ' manPageFor:''' , href , '''">[<I>' , nm , '</I>]</A>'.
^ self.
].
(href startsWith:'http:') ifTrue:[
- aStream nextPutAll:'<a href="' , href , '">[<I>' , nm , '</I>]</a>'.
+ outStream nextPutAll:'<a href="' , href , '">[<I>' , nm , '</I>]</a>'.
^ self
].
(href startsWith:'html:') ifTrue:[
href := (href copyFrom:6) withoutSpaces.
].
- aStream nextPutAll:'<a href="' , (self pathToDocumentationFile:href) , '">[<I>' , nm , '</I>]</a>'.
+ outStream nextPutAll:'<a href="' , (self pathToDocumentationFile:href) , '">[<I>' , nm , '</I>]</a>'.
!
-generateRefLines:refLines forClass:aClass on:aStream
- aStream nextPutLine:'<pre>'.
+generateRefLines:refLines forClass:aClass
+ outStream nextPutLine:'<pre>'.
refLines do:[:l |
l isString ifTrue:[
- self generateRefLineFor:l forClass:aClass on:aStream.
- aStream cr.
+ self generateRefLineFor:l forClass:aClass.
+ outStream cr.
] ifFalse:[
l do:[:ref |
- self generateRefLineFor:ref forClass:aClass on:aStream.
- aStream cr.
+ self generateRefLineFor:ref forClass:aClass.
+ outStream cr.
].
].
].
- aStream nextPutLine:'</pre>'.
+ outStream nextPutLine:'</pre>'.
!
-generateSubclassInfoFor:aClass on:aStream
- |s subs|
-
- s := aStream.
+generateSubclassInfoForClass:aClass
+ |subs|
subs := self shownSubclassesOf:aClass.
- s nextPutLine:'<pre>'.
+ outStream nextPutLine:'<pre>'.
subs do:[:cls |
|nm|
nm := cls name.
- s nextPutAll:' '.
+ outStream nextPutAll:' '.
cls isLoaded ifFalse:[
self
generateClassDocReferenceFor:nm
@@ -463,312 +629,13 @@
] ifTrue:[
self generateClassDocReferenceFor:nm.
].
- s cr.
+ outStream cr.
].
- s nextPutLine:'</pre>'.
+ outStream nextPutLine:'</pre>'.
"Modified: / 05-11-2007 / 17:22:43 / cg"
!
-htmlClassCategoryList
- "generate a formatted list of all available class categories as
- an HTML string. Each category will be a hyperlink to another
- autogenerated page, containing the classes per category.
- The generated page is supposed to be given to an HTML reader
- with home being set to ../doc/online/xxx/classDoc
- (i.e. the images are to be found one-up in the doc hierarchy)"
-
- |categories s prefixList prefix prefixStack prev|
-
- categories := Smalltalk allClassCategories asOrderedCollection sort.
-
- outStream := s := '' writeStream.
-
- self generateHTMLHeadWithTitle:'Class Categories:'.
-
- self generateBODYStart.
-
- self generateUpArrowButtonForTop.
- self generateHorizontalLine.
- self generateH1:'Class Categories:'.
- s nextPutLine:'<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 includes:$-) ifTrue:[
- prefixList add:(common copyTo:(common lastIndexOf:$-)-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 |
- |prefixWithDash|
-
- prefixWithDash := prefix , '-'.
- nm = prefix ifTrue:[
- maxPrefix
- ] ifFalse:[
- (nm startsWith:prefixWithDash)
- ifTrue:[
- prefixWithDash size > maxPrefix size
- ifTrue:[
- prefixWithDash
- ] 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 copyFrom:prefix size + 1).
- ].
- 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>'.
- s nextPutLine:(self
- anchorForHTMLDocAction:
- ('htmlClassesListOfCategory:''', nm
- , ''' backTo:''htmlClassCategoryList''')
- info:
- ('Classes in ' , nm)
- text:
- (nm copyFrom:prefix size + 1)).
-
- prev := nm.
- ].
-
- s nextPutAll:'
-</ul>
-'.
- self generateBODYandHTMLEnd.
-
- ^ s contents
-
- "
- HTMLDocGenerator new htmlClassCategoryList
- "
-
- "Created: / 22.4.1996 / 20:03:30 / cg"
- "Modified: / 30.10.1997 / 13:16:08 / cg"
-!
-
-htmlClassListPrefix:prefix
- "generate an HTML document string which contains HREFS for a list
- of classes which start with some prefix (typically, the first
- character is given)"
-
- |classes|
-
- classes := Smalltalk allClasses
- select:[:cls |
- cls isPrivate not
- and:[(cls isRealNameSpace not)
- and:[cls name startsWith:prefix]]
- ].
-
- ^ self
- htmlClasses:classes
- title:('Classes starting with ''' , prefix asString , ''':').
-
- "Created: / 22-04-1996 / 20:03:31 / cg"
- "Modified: / 10-11-2006 / 17:11:16 / cg"
-!
-
-htmlClasses:classes title:title
- "generate an HTML document string which contains HREFS for a given list
- of classes"
-
- ^ self
- htmlClasses:classes
- title:title
- backTo:nil
-
- "Modified: / 30.10.1997 / 13:21:40 / cg"
-!
-
-htmlClasses:classes title:title backTo:backRef
- "generate an HTML document string which contains HREFS for a given list
- of classes. If backref is nonNil, a back-button to that
- HREF is added at the top.
- The generated page is supposed to be given to an HTML reader
- with home being set to ../doc/online/xxx/classDoc
- (i.e. the images are to be found one-up in the doc hierarchy)"
-
- |classNames s|
-
- classNames := (classes collect:[:cls | cls name]) asOrderedCollection sort.
-
- outStream := s := '' writeStream.
-
- self generateHTMLHeadWithTitle:title.
- s nextPutLine:'<body>'.
- backRef notNil ifTrue:[
- backRef ~~ #none ifTrue:[
- self
- generateUpArrowButtonWithReference:(self pathToLanguageTopOfDocumentation , '/TOP.html')
- command:backRef
- imagePath:nil
- altLabel:'back'.
- ]
- ] ifFalse:[
- self
- generateUpArrowButtonWithReference:(self pathToLanguageTopOfDocumentation , '/TOP.html')
- command:nil
- imagePath:nil
- altLabel:'top'.
- ].
- backRef ~~ #none ifTrue:[
- self generateHorizontalLine.
- ].
- self generateH1:title.
- s nextPutLine:'<ul>'.
-
- classNames do:[:className |
- s nextPutAll:'<li>'.
- self generateClassDocReferenceFor:className.
- s cr.
- ].
-
- s nextPutAll:'
-</ul>
-'.
- self generateBODYandHTMLEnd.
-
- ^ s contents
-
- "Created: / 23.4.1996 / 15:31:55 / cg"
- "Modified: / 30.10.1997 / 13:21:32 / cg"
-!
-
-htmlClassesListOfCategory:category
- "generate an HTML document string which contains HREFS for a list
- of classes which are contained in a particular category."
-
- ^ self
- htmlClassesListOfCategory:category
- backTo:nil
-
- "Modified: / 30.10.1997 / 13:21:23 / cg"
-!
-
-htmlClassesListOfCategory:category backTo:backRef
- "generate an HTML document string which contains HREFS for a list
- of classes which are contained in a particular category."
-
- |classes|
-
- classes := Smalltalk allClasses
- select:[:cls | cls isPrivate not
- and:[(cls isRealNameSpace not)
- and:[cls category = category]]
- ].
-
- ^ self
- htmlClasses:classes
- title:('Classes in: ' , category)
- backTo:backRef
-
- "Created: / 23-04-1996 / 15:39:39 / cg"
- "Modified: / 10-11-2006 / 17:11:23 / cg"
-!
-
-htmlClassesMatching:aMatchPattern backTo:backRef
- "generate an HTML document string which contains HREFS
- for a list of classes whose name matches a given matchPattern."
-
- |classes cls|
-
- classes := Smalltalk allClasses
- select:[:cls | cls isPrivate not
- and:[(cls isRealNameSpace not)
- and:[aMatchPattern match:cls name]]
- ].
-
- ^ self
- htmlClasses:classes
- title:('Classes matching: ' , aMatchPattern)
- backTo:backRef
-
- "
- self htmlClassesMatching:'Tgen::*' backTo:nil
- "
-
- "Modified: / 10-11-2006 / 17:11:30 / cg"
-!
-
htmlDocOf:aClass
"generate an HTML document string which contains a classes documentation"
@@ -844,9 +711,8 @@
everything else is plain documentation text.
"
- |supers s indent m docu examples firstIndent firstNonEmpty
- collectionOfCategories collectionOfClassCategories subs refLines demoLines warnLines hintLines authorLines first wasLoaded didLoadBin
- privateClasses owner className metaClass shortName shortMetaName|
+ |docu examples wasLoaded didLoadBin
+ privateClasses owner shortName |
backRef := backRefArg.
backCmd := backCmdArg.
@@ -856,23 +722,21 @@
^ '' "/ just in case ...
].
- outStream := s := '' writeStream.
- className := aClass name.
+ outStream := '' writeStream.
shortName := aClass nameWithoutPrefix.
- metaClass := aClass class.
- shortMetaName := metaClass nameWithoutPrefix.
-
- self generateHTMLHeadWithTitle:('Class: ' , className).
+
+ self generateHTMLHeadWithTitle:('Class: ' , aClass name).
self generateBODYStart.
self generateBackButton.
(aClass isRealNameSpace) ifTrue:[
- s nextPutLine:'<h1>'.
- s nextPutAll:'NameSpace: ';
- nextPutLine:(shortName).
- s nextPutLine:'</h1>'.
+ outStream
+ nextPutLine:'<h1>';
+ nextPutAll:'NameSpace: ';
+ nextPutLine:(shortName);
+ nextPutLine:'</h1>'.
self generateBODYandHTMLEnd.
- ^ s contents.
+ ^ outStream contents.
].
(wasLoaded := aClass isLoaded) ifFalse:[
@@ -893,409 +757,132 @@
owner := aClass owningClass.
privateClasses := aClass privateClassesSorted.
- "/
- "/ 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 := self withSpecialHTMLCharactersEscaped:docu.
- 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.
- ].
-
- docu notEmpty ifTrue:[
- "/
- "/ strip off empty lines
- "/
- [docu notEmpty and:[(docu at:1) size == 0]] whileTrue:[
- docu removeIndex:1
- ].
- [docu notEmpty and:[(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:[
- t := l asCollectionOfWords.
- (t size == 1
- and:[ (t first includes:$:) not ]) ifTrue:[
- t first
- ] ifFalse:[
- t
- ]
- ]
- ].
- ].
-
- "/
- "/ 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 := self withSpecialHTMLCharactersEscaped:examples.
- 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 asSortedCollection.
- collectionOfClassCategories size > 0 ifTrue:[
- collectionOfClassCategories := collectionOfClassCategories asOrderedCollection.
- collectionOfClassCategories remove:'documentation' ifAbsent:nil.
- ].
- collectionOfCategories := aClass categories asSortedCollection.
- collectionOfCategories size > 0 ifTrue:[
- collectionOfCategories := collectionOfCategories asOrderedCollection.
- ].
-
- (aClass == Autoload or:[aClass == Object]) ifTrue:[
- subs := #()
- ] ifFalse:[
- subs := self shownSubclassesOf:aClass.
- ].
-
- s nextPutLine:'<h1>'.
- s nextPutAll:'Class: '.
+ docu := self extractDocumentationFromClass:aClass.
+ "/ refLines, demoLines etc. are generated as a side effect.
+
+ examples := self extractExamplesFromClass:aClass.
+
+ self extractProtocolCategoriesFrom:aClass.
+
+ outStream nextPutLine:'<h1>'.
+ outStream nextPutAll:'Class: '.
self generatingForSTXBrowser ifTrue:[
- s nextPutAll:'<a INFO="Open a Browser on ' , shortName , '" type="example" action="Smalltalk browseInClass:' , className , '">';
- nextPutAll:shortName; nextPutLine:'</a>'.
+ outStream
+ nextPutAll:'<a INFO="Open a Browser on ' , shortName , '" type="example" action="Smalltalk browseInClass:' , aClass name , '">';
+ nextPutAll:shortName; nextPutLine:'</a>'.
] ifFalse:[
- s nextPutAll:shortName.
+ outStream nextPutAll:shortName.
].
owner notNil ifTrue:[
- s nextPutAll:' (private in '.
+ outStream nextPutAll:' (private in '.
self generatingForSTXBrowser ifTrue:[
- s nextPutAll:'<a INFO="Open a Browser on ' , owner nameWithoutPrefix , '" type="example" action="Smalltalk browseInClass:' , owner name , '">';
- nextPutAll:(owner nameWithoutPrefix); nextPutLine:'</a>)'.
+ outStream
+ nextPutAll:'<a INFO="Open a Browser on ' , owner nameWithoutPrefix , '" type="example" action="Smalltalk browseInClass:' , owner name , '">';
+ nextPutAll:(owner nameWithoutPrefix); nextPutLine:'</a>)'.
] ifFalse:[
- s nextPutAll:owner nameWithoutPrefix.
+ outStream nextPutAll:owner nameWithoutPrefix.
].
] ifFalse:[
aClass nameSpace ~~ Smalltalk ifTrue:[
- s nextPutAll:' (in ' , aClass nameSpace name , ')'
+ outStream nextPutAll:' (in ' , aClass nameSpace name , ')'
]
].
- s nextPutLine:'</h1>'.
+ outStream nextPutLine:'</h1>'.
owner notNil ifTrue:[
- s nextPutLine:'This class is only visible from within'.
- s nextPutAll:owner nameWithoutPrefix.
+ outStream nextPutLine:'This class is only visible from within'.
+ outStream nextPutAll:owner nameWithoutPrefix.
owner owningClass notNil ifTrue:[
- s nextPutAll:' (which is itself a private class of '.
- s nextPutAll:owner owningClass nameWithoutPrefix.
- s nextPutAll:')'
+ outStream nextPutAll:' (which is itself a private class of '.
+ outStream nextPutAll:owner owningClass nameWithoutPrefix.
+ outStream nextPutAll:')'
].
- s nextPutLine:'.'
+ outStream nextPutLine:'.'
].
"/
"/ index
"/
"/ s nextPutAll:'Index:'; cr.
- s nextPutLine:'<ul>'.
- s nextPutLine:'<li><a href="#INHERITANCE" name="I_INHERITANCE">Inheritance</a>'.
+ outStream nextPutLine:'<ul>'.
+ outStream nextPutLine:'<li><a href="#INHERITANCE" name="I_INHERITANCE">Inheritance</a>'.
docu notNil ifTrue:[
- s nextPutLine:'<li><a href="#DESCRIPTION" name="I_DESCRIPTION">Description</a>'.
+ outStream 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>'.
+ warnLines notEmptyOrNil ifTrue:[
+ outStream 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>'.
+ hintLines notEmptyOrNil ifTrue:[
+ outStream 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>'.
+ outStream 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:[
+ self generateClassProtocolDocumentationForClass:aClass.
+ self generateInstanceProtocolDocumentationForClass:aClass.
+
+ privateClasses notEmptyOrNil ifTrue:[
privateClasses := privateClasses asOrderedCollection sort:[:a :b | a nameWithoutPrefix < b nameWithoutPrefix].
- s nextPutLine:'<li><a href="#PRIVATECLASSES" name="I_PRIVATECLASSES">Private classes</a>'.
+ outStream 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>'.
+ outStream nextPutLine:'<li><a href="#SUBCLASSES" name="I_SUBCLASSES">Subclasses</a>'.
].
demoLines notNil ifTrue:[
- s nextPutLine:'<li><a href="#DEMOSTARTUP" name="I_DEMOSTARTUP">Demonstration</a>'.
+ outStream nextPutLine:'<li><a href="#DEMOSTARTUP" name="I_DEMOSTARTUP">Demonstration</a>'.
].
examples notNil ifTrue:[
- s nextPutLine:'<li><a href="#EXAMPLES" name="I_EXAMPLES">Examples</a>'.
+ outStream nextPutLine:'<li><a href="#EXAMPLES" name="I_EXAMPLES">Examples</a>'.
].
- s nextPutLine:'</ul>'.
+ outStream nextPutLine:'</ul>'.
self generateHorizontalLine.
"/
"/ hierarchy
"/
- s nextPutLine:'<h2><a name="INHERITANCE" href="#I_INHERITANCE">Inheritance:</A></h2>'.
- s nextPutLine:'<pre>'.
- indent := 3.
- first := true.
- supers := aClass allSuperclasses.
- (supers size > 0) ifTrue:[
- supers reverseDo:[:cls |
- |className|
-
- className := cls name.
- first ifFalse:[
- s spaces:indent; nextPutLine:'|'.
- s spaces:indent; nextPutAll:'+--'.
- indent := indent + 3.
- ] ifTrue:[
- s spaces:indent
- ].
- first := false.
-
- self generateClassDocReferenceFor:className.
- s cr.
- ].
- 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 |
- |className|
-
- className := aSubclass name.
- s spaces:indent; nextPutLine:'|'.
- s spaces:indent; nextPutAll:'+--'.
- self generateClassDocReferenceFor:className.
- s cr.
- ]
- ] ifFalse:[
- aClass == Object ifTrue:[
- s spaces:indent; nextPutLine:'|'.
- s spaces:indent; nextPutLine:'+-- ... almost every other class ...'
- ]
- ].
-
-
- s nextPutLine:'</pre>'.
+ self generateInheritanceTreeForClass:aClass.
self generateHorizontalLine.
"/
"/ category, version & package
"/
- aClass category notNil ifTrue:[
- 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>'.
- self generateClassDocReferenceFor:owner name.
- s cr.
-"/ s nextPutLine:(self
-"/ anchorForHTMLDocAction:
-"/ ('htmlDocOf:', owner name )
-"/ info:
-"/ ( 'Show documentation of ' , owner nameWithoutPrefix )
-"/ text:
-"/ owner nameWithoutPrefix).
- s 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>'.
- ].
-
+ self generateClassInfoForClass:aClass.
self generateHorizontalLine.
- 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>'.
- self generateHorizontalLine.
- ].
+ self generateDescription:docu.
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.
-
+ outStream nextPutLine:'<h2><a name="WARNING" href="#I_WARNING">Warning:</A></h2>'.
+ outStream nextPutLine:'<BR>'.
+
+ outStream nextPutLine:'<pre>'.
+
+ warnLines := self undentedToFirstLinesIndent:warnLines.
warnLines do:[:aLine |
- aLine leftIndent >= firstIndent ifTrue:[
- s nextPutLine:(aLine copyFrom:firstIndent+1)
- ] ifFalse:[
- s nextPutLine:aLine
- ].
+ outStream nextPutLine:aLine
].
- s nextPutLine:'</pre>'.
+ outStream nextPutLine:'</pre>'.
self generateHorizontalLine.
].
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.
+ outStream nextPutLine:'<h2><a name="HINTS" href="#I_HINTS">Hints:</A></h2>'.
+ outStream nextPutLine:'<BR>'.
+
+ outStream nextPutLine:'<pre>'.
+ hintLines := self undentedToFirstLinesIndent:hintLines.
hintLines do:[:aLine |
- aLine leftIndent >= firstIndent ifTrue:[
- s nextPutLine:(aLine copyFrom:firstIndent+1)
- ] ifFalse:[
- s nextPutLine:aLine
- ].
+ outStream nextPutLine:aLine
].
- s nextPutLine:'</pre>'.
+ outStream nextPutLine:'</pre>'.
self generateHorizontalLine.
].
@@ -1303,8 +890,8 @@
"/ see also
"/
refLines notNil ifTrue:[
- s nextPutLine:'<h2><a name="SEEALSO" href="#I_SEEALSO">Related information:</A></h2>'.
- self generateRefLines:refLines forClass:aClass on:s.
+ outStream nextPutLine:'<h2><a name="SEEALSO" href="#I_SEEALSO">Related information:</A></h2>'.
+ self generateRefLines:refLines forClass:aClass.
self generateHorizontalLine.
].
@@ -1317,45 +904,33 @@
"/
"/ protocol
"/
- self printOutHTMLProtocolOf:aClass on:s.
+ self printOutHTMLProtocolOf:aClass on:outStream.
"/
"/ subclasses (only for Object and Autoload)
"/
(aClass == Object or:[aClass == Autoload]) ifTrue:[
- s nextPutLine:'<h2><a name="SUBCLASSES" href="#I_SUBCLASSES">Subclasses (direct subclasses only):</A></h2>'.
- self generateSubclassInfoFor:aClass on:s.
+ outStream nextPutLine:'<h2><a name="SUBCLASSES" href="#I_SUBCLASSES">Subclasses (direct subclasses only):</A></h2>'.
+ self generateSubclassInfoForClass:aClass.
self generateHorizontalLine.
].
"/
"/ private classes
"/
- privateClasses size > 0 ifTrue:[
- s nextPutLine:'<h2><a name="PRIVATECLASSES" href="#I_PRIVATECLASSES">Private classes:</A></h2>'.
- self generatePrivateClassInfoFor:aClass with:privateClasses on:s.
+ privateClasses notEmptyOrNil ifTrue:[
+ outStream nextPutLine:'<h2><a name="PRIVATECLASSES" href="#I_PRIVATECLASSES">Private classes:</A></h2>'.
+ self generatePrivateClassInfoForClass:aClass withPrivateClasses:privateClasses.
self generateHorizontalLine.
].
- "/
- "/ demonstration
- "/
+ "/ demonstration, if there are any
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:'<pre><code>'.
- s nextPutLine:' ' , l withoutSeparators.
- s nextPutLine:'</code></pre>'.
- s nextPutLine:'</a>'.
- s nextPutLine:'<br>'.
- ].
+ self generateDemo.
self generateHorizontalLine.
].
- "/
- "/ add examples if there are any
- "/
+ "/ examples, if there are any
examples notNil ifTrue:[
self generateExamples:examples.
].
@@ -1366,7 +941,7 @@
aClass unload
].
- ^ s contents
+ ^ outStream contents
"
self htmlDocOf:Object
@@ -1484,131 +1059,184 @@
self generateBODYandHTMLEnd.
^ s contents
-!
-
-htmlSelectorList
- "generate an HTML string for all selectors (for which methods exist)
- in the system"
-
- |selectors|
-
- selectors := IdentitySet new.
- Smalltalk allClassesAndMetaclassesDo:[:cls |
- selectors addAll:cls selectors.
- ].
- selectors := selectors asOrderedCollection sort.
-
- ^ self
- htmlSelectors:selectors
- title:('All Selectors:').
-
- "
- self htmlSelectorList
- "
-
- "Created: / 22.4.1996 / 20:03:31 / cg"
- "Modified: / 5.6.1996 / 12:27:09 / stefan"
- "Modified: / 30.10.1997 / 13:25:19 / cg"
-!
-
-htmlSelectorListMatching:pattern
- "generate an HTML string for all selectors which match a pattern
- (and for which methods exist) in the system"
-
- |selectors|
-
- selectors := IdentitySet new.
- Smalltalk allClassesAndMetaclassesDo:[: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*'
- "
-
- "Created: / 22.4.1996 / 20:03:31 / cg"
- "Modified: / 5.6.1996 / 12:29:27 / stefan"
- "Modified: / 30.10.1997 / 13:25:50 / cg"
-!
-
-htmlSelectorListPrefix:prefix
- "generate an HTML string for all selectors whose names starts with
- a prefix (and for which methods exist) in the system"
-
- |selectors|
-
- selectors := IdentitySet new.
- Smalltalk allClassesAndMetaclassesDo:[: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'
- "
-
- "Created: / 22.4.1996 / 20:03:31 / cg"
- "Modified: / 5.6.1996 / 12:31:13 / stefan"
- "Modified: / 30.10.1997 / 13:26:15 / cg"
-!
-
-htmlSelectors:selectors title:title
- "generate an HTML string for a given list of selectors"
-
- |s|
-
- s := outStream := '' writeStream.
-
- self generateHTMLHeadWithTitle:title.
- self generateBODYStart.
-
- self generateUpArrowButtonForTop.
- self generateHorizontalLine.
- self generateH1:title.
- s nextPutLine:'<ul>'.
-
- selectors do:[:sel |
- |selString|
-
- selString := self withSpecialHTMLCharactersEscaped:sel.
- s nextPutAll:'<li>'.
- s nextPutLine:(self
- anchorForHTMLDocAction:
- ('htmlDocOfImplementorsOf:''' , selString , '''' )
- info:
- ('Implementors of: ' , selString)
- text:
- selString).
- ].
-
- s nextPutLine:'</ul>'.
- self generateBODYandHTMLEnd.
-
- ^ s contents
-
- "Created: / 22.4.1996 / 20:03:31 / cg"
- "Modified: / 30.10.1997 / 13:26:34 / cg"
! !
!HTMLDocGenerator methodsFor:'document generation-helpers'!
+extractAndRemoveSpecial: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.
+ Attention: docu is sideeffectively changed (lines removed)"
+
+ |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"
+!
+
+extractAndRemoveSpecialLinesFromDocumentation:docu
+ "Extract things like [see also:], [author:] etc. from docu
+ If found, remove the lines from the string collection,
+ and leave them in corresponding instVars.
+ Attention: docu is sideeffectively changed (lines removed)"
+
+ "/
+ "/ search for a [see also:] section
+ "/
+ refLines := self extractAndRemoveSpecial:'[see also:]' from:docu.
+ refLines notNil ifTrue:[
+ "/ care for the special tuple format
+ refLines := refLines collect:[:l |
+ |t|
+
+ ((t := l withoutSeparators) startsWith:'(') ifTrue:[
+ t
+ ] ifFalse:[
+ t := l asCollectionOfWords.
+ (t size == 1
+ and:[ (t first includes:$:) not ]) ifTrue:[
+ t first
+ ] ifFalse:[
+ t
+ ]
+ ]
+ ].
+ ].
+
+
+ "/
+ "/ search for a [start with:] section
+ "/
+ demoLines := self extractAndRemoveSpecial:'[start with:]' from:docu.
+
+ "/
+ "/ search for a [author:] section
+ "/
+ authorLines := self extractAndRemoveSpecial:'[author:]' from:docu.
+ authorLines isNil ifTrue:[
+ authorLines := self extractAndRemoveSpecial:'[authors:]' from:docu.
+ ].
+
+ "/
+ "/ search for a [warning:] section
+ "/
+ warnLines := self extractAndRemoveSpecial:'[warning:]' from:docu.
+ warnLines notNil ifTrue:[
+ warnLines := warnLines asStringCollection.
+ ].
+
+ "/
+ "/ search for a [hints:] section
+ "/
+ hintLines := self extractAndRemoveSpecial:'[hints:]' from:docu.
+ hintLines isNil ifTrue:[
+ hintLines := self extractAndRemoveSpecial:'[hint:]' from:docu.
+ ].
+ hintLines notNil ifTrue:[
+ hintLines := hintLines asStringCollection.
+ ].
+!
+
+extractDocumentationFromClass:aClass
+ |documentationMethod docu|
+
+ documentationMethod := aClass theMetaclass compiledMethodAt:#documentation.
+ documentationMethod notNil ifTrue:[
+ docu := documentationMethod comment.
+ ] ifFalse:[
+ "try comment"
+ docu := aClass theNonMetaclass comment.
+ ].
+ docu isEmptyOrNil ifTrue:[ ^ nil ].
+
+ docu := self withSpecialHTMLCharactersEscaped:docu.
+ docu := docu asStringCollection.
+
+ self extractAndRemoveSpecialLinesFromDocumentation:docu.
+
+ docu notEmpty ifTrue:[
+ "/
+ "/ strip off empty lines
+ "/
+ [docu notEmpty and:[ docu first size == 0]] whileTrue:[
+ docu removeFirst
+ ].
+ [docu notEmpty and:[ docu last size == 0]] whileTrue:[
+ docu removeLast
+ ].
+ ].
+
+ docu notEmpty ifTrue:[
+ docu := self undentedToFirstLinesIndent:docu.
+ ].
+ docu := docu asString.
+ ^ docu
+!
+
+extractExamplesFromClass:aClass
+ |m examples|
+
+ m := aClass theMetaclass compiledMethodAt:#examples.
+ m isNil ifTrue:[ ^ nil].
+
+ examples := m comment.
+ examples isEmptyOrNil ifTrue:[ ^ nil].
+
+ examples := self withSpecialHTMLCharactersEscaped:examples.
+ 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 isEmpty ifTrue:[ ^ nil].
+
+ examples := self undentedToFirstLinesIndent:examples.
+ ^ examples
+!
+
+extractProtocolCategoriesFrom:aClass
+ classProtocolCategories := aClass theMetaclass categories asSortedCollection.
+ classProtocolCategories notEmpty ifTrue:[
+ classProtocolCategories := classProtocolCategories asSortedCollection.
+ classProtocolCategories remove:'documentation' ifAbsent:nil.
+ ].
+ instanceProtocolCategories := aClass theNonMetaclass categories asSortedCollection.
+ instanceProtocolCategories notEmpty ifTrue:[
+ instanceProtocolCategories := instanceProtocolCategories asSortedCollection.
+ ].
+!
+
htmlForMethod:aMethod
|who sel partStream args argStream methodSpecLine|
@@ -1996,6 +1624,454 @@
"Created: / 22.4.1996 / 20:03:30 / cg"
"Modified: / 25.11.1998 / 12:40:59 / cg"
+!
+
+undentedToFirstLinesIndent:someText
+ |undentedText firstIndent firstNonEmpty|
+
+ firstIndent := someText first withTabsExpanded leftIndent.
+ firstIndent > 0 ifTrue:[
+ undentedText := someText collect:[:line |
+ |l|
+
+ l := line withTabsExpanded.
+ l leftIndent >= firstIndent ifTrue:[
+ l copyFrom:firstIndent + 1.
+ ] ifFalse:[
+ l
+ ]
+ ].
+ ] ifFalse:[
+ undentedText := someText
+ ].
+
+ firstNonEmpty := undentedText findFirst:[:line | line notEmpty].
+ firstNonEmpty > 1 ifTrue:[
+ undentedText := undentedText copyFrom:firstNonEmpty
+ ].
+ ^ undentedText
+! !
+
+!HTMLDocGenerator methodsFor:'document generation-lists'!
+
+htmlClassCategoryList
+ "generate a formatted list of all available class categories as
+ an HTML string. Each category will be a hyperlink to another
+ autogenerated page, containing the classes per category.
+ The generated page is supposed to be given to an HTML reader
+ with home being set to ../doc/online/xxx/classDoc
+ (i.e. the images are to be found one-up in the doc hierarchy)"
+
+ |categories s prefixList prefix prefixStack prev|
+
+ categories := Smalltalk allClassCategories asOrderedCollection sort.
+
+ outStream := s := '' writeStream.
+
+ self generateHTMLHeadWithTitle:'Class Categories:'.
+
+ self generateBODYStart.
+
+ self generateUpArrowButtonForTop.
+ self generateHorizontalLine.
+ self generateH1:'Class Categories:'.
+ s nextPutLine:'<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 includes:$-) ifTrue:[
+ prefixList add:(common copyTo:(common lastIndexOf:$-)-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 |
+ |prefixWithDash|
+
+ prefixWithDash := prefix , '-'.
+ nm = prefix ifTrue:[
+ maxPrefix
+ ] ifFalse:[
+ (nm startsWith:prefixWithDash)
+ ifTrue:[
+ prefixWithDash size > maxPrefix size
+ ifTrue:[
+ prefixWithDash
+ ] 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 copyFrom:prefix size + 1).
+ ].
+ 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>'.
+ s nextPutLine:(self
+ anchorForHTMLDocAction:
+ ('htmlClassesListOfCategory:''', nm
+ , ''' backTo:''htmlClassCategoryList''')
+ info:
+ ('Classes in ' , nm)
+ text:
+ (nm copyFrom:prefix size + 1)).
+
+ prev := nm.
+ ].
+
+ s nextPutAll:'
+</ul>
+'.
+ self generateBODYandHTMLEnd.
+
+ ^ s contents
+
+ "
+ HTMLDocGenerator new htmlClassCategoryList
+ "
+
+ "Created: / 22.4.1996 / 20:03:30 / cg"
+ "Modified: / 30.10.1997 / 13:16:08 / cg"
+!
+
+htmlClassListPrefix:prefix
+ "generate an HTML document string which contains HREFS for a list
+ of classes which start with some prefix (typically, the first
+ character is given)"
+
+ |classes|
+
+ classes := Smalltalk allClasses
+ select:[:cls |
+ cls isPrivate not
+ and:[(cls isRealNameSpace not)
+ and:[cls name startsWith:prefix]]
+ ].
+
+ ^ self
+ htmlClasses:classes
+ title:('Classes starting with ''' , prefix asString , ''':').
+
+ "Created: / 22-04-1996 / 20:03:31 / cg"
+ "Modified: / 10-11-2006 / 17:11:16 / cg"
+!
+
+htmlClasses:classes title:title
+ "generate an HTML document string which contains HREFS for a given list
+ of classes"
+
+ ^ self
+ htmlClasses:classes
+ title:title
+ backTo:nil
+
+ "Modified: / 30.10.1997 / 13:21:40 / cg"
+!
+
+htmlClasses:classes title:title backTo:backRef
+ "generate an HTML document string which contains HREFS for a given list
+ of classes. If backref is nonNil, a back-button to that
+ HREF is added at the top.
+ The generated page is supposed to be given to an HTML reader
+ with home being set to ../doc/online/xxx/classDoc
+ (i.e. the images are to be found one-up in the doc hierarchy)"
+
+ |classNames s|
+
+ classNames := (classes collect:[:cls | cls name]) asOrderedCollection sort.
+
+ outStream := s := '' writeStream.
+
+ self generateHTMLHeadWithTitle:title.
+ s nextPutLine:'<body>'.
+ backRef notNil ifTrue:[
+ backRef ~~ #none ifTrue:[
+ self
+ generateUpArrowButtonWithReference:(self pathToLanguageTopOfDocumentation , '/TOP.html')
+ command:backRef
+ imagePath:nil
+ altLabel:'back'.
+ ]
+ ] ifFalse:[
+ self
+ generateUpArrowButtonWithReference:(self pathToLanguageTopOfDocumentation , '/TOP.html')
+ command:nil
+ imagePath:nil
+ altLabel:'top'.
+ ].
+ backRef ~~ #none ifTrue:[
+ self generateHorizontalLine.
+ ].
+ self generateH1:title.
+ s nextPutLine:'<ul>'.
+
+ classNames do:[:className |
+ s nextPutAll:'<li>'.
+ self generateClassDocReferenceFor:className.
+ s cr.
+ ].
+
+ s nextPutAll:'
+</ul>
+'.
+ self generateBODYandHTMLEnd.
+
+ ^ s contents
+
+ "Created: / 23.4.1996 / 15:31:55 / cg"
+ "Modified: / 30.10.1997 / 13:21:32 / cg"
+!
+
+htmlClassesListOfCategory:category
+ "generate an HTML document string which contains HREFS for a list
+ of classes which are contained in a particular category."
+
+ ^ self
+ htmlClassesListOfCategory:category
+ backTo:nil
+
+ "Modified: / 30.10.1997 / 13:21:23 / cg"
+!
+
+htmlClassesListOfCategory:category backTo:backRef
+ "generate an HTML document string which contains HREFS for a list
+ of classes which are contained in a particular category."
+
+ |classes|
+
+ classes := Smalltalk allClasses
+ select:[:cls | cls isPrivate not
+ and:[(cls isRealNameSpace not)
+ and:[cls category = category]]
+ ].
+
+ ^ self
+ htmlClasses:classes
+ title:('Classes in: ' , category)
+ backTo:backRef
+
+ "Created: / 23-04-1996 / 15:39:39 / cg"
+ "Modified: / 10-11-2006 / 17:11:23 / cg"
+!
+
+htmlClassesMatching:aMatchPattern backTo:backRef
+ "generate an HTML document string which contains HREFS
+ for a list of classes whose name matches a given matchPattern."
+
+ |classes cls|
+
+ classes := Smalltalk allClasses
+ select:[:cls | cls isPrivate not
+ and:[(cls isRealNameSpace not)
+ and:[aMatchPattern match:cls name]]
+ ].
+
+ ^ self
+ htmlClasses:classes
+ title:('Classes matching: ' , aMatchPattern)
+ backTo:backRef
+
+ "
+ self htmlClassesMatching:'Tgen::*' backTo:nil
+ "
+
+ "Modified: / 10-11-2006 / 17:11:30 / cg"
+!
+
+htmlSelectorList
+ "generate an HTML string for all selectors (for which methods exist)
+ in the system"
+
+ |selectors|
+
+ selectors := IdentitySet new.
+ Smalltalk allClassesAndMetaclassesDo:[:cls |
+ selectors addAll:cls selectors.
+ ].
+ selectors := selectors asOrderedCollection sort.
+
+ ^ self
+ htmlSelectors:selectors
+ title:('All Selectors:').
+
+ "
+ self htmlSelectorList
+ "
+
+ "Created: / 22.4.1996 / 20:03:31 / cg"
+ "Modified: / 5.6.1996 / 12:27:09 / stefan"
+ "Modified: / 30.10.1997 / 13:25:19 / cg"
+!
+
+htmlSelectorListMatching:pattern
+ "generate an HTML string for all selectors which match a pattern
+ (and for which methods exist) in the system"
+
+ |selectors|
+
+ selectors := IdentitySet new.
+ Smalltalk allClassesAndMetaclassesDo:[: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*'
+ "
+
+ "Created: / 22.4.1996 / 20:03:31 / cg"
+ "Modified: / 5.6.1996 / 12:29:27 / stefan"
+ "Modified: / 30.10.1997 / 13:25:50 / cg"
+!
+
+htmlSelectorListPrefix:prefix
+ "generate an HTML string for all selectors whose names starts with
+ a prefix (and for which methods exist) in the system"
+
+ |selectors|
+
+ selectors := IdentitySet new.
+ Smalltalk allClassesAndMetaclassesDo:[: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'
+ "
+
+ "Created: / 22.4.1996 / 20:03:31 / cg"
+ "Modified: / 5.6.1996 / 12:31:13 / stefan"
+ "Modified: / 30.10.1997 / 13:26:15 / cg"
+!
+
+htmlSelectors:selectors title:title
+ "generate an HTML string for a given list of selectors"
+
+ |s|
+
+ s := outStream := '' writeStream.
+
+ self generateHTMLHeadWithTitle:title.
+ self generateBODYStart.
+
+ self generateUpArrowButtonForTop.
+ self generateHorizontalLine.
+ self generateH1:title.
+ s nextPutLine:'<ul>'.
+
+ selectors do:[:sel |
+ |selString|
+
+ selString := self withSpecialHTMLCharactersEscaped:sel.
+ s nextPutAll:'<li>'.
+ s nextPutLine:(self
+ anchorForHTMLDocAction:
+ ('htmlDocOfImplementorsOf:''' , selString , '''' )
+ info:
+ ('Implementors of: ' , selString)
+ text:
+ selString).
+ ].
+
+ s nextPutLine:'</ul>'.
+ self generateBODYandHTMLEnd.
+
+ ^ s contents
+
+ "Created: / 22.4.1996 / 20:03:31 / cg"
+ "Modified: / 30.10.1997 / 13:26:34 / cg"
! !
!HTMLDocGenerator methodsFor:'format conversion-man pages'!
@@ -2240,40 +2316,6 @@
"
!
-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"
-!
-
generateBODYEnd
generateBodyOnly == true ifFalse:[
outStream nextPutLine:'</body>'.
@@ -2552,5 +2594,5 @@
!HTMLDocGenerator class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.84 2008-07-11 09:44:46 sr Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.85 2008-10-19 11:21:33 cg Exp $'
! !