"
COPYRIGHT (c) 1996 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libhtml' }"
Object subclass:#HTMLDocGenerator
instanceVariableNames:'outStream pathToTopOfDocumentation
pathToLanguageTopOfDocumentation httpRequestOrNil
generateBodyOnly backRef backCmd imagePath'
classVariableNames:''
poolDictionaries:''
category:'System-Documentation'
!
!HTMLDocGenerator class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1996 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Generates HTML documentation for a class.
Although this is normally used with the SystemBrowser
(classes-generate documentation menu),
it may be useful on its own, to programatically generate
up-to-date documents from a classes source.
This generator extracts the documentation methods source
(or comment), individual method comments (the first comment in
a method) and version information to generate a neatly formatted
HTML page.
If executable examples (EXBEGIN .. EXEND) are present in the classes
documentation category these are also added as executable code
to the document.
[author:]
Claus Gittinger
[see also:]
BrowserView
HTMLDocumentView
"
! !
!HTMLDocGenerator class methodsFor:'document generation'!
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)"
^ self new htmlClassCategoryList
"
HTMLDocGenerator htmlClassCategoryList
"
!
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)"
^ self new htmlClassListPrefix:prefix
"
HTMLDocGenerator htmlClassListPrefix:'A'
"
!
htmlClassesListOfCategory:aCategory backTo:backMessage
"generate an HTML document string which contains HREFS for a list
of classes which are contained in a particular category."
^ self new htmlClassesListOfCategory:aCategory backTo:backMessage
!
htmlDocOf:aClass
"generate an HTML document string which contains a classes documentation"
^ self new htmlDocOf:aClass
"
HTMLDocGenerator htmlDocOf:Array
"
!
htmlDocOf:aClass back:backCmd backRef:backRef imagePath:imagePath
"generate a nice HTML page from a class, with a back-reference
to a command or document."
^ self new htmlDocOf:aClass back:backCmd backRef:backRef imagePath:imagePath
!
htmlDocOf:aClass backRef:backRef
"generate an HTML document string which contains a classes documentation"
^ self new htmlDocOf:aClass backRef:backRef
!
htmlDocOfImplementorsOf:selector
"generate an HTML document string which contains HREFS
to all implementors of a particular selector"
^ self new htmlDocOfImplementorsOf:selector
"
HTMLDocGenerator htmlDocOfImplementorsOf:#at:
"
!
htmlSelectorList
"generate an HTML string for all selectors (for which methods exist)
in the system"
^ self new htmlSelectorList
"
HTMLDocGenerator htmlSelectorList
"
!
htmlSelectorListMatching:prefix
"generate an HTML string for all selectors which match a pattern
(and for which methods exist) in the system"
^ self new htmlSelectorListMatching:prefix
!
htmlSelectorListPrefix:prefix
"generate an HTML string for all selectors whose names starts with
a prefix (and for which methods exist) in the system"
^ self new htmlSelectorListPrefix:prefix
"
HTMLDocGenerator htmlSelectorListPrefix:'a'
"
!
manPageFor:aCommandName
"generate a (unix-) man page for a given command & convert the output to html"
^ self new manPageFor:aCommandName
"
HTMLDocGenerator manPageFor:'ls'
HTMLDocumentView openFullOnText:(HTMLDocGenerator manPageFor:'ls')
"
!
manPageFor:aManPageTemplateFile manCommand:nroffCommand
"convert man-command output to html.
Only the body of the text (without head../head and body../body) is generated"
^ self new manPageFor:aManPageTemplateFile manCommand:nroffCommand
"
HTMLDocGenerator
manPageForFile:'/usr/man/man2/open.2'
manCommand:'nroff -man /usr/man/man2/open.2'
"
!
manPageForFile:aManPageTemplateFile
"convert a .man file to html"
^ self new manPageForFile:aManPageTemplateFile
"
HTMLDocGenerator manPageForFile:'/usr/man/man2/open.2'
HTMLDocumentView openFullOnText:(HTMLDocGenerator manPageForFile:'../../stc/stc.1')
"
! !
!HTMLDocGenerator class methodsFor:'pathnames'!
languageSpecificDocDirectory
|lang|
lang := Smalltalk language.
"XXX Kludge for now, map ISO-639 abbreviations to dir names.
Should rename the directories"
lang == #en ifTrue:[
^ 'english'.
].
lang == #de ifTrue:[
^ 'german'.
].
lang == #fr ifTrue:[
^ 'french'.
].
lang == #it ifTrue:[
^ 'italian'.
].
lang == #jp ifTrue:[
^ 'japanese'.
].
^ 'english'.
"
self languageSpecificDocDirectory
"
! !
!HTMLDocGenerator methodsFor:'accessing'!
generateBodyOnly:something
"set the value of the instance variable 'generateBodyOnly' (automatically generated)"
generateBodyOnly := something.
!
httpRequest:aRequest
httpRequestOrNil := aRequest.
!
pathToLanguageTopOfDocumentation:something
"set the value of the instance variable 'pathToLanguageTopOfDocumentation' (automatically generated)"
pathToLanguageTopOfDocumentation := something.
!
pathToTopOfDocumentation:something
"set the value of the instance variable 'pathToTopOfDocumentation' (automatically generated)"
pathToTopOfDocumentation := something.
! !
!HTMLDocGenerator methodsFor:'document generation'!
generateExampleEnd
self generatingForSTXBrowser ifFalse:[
outStream nextPutLine:'</font>'.
^ self
].
outStream nextPutLine:'</a>'.
!
generateExampleStart
self generatingForSTXBrowser ifFalse:[
outStream nextPutLine:'<font color=#7F0000>'.
^ self
].
outStream nextPutLine:'<a INFO="execute the example" type="example" showresult>'.
!
generateExamples:examples
|inExample|
inExample := false.
outStream nextPutLine:'<h2><a name="EXAMPLES" href="#I_EXAMPLES">Examples:</A></h2>'.
outStream nextPutLine:'<BR>'.
outStream nextPutLine:'<code><pre>'.
examples do:[:line |
line withoutSeparators = '[exBegin]' ifTrue:[
inExample ifTrue:[
self generateExampleEnd.
].
self generateExampleStart.
inExample := true.
] ifFalse:[
line withoutSeparators = '[exEnd]' ifTrue:[
inExample ifTrue:[
self generateExampleEnd.
].
inExample := false.
] ifFalse:[
outStream nextPutLine:line
]
].
].
inExample ifTrue:[
self generateExampleEnd.
].
outStream nextPutLine:'</pre></code>'.
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.
].
].
s nextPutLine:'</pre>'.
!
generateRefLines:refLines forClass:aClass on:aStream
|s|
s := aStream.
s nextPutLine:'<pre>'.
refLines do:[:l |
|nm href|
l isString ifTrue:[
s nextPutAll:' '.
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 manual page" href="' , self pathToTopOfDocumentation , '/misc/onlyInSTX2.html" action="html:' , self class name , ' manPageFor:''' , href , '''">[<I>' , nm , '</I>]</A>'.
] ifFalse:[
(href startsWith:'html:') ifTrue:[
href := (href copyFrom:6) withoutSpaces.
].
s nextPutAll:'<a href="' , (self pathToDocumentationFile:href) , '">[<I>' , nm , '</I>]</a>'.
].
s cr.
] ifFalse:[
l do:[:ref |
|realRef ns|
s nextPutAll:' '.
(ref includesMatchCharacters) ifTrue:[
s nextPutAll:(self
anchorForHTMLDocAction:
('htmlClassesMatching:''' , ref , ''' backTo:nil')
info:
( 'Show documentation of ' , ref )
text:
ref).
] ifFalse:[
realRef := ref.
(ns := aClass nameSpace) notNil ifTrue:[
ns isNameSpace ifTrue:[
(ns at:realRef asSymbol) notNil ifTrue:[
realRef := ns name , '::' , realRef
]
] ifFalse:[
]
].
self generateClassDocReferenceFor:realRef text:ref.
].
s cr.
].
].
].
s nextPutLine:'</pre>'.
!
generateSubclassInfoFor:aClass on:aStream
|s subs|
s := aStream.
subs := aClass subclasses
asOrderedCollection sort:[:a :b | a name < b name].
s nextPutLine:'<pre>'.
subs do:[:cls |
|nm|
nm := cls name.
s nextPutAll:' '.
cls isLoaded ifFalse:[
self
generateClassDocReferenceFor:nm
text:nm
autoloading:nm
] ifTrue:[
self generateClassDocReferenceFor:nm.
].
].
s nextPutLine:'</pre>'.
!
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 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: / 30.10.1997 / 13:21:49 / 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 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 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: / 30.10.1997 / 13:21:16 / 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 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: / 30.10.1997 / 13:21:06 / cg"
!
htmlDocOf:aClass
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass back:nil backRef:nil
"
self htmlDocOf:PostscriptPrinterStream
"
"Modified: / 30.10.1997 / 13:22:19 / cg"
!
htmlDocOf:aClass back:backCmd
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass back:backCmd backRef:nil
"Modified: / 30.10.1997 / 13:22:27 / 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.
Also 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.
"
^ self
htmlDocOf:aClass
back:backCmd
backRef:backRef
imagePath:(self pathToTopOfDocumentation , '/icons')
!
htmlDocOf:aClass back:backCmdArg backRef:backRefArg imagePath:imagePathArg
"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.
Also 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 subs refLines demoLines warnLines hintLines authorLines first wasLoaded didLoadBin
privateClasses owner className metaClass shortName shortMetaName|
backRef := backRefArg.
backCmd := backCmdArg.
imagePath := imagePathArg.
aClass isNil ifTrue:[
^ '' "/ just in case ...
].
outStream := s := '' writeStream.
className := aClass name.
shortName := aClass nameWithoutPrefix.
metaClass := aClass class.
shortMetaName := metaClass nameWithoutPrefix.
self generateHTMLHeadWithTitle:('Class: ' , className).
self generateBODYStart.
self generateBackButton.
aClass isNameSpace ifTrue:[
s nextPutLine:'<h1>'.
s nextPutAll:'NameSpace: ';
nextPutLine:(shortName).
s nextPutLine:'</h1>'.
self generateBODYandHTMLEnd.
^ s contents.
].
(wasLoaded := aClass isLoaded) ifFalse:[
"/ load it - but not a binary
didLoadBin := Smalltalk loadBinaries.
Smalltalk loadBinaries:false.
[
Autoload autoloadFailedSignal handle:[:ex |
^ 'Autoload of ' , aClass name , ' failed - no documentation available.'
] do:[
aClass autoload.
].
] ensure:[
didLoadBin ifTrue:[Smalltalk loadBinaries:true].
].
].
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:[
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 := 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 := aClass subclasses
asOrderedCollection sort:[:a :b | a name < b name].
].
s nextPutLine:'<h1>'.
s nextPutAll:'Class: ';
nextPutAll:'<a INFO="Open a Browser on ' , shortName , '" type="example" action="Smalltalk browseInClass:' , className , '">';
nextPutAll:(shortName); nextPutLine:'</a>'.
owner notNil ifTrue:[
s nextPutAll:' (private in ';
nextPutAll:'<a INFO="Open a Browser on ' , owner nameWithoutPrefix , '" type="example" action="Smalltalk browseInClass:' , 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 nextPutAll:owner nameWithoutPrefix.
owner owningClass notNil ifTrue:[
s nextPutAll:' (which is itself a private class of '.
s nextPutAll:owner owningClass nameWithoutPrefix.
s nextPutAll:')'
].
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>'.
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 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.
]
] ifFalse:[
aClass == Object ifTrue:[
s spaces:indent; nextPutLine:'|'.
s spaces:indent; nextPutLine:'+-- ... almost every other class ...'
]
].
s nextPutLine:'</pre>'.
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 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 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.
].
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>'.
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.
hintLines do:[:aLine |
aLine leftIndent >= firstIndent ifTrue:[
s nextPutLine:(aLine copyFrom:firstIndent+1)
] ifFalse:[
s nextPutLine:aLine
].
].
s nextPutLine:'</pre>'.
self generateHorizontalLine.
].
"/
"/ 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.
self generateHorizontalLine.
].
"/
"/ inst & classVars
"/ to be added
"/
"/ protocol
"/
self printOutHTMLProtocolOf:aClass on:s.
"/
"/ 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.
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.
self generateHorizontalLine.
].
"/
"/ 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>'.
].
self generateHorizontalLine.
].
"/
"/ add examples if there are any
"/
examples notNil ifTrue:[
self generateExamples:examples.
].
self generateBODYandHTMLEnd.
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: / 25.11.1998 / 12:40:51 / cg"
!
htmlDocOf:aClass backRef:backRef
"generate an HTML document string which contains a classes documentation"
^ self htmlDocOf:aClass back:nil backRef:backRef
"Created: / 24.4.1996 / 15:03:25 / cg"
"Modified: / 30.10.1997 / 13:23:12 / cg"
!
htmlDocOfImplementorsOf:selector
"generate an HTML document string which contains HREFS
to all implementors of a particular selector"
|sel s classes|
sel := self withSpecialHTMLCharactersEscaped:selector.
outStream := s := '' writeStream.
self generateHTMLHeadWithTitle:('Implementations of: ' , sel).
self generateBODYStart.
self generateUpArrowButtonForTop.
self generateHorizontalLine.
self generateH1:sel.
s nextPutLine:'<dl>'.
classes := IdentitySet new.
sel := selector asSymbol.
Smalltalk allClassesAndMetaclassesDo:[:cls |
cls isPrivate ifFalse:[
(cls includesSelector:sel) ifTrue:[
classes add:cls
]
]
].
(classes asOrderedCollection sort:[:a :b | a name < b name])
do:[:cls |
self
printOutHTMLMethodProtocol:(cls compiledMethodAt:sel)
on:s
showClassName:true
classRef:true.
s nextPutLine:'<p>'.
].
s nextPutLine:'</dl>'.
self generateBODYandHTMLEnd.
^ s contents
"Created: / 22.4.1996 / 20:03:31 / cg"
"Modified: / 30.10.1998 / 22:15: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:'document generation-helpers'!
htmlRevisionDocOf:aClass to:s
"extract a classes versionInfo and return an HTML document string
for that."
|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: / 30.10.1997 / 13:24:39 / cg"
!
printOutHTMLCategoryProtocol:aCategory of:aClass on:aStream
"append documentation on each method in a particular methodCategory
of the given class in HTML onto 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:[
Error 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.10.1997 / 13:27:58 / 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"
^ self
printOutHTMLMethodProtocol:aMethod
on:aStream
showClassName:showClassName
classRef:withClassRef
picturePath:'/pictures'
!
printOutHTMLMethodProtocol:aMethod on:aStream showClassName:showClassName classRef:withClassRef picturePath:picturePath
"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
firstIndent firstNonEmpty isSubres isObsolete smallOrEmpty
ballColor anchorName|
who := aMethod who.
cls := who methodClass.
sel := who methodSelector.
partStream := sel keywords readStream.
(args := aMethod methodArgNames) notNil ifTrue:[
argStream := aMethod methodArgNames readStream.
methodSpecLine := ''.
1 to:sel numArgs do:[:index |
methodSpecLine size > 0 ifTrue:[
methodSpecLine := methodSpecLine , ' '
].
methodSpecLine := methodSpecLine , '<B>' , partStream next , '</B>'.
methodSpecLine := methodSpecLine , ' <I>' , argStream next , '</I>'.
].
] ifFalse:[
methodSpecLine := '<B>' , partStream next , '</B>'
].
"/ use string-asSymbol (instead of the obvious symbol itself)
"/ in the checks below, to avoid tricking myself,
"/ when the documentation on this method is generated
"/ (otherwise, I'll say that this method is both
"/ a subres and and obsolete method ...)
isSubres := (aMethod sends:'subclassResponsibility' asSymbol).
isObsolete := false.
((aMethod sends:'obsoleteMethodWarning' asSymbol)
or:[(aMethod sends:'obsoleteMethodWarning:' asSymbol)
or:[(aMethod sends:'obsoleteMethodWarning:from:' asSymbol)]]) 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="' , picturePath , '/' , ballColor , '-ball' , smallOrEmpty , '.gif" alt="o " width=6 height=6>'.
sel := self withSpecialHTMLCharactersEscaped:sel.
anchorName := cls name , '_' , sel.
withClassRef ifTrue:[
aStream nextPutAll:(self
anchorForHTMLDocAction:
('htmlDocOf:', cls theNonMetaclass name )
info:
('Show documentation of ' , cls theNonMetaclass name )
text:
cls name
name:anchorName).
aStream nextPutLine:' ' , methodSpecLine.
] ifFalse:[
showClassName ifTrue:[
methodSpecLine := cls name , ' ' , methodSpecLine
].
aStream nextPutLine:'<a name="' , anchorName , '" ' ,
"/ 'href="' , cls name , '_' , sel , '"' ,
'>' , methodSpecLine , '</a>'.
].
aStream nextPutLine:'<DD>'.
(comment := self methodCommentOf:aMethod) notNil ifTrue:[
comment := self withSpecialHTMLCharactersEscaped:comment.
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:'<I>';
nextPutAll:line;
"/ nextPutAll:'</I>';
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: / 30.10.1997 / 13:09:45 / cg"
!
printOutHTMLProtocolOf:aClass on:aStream
"append documentation of the given class in HTML onto aStream."
|collectionOfCategories any|
"/ self printOutDefinitionOn:aPrintStream.
collectionOfCategories := aClass class categories asSortedCollection.
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'
"/ ].
self generateHorizontalLine.
]
].
collectionOfCategories := aClass categories asSortedCollection.
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'
"/ ].
self generateHorizontalLine.
]
"
self printOutHTMLProtocolOf:Float on:Stdout
"
"Created: / 22.4.1996 / 20:03:30 / cg"
"Modified: / 25.11.1998 / 12:40:59 / cg"
! !
!HTMLDocGenerator methodsFor:'format conversion-man pages'!
manPageFor:aCommand
"generate a (unix-) man page for a given command & convert the output to html"
^ self
manPageFor:aCommand
inSection:nil
"Modified: / 30.10.1997 / 13:29:31 / cg"
!
manPageFor:aCommand inSection:sectionOrNil
"generate a (unix-) man page for some entry in a section
& convert the 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: / 30.10.1997 / 13:29:44 / cg"
!
manPageFor:aCommand manCommand:manCommand
"convert man-command output to html.
Only the body of the text (without head../head and body../body) is generated"
|manPageStream text|
manPageStream := PipeStream readingFrom:manCommand.
manPageStream notNil ifTrue:[
[
text := self manPageFromStream:manPageStream.
] ensure:[
manPageStream shutDown.
]
].
text isEmptyOrNil ifTrue:[
^ self noManPageForCommand:aCommand usingManCommand:manCommand.
].
^ '<pre>
' , text , '
</pre>
'
"
self manPageFor:'cvs'
"
"Modified: / 28.6.1996 / 21:28:47 / stefan"
"Created: / 9.9.1996 / 17:43:16 / cg"
"Modified: / 30.10.1997 / 13:30:22 / cg"
!
manPageForFile:aFilename
"convert a .man file to html"
^ self
manPageFor:aFilename asFilename name
manCommand:('nroff -man ' , aFilename asFilename pathName).
"
self manPageForFile:'../../stc/stc.1'
"
"
HTMLDocumentView openFullOnText:(self manPageForFile:'../../stc/stc.1')
"
"Modified: 4.4.1997 / 10:44:05 / cg"
!
manPageFromStream:manPageStream
"convert man-command output to html.
Only the body of the text (without head../head and body../body) is generated.
This method looks for
char-backspace-char -> bold
char-backspace-underline -> italic"
|state ch keep|
outStream := '' writeStream.
state := nil.
keep := nil.
[manPageStream atEnd] whileFalse:[
ch := manPageStream next.
ch notNil ifTrue:[
state == nil ifTrue:[
ch == Character backspace ifTrue:[
state := #back
] ifFalse:[
keep notNil ifTrue:[
self nextPutAllEscaped:keep.
].
keep := ch
]
] ifFalse:[
state == #back ifTrue:[
ch == keep ifTrue:[
self nextPutBold:ch.
] ifFalse:[
ch == $_ ifTrue:[
keep notNil ifTrue:[
self nextPutItalic:keep.
].
] ifFalse:[
keep == $_ ifTrue:[
self nextPutItalic:ch.
] ifFalse:[
keep notNil ifTrue:[
self nextPutAllEscaped:keep.
self nextPutAllEscaped:ch.
].
].
].
].
state := keep := nil.
]
]
]
].
keep notNil ifTrue:[
self nextPutAllEscaped:keep.
].
^ outStream contents.
"
HTMLDocGenerator new manPageFor:'cvs'
"
!
noManPageForCommand:aCommand usingManCommand:manCommand
^ '
No manual page for "<CODE><B>' , aCommand , '</B></CODE>" available.
<BR>
(The failed command was: "<CODE>' , manCommand , '"</CODE>.)
'.
! !
!HTMLDocGenerator methodsFor:'helpers'!
anchorFor:href info:infoMessageOrNil text:text name:nameOrNil
|infoPart namePart|
infoPart := namePart := ''.
infoMessageOrNil notNil ifTrue:[
infoPart := 'INFO="' , infoMessageOrNil , '" '.
].
nameOrNil notNil ifTrue:[
namePart := 'NAME="' , nameOrNil , '" '.
].
^ '<A HREF="' , href , '" '
, namePart
, infoPart
, '>' , text
,'</A>'.
"
self new anchorFor:'foo' info:'bla' text:'text' name:nil
"
!
anchorForHTMLAction:actionString info:infoMessageOrNil text:text
^ self
anchorForHTMLAction:actionString
info:infoMessageOrNil
text:text
name:nil
"
self new anchorForHTMLAction:'foo' info:'bla' text:'text'
"
!
anchorForHTMLAction:actionString info:infoMessageOrNil text:text name:nameOrNil
|infoPart namePart|
infoPart := namePart := ''.
infoMessageOrNil notNil ifTrue:[
infoPart := 'INFO="' , infoMessageOrNil , '" '.
].
nameOrNil notNil ifTrue:[
namePart := 'NAME="' , nameOrNil , '" '.
].
^ '<A HREF="' , self pathToTopOfDocumentation , '/misc/onlyInSTX2.html" '
, namePart
, infoPart
, 'ACTION="html:'
, actionString
, '">' , text
,'</A>'.
"
self new anchorForHTMLAction:'foo' info:'bla' text:'text'
"
!
anchorForHTMLDocAction:actionString info:infoMessageOrNil text:text
^ self
anchorForHTMLDocAction:actionString
info:infoMessageOrNil
text:text
name:nil
"
self new anchorForHTMLDocAction:'foo' info:'bla' text:'text'
"
!
anchorForHTMLDocAction:actionString info:infoMessageOrNil text:text name:anchorName
^ self
anchorForHTMLAction:(self class name , ' ' , actionString)
info:infoMessageOrNil
text:text
name:anchorName
"
self new anchorForHTMLDocAction:'foo' info:'bla' text:'text' name:'baz'
"
!
anchorForHTMLDocAction:actionString text:text
^ self anchorForHTMLDocAction:actionString info:nil text:text
"
self new anchorForHTMLDocAction:'foo' text:'text'
"
!
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>'.
]
!
generateBODYStart
generateBodyOnly == true ifFalse:[
outStream nextPutLine:'<body>'.
]
!
generateBODYandHTMLEnd
self generateBODYEnd.
self generateHTMLEnd.
!
generateBackButton
|backHRef backLabel|
backRef isNil ifTrue:[
backHRef := self pathToLanguageTopOfDocumentation , '/TOP.html'.
backLabel := 'top'.
] ifFalse:[
backHRef := backRef.
backLabel := 'back'.
].
backCmd notNil ifTrue:[
self
generateUpArrowButtonWithReference:backHRef
command:backCmd
imagePath:imagePath
altLabel:backLabel.
self generateHorizontalLine.
] ifFalse:[
backHRef ~~ #none ifTrue:[
self
generateUpArrowButtonWithReference:backHRef
command:nil
imagePath:imagePath
altLabel:backLabel.
self generateHorizontalLine.
]
].
!
generateClassDocReferenceFor:className
self generateClassDocReferenceFor:className text:className
!
generateClassDocReferenceFor:className text:text
|href serviceLinkName|
self generatingForSTXBrowser ifFalse:[
httpRequestOrNil notNil ifTrue:[
serviceLinkName := httpRequestOrNil serviceLinkName.
].
href := self
anchorFor:(serviceLinkName, '/classDocOf,', (HTTPRequest escape:className) )
info:('Show documentation of ' , className )
text:text
name:nil
] ifTrue:[
href := self
anchorForHTMLDocAction:
('htmlDocOf:', className )
info:
('Show documentation of ' , className )
text:
text.
].
outStream nextPutLine:href.
!
generateClassDocReferenceFor:className text:text autoloading:autoloadedClass
|href serviceLinkName|
self generatingForSTXBrowser ifFalse:[
httpRequestOrNil notNil ifTrue:[
serviceLinkName := httpRequestOrNil serviceLinkName.
].
href := self
anchorFor:(serviceLinkName, '/classDocOf,', className )
info:('Show documentation of ' , className )
text:text
name:nil
] ifTrue:[
href := self
anchorForHTMLAction:
(autoloadedClass , ' autoload,', self class name , ' htmlDocOf:' , className )
info:
('Show documentation of ' , className )
text:
text.
].
outStream nextPutLine:href.
!
generateH1:headerLine
outStream nextPutLine:'<h1>'.
outStream nextPutLine:headerLine.
outStream nextPutLine:'</h1>'.
!
generateHTMLEnd
generateBodyOnly == true ifFalse:[
outStream nextPutLine:'</html>'
]
!
generateHTMLHeadWithTitle:title
generateBodyOnly == true ifFalse:[
outStream
nextPutLine:'<!!DOCTYPE html PUBLIC "-//w3c//dtd html 4.0 transitional//en">';
nextPutLine:('<!!-- generated by ' , self class name , ' ' , thisContext sender selector , ' -->');
cr;
nextPutLine:'<html>';
nextPutLine:'<head>';
nextPutLine:'<title>';
nextPutLine:title;
nextPutLine:'</title>';
nextPutLine:'</head>';
cr.
] ifTrue:[
outStream
nextPutLine:('<!!-- generated by ' , self class name , ' ' , thisContext sender selector , ' -->')
].
!
generateHorizontalLine
outStream nextPutLine:'<hr>'.
!
generateUpArrowButtonForTop
self
generateUpArrowButtonWithReference:(self pathToLanguageTopOfDocumentation , '/TOP.html')
command:nil
imagePath:nil
altLabel:'top'
!
generateUpArrowButtonWithReference:backHRef command:backCmd imagePath:imagePath altLabel:altLabel
|p|
outStream nextPutAll:'<a NOPRINT HREF="' , backHRef , '"'.
backCmd notNil ifTrue:[
outStream nextPutAll:' action="html:' , self class name , ' ' , backCmd , '"'.
].
p := imagePath.
p isNil ifTrue:[
p := self pathToTopOfDocumentation , '/icons'
].
outStream nextPutLine:'> <IMG NOPRINT SRC="' , p , '/DocsUpArrow.gif" ALT="[' , (altLabel ? 'back') , ']"></A>'.
!
generatingForSTXBrowser
^ httpRequestOrNil isNil
!
methodCommentOf:aMethod
|comment mClass mSel parseTree matcher|
comment := aMethod comment.
comment notNil ifTrue:[^ comment].
mClass := aMethod mclass.
mClass isNil ifTrue:[^ nil].
mSel := aMethod selector.
mSel isNil ifTrue:[^ nil].
"/ generate a comment if its a getter, setter or similar
ParseTreeSearcher notNil ifTrue:[
(mClass allInstanceVariableNames) do:[:eachVar |
parseTree := mClass parseTreeFor:mSel.
parseTree notNil ifTrue: [
matcher := ParseTreeSearcher getterMethod:eachVar.
(matcher executeTree: parseTree) notNil ifTrue:[
^ 'Return the instance variable ' , eachVar, '.'.
].
].
parseTree := mClass parseTreeFor:mSel.
parseTree notNil ifTrue: [
matcher := ParseTreeSearcher setterMethod:eachVar.
(matcher executeTree: parseTree) notNil ifTrue:[
^ 'Set the instance variable ' , eachVar, '.'.
].
].
].
].
"/ (mSuperClass := mClass superclass) notNil ifTrue:[
"/self halt.
"/ ].
^ nil.
!
nextPutAllEscaped:aStringOrCharacter
outStream nextPutAll:(self withSpecialHTMLCharactersEscaped:aStringOrCharacter)
!
nextPutBold:aStringOrCharacter
outStream nextPutAll:'<b>'.
self nextPutAllEscaped:aStringOrCharacter.
outStream nextPutAll:'</b>'.
!
nextPutItalic:aStringOrCharacter
outStream nextPutAll:'<i>'.
self nextPutAllEscaped:aStringOrCharacter.
outStream nextPutAll:'</i>'.
!
withSpecialHTMLCharactersEscaped:aStringOrCharacter
^ HTTPServer withSpecialHTMLCharactersEscaped:aStringOrCharacter
"
self new withSpecialHTMLCharactersEscaped:'foo>'
self new withSpecialHTMLCharactersEscaped:$<
self new withSpecialHTMLCharactersEscaped:$A
"
! !
!HTMLDocGenerator methodsFor:'pathnames'!
findPathToTopOfDocumentation
#(
'../../doc/online'
'doc/online'
'/opt/stx/doc/online'
) do:[:eachPathToTry |
(eachPathToTry asFilename exists
and:[eachPathToTry asFilename isDirectory])
ifTrue:[
^ eachPathToTry
]
].
^ '.'
!
pathToDocumentationFile:relativeHref
|top|
top := self pathToLanguageTopOfDocumentation.
(top asFilename construct:relativeHref) exists ifTrue:[
"unix format: used as URL"
^ top , '/' , relativeHref
].
^ self pathToEnglishTopOfDocumentation , '/' , relativeHref
!
pathToEnglishTopOfDocumentation
"/ always unix-name convention (used as an URL)
^ self pathToTopOfDocumentation , '/english'
!
pathToLanguageTopOfDocumentation
|languageSpecificDocDirectory fn|
pathToLanguageTopOfDocumentation isNil ifTrue:[
pathToLanguageTopOfDocumentation := self pathToTopOfDocumentation.
languageSpecificDocDirectory := self class languageSpecificDocDirectory.
fn := pathToLanguageTopOfDocumentation asFilename construct:languageSpecificDocDirectory.
(fn exists and:[fn isDirectory]) ifTrue:[
"/ always unix-name convention (used as an URL)
pathToLanguageTopOfDocumentation := pathToLanguageTopOfDocumentation , '/' , languageSpecificDocDirectory.
].
].
^ pathToLanguageTopOfDocumentation
!
pathToTopOfDocumentation
pathToTopOfDocumentation isNil ifTrue:[
pathToTopOfDocumentation := self findPathToTopOfDocumentation
].
^ pathToTopOfDocumentation
! !
!HTMLDocGenerator class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.61 2003-09-30 08:26:44 penk Exp $'
! !